一個從EXE、DLL文件中提取、存取圖標完整程序

作為一名程序員，會經常為制作、設計程序圖標費盡心思，當我們看到許多應用軟件的圖標非常漂亮的時候，是多麼的羨慕！我們可不可以借鑒一下他們的圖標？完全可以！我們利用 ExtractIcon API函數就能夠輕松地從ICO文件或可執行文件以及DLL文件中提取圖標。
　　

　　     下面的代碼示范了一個完整的提取圖標、存儲圖標的程序：
　　unit UFormIconGrabber;
　　interface
　　uses
　　  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　　  StdCtrls, ExtCtrls, ShellAPI, ExtDlgs;
　　type
　　  TForm1 = class(TForm)
　　    Image1: TImage;
　　    btNextIcon: TButton;
　　    Label1: TLabel;
　　    EditFileName: TEdit;
　　    btBowserFile: TButton;
　　    OpenDialog1: TOpenDialog;
　　    btSaveIco: TButton;
　　    SavePictureDialog1: TSavePictureDialog;
　　    btPrevirousIcon: TButton;
　　    procedure btNextIconClick(Sender: TObject);
　　    procedure btBowserFileClick(Sender: TObject);
　　    procedure btSaveIcoClick(Sender: TObject);
　　    procedure btPrevirousIconClick(Sender: TObject);
　　  private
　　    { Private declarations }
　　  public
　　    { Public declarations }
　　    Procedure MoveIconIndex(Const OperateString:String);
　　  end;
　　var
　　  Form1: TForm1;
　　implementation
　　{$R *.DFM}
　　procedure TForm1.MoveIconIndex(Const OperateString:String);
　　const
　　 I : Integer = 0;
　　 FileName : String = '';
　　var
　　 Count : Integer;
　　begin
　　 if( FileName <> EditFileName.Text ) then
　　     begin
　　         FileName := EditFileName.Text;
　　         I := 0;
　　     end
　　 else
　　     if OperateString='MoveNextIcon' then
　　        Inc(I)
　　     else
　　        begin
　　            if I>0 then
　　               dec(I);
　　        end;
　　//得到總的圖標數目
　　 Count := ExtractIcon( Application.Handle, PChar(FileName),$FFFFFFFF);
　　 if( I < Count ) then
　　  Image1.Picture.Icon.Handle :=
　　   ExtractIcon( Application.Handle, PChar(FileName), I ) // I為圖標的索引
　　 else
　　   ShowMessage('此文件沒有更多的圖標資源！' );
　　end;
　　procedure TForm1.btNextIconClick(Sender: TObject);
　　begin
　　 MoveIconIndex('MoveNextIcon');
　　end;
　　procedure TForm1.btBowserFileClick(Sender: TObject);
　　begin
　　     try
　　        OpenDialog1.Title:='選擇EXE文件或DLL文件：';
　　        OpenDialog1.Filter:='提取文件(*.EXE;*.DLL;*.ICO)|*.DLL;*.EXE;*.ICO|All files (*.*)|*.*';
　　        OpenDialog1.FilterIndex:=1;
　　        if OpenDialog1.Execute then
　　           EditFileName.Text :=OpenDialog1.FileName;
　　        MoveIconIndex('MoveNextIcon');  
　　     except
　　        exit;
　　     end;

　　end;

　　procedure TForm1.btSaveIcoClick(Sender: TObject);
　　begin
　　     SavePictureDialog1.DefaultExt := GraphicExtension(TIcon);
　　     SavePictureDialog1.Filter := GraphicFilter(TIcon);
　　     if SavePictureDialog1.Execute then
　　        image1.Picture.SaveToFile(SavePictureDialog1.FileName);
　　end;
　　procedure TForm1.btPrevirousIconClick(Sender: TObject);
　　begin
　　    MoveIconIndex('MovePrevIcon');
　　end;
　　end.
　　       OK!，這樣我們使用TImage.Picture.SaveToFile方法就可以很容易地將圖標保存到單獨的文件中，然後再利用Image Editor作適量的修改即可！