10-17-2011، 08:34 PM
Hi guys didn't find anywhere an unit capable of changing icons for apps compiled with delphi xe so i decided to write one. Is not exactly scientific but gets the job done
کد:
//Credits ??
unit vIconChanger;
interface
uses
Windows, Classes, SysUtils, Graphics;
procedure ChangeIcon(FileName, IconFile, ResName:string);
implementation
type
TNewHeader = record
idReserved:WORD;
idType:WORD;
idCount:WORD;
end;
TResDirHeader = packed record
bWidth:Byte;
bHeight:Byte;
bColorCount:Byte;
bReserved:Byte;
wPlanes:WORD;
wBitCount:WORD;
lBytesInRes:Longint;
end;
TIconFileResDirEntry = packed record
DirHeader:TResDirHeader;
lImageOffset:Longint;
end;
TIconResDirEntry = packed record
DirHeader:TResDirHeader;
wNameOrdinal:WORD;
end;
PIconResDirGrp = ^TIconResDirGrp;
TIconResDirGrp = packed record
idHeader:TNewHeader;
idEntries:array[0..0] of TIconResDirEntry;
end;
PIconFileResGrp = ^TIconFileResDirGrp;
TIconFileResDirGrp = packed record
idHeader:TNewHeader;
idEntries:array[0..0] of TIconFileResDirEntry;
end;
TBeginUpdateRes=function(pFileName: PChar; bDeleteExistingResources: BOOL): THandle; stdcall;
TUpdateRes=function(hUpdate: THandle; lpType, lpName: PChar;
wLanguage: Word; lpData: Pointer; cbData: DWORD): BOOL; stdcall;
TEndUpdateRes=function(hUpdate: THandle; fDiscard: BOOL): BOOL; stdcall;
function MakeLangID:WORD;
begin
Result:=(SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
end;
procedure ChangeIcon(FileName, IconFile, ResName:string);
var
I:Integer;
Group:Pointer;
Header:TNewHeader;
FileGrp:PIconFileResGrp;
IconGrp:PIconResDirGrp;
IconGrpSize,
FileGrpSize:Integer;
Icon:TIcon;
Stream:TMemoryStream;
hUpdateRes:THandle;
begin
hUpdateRes:=BeginUpdateResource(PChar(FileName), False);
Win32Check(hUpdateRes <> 0);
Icon:=TIcon.Create;
Icon.LoadFromFile(IconFile);
Stream:=TMemoryStream.Create;
try
Icon.SaveToStream(Stream);
finally
Icon.Free;
end;
Stream.Position:=0;
Stream.Read(Header, SizeOf(Header));
FileGrpSize := SizeOf(TIconFileResDirGrp) + (Header.idCount - 1) * SizeOf(TIconFileResDirEntry);
IconGrpSize := SizeOf(TIconResDirGrp) + (Header.idCount - 1) * SizeOf(TIconResDirEntry);
GetMem(FileGrp, FileGrpSize);GetMem(IconGrp, IconGrpSize);
Stream.Position:=0;
Stream.Read(FileGrp^, FileGrpSize);//loading icongroup
Group:=nil;
try
for I:=0 to FileGrp^.idHeader.idCount - 1 do //building icongroup from loaded entries
begin
with IconGrp^ do
begin
idHeader:=FileGrp^.idHeader;
idEntries[I].DirHeader:=FileGrp^.idEntries[I].DirHeader;
idEntries[I].wNameOrdinal:=I;//fixing Ordinals
end;
with FileGrp^.idEntries[I] do
begin
Stream.Seek(lImageOffset, soFromBeginning);
ReallocMem(Group, DirHeader.lBytesInRes);
Stream.Read(Group^, DirHeader.lBytesInRes);
Win32Check(UpdateResource(hUpdateRes,RT_ICON,PChar(MakeIntResource(I)),
MakeLangID, Group, DirHeader.lBytesInRes));
end;
end;
Win32Check(UpdateResource(hUpdateRes,RT_GROUP_ICON, PChar(ResName),
MakeLangID, IconGrp, IconGrpSize));//adding the icongroup
Win32Check(EndUpdateResource(hUpdateRes, False));
finally
Stream.Free;
FreeMem(FileGrp);
FreeMem(IconGrp);
FreeMem(Group);
end;
end;
var
hLib:HMODULE;
BeginUpdateRes:TBeginUpdateRes;
UpdateRes:TUpdateRes;
EndUpdateRes:TEndUpdateRes;
procedure GetFunctions(hLib:HMODULE);
begin
@BeginUpdateRes:=GetProcAddress(hLib,'BeginUpdateResourceA');
@UpdateRes:=GetProcAddress(hLib,'UpdateResourceA');
@EndUpdateRes:=GetProcAddress(hLib,'EndUpdateResourceA');
end;
initialization
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
hLib:=LoadLibrary('unicows.dll')
else
hLib:=GetModuleHandle('Kernel32.dll');
if hLib > 0 then GetFunctions(hLib);
finalization
if GetModuleHandle('unicows.dll') > 0 then
FreeLibrary(hLib);
end.کد:
unit UntIconChanger;
interface
uses Windows, SysUtils, Classes ;
type
TIconModifier = Class(TComponent)
private
FSourceFile : String ;
FDestFile : String ;
procedure SetSourceFile(AFile: String) ;
procedure SetDestFile(AFile: String) ;
function ModifyIconForNt(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
function ModifyIconFor9x(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
public
property SourceFile: String Read FSourceFile Write SetSourceFile ;
property DestFile : String Read FDestFile Write SetDestFile ;
function ModifyIcon(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
end;
implementation
procedure TIconModifier.SetSourceFile(AFile: String);
begin
FSourceFile := AFile ;
end;
procedure TIconModifier.SetDestFile(AFile: String);
begin
FDestFile := AFile ;
end;
function TIconModifier.ModifyIconForNt(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
var
hModule : Cardinal ;
hResFind : Cardinal ;
hResLoad : Cardinal ;
pResLock : PChar ;
hResUpdate: Cardinal ;
begin
Result := false ;
hModule := LoadLibrary(PChar(FSourceFile));
if hModule = 0 then
Exit ;
try
hResFind := FindResource(hModule, MakeIntResource(SourceIndex+1), RT_ICON) ;
if hResFind = 0 then
Exit ;
hResLoad := LoadResource(hModule, hResFind) ;
if hResLoad = 0 then
Exit ;
pResLock := LockResource(hResLoad) ;
if pResLock = nil then
Exit ;
hResUpdate := BeginUpdateResource(PChar(FDestFile), false) ;
if hResUpdate = 0 then
Exit ;
if not UpdateResource(hResUpdate,
RT_ICON,
MakeIntResource(DestIndex + 1),
0, //local language
pResLock,
SizeofResource(hModule, hResFind)) then
Exit ;
if not EndUpdateResource(hResUpdate, false) then
Exit ;
finally
FreeLibrary(hModule) ;
end;
Result := true ;
end;
function TIconModifier.ModifyIconFor9x(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
begin
Result := false ;
end;
function TIconModifier.ModifyIcon(SourceIndex, DestIndex: Cardinal = 1): Boolean ;
begin
Result := false ;
if Win32PlatForm = VER_PLATFORM_WIN32_NT then
Result := ModifyIconForNt(SourceIndex, DestIndex)
else
Result := ModifyIconFor9x(SourceIndex, DestIndex) ; // not implement now.
end;
end.کد:
unit iconchanger;
{shaped by shapeless}
interface
uses windows;
type
PICONDIRENTRYCOMMON = ^ICONDIRENTRYCOMMON;
ICONDIRENTRYCOMMON = packed record
bWidth : Byte; // Width, in pixels, of the image
bHeight : Byte; // Height, in pixels, of the image
bColorCount : Byte; // Number of colors in image (0 if >=8bpp)
bReserved : Byte; // Reserved ( must be 0)
wPlanes : Word; // Color Planes
wBitCount : Word; // Bits per pixel
dwBytesInRes : DWord; // How many bytes in this resource?
end;
PICONDIRENTRY = ^ICONDIRENTRY;
ICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
dwImageOffset : DWord; // Where in the file is this image?
end;
PICONDIR = ^ICONDIR;
ICONDIR = packed record
idReserved : Word; // Reserved (must be 0)
idType : Word; // Resource Type (1 for icons)
idCount : Word; // How many images?
idEntries : ICONDIRENTRY; // An entry for each image (idCount of 'em)
end;
PGRPICONDIRENTRY = ^GRPICONDIRENTRY;
GRPICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
nID : Word; // the ID
end;
PGRPICONDIR = ^GRPICONDIR;
GRPICONDIR = packed record
idReserved : Word; // Reserved (must be 0)
idType : Word; // Resource type (1 for icons)
idCount : Word; // How many images?
idEntries : GRPICONDIRENTRY; // The entries for each image
end;
function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
implementation
function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
var hFile : Integer;
id : ICONDIR;
pid : PICONDIR;
pgid : PGRPICONDIR;
uRead : DWord;
nSize : DWord;
pvFile : PByte;
hInst : LongInt;
begin
result := False;
hFile := CreateFile(srcicon, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile > 0 then
begin
ReadFile(hFile, id, sizeof(id), uRead, nil);
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
GetMem(pid, sizeof(ICONDIR) + sizeof(ICONDIRENTRY));
GetMem(pgid, sizeof(GRPICONDIR) + sizeof(GRPICONDIRENTRY));
ReadFile(hFile, pid^, sizeof(ICONDIR) + sizeof(ICONDIRENTRY), uRead, nil);
move(pid^, pgid^, sizeof(GRPICONDIR));
pgid^.idEntries.common := pid^.idEntries.common;
pgid^.idEntries.nID := 1;
nSize := pid^.idEntries.common.dwBytesInRes;
GetMem(pvFile, nSize);
SetFilePointer(hFile, pid^.idEntries.dwImageOffset, nil, FILE_BEGIN);
ReadFile(hFile, pvFile^, nSize, uRead, nil);
CloseHandle(hFile);
hInst:=BeginUpdateResource(destexe, False);
if hInst > 0 then
begin
UpdateResource(hInst, RT_ICON, MAKEINTRESOURCE(1), LANG_NEUTRAL, pvFile, nSize);
EndUpdateResource(hInst, False);
result := True;
end;
FreeMem(pvFile);
FreeMem(pgid);
FreeMem(pid);
end;
end;
end.