Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Loading images to TImageList and Reading them?

Tags:

delphi

I am trying to load jpg into an imagelist by converting the .jpg to a bmp and then saving it to imagelist1.

From top to bottom of the code snip. The Selectdir works and fileexists parts work. This is used to load in all the Images in a folder.All images are named like so 0.jpg / 1.jpg ect..

I then load the jpg to a tpicture. Set the bmp width /height and load the bmp with same image as jpg , i then add the bmp to the imagelist. And when its done it should show the first image 0.jpg

Two issues, first if i did it like so it would only show a small area (top left) of the bmp but it was the correct image. I assume this is due to the option crop. which i cant seem to figure out how to make it select center during runtime?

Second, If i put

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

Then it shows last image. like Imagelist1.GetBitmap() did not work? so i assume a fix for either one would be great! cheers squills

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;
like image 614
Glen Morse Avatar asked Jun 11 '12 22:06

Glen Morse


1 Answers

You're adding a lot of unnecessary overhead by using the TImage every time.

Try something like this (untested, because I don't have a folder full of images named this way - it compiles, though <g>). You'll need to add Jpeg to your implementation uses clause if it's not already there, of course.

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;
like image 64
Ken White Avatar answered Oct 06 '22 15:10

Ken White