加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

delphi – 将图像加载到TImageList并读取它们?

发布时间:2020-12-15 09:50:32 所属栏目:大数据 来源:网络整理
导读:我试图通过将.jpg转换为bmp然后将其保存到imagelist1来将jpg加载到图像列表中. 从代码片段的顶部到底部. Selectdir工作和文件存在部件工作.这用于加载文件夹中的所有图像.所有图像都被命名??为如此0.jpg / 1.jpg等. 然后我将jpg加载到tpicture.设置bmp宽度/
我试图通过将.jpg转换为bmp然后将其保存到imagelist1来将jpg加载到图像列表中.

从代码片段的顶部到底部.
Selectdir工作和文件存在部件工作.这用于加载文件夹中的所有图像.所有图像都被命名??为如此0.jpg / 1.jpg等.

然后我将jpg加载到tpicture.设置bmp宽度/高度并使用与jpg相同的图像加载bmp,然后将bmp添加到图像列表.当它完成它应该显示第一个图像0.jpg

两个问题,首先,如果我这样做,它只会显示bmp的一个小区域(左上角)
但这是正确的形象.我认为这是由于选项裁剪.我似乎无法弄清楚如何让它在运行时选择中心?

第二,如果我放

Imagelist1.width := currentimage.width;
Imagelist1.height := currentimage.height;

然后它显示最后一张图片.像Imagelist1.GetBitmap()没有用?
所以我假设任何一个的修复都会很棒!
干杯
虾蛄

procedure TForm1.Load1Click(Sender: TObject);
var
openDialog : TOpenDialog;
dir :string;
MyPicture :TPicture;
currentimage :Tbitmap;
image : integer;
clTrans : TColor;
begin
  Image := 0 ;
  //lets user select a dir
 SelectDirectory(Dir,[sdAllowCreate,sdPerformCreate,sdPrompt],SELDIRHELP);
  myPicture :=Tpicture.Create;
  currentimage := TBitmap.Create;
//keeps adding images as long as the file path exsist.
//thus comic pages should be renumbed to 0-XX
  while FileExists(Dir+''+inttostr(image)+'.jpg') do
  begin
   try
    MyPicture.LoadFromFile(Dir+''+inttostr(image)+'.jpg');   //load image to jpg holder
    currentimage.Width := mypicture.Width;       //set width same as jpg
    currentimage.Height:= mypicture.Height;      //set height same as jpg
    currentimage.Canvas.Draw(0,myPicture.Graphic);     //draw jpg on bmp
    clTrans:=currentimage.TransparentColor;           //unknown if needed?
    //Imagelist1.Width := currentimage.Width;
    //imagelist1.Height := currentimage.Height;
    Imagelist1.Addmasked(Currentimage,clTrans);     //add to imagelist
   finally
    image := image +1;                          //add one so it adds next page
   end;
 end;
 ImageList1.GetBitmap(0,zImage1.Bitmap);
 mypicture.Free;
 currentimage.Free;
end;

解决方法

每次使用TImage都会增加许多不必要的开销.

尝试这样的事情(未经测试,因为我没有一个文件夹,这个图像以这种方式命名 – 它编译,但是< g>).当然,如果它尚未存在,你需要将Jpeg添加到你的实现使用子句中.

procedure TForm2.Button1Click(Sender: TObject);
var
  DirName: string;
begin
  DirName := 'D:Images';
  if SelectDirectory('Select Image Path','D:TempFiles',DirName,[sdNewUI],Self) then
    LoadImages(DirName);
end;

procedure TForm2.LoadImages(const Dir: string);
var
  i: Integer;
  CurFileName: string;
  JpgIn: TJPEGImage;
  BmpOut: TBitmap;
begin
  i := 1;
  while True do
  begin
    CurFileName := Format('%s%d.jpg',[IncludeTrailingPathDelimiter(Dir),i]);
    if not FileExists(CurFileName) then
      Break;
    JpgIn := TJPEGImage.Create;
    try
      JpgIn.LoadFromFile(CurFileName);

      // If you haven't initialized your ImageList width and height,it
      // defaults to 16 x 16; we can set it here,if all the images are
      // the same dimensions.
      if (ImageList1.Count = 0) then
        ImageList1.SetSize(JpgIn.Width,JpgIn.Height);

      BmpOut := TBitmap.Create;
      try
        BmpOut.Assign(JpgIn);
        ImageList1.Add(BmpOut,nil);
      finally
        BmpOut.Free;
      end;
    finally
      JpgIn.Free;
    end;
    Inc(i);
  end;
  if ImageList1.Count > 0 then
  begin
    BmpOut := TBitmap.Create;
    try
      ImageList1.GetBitmap(0,BmpOut);
      Image1.Picture.Assign(BmpOut);
    finally
      BmpOut.Free;
    end;
  end;
end;

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读