一个从EXE、DLL文件中提取、存取图标完整程序

详细描述：
  

       作为一名程序员，会经常为制作、设计程序图标费尽心思，当我们看到许多应用软件的图标非常漂亮的时候，是多么的羡慕！我们可不可以借鉴一下他们的图标？完全可以！我们利用 ExtractIcon API函数就能够轻松地从ICO文件或可执行文件以及DLL文件中提取图标。

     下面的代码示范了一个完整的提取图标、存储图标的程序：

 

unit Unit1;

 

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;

  I:Integer=0;

  FileName:String='';

 

 

implementation

 

{$R *.dfm}

 

{ TForm1 }

 

procedure TForm1.MoveIconIndex(const OperateString: 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.