Как отобразить иконку, связанную с типом файла

© 2002 Галимарзанов Фанис

Очень часто - например, при выводе в ListView списка файлов, требуется отобразить "иконку расширения файла" - так, как это делает Windows.

Проблема заключается в том, что для решения этой задачи требуется как минимум два компонента - TImageList и TlistView, причем элементы обоих компонетов придется формировать динамически, или

Procedure TmainForm.AddNewItem(aFileName:string);
  Var
    NewItem:TlistItem;
Begin
  NewItem:=MyListView.Add;
  NewItem.Caption:= aFileName;
  NewItem.ImageIndex:=????? // Кто вернет индекс?
End;

Кто вернет ImageIndex и вообще, где и как найти иконку?

При решении этой проблемы я перебрал несколько вариантов, но все они крутились вокруг ExtractAssociatedIcon – увы, нет под рукой MSDN, посему ничего не получалось. Отчаявшись, попросил помощи у коллег – ответ пришел почти мгновенно:

Fanis wrote:
Привет!
При отображении в PopMenu имен приаттаченных к сообщению файлов хочу также отрисовывать иконки в соответствии с расширением файла. День потерял, но...
Сам не пробовал, но вдруг поможет

============ //Author: Pascal Enz
uses
ShellApi;

function GetAssociatedIcon(const AExtension: string; ASmall: Boolean): HIcon;
var
  Info: TSHFileInfo;
  Flags: Cardinal;
begin
  if ASmall then
    Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES
  else
    Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES;

  SHGetFileInfo(PChar(AExtension), FILE_ATTRIBUTE_NORMAL, Info,
  SizeOf(TSHFileInfo), Flags);
  Result := Info.hIcon;
end;
============
Игорь Захребетков

Игорь, еше раз спасибо!
Протестировав пример, пришел к выводу, что это именно то, что я искал. Оставалось лишь найти способ хранения связки «расширение файла-иконка» и приспособить его для возврата ImageIndex. Ниже базовое решение – этого достаточно, чтобы приспособить для "внутреннего употребления". В тестовом проекте реализованы некоторые варианты его использования - для TListView и TPopupMenu.

unit ext_icon;

interface
uses Windows,controls,contnrs,classes;
type

  // В этом объекте будут храниться имена расширений файлов,
  // дескрипторы HICON и индесы иконок в TImageList
  TExtFileIcon=class(TObject)
    private
      fExtName:string;
      fExtIcon:HICON;
      fPosInImageList:integer;
    public
      property ExtName:string read fExtName write fExtName;
      property ExtIcon:HICON read fExtIcon write fExtIcon;
      property PosInImageList:integer read fPosInImageList write fPosInImageList;
      constructor Create(aExtname:string; aExtIcon:HICON; aPosInImageList:integer);
      destructor Destroy;override;
  end;

  // Здесь будет храниться список объектов TextFileIcon
  // Здесь решается вопрос, кто должен вернуть индекс
  TExtIconList=class(TObjectList)
    private
      fExtImageList:TImageList;
      procedure SetExtImageList(Value:TImageList);
    public
    // Указатель на TImageList
      property ExtImageList:TImageList read fExtImageList write SetExtImageList;       function GetPosInImageList(aExtName:string):integer;
      destructor Destroy;override;
  end;

function GetAssociatedIcon(const AExtension: string; ASmall: Boolean): HIcon;

implementation

uses ShellApi,SysUtils,graphics;

function GetAssociatedIcon(const AExtension: string; ASmall: Boolean): HIcon;
var
  Info: TSHFileInfo;
  Flags: Cardinal;
begin
  if ASmall then
    Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES
  else
    Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES;
  SHGetFileInfo(PChar(AExtension), FILE_ATTRIBUTE_NORMAL, Info, SizeOf(TSHFileInfo), Flags);
  Result := Info.hIcon;
end;

constructor TExtFileIcon.Create(aExtname:string; aExtIcon:HICON; aPosInImageList:integer);
begin
  inherited Create;
  fExtName:=fExtName; // Расширение файла
  fExtIcon:=aExtIcon; // Дескриптор иконки
  fPosInImageList:=aPosInImageList; // Индекс TImageList
end;

destructor TExtFileIcon.Destroy;
begin
  fExtName:='';
  // Иконка была создана вызовом SHGetFileInfo,
  // поэтому на нас «висит» ее уничтожение
  if fExtIcon<>0 then DestroyIcon(fExtIcon);
  fExtIcon:=0;
  inherited Destroy;
end;

procedure TExtIconList.SetExtImageList(Value:TImageList);
begin
  fExtImageList:=Value;
end;

// Вот кто возвращает требуемый индекс
function TExtIconList.GetPosInImageList(aExtName:string):integer;
var
  j:integer;
  xIcon:TIcon;
  s:string;
begin
  // Результат по умолчанию
  Result:=-1;
  if Assigned(fExtImageList) then
    begin
      // Если TImageList определен, то начнем
      s:=lowercase(ExtractFileExt(aExtName));
      // начнем перебор объектов
      for j:=0 to Count-1 do
        begin
          if TExtFileIcon(Items[j]).ExtName=s then
            // если есть совпадение «расширений», то
            begin
            // вернем индекс
            Result:=TExtFileIcon(Items[j]).PosInImageList;
            Exit;
          end
        end;
      // Ага, в списке не нашли, значит надо его дополнить
      // Создадим контейнер иконки
      xIcon:=TIcon.Create;
      // Установим его дескриптор как результат функции GetAssociatedIcon
      xIcon.Handle:=GetAssociatedIcon(s,true);
      // Индекс иконки найдем через
      Result:=fExtImageList.AddIcon(xIcon);
      // Дополним наш список новым объектом
      Add(TExtFileIcon.Create(s,xIcon.Handle,Result));
    end;
end;

destructor TExtIconList.Destroy;
begin
  fExtImageList:=nil;
  Clear;
  inherited Destroy;
end;

end.

Исходники (5.59К).

---

Copyright© 2002 Галимарзанов Фанис  Специально для Delphi Plus