通过TListView实现Windows缩略图

我正在使用Delphi XE3，希望实现Windows缩略图样式，以便通过TListView控件显示图像列表

我需要的是如下所示：

图像显示为缩略图样式，每个图像下方都有一个标题。当我点击图片时，图片和标题将显示为选中

为了提高性能，我不想预先将所有图像加载到图像列表中，而是希望在显示图像时加载图像。因此，我考虑使用OnCustomDrawItem和高级CustomDrawItem

下面是我的计划的一个非常简单的版本，我将列表视图的样式设置为vsIcon：

    procedure TForm1.FormCreate(Sender: TObject);
    var
      ListItem1: TListItem;
    begin
      ListItem1 := ListView1.Items.Add;

      ListItem1.Caption := 'Chrysanthemum';
    end;

    procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    var
      JPEG: TJPEGImage;
      R: TRect;
    begin
    {
      R := Item.DisplayRect(drBounds);

      JPEG := TJPEGImage.Create;

      JPEG.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum (2).jpg');

      Sender.Canvas.StretchDraw(R, JPEG);
    }
    end;

    procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    var
      JPEG: TJPEGImage;
      R: TRect;
    begin
      R := Item.DisplayRect(drBounds);

      JPEG := TJPEGImage.Create;

      JPEG.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum (2).jpg');

      Sender.Canvas.StretchDraw(R, JPEG);
    end;

但结果并不令人满意，如下所示：

我找不到设置每个图标大小的方法。所有图标的大小都相同

我尝试将代码放在OnCustomDrawItem和AdvancedCustomDrawItem中。我想不出这两个人有什么不同。唯一的主要区别是在Advancedxxx版本中，标题是可编辑的。我不明白为什么

字幕不显示在图像下，而是在图像的中间，这是不需要的。如何解决这个问题

---

感谢

仅当相关图标实际显示在listview中时，所附代码才会将本例中的图像图标加载到TImageList中，该TImageList分配给TListView的LargeImages属性。主要是将listview的OwnerData属性设置为TRUE，并为OnData事件创建事件处理程序。与listview中的项目并行，程序维护listview中的项目列表，该列表与listview中的实际列表同步，在本例中为TStringList。在它的Objects属性中，我存储了相关图标资源的索引（如果已经加载并添加到TImageList中）。如果尚未加载图标资源，则在LoadIconFromFile函数中会发生这种情况，并且TImageList中图标的索引将存储在TStringList中

TListView中图标和文本的实际绘制完全由控件本身处理，代码既不处理OnDraw也不处理任何OnCustomDraw*事件。只需将TImageList中的图像大小设置为要显示的位图的大小，并相应地创建它们

较旧的Delphi版本包含一个名为VirtualListView.dpr的示例项目，它非常有助于理解各种OnData*事件何时触发以及如何正确使用它们

