//将其他程序的图标作为自己程序的图标 //以记事本为例 procedure TForm1.FormCreate(Sender:TObject); var myIcon:HIcon; begin myIcon:=ExtractIcon(self.handle,'c:\windows\notepad.exe',0); if myIcon<2 then Statusbar1.SimpleText:='Load Icon Failure!' else begin StatusBar1.SimpleText:='Load Icon OK'; self.Icon.Handle:=myIcon; //self.Icon.SaveToFile('c:\myicon.ico');保存图标到文件 end; end;
调用系统API可以对可执行文件更改图标: SHChangeIconDialog(hwnd,filename,0,index); function SHChangeIconDialog;external 'shell32.dll' index 62; function SHChangeIconDialog(h:hwnd;filename:pchar; Reserved:integer;var index:integer):integer;stdcall;{ procedure TForm1.Button1Click(Sender: TObject); var b:integer; str:array[0..MAX_PATH] of char; begin b:=0; if opendialog1.Execute then begin strpcopy(str,opendialog1.filename); shChangeIconDialog(handle,str,0,b); end; showmessage(str); end; }function SHChangeIconDialog(h:hwnd;filename:pchar; Reserved:integer;var index:integer):integer;stdcall;
找到图标资源-选取一个图标文件-替换-WIN显示
2.可执行文件的图标是在菜单project下选择option,然后选择application页面,看见图标了吧!
可执行文件:菜单project-->build all projects
参考Delphi自带的例子程序ResxplorAPI:
BOOL UpdateResource(
HANDLE hUpdate, // 用BeginUpdateResource获得的Handle
LPCTSTR lpType, // 资源类型名称(例如 RT_ICON, RT_ANIICON, 等)
LPCTSTR lpName, // 需要修改的资源的名称
WORD wLanguage, // 资源的语言类型, 可以使用MAKELANGID构造
LPVOID lpData, // 存放资源的二进制数据的地址
DWORD cbData // 用字节描述的数据的长度
); 还需要参考
BeginUpdateResource,
EndUpdateResource,
LoadIcon,
LoadString,
LockResource,
MAKEINTRESOURCE,
MAKELANGID,
SizeofResource
//以记事本为例
procedure TForm1.FormCreate(Sender:TObject);
var
myIcon:HIcon;
begin
myIcon:=ExtractIcon(self.handle,'c:\windows\notepad.exe',0);
if myIcon<2 then
Statusbar1.SimpleText:='Load Icon Failure!'
else
begin
StatusBar1.SimpleText:='Load Icon OK';
self.Icon.Handle:=myIcon;
//self.Icon.SaveToFile('c:\myicon.ico');保存图标到文件
end;
end;
SHChangeIconDialog(hwnd,filename,0,index);
function SHChangeIconDialog;external 'shell32.dll' index 62;
function SHChangeIconDialog(h:hwnd;filename:pchar; Reserved:integer;var index:integer):integer;stdcall;{
procedure TForm1.Button1Click(Sender: TObject);
var
b:integer;
str:array[0..MAX_PATH] of char;
begin
b:=0;
if opendialog1.Execute then
begin
strpcopy(str,opendialog1.filename);
shChangeIconDialog(handle,str,0,b);
end;
showmessage(str);
end;
}function SHChangeIconDialog(h:hwnd;filename:pchar; Reserved:integer;var index:integer):integer;stdcall;
执行程序生成可执行程序,这就不是一般的技巧了,不是一般人能掌握的。
去问微软、Borland那些写编译程序、连接程序的专家吧。
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,shellapi;type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
OpenDialog2: TOpenDialog;
StatusBar1: TStatusBar;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;procedure TForm1.Button1Click(Sender: TObject);
const
readlen=10; //每次读取字节数,可改变
icolen=766;//32*32图标长度,根据研究前126为图标头,后640为图标数据
var
i,j,itemp,nPos:int64;// nPos为目的图标在目的文件的位置
ci,cj:array[0..readlen-1] of char;
SourceFile,DestFile:String;//如果要把记事本图标换成瑞星杀毒软件图标
bOK:boolean;//则SourceFile='C:\windows\notepad.exe',DestFile:='C:\Progra
m Files\rising\rav\ravmon.exe'
SourceIcon,DestIcon:TIcon;
SIconStream,s,sDest:TMemoryStream;
begin
bOK:=false;
if OpenDialog1.Execute then
SourceFile:=OpenDialog1.FileName
else
exit;
if AnsiUpperCase(ExtractFileExt(SourceFile))<>'.EXE' then
begin
ShowMessage(AnsiUpperCase(ExtractFileExt(SourceFile)));
exit;
end;
Edit1.Text:=SourceFile;
if OpenDialog2.Execute then
DestFile:=OpenDialog2.FileName
else
exit;
if AnsiUpperCase(ExtractFileExt(DestFile))<>'.EXE' then
exit;
Edit2.Text:=DestFile;
SourceIcon:=TIcon.Create;
case ExtractIcon(handle,PChar(SourceFile),UINT(-1)) of
0:begin ShowMessage('源程序没有图标');exit;end;
1:;
else ShowMessage('源程序有多个图标,本程序选择第一个图标');
end;
SourceIcon.Handle:=ExtractIcon(handle,PChar(SourceFile),0);//选择第一个图
标
DestIcon:=TIcon.Create;//选择第N个图标为 ExtractIcon(handle,PChar(Source
File),N-1)
case ExtractIcon(handle,PChar(DestFile),UINT(-1)) of
0:begin ShowMessage('目的程序没有图标');exit;end;
1:;
else ShowMessage('目的程序有多个图标,本程序选择第一个图标替换');
end;
DestIcon.Handle:=ExtractIcon(handle,PChar(DestFile),0);//选择第一个图标
SIconStream:=TMemoryStream.Create;
DestIcon.SaveToStream(sIconStream);
if sIconStream.size<>icolen then
ShowMessage('SIcon.size<>icolen');
SDest:=TMemoryStream.Create;
sDest.LoadFromFile(DestFile);
i:=0;j:=0; //以下程序查找目的图标在目的程序中的位置
while i< sDest.size do
begin
itemp:=i;
j:=126;
{ repeat
SDest.Position:=i;
sDest.read(ci,Readlen);
SiconStream.Position:=j;
SIconStream.Read(cj,Readlen);
i:=i+Readlen;
j:=j+Readlen;
until (String(ci)=String(cj)) and (i<sDest.size) and (j<icolen);
} ci:='';cj:='';
while (String(ci)=String(cj)) and (i<SDest.size) and (j<
icolen) do
begin
i:=i+readlen;
j:=j+readlen;
SDest.Position:=i;
SDest.read(ci,readlen);
SiconStream.Position:=j;
SiconStream.Read(cj,readlen);
end;
if j<icolen then
i:=itemp+1 //没找到
else
begin
nPos:=itemp; //找到
bOK:=true;
break;
end;
end;
if bOK=false then
exit;//目标文件二进制码中未找到图标
SIconStream.Clear;//将源程序图标存入
SourceIcon.SaveToStream(SIconStream); SIconStream.position:=126;
s:=TMemoryStream.Create; sDest.Position:=0;
s.CopyFrom(sDest,nPos);//将目的程序图标前数据拷入
s.CopyFrom(SIconStream,640); //将源程序图标拷入
if sDest.size>sDest.Position+640 then //将目的程序剩余数据拷入
begin
sDest.Position:=sDest.Position+640;
s.CopyFrom(sDest,sDest.Size-sDest.Position);
end;
s.SaveToFile(Extractfilepath(application.exename)+'Result.exe');
SourceIcon.Free;DestIcon.Free; //改造好的程序存放在本目录Result.exe文件中
SIconStream.Free;s.Free;sDest.Free;
ShowMessage(Extractfilepath(application.exename)+'Result.exe');
end;
//以上程序可以将目的程序的第一个图标换成源程序的第一个图标,经实证很多程序有二个
//或更多图标,转换原理相似,不在陈述
end.
对于图标,菜单project-->option->aplication->图标