提取应用程序中的图标资源
经常看见一些软件有着美丽，光艳夺目，非常个性化的图标，曾几何时也想拥有，可苦于缺少一点点艺术细胞，只好打起妙手空空的念头。经过一天的捉摸，也找到一些门道，效果还佳，再用delphi自带的Image Editor加以修改，彻底私有化，为我所用。洒家用此法做了一些漂亮的图标，令老友羡慕不已。好了，好东西当然不敢独享，且容我为各位慢慢道来：
首先用API函数LoadLibrary(lpLibFileName: PChar): HMODULE; stdcall; 把指定的程序模块映射到调用程序的地址空间去。该函数返回模块的句柄，假定为hExe;
然后用EnumResourceNames(hExe,RT_ICON,@EnumResName,myflag)找到图标的资源名，其中参数EnumResName是回调函数，图标的name值将由回调函数的一个变参得到。
然后再向回调函数体内加入代码提取图标就可以了。EnumResourceNames函数将会一直查找每一个图标直到查找失败或EnumResName返回false值为止。这样我们就能提取程序所包含的每一个图标，榨尽最后一滴油，够狠吧！
详细代码如下：
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ImgList;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
OpenDialog1: TOpenDialog;
ListView1: TListView;
StatusBar1: TStatusBar;
ImageList1: TImageList;
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
FileName: TFileName;
FIcon: TIcon;
public
{ Public declarations }
end;
Function EnumResName(hModule: HMODULE; lpType, lpName: PChar;lParam: Longint):BOOL;stdcall;
var
Form1: TForm1;
hExe: HINST;
implementation
{＄R ＊.DFM}
Function EnumResName(hModule: HMODULE; lpType, lpName: PChar;lParam: Longint):BOOL; //回调函数不能是对象方法
//lpType是要提取的资源类型，这里为RT_ICON
//lpName为图标资源名
var
hIcon1: HICON;
hResource: HRSRC;
hMem: HRSRC;
lpResource: PByte;
ListItem: TListItem;
Begin
//返回在hExe模块中lpName指定的图标资源的句柄；
hResource:=FindResource(hExe,lpName,RT_ICON);
//Load and Lock the icon
hMem:=LoadResource(hExe,hResource);
lpResource:=LockResource(hMem);
//从资源文件中创建图标并返回其句柄
hIcon1:=Create Iconfrom Resource Ex(lp Resource,Sizeof Resource(hExe,h Resource),True,＄00030000,32,32,LR－DEFAULTCOLOR);
with Form1 do
begin
//用控件ImageList保存提取的图标，并在ListView中显示出来
FIcon.Handle:=hIcon1;
ImageList1.AddIcon(fIcon);
ListItem:=ListView1.Items.Add;
ListItem.ImageIndex:=ImageList1.Count－1;
end;
result:=true;//注意：只有返回为真值时，才能继续提取下一个图标
end;
procedure TForm1.Open1Click(Sender: TObject);
var
myflag: integer;
begin
if Opendialog1.Execute then
begin
FileName:=Opendialog1.FileName;
StatusBar1.Panels.Items[0].Text:=FileName;
Opendialog1.HistoryList.Add(FileName);
hExe:=LoadLibrary((PCharFileName));
myflag:=1;
ImageList1.Clear;
ListView1.Items.Clear;
EnumResourceNames(hExe,RT_ICON,@EnumResName,myflag);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FIcon:=TIcon.Create;
Opendialog1.Filter:='可执行文件(＊.exe)|＊.exe';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FIcon.Free;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
end.
篇幅所限，存盘和查错的代码没有列出
本文地址：http://com.8s8s.com/it/it6143.htm