提取應用程式中的圖示資源 (轉)

提取應用程式中的圖示資源 (轉)[@more@]

提取應用中的圖示資源

---

　　經常看見一些有著美麗，光豔奪目，非常個性化的圖示，曾幾何時也想擁有，可苦於缺少一點點藝術細胞，只好打起妙手空空的念頭。經過一天的捉摸，也找到一些門道，效果還佳，再用自帶的Image Editor加以修改，徹底私有化，為我所用。灑家用此法做了一些漂亮的圖示，令老友羨慕不已。好了，好東西當然不敢獨享，且容我為各位慢慢道來：
首先用LoadLibrary(lpLibFileName: PChar): HMODULE; stdcall; 把指定的程式模組對映到程式的地址空間去。該函式返回模組的控制程式碼，假定為hExe;
然後用EnumReNames(hExe,RT_ICON,@EnumResName,myflag)找到圖示的資源名，其中引數EnumResName是回撥函式，圖示的name值將由回撥函式的一個變參得到。
然後再向回撥函式體內加入程式碼提取圖示就可以了。EnumResourceNames函式將會一直查詢每一個圖示直到查詢失敗或EnumResName返回false值為止。這樣我們就能提取程式所包含的每一個圖示，榨盡最後一滴油，夠狠吧！
詳細程式碼如下：
unit main;
interface
uses
, 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;
Statar1: TStatusBar;
ImageList1: TImageList;
procedure Open1Click(Sender: T);
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.
篇幅所限，存檔和查錯的程式碼沒有列出