【问题标题】:Loading images to TImageList and Reading them?将图像加载到 TImageList 并读取它们?
【发布时间】:2014-03-03 20:17:58
【问题描述】:

我正在尝试通过将 .jpg 转换为 bmp 然后将其保存到 imagelist1 来将 jpg 加载到图像列表中。

从上到下的代码片段。 Selectdir 工作和 fileexists 部分工作。这用于加载文件夹中的所有图像。所有图像都以 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, 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;

【问题讨论】:

    标签: delphi


    【解决方案1】:

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

    尝试这样的事情(未经测试,因为我没有一个以这种方式命名的充满图像的文件夹——它可以编译,尽管 )。当然,如果 uses 子句不存在,您需要将 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;
    

    【讨论】:

    • 这确实有效,在某种程度上,一旦完成加载它就不会显示任何图像。我还必须将 image1 更改为 ZImage1.bitmap.assign(bmpout);由于 ZImage1 是 TGraphicControl 的一个类。不确定这是否重要..
    • 它似乎永远不会进入 while 循环。总是爆发
    • 如果函数被调用,它不可能进入while循环; while True 始终是 True。代码不会执行它的唯一方法是SelectDirectory 返回 false 并且函数没有被调用。如果您在该行设置断点,调试器会显示什么?
    • 知道了。 SelectDirectory 返回不带反斜杠的路径名。 (调试器告诉我,当您评估传递给FileExists 的参数时,顺便说一句。)编辑修复。 (你真的应该学会使用调试器——它是你的朋友。
    • ok 修复了格式问题,但现在回到原来的问题,它只显示图像的左上角..
    猜你喜欢
    • 1970-01-01
    • 2015-12-25
    • 2018-02-26
    • 1970-01-01
    • 2014-02-22
    • 1970-01-01
    • 1970-01-01
    • 2018-05-23
    • 1970-01-01
    相关资源
    最近更新 更多