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

时间:2021-08-29 21:48:15

Basically I have a TcxGrid which will be listing various files names and I'd like to give further details based on the file extension, specifically it's description (e.g. for .PDF it's "Adobe Acrobat Document") and it's related icon.

基本上我有一个TcxGrid,它将列出各种文件名,我想根据文件扩展名给出更多细节,特别是它的描述(例如.PDF它的“Adobe Acrobat文档”)和它的相关图标。

I notice there is a very similar question already but it's C# related and I'd like something Delphi based.

我注意到有一个非常类似的问题,但它与C#有关,我想要一些基于Delphi的东西。

Suggestions on where to look for this kind of info would be good and if there is a class similar to the one mentioned in the C# post above (obviously in Delphi) that would be great.

关于在哪里寻找这种信息的建议是好的,如果有一个类似于上面的C#帖子中提到的类(显然在Delphi中),这将是很好的。

7 个解决方案

#1


Thanks to Rob Kennedy for pointing me in the direction of ShGetFileInfo. I then Googled on that and found these two examples - Delphi 3000, Torry's. From that I wrote the following class to do what I needed.

感谢Rob Kennedy将我指向了ShGetFileInfo的方向。然后我用Google搜索并找到了这两个例子 - Delphi 3000,Torry's。从那以后我写了下面的课来做我需要的。

Also, just as I was finishing up Bill Miller's answer gave me the final bit of help I needed. Originally I was passing full file names through to ShGetFileInfo, which wasn't ideally what I wanted. The tweak suggested of passing "*.EXT" was great.

同样,就在我完成比尔米勒的回答时,我给了我最后一点帮助。最初我将完整的文件名传递给ShGetFileInfo,这不是我想要的理想选择。传递“* .EXT”的调整很棒。

The class could do with more work but it does what I need. It seems to handle file extensions that have no details associated either.

班级可以做更多的工作,但它做我需要的。它似乎处理没有相关细节的文件扩展名。

Finally, in what I'm using I've switched it to using a TcxImageList instead of a TImageList, since I was having problems with black borders appearing on the icons, because it was a quick fix.

最后,在我正在使用的内容中,我将其切换为使用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.

Also here is an example test app using it, it's very simple, just a form with a TPageControl on it. My actual use was not for this, but for with a Developer Express TcxImageComboxBox in a TcxGrid.

这里还有一个使用它的示例测试应用程序,它非常简单,只是一个带有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.

Thanks everyone for your answers!

谢谢大家的回答!

#2


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;

#3


Call ShGetFileInfo. It can tell you the description (the "type name," in that function's vocabulary), and it can give you an icon handle, or a handle to the system image list, where the icon resides, or the path to the module that holds the image resource. That function can do lots of different things, so make sure to read the documentation carefully.

调用ShGetFileInfo。它可以告诉你描述(该类型名称,在该函数的词汇表中),它可以为您提供图标句柄,或图标所在的系统图像列表的句柄,或者保存模块的路径图像资源。该功能可以执行许多不同的操作,因此请务必仔细阅读文档。

MSDN says ShGetFileInfo "may be slow" and calls the IExtractIcon interface a "more flexible and efficient" alternative. But the sequence it recommends is to use an IShellFolder interface, then call GetUIObjectOf to get the file's IExtractIcon interface, and then call GetIconLocation and Extract on it to retrieve the icon's handle.

MSDN称ShGetFileInfo“可能很慢”,并将IExtractIcon接口称为“更灵活,更高效”的替代方案。但它建议的顺序是使用IShellFolder接口,然后调用GetUIObjectOf获取文件的IExtractIcon接口,然后调用GetIconLocation和Extract来检索图标的句柄。

For all I know, that's exactly what ShGetFileInfo does anyway, but it's much more cumbersome, and after you've done all that, you still wouldn't have the file's type description. Stick with ShGetFileInfo until speed and efficiency become a noticeable problem.

据我所知,这正是ShGetFileInfo所做的,但它更麻烦,在你完成所有这些之后,你仍然没有文件的类型描述。坚持使用ShGetFileInfo,直到速度和效率成为一个明显的问题。

#4


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;

#5


Not to sound glib, but Google is your friend. Here are a couple of the first results for "delphi associated icon":

不要说声音,但谷歌是你的朋友。以下是“delphi关联图标”的第一个结果:

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

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

#6


The other method is to hunt down the extension in the registry under HKEY_CLASSES_ROOT, then follow the key in the default value (if available) and its default is the description. This second level is also where you can get the shell commands to open, or print the file type as well as the path to the default icon.

另一种方法是在HKEY_CLASSES_ROOT下搜索注册表中的扩展名,然后按照默认值(如果可用)中的键,其默认值为描述。此第二级也是您可以打开shell命令,或打印文件类型以及默认图标的路径的位置。

#7


Here are a couple good examples of using ShGetFileInfo from bitwisemag.com:

以下是使用bitwisemag.com的ShGetFileInfo的几个很好的例子:

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

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

#1


Thanks to Rob Kennedy for pointing me in the direction of ShGetFileInfo. I then Googled on that and found these two examples - Delphi 3000, Torry's. From that I wrote the following class to do what I needed.

感谢Rob Kennedy将我指向了ShGetFileInfo的方向。然后我用Google搜索并找到了这两个例子 - Delphi 3000,Torry's。从那以后我写了下面的课来做我需要的。

Also, just as I was finishing up Bill Miller's answer gave me the final bit of help I needed. Originally I was passing full file names through to ShGetFileInfo, which wasn't ideally what I wanted. The tweak suggested of passing "*.EXT" was great.

同样,就在我完成比尔米勒的回答时,我给了我最后一点帮助。最初我将完整的文件名传递给ShGetFileInfo,这不是我想要的理想选择。传递“* .EXT”的调整很棒。

The class could do with more work but it does what I need. It seems to handle file extensions that have no details associated either.

班级可以做更多的工作,但它做我需要的。它似乎处理没有相关细节的文件扩展名。

Finally, in what I'm using I've switched it to using a TcxImageList instead of a TImageList, since I was having problems with black borders appearing on the icons, because it was a quick fix.

最后,在我正在使用的内容中,我将其切换为使用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.

Also here is an example test app using it, it's very simple, just a form with a TPageControl on it. My actual use was not for this, but for with a Developer Express TcxImageComboxBox in a TcxGrid.

这里还有一个使用它的示例测试应用程序,它非常简单,只是一个带有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.

Thanks everyone for your answers!

谢谢大家的回答!

#2


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;

#3


Call ShGetFileInfo. It can tell you the description (the "type name," in that function's vocabulary), and it can give you an icon handle, or a handle to the system image list, where the icon resides, or the path to the module that holds the image resource. That function can do lots of different things, so make sure to read the documentation carefully.

调用ShGetFileInfo。它可以告诉你描述(该类型名称,在该函数的词汇表中),它可以为您提供图标句柄,或图标所在的系统图像列表的句柄,或者保存模块的路径图像资源。该功能可以执行许多不同的操作,因此请务必仔细阅读文档。

MSDN says ShGetFileInfo "may be slow" and calls the IExtractIcon interface a "more flexible and efficient" alternative. But the sequence it recommends is to use an IShellFolder interface, then call GetUIObjectOf to get the file's IExtractIcon interface, and then call GetIconLocation and Extract on it to retrieve the icon's handle.

MSDN称ShGetFileInfo“可能很慢”,并将IExtractIcon接口称为“更灵活,更高效”的替代方案。但它建议的顺序是使用IShellFolder接口,然后调用GetUIObjectOf获取文件的IExtractIcon接口,然后调用GetIconLocation和Extract来检索图标的句柄。

For all I know, that's exactly what ShGetFileInfo does anyway, but it's much more cumbersome, and after you've done all that, you still wouldn't have the file's type description. Stick with ShGetFileInfo until speed and efficiency become a noticeable problem.

据我所知,这正是ShGetFileInfo所做的,但它更麻烦,在你完成所有这些之后,你仍然没有文件的类型描述。坚持使用ShGetFileInfo,直到速度和效率成为一个明显的问题。

#4


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;

#5


Not to sound glib, but Google is your friend. Here are a couple of the first results for "delphi associated icon":

不要说声音,但谷歌是你的朋友。以下是“delphi关联图标”的第一个结果:

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

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

#6


The other method is to hunt down the extension in the registry under HKEY_CLASSES_ROOT, then follow the key in the default value (if available) and its default is the description. This second level is also where you can get the shell commands to open, or print the file type as well as the path to the default icon.

另一种方法是在HKEY_CLASSES_ROOT下搜索注册表中的扩展名,然后按照默认值(如果可用)中的键,其默认值为描述。此第二级也是您可以打开shell命令,或打印文件类型以及默认图标的路径的位置。

#7


Here are a couple good examples of using ShGetFileInfo from bitwisemag.com:

以下是使用bitwisemag.com的ShGetFileInfo的几个很好的例子:

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

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