/// 文件名：Icons.Pas
unit Icons;
interface
uses windows, sysutils;
type
PByte = ^Byte;
PBitmapInfo = ^BitmapInfo;
/ // These first two structs represent how the icon information is stored
/ / / when it is bound into a EXE or DLL file. Structure members are WORD
// / aligned and the last member of the structure is the ID instead of
// / the imageoffset.
type
PMEMICONDIRENTRY = ^TMEMICONDIRENTRY;
TMEMICONDIRENTRY = packed record
bWidth: BYTE; / // Width of the image
bHeight: BYTE; / // Height of the image (times 2)
bColorCount: BYTE; / // Number of colors in image (0 if >=8bpp)
bReserved: BYTE; // / Reserved
wPlanes: WORD; // / Color Planes
wBitCount: WORD; / / / Bits per pixel
dwBytesInRes: DWORD; / // how many bytes in this resource?
nID: WORD; / / / the ID
end;
type
PMEMICONDIR = ^TMEMICONDIR;
TMEMICONDIR = packed record
idReserved: WORD; / // Reserved
idType: WORD; // / resource type (1 for icons)
idCount: WORD; / / / how many images?
idEntries: array[0..10] of TMEMICONDIRENTRY; / // the entries for each image
/// 查看msdn，这个数组长度应该是1，但是为什么图标猎手定义的是0..10？
end;
/// These next two structs represent how the icon information is stored
/// in an ICO file.
type
PICONDIRENTRY = ^TICONDIRENTRY;
TICONDIRENTRY = packed record
bWidth: BYTE; /// Width of the image
bHeight: BYTE; /// Height of the image (times 2)
bColorCount: BYTE; /// Number of colors in image (0 if >=8bpp)
bReserved: BYTE; /// Reserved
wPlanes: WORD; /// Color Planes
wBitCount: WORD; /// Bits per pixel
dwBytesInRes: DWORD; /// how many bytes in this resource?
dwImageOffset: DWORD; /// where in the file is this image
end;
type
PICONDIR = ^TICONDIR;
TICONDIR = packed record
idReserved: WORD; /// Reserved
idType: WORD; /// resource type (1 for icons)
idCount: WORD; /// how many images?
idEntries: array[0..0] of TICONDIRENTRY; /// the entries for each image
end;
/// The following two structs are for the use of this program in
/// manipulating icons. They are more closely tied to the operation
/// of this program than the structures listed above. One of the
/// main differences is that they provide a pointer to the DIB
/// information of the masks.
type
PICONIMAGE = ^TICONIMAGE;
TICONIMAGE = packed record
Width, Height, Colors: UINT; /// Width, Height and bpp
lpBits: pointer; /// ptr to DIB bits
dwNumBytes: DWORD; /// how many bytes?
pBmpInfo: PBitmapInfo;
end;
{ ///这是原来的，上面的是对照IconHunt的
TICONIMAGE = packed record
Width, Height, Colors: UINT; /// Width, Height and bpp
lpBits: pointer; /// ptr to DIB bits
dwNumBytes: DWORD; /// how many bytes?
lpbi: PBITMAPINFO; /// ptr to header
lpXOR: LPBYTE; /// ptr to XOR image bits
lpAND: LPBYTE; /// ptr to AND image bits
end;
}
type
PICONRESOURCE = ^TICONRESOURCE;
TICONRESOURCE = packed record
nNumImages: UINT; /// How many images?
IconImages: array[0..10] of TICONIMAGE; /// Image entries
end;
{///下面是原来的，上面是对照IconHunt的
TICONRESOURCE = packed record
bHasChanged: BOOL; /// Has image changed?
szOriginalICOFileName: array[0..MAX_PATH] of char; /// Original name
szOriginalDLLFileName: array[0..MAX_PATH] of char; /// Original name
nNumImages: UINT; /// How many images?
IconImages: array[0..0] of ICONIMAGE; /// Image entries
end;
}
type
TPageInfo = packed record
Width: byte;
Height: byte;
ColorQuantity: integer;
Reserved: DWORD;
PageSize: DWORD;
PageOffSet: DWORD;
end;
type
TPageDataHeader = packed record
PageHeadSize: DWORD;
XSize: DWORD;
YSize: DWORD;
SpeDataPerPixSize: integer;
ColorDataPerPixSize: integer;
Reserved: DWORD;
DataAreaSize: DWORD;
ReservedArray: array[0..15] of char;
end;
type
TIcoFileHeader = packed record
FileFlag: array[0..3] of byte;
PageQuartity: integer;
PageInfo: TPageInfo;
end;
///function WriteIconToFile(Bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean; overload;
function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
implementation
function WriteICOHeader(hFile: HWND; nNumEntries: UINT): Boolean;
type
TFIcoHeader = record
wReserved: WORD;
wType: WORD;
wNumEntries: WORD;
end;
var
IcoHeader: TFIcoHeader;
/// Output: WORD;
dwBytesWritten: DWORD;
begin
Result := False;
IcoHeader.wReserved := 0;
IcoHeader.wType := 1;
IcoHeader.wNumEntries := WORD(nNumEntries);
if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil) then
begin
MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'info', MB_OK);
exit;
end;
if dwBytesWritten <> SizeOf(IcoHeader) then
exit;
{
Output := 0;
/// Write 'reserved' WORD
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
/// Did we write a WORD?
if dwBytesWritten <> SizeOf(WORD) then exit;
/// Write 'type' WORD (1)
Output := 1;
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
/// Write Number of Entries
Output := WORD(nNumEntries);
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
}
Result := True;
end;
function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
var
dwSize: DWORD;
i: integer;
begin
/// Calculate the ICO header size
dwSize := 3 * sizeof(WORD);
/// Add the ICONDIRENTRY's
inc(dwSize, lpIR.nNumImages * sizeof(TICONDIRENTRY));
/// Add the sizes of the previous images
for i := 0 to nIndex - 1 do
inc(dwSize, lpIR.IconImages[i].dwNumBytes);
/// we're there - return the number
Result := dwSize;
end;
function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
var
i: UINT;
dwBytesWritten: DWORD;
ide: TICONDIRENTRY;
dwTemp: DWORD;
begin
/// open the file
Result := False;
/// Write the ICONDIRENTRY's
for i := 0 to lpIR^.nNumImages - 1 do
begin
/// Convert internal format to ICONDIRENTRY
ide.bWidth := lpIR^.IconImages[i].Width;
ide.bHeight := lpIR^.IconImages[i].Height;
ide.bReserved := 0;
ide.wPlanes := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biPlanes;
ide.wBitCount := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biBitCount;
if ide.wPlanes * ide.wBitCount >= 8 then
ide.bColorCount := 0
else
ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
ide.dwBytesInRes := lpIR^.IconImages[i].dwNumBytes;
ide.dwImageOffset := CalculateImageOffset(lpIR, i);
/// Write the ICONDIRENTRY out to disk
if not WriteFile(hFile, ide, sizeof(TICONDIRENTRY), dwBytesWritten, nil) then
exit;
/// Did we write a full ICONDIRENTRY ?
if dwBytesWritten <> sizeof(TICONDIRENTRY) then
exit;
end;
/// Write the image bits for each image
for i := 0 to lpIR^.nNumImages - 1 do
begin
dwTemp := lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage;
/// Set the sizeimage member to zero
lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := 0;
/// Write the image bits to file
if not WriteFile(hFile, lpIR^.IconImages[i].lpBits^, lpIR^.IconImages[i].dwNumBytes, dwBytesWritten, nil) then
exit;
if dwBytesWritten <> lpIR^.IconImages[i].dwNumBytes then
exit;
/// set it back
lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := dwTemp;
end;
Result := True;
end;
function AWriteIconToFile(bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean;
var
fh: file of byte;
IconInfo: _ICONINFO;
PageInfo: TPageInfo;
PageDataHeader: TPageDataHeader;
IcoFileHeader: TIcoFileHeader;
BitsInfo: tagBITMAPINFO;
p: pointer;
PageDataSize: integer;
begin
Result := False;
GetIconInfo(Icon, IconInfo);
AssignFile(fh, szFileName);
FileMode := 1;
Reset(fh);
GetDIBits(0, Icon, 0, 32, nil, BitsInfo, DIB_PAL_COLORS);
GetDIBits(0, Icon, 0, 32, p, BitsInfo, DIB_PAL_COLORS);
PageDataSize := SizeOf(PageDataHeader) + BitsInfo.bmiHeader.biBitCount;
PageInfo.Width := 32;
PageInfo.Height := 32;
PageInfo.ColorQuantity := 65535;
Pageinfo.Reserved := 0;
PageInfo.PageSize := PageDataSize;
PageInfo.PageOffSet := SizeOf(IcoFileHeader);
IcoFileHeader.FileFlag[0] := 0;
IcoFileHeader.FileFlag[1] := 0;
IcoFileHeader.FileFlag[2] := 1;
IcoFileHeader.FileFlag[3] := 0;
IcoFileHeader.PageQuartity := 1;
IcoFileHeader.PageInfo := PageInfo;
FillChar(PageDataHeader, SizeOf(PageDataHeader), 0);
PageDataHeader.XSize := 32;
PageDataHeader.YSize := 32;
PageDataHeader.SpeDataPerPixSize := 0;
PageDataHeader.ColorDataPerPixSize := 32;
PageDataHeader.PageHeadSize := SizeOf(PageDataHeader);
PageDataHeader.Reserved := 0;
PageDataHeader.DataAreaSize := BitsInfo.bmiHeader.biBitCount;
BlockWrite(fh, IcoFileHeader, SizeOf(IcoFileHeader));
BlockWrite(fh, PageDataHeader, SizeOf(PageDataHeader));
BlockWrite(fh, p, BitsInfo.bmiHeader.biBitCount);
CloseFile(fh);
end;
function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool;
begin
if lpImage = nil then
begin
Result := False;
exit;
end;
lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits);
lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth;
lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2;
lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes * lpImage^.pBmpInfo^.bmiHeader.biBitCount;
Result := true;
end;
function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
var
h: HMODULE;
lpMemIcon: PMEMICONDIR;
lpIR: TICONRESOURCE;
src: HRSRC;
Global: HGLOBAL;
i: integer;
hFile: hwnd;
begin
Result := False;
hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile = INVALID_HANDLE_VALUE then exit; ///Error Create File
h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
if h = 0 then exit;
try
src := FindResource(h, pchar(nIndex), RT_GROUP_ICON);
if src = 0 then
Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON);
if src <> 0 then
begin
Global := LoadResource(h, src);
if Global <> 0 then
begin
lpMemIcon := LockResource(Global);
if Global <> 0 then
begin
/// lpIR := @IR;
try
lpIR.nNumImages := lpMemIcon.idCount;
/// Write the header
for i := 0 to lpMemIcon^.idCount - 1 do
begin
src := FindResource(h, MakeIntResource(lpMemIcon^.idEntries[i].nID), RT_ICON);
if src <> 0 then
begin
Global := LoadResource(h, src);
if Global <> 0 then
begin
lpIR.IconImages[i].dwNumBytes := SizeofResource(h, src);
GetMem(lpIR.IconImages[i].lpBits, lpIR.IconImages[i].dwNumBytes);
CopyMemory(lpIR.IconImages[i].lpBits, LockResource(Global), lpIR.IconImages[i].dwNumBytes);
if not AdjustIconImagePointers(@(lpIR.IconImages[i])) then exit;
end;
end;
end;
if WriteICOHeader(hFile, lpIR.nNumImages) then ///No Error Write File
if WriteIconResourceToFile(hFile, @lpIR) then
Result := True;
finally
for i := 0 to lpIR.nNumImages - 1 do
if assigned(lpIR.IconImages[i].lpBits) then
FreeMem(lpIR.IconImages[i].lpBits);
end;
end;
end;
end;
finally
FreeLibrary(h);
end;
CloseHandle(hFile);
end;
end.