0

在 Delphi 11 Alexandria 的 Windows 10 中的 32 位 VCL 应用程序中，我有一个TListBox在显示文件名的 ListBox 项目前面Style = lbOwnerDrawVariable从 16x16 绘制图像的位置：TImageList

procedure TformMain.listboxProjectFilesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  CenterText: integer;
begin
  listboxProjectFiles.Canvas.FillRect(Rect);
  ImageList1.Draw(listboxProjectFiles.Canvas, Rect.Left + 4, Rect.Top + 4, 5);
  CenterText := (Rect.Bottom - Rect.Top - listboxProjectFiles.Canvas.TextHeight(text)) div 2;
  listboxProjectFiles.Canvas.TextOut(Rect.left + ImageList1.Width + 8, Rect.Top + CenterText, listboxProjectFiles.Items.Strings[Index]);
end;

procedure TformMain.listboxProjectFilesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
  Height := 20;
end;

这会产生以下结果：

在此处输入图像描述

但是，此示例使用 ImageList 的固定索引号 (Index = 5)。如何改为显示每种文件类型的关联系统映像？(dpr, pas, dfm)

编辑：我使用了@Amigojack 的建议并编写了以下代码：

procedure SetShellIcons;
var
  FileInfo: SHFILEINFO;
  NewIcon: TIcon;
begin
  NewIcon := TIcon.Create;
  try
    SHGetFileInfo(PChar('C:\MyExistingFile.dpr'), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
    NewIcon.Handle := FileInfo.hIcon;
    CodeSite.Send('SetFileIcons: NewIcon', NewIcon);
    formMain.ilShellIcons.AddIcon(NewIcon);
    DestroyIcon(FileInfo.hIcon);
  finally
    NewIcon.Free;
  end;
end;

这行得通 - 但我必须提供一个现有文件 - '.DPR' 不起作用！。这迫使我为每个新文件创建一个新图标，这是一种资源浪费，因为它在我的应用程序中经常发生。相反，我更愿意在程序启动时创建我需要的几个图标，然后在整个应用程序中使用这些图标。那么，如何使用 '.DPR'SHFILEINFO而不是现有文件呢？

EDIT2：现在我使用此代码在程序启动时有效地设置所需扩展的图标：

procedure TformMain.SetShellIcons;
var
  FileInfo: Winapi.ShellAPI.SHFILEINFO;
  NewIcon: TIcon;
  function GetFileInfo(const aExt: string): Integer;
  begin
    Winapi.ShellAPI.SHGetFileInfo(PChar(aExt), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
    NewIcon.Handle := FileInfo.hIcon;
    Result := formMain.ilShellIcons.AddIcon(NewIcon);
  end;
begin
  NewIcon := TIcon.Create;
  try
    FIconIdx_DPR := GetFileInfo('*.dpr');
    FIconIdx_PAS := GetFileInfo('*.pas');
    FIconIdx_DFM := GetFileInfo('*.dfm');
  finally
    DestroyIcon(FileInfo.hIcon);
    NewIcon.Free;
  end;
end;

function TformMain.GetIconIdx(const aExtension: string): Integer;
begin
  Result := -1;

  if SameText(aExtension, '.DPR') then
    Result := FIconIdx_DPR
  else if SameText(aExtension, '.PAS') then
    Result := FIconIdx_PAS
  else if SameText(aExtension, '.DFM') then
    Result := FIconIdx_DFM;
end;

procedure TformMain.listboxProjectFilesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  CenterText: integer;
begin
  listboxProjectFiles.Canvas.FillRect(Rect);
  ilShellIcons.Draw(listboxProjectFiles.Canvas, Rect.Left + 4, Rect.Top + 4, GetIconIdx(ExtractFileExt(listboxProjectFiles.Items.Strings[Index])));
  CenterText := (Rect.Bottom - Rect.Top - listboxProjectFiles.Canvas.TextHeight(text)) div 2 + 1;
  listboxProjectFiles.Canvas.TextOut(Rect.left + ilShellIcons.Width + 8, Rect.Top + CenterText, listboxProjectFiles.Items.Strings[Index]);
end;
4

0 回答 0