Delphi从EXE或DLL获取ICO图标

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