Read and write icon files

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.