基本上我有一个 TcxGrid，它将列出各种文件名，我想根据文件扩展名提供更多详细信息，特别是它的描述（例如，对于 .PDF，它是“Adobe Acrobat 文档”）及其相关图标。
我注意到有一个 very similar question already，但它与 C# 相关，我想要基于 Delphi 的东西。
关于在哪里寻找此类信息的建议会很好，如果有一个类似于上面 C# 帖子中提到的类（显然是在 Delphi 中），那就太好了。
【问题讨论】：
标签： windows delphi icons file-association
感谢 Rob Kennedy 为我指明了 ShGetFileInfo 的方向。然后我在谷歌上搜索并找到了这两个例子 - Delphi 3000，Torry's。从那以后，我编写了以下课程来做我需要的事情。
另外，就在我完成比尔米勒的回答时，我得到了我需要的最后一点帮助。最初我将完整的文件名传递给 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.
感谢大家的回答！
【讨论】：
.ico 文件通常是这种情况：每个图标文件本身都包含要显示的图标。在这种情况下，使用完整的文件名将产生正确的图标。仅在此处使用扩展名会导致“通用”图标。
致电ShGetFileInfo。它可以告诉您描述（该函数的词汇表中的“类型名称”），它可以为您提供图标句柄，或系统图像列表的句柄，图标所在的位置，或包含模块的路径图片资源。该函数可以做很多不同的事情，因此请务必仔细阅读文档。
MSDN says ShGetFileInfo “可能很慢”，并将IExtractIcon 接口称为“更灵活和高效”的替代方案。但它推荐的顺序是使用IShellFolder接口，然后调用GetUIObjectOf获取文件的IExtractIcon接口，然后调用GetIconLocation和Extract获取图标的句柄。
据我所知，这正是ShGetFileInfo 所做的，但它更麻烦，在你完成所有这些之后，你仍然不会有文件的类型描述。坚持使用ShGetFileInfo，直到速度和效率成为一个明显的问题。
【讨论】：
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;
【讨论】：
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;
【讨论】：
不要听起来油嘴滑舌，但 Google 是您的朋友。以下是“delphi 关联图标”的一些初步结果：
http://www.delphi3000.com/articles/article_453.asp?SK=
http://www.jpgriffiths.com/tutorial/Snippets%5Cgetassociatedicon.html
【讨论】：
另一种方法是在注册表中的 HKEY_CLASSES_ROOT 下查找扩展名，然后按照默认值（如果可用）中的键，其默认值是描述。在第二级，您还可以获取打开的 shell 命令，或打印文件类型以及默认图标的路径。
【讨论】：
这里有几个使用来自 bitwisemag.com 的 ShGetFileInfo 的好例子：
【讨论】：