unit MainFormU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Icons_LV: TListView;
    Label1: TLabel;
    Large_IL: TImageList;
    procedure Icons_LVData(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FileList : TStringList;

    procedure FillListView;
    function LoadIconFromFile (const sFileName: String;
                               out iIndex: Integer) : Boolean;
  end;

var Form1 : TForm1;

implementation

{$R *.dfm}

uses ShellApi;

const
  cWinSysDir = 'c:\windows\system32\';

procedure TForm1.FormCreate (Sender: TObject);
begin
  FileList := TStringList.Create;
  FillListView;
end;

procedure TForm1.FormDestroy (Sender: TObject);
begin
  FileList.Free;
end;

procedure TForm1.Icons_LVData (Sender: TObject; Item: TListItem);

var iIndex : Integer;

begin
  if (Item.Index >= FileList.Count) then
    exit;

  Item.Caption := FileList [Item.Index];

  if (FileList.Objects [Item.Index] = TObject (-1)) then
  begin
    if not (LoadIconFromFile (cWinSysDir + Item.Caption, iIndex)) then
      iIndex := 0;

    FileList.Objects [Item.Index] := TObject (iIndex);
  end { if }
  else iIndex := Integer (FileList.Objects [Item.Index]);

  Item.ImageIndex := iIndex
end;

procedure TForm1.FillListView;

var SR : TSearchRec;

begin
  FillChar (SR, SizeOf (TSearchRec), #0);

  if (FindFirst (cWinSysDir + '*.exe', faAnyFile, SR) = 0) then
    repeat
      FileList.AddObject (SR.Name, TObject ((-1)));
    until (FindNext (SR) <> 0);

  FindClose (SR);
  Icons_LV.Items.Count := FileList.Count;
end;

function TForm1.LoadIconFromFile (const sFileName: String;
                                  out iIndex: Integer) : Boolean;

var
  hIcon : Windows.HICON;
  Icon : TIcon;

begin
  Result := false;

  if (ExtractIcon (MainInstance, PChar (sFileName), UInt ((-1))) > 0) then
  begin
{$IFDEF DEBUG}
    OutputDebugString (PChar (Format ('LoadIconFromFile "%s"', [sFileName])));
{$ENDIF}
    hIcon := ExtractIcon (MainInstance, PChar (sFileName), 0);

    if (hIcon <> 0) then
    begin
      Icon := TIcon.Create;
      Icon.Handle := hIcon;
      iIndex := Large_IL.AddIcon (Icon);
      Icon.Free;
      Result := true;
    end; { if }
  end { if }
end;

end.

---

完整示例可供下载。

所附代码仅当相关图标实际显示在listview中时，才会将本例中的图像图标加载到TImageList中，该TImageList分配给TListView的LargeImages属性。主要是将listview的OwnerData属性设置为TRUE，并为OnData事件创建事件处理程序。与listview中的项目并行，程序维护listview中的项目列表，该列表与listview中的实际列表同步，在本例中为TStringList。在它的Objects属性中，我存储了相关图标资源的索引（如果已经加载并添加到TImageList中）。如果尚未加载图标资源，则在LoadIconFromFile函数中会发生这种情况，并且TImageList中图标的索引将存储在TStringList中

TListView中图标和文本的实际绘制完全由控件本身处理，代码既不处理OnDraw也不处理任何OnCustomDraw*事件。只需将TImageList中的图像大小设置为要显示的位图的大小，并相应地创建它们

较旧的Delphi版本包含一个名为VirtualListView.dpr的示例项目，它非常有助于理解各种OnData*事件何时触发以及如何正确使用它们

unit MainFormU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Icons_LV: TListView;
    Label1: TLabel;
    Large_IL: TImageList;
    procedure Icons_LVData(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FileList : TStringList;

    procedure FillListView;
    function LoadIconFromFile (const sFileName: String;
                               out iIndex: Integer) : Boolean;
  end;

var Form1 : TForm1;

implementation

{$R *.dfm}

uses ShellApi;

const
  cWinSysDir = 'c:\windows\system32\';

procedure TForm1.FormCreate (Sender: TObject);
begin
  FileList := TStringList.Create;
  FillListView;
end;

procedure TForm1.FormDestroy (Sender: TObject);
begin
  FileList.Free;
end;

procedure TForm1.Icons_LVData (Sender: TObject; Item: TListItem);

var iIndex : Integer;

begin
  if (Item.Index >= FileList.Count) then
    exit;

  Item.Caption := FileList [Item.Index];

  if (FileList.Objects [Item.Index] = TObject (-1)) then
  begin
    if not (LoadIconFromFile (cWinSysDir + Item.Caption, iIndex)) then
      iIndex := 0;

    FileList.Objects [Item.Index] := TObject (iIndex);
  end { if }
  else iIndex := Integer (FileList.Objects [Item.Index]);

  Item.ImageIndex := iIndex
end;

procedure TForm1.FillListView;

var SR : TSearchRec;

begin
  FillChar (SR, SizeOf (TSearchRec), #0);

  if (FindFirst (cWinSysDir + '*.exe', faAnyFile, SR) = 0) then
    repeat
      FileList.AddObject (SR.Name, TObject ((-1)));
    until (FindNext (SR) <> 0);

  FindClose (SR);
  Icons_LV.Items.Count := FileList.Count;
end;

function TForm1.LoadIconFromFile (const sFileName: String;
                                  out iIndex: Integer) : Boolean;

var
  hIcon : Windows.HICON;
  Icon : TIcon;

begin
  Result := false;

  if (ExtractIcon (MainInstance, PChar (sFileName), UInt ((-1))) > 0) then
  begin
{$IFDEF DEBUG}
    OutputDebugString (PChar (Format ('LoadIconFromFile "%s"', [sFileName])));
{$ENDIF}
    hIcon := ExtractIcon (MainInstance, PChar (sFileName), 0);

    if (hIcon <> 0) then
    begin
      Icon := TIcon.Create;
      Icon.Handle := hIcon;
      iIndex := Large_IL.AddIcon (Icon);
      Icon.Free;
      Result := true;
    end; { if }
  end { if }
end;

end.

---

完整示例可供下载。

请查看OnDrawItem事件的文档。有一个注释是这样的：注意：列表视图接收其他几个自定义绘制事件，包括OnCustomDraw、OnCustomDrawItem、OnCustomDrawSubItem、OnAdvancedCustomDraw、OnAdvancedCustomDrawItem和OnAdvancedCustomDrawSubItem。与OnDrawItem不同，这些其他事件的发生与OwnerDraw属性的值无关。。。因此，使用这些其他事件中的任何一个。如果要在TListVIEW中显示大量图像，请考虑在虚拟模式中将其设置为OutReDATA属性为true。@Dima TListView所有者图纸上是否有完整的示例代码？您提供的链接使用AdvancedCustomDrawItem，我检查了文档，它说要在其他阶段（例如在绘制列表项之后）增加默认的绘制过程，请改用OnAdvancedCustomDrawItem事件。所以这个例子似乎使用了错误的事件处理程序？不，这个例子是正确的。若要使用OnCustomDrawItem事件，则应从头开始绘制项目，将DefaultDraw设置为false，否则将使用默认图形d

---

一个在你的画上。OnAdvancedCustomDrawItem事件允许您控制绘制阶段cdPrePaint和cdPostPaint。在我看来，这是一种更优雅的方式来绘制TListView，对于这个简单的例子来说，这就足够了。但如果要在绘图事件中进行重绘制，则最好使用OnCustomDrawItem事件，因为它发生在实际项目绘图之前。使用什么取决于你的需要。我建议你看看。它可以将图像显示为标准的TListView，但并不具备后者的所有功能。指定要在其中搜索的文件夹后，它会缓存图像。这件事值得一试。对于您的任务来说，它可能比使用标准TListView更有用。有一个注释是这样的：注意：列表视图接收其他几个自定义绘制事件，包括OnCustomDraw、OnCustomDrawItem、OnCustomDrawSubItem、OnAdvancedCustomDraw、OnAdvancedCustomDrawItem和OnAdvancedCustomDrawSubItem。与OnDrawItem不同，这些其他事件的发生与OwnerDraw属性的值无关。。。因此，使用这些其他事件中的任何一个。如果要在TListVIEW中显示大量图像，请考虑在虚拟模式中将其设置为OutReDATA属性为true。@Dima TListView所有者图纸上是否有完整的示例代码？您提供的链接使用AdvancedCustomDrawItem，我检查了文档，它说要在其他阶段（例如在绘制列表项之后）增加默认的绘制过程，请改用OnAdvancedCustomDrawItem事件。所以这个例子似乎使用了错误的事件处理程序？不，这个例子是正确的。若要使用OnCustomDrawItem事件，则应从头开始绘制项目，将DefaultDraw设置为false，否则将对图形进行默认绘制。OnAdvancedCustomDrawItem事件允许您控制绘制阶段cdPrePaint和cdPostPaint。在我看来，这是一种更优雅的方式来绘制TListView，对于这个简单的例子来说，这就足够了。但如果要在绘图事件中进行重绘制，则最好使用OnCustomDrawItem事件，因为它发生在实际项目绘图之前。使用什么取决于你的需要。我建议你看看。它可以将图像显示为标准的TListView，但并不具备后者的所有功能。指定要在其中搜索的文件夹后，它会缓存图像。这件事值得一试。对于您的任务，它可能比使用标准TListView更有用。OP希望显示图像的缩略图，而不是*.exe-files的图标。步骤相同，只需将LoadIconFromFile方法替换为将图像加载到TImageList中的方法即可。从随问题一起发布的代码中，我发现创建缩略图不是问题所在。我之前的评论很愚蠢，因为我错误地说明了内存泄漏发生的位置。此外，仅在TImageList中加载图像不会创建缩略图。顺便说一句，我已经测试了你的代码，有一个内存泄漏。发生这种情况是因为您没有在LoadIconFromFile方法中释放TIcon的实例。更改TIcon创建的代码：Icon:=TIcon.Create；尝试图标。句柄：=hIcon；iIndex:=大的附加图标；最后是图标。免费；结束@迪玛：我已经修复了内存泄漏。感谢您指出。OP希望显示图像的缩略图，而不是*.exe-files的图标。步骤相同，只需将LoadIconFromFile方法替换为将图像加载到TImageList中的方法即可。从随问题一起发布的代码中，我发现创建缩略图不是问题所在。我之前的评论很愚蠢，因为我错误地说明了内存泄漏发生的位置。此外，仅在TImageList中加载图像不会创建缩略图。顺便说一句，我已经测试了你的代码，有一个内存泄漏。发生这种情况是因为您没有在LoadIconFromFile方法中释放TIcon的实例。更改TIcon创建的代码：Icon:=TIcon.Create；尝试图标。句柄：=hIcon；iIndex:=大的附加图标；最后是图标。免费；结束@迪玛：我已经修复了内存泄漏。谢谢你指出这一点。