Как получить значок и описание из расширения файла с помощью Delphi?

В основном у меня есть TcxGrid, в котором будут перечислены имена различных файлов, и я хотел бы дать более подробную информацию на основе расширения файла, в частности, это описание (например, для .PDF это "Adobe Acrobat Document" ) и связанный значок.

Я замечаю, что есть очень похожий вопрос уже, но он связан с С#, и мне бы хотелось, чтобы что-то основало Delphi.

Предложения о том, где искать такую информацию, были бы хорошими, и если бы был класс, подобный тому, который упоминался выше в С# (очевидно, в Delphi), это было бы здорово.

Ответ 1

Спасибо Робу Кеннеди за то, что он указал мне в направлении ShGetFileInfo. Затем я нашел Googled и нашел эти два примера: 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 на нем. Мое фактическое использование было не для этого, а для разработчика Express TcxImageComboxBox в TcxGrid.

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.

Спасибо всем за ваши ответы!

Ответ 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

Вызвать ShGetFileInfo. Он может рассказать вам описание ( "имя типа" в этом словаре функций), и он может дать вам дескриптор значка или дескриптор списка системных изображений, где находится значок, или путь к модулю, который содержит ресурс изображения. Эта функция может делать много разных вещей, поэтому обязательно внимательно прочитайте документацию.

MSDN говорит ShGetFileInfo "может быть медленным" и вызывает IExtractIcon - "более гибкая и эффективная" альтернатива. Но рекомендуемая им последовательность заключается в использовании IShellFolder интерфейса, затем вызовите GetUIObjectOf, чтобы получить файл IExtractIcon, а затем вызовите GetIconLocation и Extract, чтобы получить дескриптор значка.

Насколько мне известно, именно то, что 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

Не звучать, но Google - ваш друг. Вот пара первых результатов для "значка, связанного с delphi":

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

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

Ответ 6

Другим методом является поиск продолжения в реестре под HKEY_CLASSES_ROOT, затем следуйте за ключом по умолчанию (если доступно), а его по умолчанию - описание. На этом втором уровне вы также можете открыть команды оболочки или напечатать тип файла, а также путь к значку по умолчанию.

Ответ 7

Вот несколько хороших примеров использования ShGetFileInfo с bitwisemag.com:

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

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