Извлечение иконки из EXE, DLL или ICO-файла

=== Извлечение иконки из EXE, DLL или ICO-файла ===
Обратите внимание - в примере функции обьявленны иначе, чем в модуле ShellAPI
Функция SHELLAPI ExtractIconEx:
type ThIconArray = array[0..0] of hIcon;
type PhIconArray = ^ThIconArray;
function ExtractIconExA(lpszFile: PAnsiChar;
 nIconIndex: Integer;
 phiconLarge : PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external 'shell32.dll' name 'ExtractIconExA';
function ExtractIconExW(lpszFile: PWideChar;
 nIconIndex: Integer;
 phiconLarge: PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external 'shell32.dll' name 'ExtractIconExW';
function ExtractIconEx(lpszFile: PAnsiChar;
 nIconIndex: Integer;
 phiconLarge : PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external 'shell32.dll' name 'ExtractIconExA';
procedure TForm1.Button1Click(Sender: TObject);
var
 NumIcons: Integer;
 pTheLargeIcons: phIconArray;
 pTheSmallIcons: phIconArray;
 LargeIconWidth: Integer;
 SmallIconWidth: Integer;
 SmallIconHeight: Integer;
 i: Integer;
 TheIcon: TIcon;
 TheBitmap: TBitmap;
begin
 NumIcons := ExtractIconEx('C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe',
 -1,
 nil,
 nil,
 0);
 if NumIcons > 0 then
 begin
 LargeIconWidth := GetSystemMetrics(SM_CXICON);
 SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
 SmallIconHeight := GetSystemMetrics(SM_CYSMICON);
 GetMem(pTheLargeIcons, NumIcons * SizeOf(hIcon));
 GetMem(pTheSmallIcons, NumIcons * SizeOf(hIcon));
 FillChar(pTheLargeIcons^, NumIcons * SizeOf(hIcon), #0);
 FillChar(pTheSmallIcons^, NumIcons * SizeOf(hIcon), #0);
 ExtractIconEx('C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe',
 0,
 pTheLargeIcons,
 pTheSmallIcons,
 numIcons);
 {$IFOPT R+}
 {$DEFINE CKRANGE}
 {$R-}
 {$ENDIF}
 for i := 0 to (NumIcons - 1) do
 begin
 DrawIcon(Form1.Canvas.Handle,
 i * LargeIconWidth,
 0,
 pTheLargeIcons^[i]);
 TheIcon := TIcon.Create;
 TheBitmap := TBitmap.Create;
 TheIcon.Handle := pTheSmallIcons^[i];
 TheBitmap.Width := TheIcon.Width;
 TheBitmap.Height := TheIcon.Height;
 TheBitmap.Canvas.Draw(0, 0, TheIcon);
 TheIcon.Free;
 Form1.Canvas.StretchDraw(Rect(i * SmallIconWidth,
 100,
 (i + 1) * SmallIconWidth,
 100 + SmallIconHeight),
 TheBitmap);
 TheBitmap.Free;
 end;
 {$IFDEF CKRANGE}
 {$UNDEF CKRANGE}
 {$R+}
 {$ENDIF}
 FreeMem(pTheLargeIcons, NumIcons * SizeOf(hIcon));
 FreeMem(pTheSmallIcons, NumIcons * SizeOf(hIcon));
 end;
end;
end.
ID: 02343
----
Функция ExtractIcon позволяет извлечь иконку из exe, dll и ico-файлов. Если указанная иконка отсутствует, функция возвращает 0. Количество иконок, содержащихся в файле, можно узнать, указав в качестве последнего параметра –1.
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
 ic: TIcon;
 i, count: integer;
 w: integer;
begin
 if OpenDialog1.Execute = false then
 Exit;
 Form1.Canvas.FillRect(Form1.Canvas.ClipRect);
 count := ExtractIcon(Application.Handle,
 PChar(OpenDialog1.FileName), -1);
 ic := TIcon.Create;
 w := Form1.Width div 32;
 for i := 0 to count - 1 do
 begin
 ic.Handle := ExtractIcon(Application.Handle,
 PChar(OpenDialog1.FileName), i);
 Form1.Canvas.Draw(32 * (i mod w), 32 * (i div w), ic);
 end;
 ic.Destroy;
end;
Source: http://delphiworld.narod.ru/
ID: 02344
----
Извлечь основную иконку EXE-файла:
procedure TForm1.Button1Click(Sender: TObject);
var
 Icon: TIcon;
 FileInfo: SHFILEINFO;
begin
 Icon := TIcon.Create;
 try
 // Get the Icon
 SHGetFileInfo(PChar('Filename.exe'), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON);
 icon.Handle := FileInfo.hIcon;
 DestroyIcon(FileInfo.hIcon);
 // Save the Icon to a file:
 icon.SaveToFile('IconFromExe.ico');
 // Set the Icon as Application Icon (temporary)
 Application.Icon := icon;
 finally
 Icon.Free;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 02345
----
Процесс получения иконок из .EXE, .DLL или .ICO файлов полностью идентичен. Различие только в том, что в .ICO файле может храниться только одна иконка, а в .EXE и .DLL несколько. Для получения иконок из файлов, в модуле ShellAPI, есть функция:
function ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word): HIcon;
где
; Inst
: указатель на приложение вызвавшее функцию,
; FileName
: имя файла из которого необходимо получить иконку,
; IconIndex
: номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть следующая иконка.
В данном примере в компонент Image1 выводится иконка запущенного файла.
uses ShellAPI;
procedure TForm1.FormCreate(Sender: TObject);
var
 A: array [0..78] of Char;
begin
 { Получение имени запущенного файла }
 StrPCopy(A, ParamStr(0));
 { Вывод на экран нулевой иконки из файла }
 Image1.Picture.Icon.Handle := ExtractIcon(HInstance, A, 0);
end;
Если вы хотите создать некий браузер по иконкам, то можете воспользоваться компонентами с закладки Win3.1. Вынесите на форму компонент TFileListBox; затем TDirectoryListBox, в свойстве FileList укажите на список файлов [TFileListBox]; после этого возьмите компонент класса TDriveComboBox, указав в его свойстве DirList на список каталогов [TDirectoryListBox], ну, и, наконец, ставьте TFilterComboBox, который позволит в списке файлов отображать только те файлы, которые соответствуют маске, указанной в свойстве Filter. Здесь в качестве значения укажите следующее:
 ico|*.ico|dll|*.dll|exe|*.exe|all|*.ico; *.dll; *.exe 
..а в свойстве FileList задайте список файлов [TFileListBox]. В обработчике OnClick компонента TFileListBox напишите такой код:
var
 A: array [0..78] of Char;
begin
 { Получение имени файла, указанного в списке файлов }
 StrPCopy(A, FileListBox1.FileName);
 { Вывод на экран нулевой иконки из файла }
 Image1.Picture.Icon.Handle := ExtractIcon(HInstance, A, 0);
Source: http://delphiworld.narod.ru/
ID: 02346