Load MultiFrame Icons - delphi

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;