通过 TListView 实现 Windows 缩略图

Question

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

我需要的如下：

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

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

下面是我计划的一个非常简单的版本（我将列表视图的样式设置为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;

但结果并不理想，如下：

1. 我找不到设置每个图标大小的方法。 （所有图标都将具有相同的大小）。

2. 我尝试将代码放在 OnCustomDrawItem 和 OnAdvancedCustomDrawItem 中。我无法弄清楚这两者之间有多大区别。 Advancedxxx 版本中唯一的主要区别在于，标题是可编辑的。我不明白为什么。

3. 标题不显示在图像下方，而是显示在图像中间，这是不希望的。如何解决？

谢谢

Answer 1

仅当关联图标实际显示在列表视图中时，附加代码才会将图像（在本例中为图标）加载到分配给 TListView 的LargeImages 属性的 TImageList 中。主要是将列表视图的OwnerData 属性设置为TRUE，并为OnData 事件创建事件处理程序。与列表视图中的项目并行，程序维护列表视图中的项目列表，该列表与列表视图中的实际列表同步，在本例中为 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.

完整示例可供下载here。