如何使用Delphi从文件扩展名获取图标和描述？

Question

如何使用Delphi从文件扩展名获取图标和描述？

windowsdelphiiconsfile-association

15

我有一个TcxGrid用于列出各种文件名称，我想根据文件扩展名提供进一步的详细信息，尤其是它的描述（例如对于.PDF文件是“Adobe Acrobat文档”）和相关图标。

我注意到已经有一个非常类似的问题在这里，但它是关于C#的，我想要Delphi相关的内容。

建议在哪里查找此类信息，并且如果有类似于上面C#帖子中提到的类（显然是Delphi的），那就太好了。

- Pauk

7个回答

3

function GetGenericFileType( AExtension: string ): string;
{ Get file type for an extension }
var
  AInfo: TSHFileInfo;
begin
  SHGetFileInfo( PChar( AExtension ), FILE_ATTRIBUTE_NORMAL, AInfo, SizeOf( AInfo ),
    SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES );
  Result := AInfo.szTypeName;
end;

function GetGenericIconIndex( AExtension: string ): integer;
{ Get icon index for an extension type }
var
  AInfo: TSHFileInfo;
begin
  if SHGetFileInfo( PChar( AExtension ), FILE_ATTRIBUTE_NORMAL, AInfo, SizeOf( AInfo ),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES ) <> 0 then
  Result := AInfo.iIcon
  else
    Result := -1;
end;

function GetGenericFileIcon( AExtension: string ): TIcon;
{ Get icon for an extension }
var
  AInfo: TSHFileInfo;
  AIcon: TIcon;
begin
  if SHGetFileInfo( PChar( AExtension ), FILE_ATTRIBUTE_NORMAL, AInfo, SizeOf( AInfo ),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES ) <> 0 then
  begin
    AIcon := TIcon.Create;
    try
      AIcon.Handle := AInfo.hIcon;
      Result := AIcon;
    except
      AIcon.Free;
      raise;
    end;
  end
  else
    Result := nil;
end;

- Bill Miller

感谢Bill提供的两个答案。我注意到你能够仅传递扩展名给SHGetFileInfo（而我一直在使用完整文件名），因此我相应地修改了我的代码。 - Pauk

3

调用 ShGetFileInfo 函数。它可以告诉你描述信息（在该函数的术语中称为“类型名称”），并且可以给你一个图标句柄，或者一个系统图像列表的句柄，其中包含图标，或者是持有图像资源的模块路径。该函数可以执行许多不同的操作，因此请务必仔细阅读文档。 MSDN 表示 ShGetFileInfo "可能会很慢"，并将 IExtractIcon 接口称为“更灵活和高效”的替代方法。但其推荐的顺序是使用 IShellFolder 接口，然后调用 GetUIObjectOf 获取文件的 IExtractIcon 接口，然后调用 GetIconLocation 和 Extract 来检索图标句柄。

据我所知，这正是 ShGetFileInfo 所执行的操作，但它更加繁琐，并且在完成所有操作后仍无法获得文件的类型描述。在速度和效率成为明显问题之前，请继续使用 ShGetFileInfo。

- Rob Kennedy

2

uses ShellAPI;

var
AExtension: string;
AFileType: string;    
AListItem: TListItem;
AFileInfo: TSHFileInfo;
begin
// get the extensions file icon
AExtension := ExtractFileExt( FileName );
if SHGetFileInfo( PChar( '*' + AExtension ), FILE_ATTRIBUTE_NORMAL, AFileInfo, SizeOf
  ( AFileInfo ), SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES ) <> 0 then
  AIndex := AFileInfo.iIcon
else
  AIndex := -1;
AListItem.ImageIndex := AIndex;
// get extensions file info
if SHGetFileInfo( PChar( '*' + AExtension ), FILE_ATTRIBUTE_NORMAL, Info, SizeOf( Info ),
  SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES ) then
    AFileType := AFileInfo.szTypeName;
end;

- Bill Miller

1

不想听起来轻率，但谷歌是你的好朋友。以下是“Delphi相关图标”的前几个搜索结果：

http://www.delphi3000.com/articles/article_453.asp?SK=

http://www.jpgriffiths.com/tutorial/Snippets%5Cgetassociatedicon.html

- Bruce McGee

感谢Bruce提供的指引，不幸的是那并不完全是我所需要的。我还需要相应的描述。此外，我只是想尝试一下StackOverflow，看看它对Delphi有何专业知识，我认为效果还不错！ - Pauk

0

另一种方法是在HKEY_CLASSES_ROOT注册表中查找扩展名，然后按照默认值中的键（如果有）进行跟踪，其默认值即为描述。这第二个级别也是您可以获取打开或打印文件类型以及默认图标路径的shell命令的地方。

- skamradt

0

以下是从bitwisemag.com中使用ShGetFileInfo的几个很好的示例：

http://www.bitwisemag.com/copy/delphi/lpad1.html

http://www.bitwisemag.com/copy/delphi/prog_groups2.html

- Bob S

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Pauk · Accepted Answer

感谢Rob Kennedy指导我使用ShGetFileInfo，然后我通过谷歌找到了这两个例子 - Delphi 3000和Torry's。基于此，我编写了以下类以满足我的需求。

