0

Delphi 11 Alexandria の Windows 10 の 32 ビット VCL アプリケーションでは、ファイル名を示す ListBox 項目の前に16x16 から画像を描画するTListBox場所があります。Style = lbOwnerDrawVariableTImageList

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、パス、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」は機能しません。これにより、アプリケーションで頻繁に発生するため、新しいファイルごとに新しいアイコンを作成する必要があり、リソースが無駄になります。代わりに、プログラムの開始時に必要ないくつかのアイコンを作成し、アプリケーション全体でこれらのアイコンを使用することを好みます。SHFILEINFOでは、既存のファイルの代わりに「.DPR」を使用するにはどうすればよいですか?

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