Delphi从EXE或DLL获取ICO图标

WinAPI: ExtractIcon - 获取 EXE、DLL 或 ICO 文件中的图标

//声明:

ExtractIcon(
hInst: HINST; {调用函数的程序实例}
lpszExeFileName: PChar; {文件路径; 文件可以是 *.exe、*.dll、*.ico}
nIconIndex: UINT {图标索引}
): HICON; {返回图标句柄; 索引为 0 时返回第一个图标句柄; 索引为 #FFFFFFFF 时返回图标总数}

//举例:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI; {ExtractIcon 在其中声明}

procedure TForm1.Button1Click(Sender: TObject);
var
ico: TIcon;
i,count,x,y,w,h: Integer;
FilePath: string;
begin
{随便找了个路径, 如果缺失会退出}
FilePath := 'C:\Program Files\Macromedia\Fireworks 8\Fireworks.exe';
if not FileExists(FilePath) then begin ShowMessage('文件不存在'); Exit; end;

ico := TIcon.Create;
x := 10; y := 10; w := 0; h := 0;
Repaint;

{先算出文件内的图标总数}
count := ExtractIcon(HInstance, PChar(FilePath), HICON(-1));

for i := 0 to count - 1 do
begin
{循环提取图标}
ico.Handle := ExtractIcon(HInstance, PChar(FilePath), i);

{画出图标}
Canvas.Draw(x,y,ico);

{下面只是调整显示位置}
if w < ico.Width then w := ico.Width;
if h < ico.Height then h := ico.Height;
x := x + ico.Width + 10;
if x >= ClientWidth - w then
begin
x := 10;
y := y + h + 10;
end;
end;

ico.Free;
end;

end.

例2：

unit Unit1;

 

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI;

{ 从 EXE 或 DLL 中获取 ICO 图标的函数, 需要 uses ShellAPI }
function GetIco(const ExePath: string; SavePath: string): Integer; { 返回获取总数 }
var
  ico: TIcon;
  i, count: Integer;
  FileName: string;
begin
  Result := 0;
  count := ExtractIcon(HInstance, PChar(ExePath), $FFFFFFFF);
  if count = 0 then
    Exit;

  if not DirectoryExists(SavePath) then
    ForceDirectories(SavePath);
  FileName := ChangeFileExt(ExtractFileName(ExePath), '');
  SavePath := ExcludeTrailingPathDelimiter(SavePath)
    + '\' + FileName + '_%.3d.ico';

  ico := TIcon.Create;
  for i := 0 to count - 1 do
  begin
    ico.Handle := ExtractIcon(HInstance, PChar(ExePath), i);
    ico.SaveToFile(Format(SavePath, [i + 1]));
  end;
  ico.Free;
  Result := count;
end;

{ 测试: 获取当前程序图标 }
procedure TForm1.Button1Click(Sender: TObject);
begin
  GetIco(ParamStr(0), Application.ExeName + 'ICO');
end;

{ 测试: 获取记事本图标 }
procedure TForm1.Button2Click(Sender: TObject);
var
  buf: array [0 .. MAX_PATH] of Char;
begin
  // GetSystemDirectory(buf, Length(buf) * SizeOf(buf[0]));
  if OpenDialog1.Execute then
    GetIco(OpenDialog1.FileName, Application.ExeName + 'ICO');
  ShowMessage(Application.ExeName + 'ICO 中图片图片保存ok');
end;

{ 测试: 获取 Windows 的标准图标库 }
procedure TForm1.Button3Click(Sender: TObject);
var
  buf: array [0 .. MAX_PATH] of Char;
begin
  GetSystemDirectory(buf, Length(buf) * SizeOf(buf[0]));
  GetIco(buf + '\Shell32.dll', Application.ExeName + 'ICO 中图片图片保存ok');
end;

end.

 

窗体文件

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 194
  ClientWidth = 206
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button2: TButton
    Left = 24
    Top = 32
    Width = 131
    Height = 25
    Caption = #33719#21462'dll,exe'#20013#30340'ICO'#22270#29255
    TabOrder = 0
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 24
    Top = 87
    Width = 161
    Height = 25
    Caption = #33719#21462#31995#32479'Shell32.dll'#20013'ico'#22270#29255
    TabOrder = 1
    OnClick = Button3Click
  end
  object OpenDialog1: TOpenDialog
    Left = 168
    Top = 24
  end
end

 

来源：https://www.cnblogs.com/blogpro/p/11344001.html