從 EXE 或 DLL 中獲取圖標的函數

代碼文件:

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.　

　　窗體文件:

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　Button1:　TButton　
　　Left　=　64　
　　Top　=　32　
　　Width　=　75　
　　Height　=　25　
　　Caption　=　'Button1'　
　　TabOrder　=　0　
　　OnClick　=　Button1Click　
　end　
　object　Button2:　TButton　
　　Left　=　64　
　　Top　=　80　
　　Width　=　75　
　　Height　=　25　
　　Caption　=　'Button2'　
　　TabOrder　=　1　
　　OnClick　=　Button2Click　
　end　
　object　Button3:　TButton　
　　Left　=　64　
　　Top　=　127　
　　Width　=　75　
　　Height　=　25　
　　Caption　=　'Button3'　
　　TabOrder　=　2　
　　OnClick　=　Button3Click　
　end　
end　
a