Read and write icon files (Views: 35)
Problem/Question/Abstract: How to read and write icon files Answer: { icon. 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} 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; { 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; { 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. |