本文整理自网络，侵删。
代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
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), 'c:\temp');
end;
{测试: 获取记事本图标}
procedure TForm1.Button2Click(Sender: TObject);
var
buf: array[0..MAX_PATH] of Char;
begin
GetSystemDirectory(buf, Length(buf)*SizeOf(buf[0]));
GetIco(buf + '\notepad.exe', 'c:\temp');
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','c:\temp');
end;
end.
相关阅读 >>
Delphi ado 连接 excel （附excel各个版本的版本号）
更多相关阅读请进入《Delphi》频道 >>
