0

I'm trying to build a file listbox with thumbnails. To achieve this I'm doing:

  1. Feed a TListBox with the files in a folder.
  2. Build an array with thumbnails - for this I'm using a temporary TImage component to load the picture and resize it.
  3. Draw the listbox with the thumbnails.

Here is my code: an older version using an array of TImage instead of TBitmap was working but only in small folders - but in a folder with more than 100 files the CPU goes 100% and takes a lot of time processing, so I tried to change TBitmap to TImage`, but now I can't see the thumbnails anymore.

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, pngimage;

type
  TForm2 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
    function listfiles(path: string): boolean;
    function loadImage(im: TImage; arq: string; w, h: Integer): boolean;
    function isImage(f : string) : boolean;

  var
    thumbs: array[1..1000] of TBitMap;

  const
    thumbSize = 48;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
var
  im: TImage;
  i: integer;
  f,dir: string;

begin
  try
  dir := 'C:\users\admin\desktop\';
  listfiles(dir);
  im := TImage.Create(Form2);
  for i := 0 to ListBox1.Items.Count - 1 do
  begin
    f := ListBox1.Items[i];
    if isImage(f) then
    begin
    thumbs[i+1] := tbitmap.Create;
    loadImage(im,dir+f,thumbSize,thumbSize);
    thumbs[i+1] := im.Picture.Bitmap;
    end;
  end;
  finally
    im.Free;
  end;
end;

  function TForm2.isImage(f: string): boolean;
begin
result := (pos('.jpg', lowercase(f)) > 0) or (pos('.jpeg', lowercase(f)) > 0) or (pos('.bmp', lowercase(f)) > 0) or (pos('.png', lowercase(f)) > 0) or
      (pos('.gif', lowercase(f)) > 0) ;
end;

procedure TForm2.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  CenterText: Integer;
  f: string;
  gw: Integer;
begin
  if (index = -1) or (Control <> listbox1) then
    exit;

  var
  C := listbox1.Canvas;

  C.FillRect(Rect);

  var
  R := Rect;
  var
  s := listbox1.Items[Index];

  var
  G := thumbs[index+1];

  var
  scale := 1.0;

  gw := 1;

  if G <> nil then
    if (G.Width > 0) and (G.Height > 0) then
    begin

      gw := G.Width;
      var
      xscale := R.Width / G.Width;
      var
      yscale := R.Height / G.Height;
      if xscale < yscale then
        scale := xscale
      else
        scale := yscale;

      R.Width := Round(G.Width * scale);
      R.Height := Round(G.Height * scale);

      R.Width := thumbSize;
      R.Height := thumbSize;

      C.StretchDraw(R, G);
    end;

  R := Rect;
  R.left := R.left + Round(gw * scale) + C.TextWidth('0');

  R.left := thumbSize + 10;
  C.TextRect(R, s, [tfSingleLine, tfVerticalCenter, tfEndEllipsis]);
end;


function TForm2.listfiles(path: string): boolean;
  Var
    SR: TSearchRec;
  begin
    try
      if FindFirst(path + '*.*', faArchive, SR) = 0 then
      begin
        repeat
          ListBox1.Items.Add(SR.Name); // Fill the list
        until FindNext(SR) <> 0;
        FindClose(SR);
      end;

      // do your stuff

    finally
    end;
  end;

function TForm2.loadImage(im: TImage; arq: string; w, h: Integer): boolean;
begin
  try
    if (isImage(arq)) and (fileexists(arq)) then
    begin
      im.Width := w;
      im.Height := h;
      im.picture.LoadFromFile(arq);
      im.AutoSize := false;
      im.Stretch := true;
      if ((im.picture.Width * im.Height) div im.picture.Height) > im.Width then
      begin
        im.Height := (im.picture.Height * im.Width) div im.picture.Width;
      end
      else
      begin
        im.Width := (im.picture.Width * im.Height) div im.picture.Height;
      end;
      result := true;
    end
    else
    begin
      result := false;
      im.picture := nil;
    end;

  except
    result := false;
  end;
end;

end.
AmigoJack
  • 5,234
  • 1
  • 15
  • 31
delphirules
  • 6,443
  • 17
  • 59
  • 108
  • 2
    This will also validate [AnnaKournikova.jpg.vbs](https://en.wikipedia.org/wiki/Anna_Kournikova_(computer_virus)#Background) as being a picture. – AmigoJack Jan 27 '22 at 12:30
  • @AmigoJack I can fix this later, what i need right now is the thumbnails to show – delphirules Jan 27 '22 at 12:41
  • "for this I'm using a temporary TImage component to load the picture and resize it" That's the wrong way of doing it. – Andreas Rejbrand Jan 27 '22 at 13:00
  • @AndreasRejbrand Can you teach me the right way , please ? – delphirules Jan 27 '22 at 13:01
  • Also: If `listfiles(dir)` raises an exception, you'll call the destructor on a random pointer. *Always* use the standard idiom `Frog := TFrog.Create; try {use Frog} finally Frog.Free; end`. – Andreas Rejbrand Jan 27 '22 at 13:01
  • `TImage` is a control (=visible thing on a form), and every time you use a control that isn't visible on a form, but is only used for some internal things, you are almost certainly doing something wrong. // You seem to believe that your `TImage` is shrinking the bitmap. It isn't. As I wrote in my A to your previous Q at https://stackoverflow.com/questions/70852853/how-to-draw-image-from-timage-into-tlistbox, resizing the image control doesn't affect the bitmap at all. Your `thumbs` array will thus contain the original, full-size bitmaps. Resizing happens at drawing by means of `StrechDraw`. – Andreas Rejbrand Jan 27 '22 at 13:23
  • In addition, your `thumbs[i+1] := tbitmap.Create;` is superfluous since you two lines later assign a completely different bitmap to this array element. – Andreas Rejbrand Jan 27 '22 at 13:26
  • One way to resize a bitmap in-memory is to simply `StretchDraw` it from one in-memory bitmap canvas to another in-memory bitmap canvas. – Andreas Rejbrand Jan 27 '22 at 13:30
  • Could you please edit my code and post one that works ? My skills are limited – delphirules Jan 27 '22 at 14:28
  • @delphirules: Very sorry, but I don't have the time to do that today. – Andreas Rejbrand Jan 27 '22 at 18:31

0 Answers0