下面的代碼示范了一個完整的提取圖標、存儲圖標的程序:
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作適量的修改即可!
新聞熱點
疑難解答