2009-05-06 63 views
12

基本上我有一個TcxGrid,它將列出各種文件名稱,我想根據文件擴展名提供更詳細的信息,特別是它的描述(例如.PDF是「Adobe Acrobat文檔」)和它的相關圖標。如何使用Delphi從文件擴展名中獲取圖標和描述?

我注意到有一個very similar question already但它是C#相關的,我想要一些基於Delphi的東西。

關於在哪裏尋找這種信息的建議是很好的,如果有一個類似於上面C#post中提到的類(很明顯在Delphi中)會很好。

回答

17

感謝Rob肯尼迪指着我的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. 

謝謝大家的回答!

+0

注意:傳遞完整文件名時,快捷方式(如'%1')作爲圖標或位圖文件的快捷方式將爲每個特定文件生成正確的結果。 * .ext只會在這種情況下顯示一個通用圖標。 – Martijn 2010-11-29 08:15:56

1

不要發出聲音,但Google是你的朋友。這裏有一對夫婦爲 「德爾福相關的圖標」 第一個結果:

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

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

+0

感謝布魯斯的指針,不幸的是,這不完全是我之後。我也是在描述之後。此外,我只是想我會嘗試StackOverflow,看看它有什麼德爾福的專業知識,我不認爲它做得太糟糕! – Pauk 2009-05-07 14:35:48

2

呼叫ShGetFileInfo。它可以告訴你描述(該函數的詞彙表中的「類型名稱」),它可以給你一個圖標句柄,或者系統圖像列表的句柄,圖標所在的位置,或者模塊的路徑圖像資源。該功能可以做很多不同的事情,因此請務必仔細閱讀文檔。

MSDN saysShGetFileInfo「可能會很慢」,並將IExtractIcon接口稱爲「更靈活和更高效」的替代方案。但它推薦的順序是使用IShellFolder接口,然後調用GetUIObjectOf來獲取文件的IExtractIcon接口,然後調用GetIconLocationExtract來檢索圖標的句柄。

據我所知,這正是ShGetFileInfo確實是這樣,但是它更麻煩,而且你所做的一切之後,你仍然不會有該文件的類型描述。堅持與ShGetFileInfo,直到速度和效率成爲一個明顯的問題。

+0

感謝羅布,指出我在正確的方向。 – Pauk 2009-05-07 14:30:01

0

另一種方法是在HKEY_CLASSES_ROOT下查找註冊表中的擴展名,然後按照默認值(如果可用)中的鍵,其默認值是描述。第二級也是您可以打開shell命令的位置,或者打印文件類型以及默認圖標的路徑。

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; 
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; 
+0

感謝Bill對你的答案。我注意到你只能將擴展名傳遞給SHGetFileInfo(我使用完整的文件名),所以我相應地調整了我的代碼。 – Pauk 2009-05-07 14:31:06

相關問題