delphi - 如何制作带有缩略图的 FileListBox？

Question

我正在尝试使用缩略图构建文件列表框。为了实现这一点，我正在做：

1. 用文件夹中的文件馈送 a TListBox。
2. 用缩略图构建一个数组——为此我使用一个临时TImage组件来加载图片并调整它的大小。
3. 用缩略图绘制列表框。

这是我的代码：使用数组TImage而不是的旧版本TBitmap正在工作，但仅在小文件夹中工作-但在包含 100 多个文件的文件夹中，CPU 运行 100% 并且需要大量时间处理，所以我尝试更改TBitmap为TImage`，但现在我看不到缩略图了。

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.