Load MultiFrame Icons

Question

Does anyone know of a class that can read multiframe icons? Searching the internet has not produced any information.

I tried using IconTools 2.0 by Alan Peter Stotz, which loads the icons into a list correctly but the bit-depth for 8-bit and 4-bit icons return as 0. The bitdepth for 32 and 24-bit icon frames is returned correctly, however.

The icon itself appears correct when viewing... just the bitdepth is wrong for the bits mentioned.

EDIT #2 Baised on the comment by TLama here is some untested code:

function NumberOfIcons ( AFileName: string ): integer;
var
  iNumberOfIcons: Integer;
begin

  iNumberOfIcons := ExtractIcon ( hInstance, PChar ( AFilename ), UINT ( -1 ) );
  Result := iNumberOfIcons;

end;

function ExtractAnIcon ( AFilename: string; AIndex: integer ): TBitmap;
var
  icoHandle: HIcon;
  iBitmap: TBitmap;
  iIcon: TIcon;
  iNumberOfIcons, i: Integer;
begin

  Result := nil;

  iBitmap := TBitMap.Create;

  iIcon := TIcon.Create;
  try

    // Get the number of Icons
    iNumberOfIcons := ExtractIcon ( hInstance, PChar ( AFilename ), UINT ( -1 ) );

    // Extract the icon frame
    icoHandle := ExtractIcon ( hInstance, PChar ( AFileName ), AIndex );
    iIcon.Handle := icoHandle;
    iBitmap.Width := iIcon.Width;
    iBitmap.Height := iIcon.Height;
    // Draw the icon on your bitmap
    DrawIcon ( iBitmap.Canvas.Handle, 0, 0, iIcon.Handle );    
    Result := iBitmap;

  finally
    iIcon.Free;
  end;

end;

function PixelFormatToBitDepth ( APixelFormat: TPixelFormat ): integer;
// Convert TPixelFormat to integer
begin

  Result := -1;
  case APixelFormat of
    pf32Bit:
      Result := 32;
    pf24bit:
      Result := 24;
    pf8bit:
      Result := 8;
    pf4Bit:
      Result := 4;
    pf1bit:
      Result := 1;
  end;

end;

Am I on the right track? In my testing I now get 1 icon but the NumberOfIcons function is returning 1?

EDIT#3 According to the help file "If the file is an .ICO file, the return value of ExtractIcon is 1." So what method can be used to get the number of icons in the ico file?

Answer 1

Here is a small code example:

uses ShellApi;

type
  TICONDIRENTRY = 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?
    dwImageOffset: DWORD;  // Where in the file is this image?
  end;

  TICONDIR = packed record
    idReserved: Word; // Reserved (must be 0)
    idType: Word;     // Resource Type (1 for icons)
    idCount: Word;    // How many images?
    idEntries: array [0..255] of TICONDIRENTRY;
  end;
  PICONDIR=^TICONDIR;

function GetIconsCount(const FileName: string): Word;
var
  Stream: TMemoryStream;
  IconDir: PICONDIR;
begin
  Result := 0;
  if ExtractIcon(hInstance, PChar(FileName), UINT(-1)) <> 0 then
  try
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(FileName);
      IconDir := Stream.Memory;
      if IconDir.idType = 1 then
        Result := IconDir.idCount;
    finally
      Stream.Free;
    end;
  except
    // do not raise exceptions
  end;
end;

function ExtractIcons(const FileName: string; IconList: TList): Boolean;
var
  Stream: TMemoryStream;
  NewIconStream: TMemoryStream;
  IconDir: PICONDIR;
  NewIconDir: PICONDIR;
  Icon: TIcon;
  I: Integer;
begin
  Result := False;
  if ExtractIcon(hInstance, PChar(FileName), UINT(-1)) <> 0 then
  try
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(FileName);
      IconDir := Stream.Memory;
      for I := 0 to IconDir.idCount-1 do
      begin
        NewIconStream := TMemoryStream.Create;
        try
          NewIconStream.Size := SizeOf(Word) * 3 + SizeOf(TICONDIRENTRY);
          NewIconStream.Position:= SizeOf(Word) * 3 + SizeOf(TICONDIRENTRY);

          NewIconDir := NewIconStream.memory;
          NewIconDir.idCount := 1;
          NewIconDir.idType := IconDir.idType;
          NewIconDir.idReserved := IconDir.idReserved;
          NewIconDir.idEntries[0] := IconDir.idEntries[I];
          NewIconDir.idEntries[0].dwImageOffset := NewIconStream.Size;

          Stream.Position := IconDir.idEntries[I].dwImageOffset;
          NewIconStream.CopyFrom(Stream, IconDir.idEntries[I].dwBytesInRes);
          NewIconStream.Position := 0;
          Icon := TIcon.Create;
          Icon.LoadFromStream(NewIconStream);
          IconList.Add(Icon);
        finally
          NewIconStream.Free;
        end;
        IconList.Add(Icon);
      end;
      Result := True;
    finally
      Stream.Free;
    end;
  except
    // do not raise exceptions
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
  Icon: TIcon;
  List: TList;
  I: Integer;
begin
  FileName := 'c:\myicon.ico';
  List := TList.Create;
  try
    if ExtractIcons(FileName, List) then
    for I := 0 to List.Count - 1 do
    begin
      Icon := TIcon(List.Items[I]);
      DrawIcon(Form1.Canvas.Handle, 10, I * 40, Icon.Handle);
      Icon.Free;
    end;
  finally
    List.Free;
  end;
end;