另外，当我快要完成时，Bill Miller的回答给了我最后一点帮助。最初我将完整文件名传递给ShGetFileInfo，这并不是我想要的。建议传递“*. EXT”非常好。

该类仍需要更多工作，但它可以满足我的需求。它似乎也能处理没有任何相关详细信息的文件扩展名。

最后，在我使用的程序中，我已经切换到使用TcxImageList而不是TImageList，因为这是一个快速解决黑边出现在图标上的问题。

unit FileAssociationDetails;

{
  Created       : 2009-05-07
  Description   : Class to get file type description and icons.
                  * Extensions and Descriptions are held in a TStringLists.
                  * Icons are stored in a TImageList.

                  Assumption is all lists are in same order.
}

interface

uses Classes, Controls;

type
  TFileAssociationDetails = class(TObject)
  private
    FImages : TImageList;
    FExtensions : TStringList;
    FDescriptions : TStringList;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddFile(FileName : string);
    procedure AddExtension(Extension : string);    
    procedure Clear;    
    procedure GetFileIconsAndDescriptions;

    property Images : TImageList read FImages;
    property Extensions : TStringList read FExtensions;
    property Descriptions : TStringList read FDescriptions;
  end;

implementation

uses SysUtils, ShellAPI, Graphics, Windows;

{ TFileAssociationDetails }

constructor TFileAssociationDetails.Create;
begin
  try
    inherited;

    FExtensions := TStringList.Create;
    FExtensions.Sorted := true;
    FDescriptions := TStringList.Create;
    FImages := TImageList.Create(nil);
  except
  end;
end;

destructor TFileAssociationDetails.Destroy;
begin
  try
    FExtensions.Free;
    FDescriptions.Free;
    FImages.Free;
  finally
    inherited;
  end;
end;

procedure TFileAssociationDetails.AddFile(FileName: string);
begin
  AddExtension(ExtractFileExt(FileName));
end;

procedure TFileAssociationDetails.AddExtension(Extension : string);
begin
  Extension := UpperCase(Extension);
  if (Trim(Extension) <> '') and
     (FExtensions.IndexOf(Extension) = -1) then
    FExtensions.Add(Extension);
end;

procedure TFileAssociationDetails.Clear;
begin
  FExtensions.Clear;
end;

procedure TFileAssociationDetails.GetFileIconsAndDescriptions;
var
  Icon: TIcon;
  iCount : integer;
  Extension : string;
  FileInfo : SHFILEINFO; 
begin
  FImages.Clear;
  FDescriptions.Clear;

  Icon := TIcon.Create;
  try
    // Loop through all stored extensions and retrieve relevant info
    for iCount := 0 to FExtensions.Count - 1 do
    begin
      Extension := '*' + FExtensions.Strings[iCount];

      // Get description type
      SHGetFileInfo(PChar(Extension),
                    FILE_ATTRIBUTE_NORMAL,
                    FileInfo,
                    SizeOf(FileInfo),
                    SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES
                    );
      FDescriptions.Add(FileInfo.szTypeName);

      // Get icon and copy into ImageList
      SHGetFileInfo(PChar(Extension),
                    FILE_ATTRIBUTE_NORMAL,
                    FileInfo,
                    SizeOf(FileInfo),
                    SHGFI_ICON or SHGFI_SMALLICON or
                    SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES
                    );
      Icon.Handle := FileInfo.hIcon;
      FImages.AddIcon(Icon);
    end;
  finally
    Icon.Free;
  end;
end;

end.

以下是示例测试应用程序，它非常简单，只是一个带有TPageControl的表单。我的实际用途不是这个，而是在TcxGrid中使用Developer Express TcxImageComboxBox。

unit Main;

{
  Created       : 2009-05-07
  Description   : Test app for TFileAssociationDetails.
}

interface

uses
  Windows, Forms, FileAssociationDetails, Classes, Controls, ComCtrls;

type
  TfmTest = class(TForm)
    PageControl1: TPageControl;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FFileDetails : TFileAssociationDetails;
  public
    { Public declarations }
  end;

var
  fmTest: TfmTest;

implementation

{$R *.dfm}

procedure TfmTest.FormShow(Sender: TObject);
var
  iCount : integer;
  NewTab : TTabSheet;
begin
  FFileDetails := TFileAssociationDetails.Create;
  FFileDetails.AddFile('C:\Documents and Settings\...\Test.XLS');
  FFileDetails.AddExtension('.zip');
  FFileDetails.AddExtension('.pdf');
  FFileDetails.AddExtension('.pas');
  FFileDetails.AddExtension('.XML');
  FFileDetails.AddExtension('.poo');

  FFileDetails.GetFileIconsAndDescriptions;
  PageControl1.Images := FFileDetails.Images;

  for iCount := 0 to FFileDetails.Descriptions.Count - 1 do
  begin
    NewTab := TTabSheet.Create(PageControl1);
    NewTab.PageControl := PageControl1;
    NewTab.Caption := FFileDetails.Descriptions.Strings[iCount];
    NewTab.ImageIndex := iCount;
  end;
end;

procedure TfmTest.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  PageControl1.Images := nil;
  FFileDetails.Free;
end;

end.

谢谢大家的回答！