Download MultiFrame Icons

Question

Does anyone know a class that can read multi-frame icons? An Internet search did not provide any information.

I tried to use IconTools 2.0 from Alan Peter Stotz, which correctly loads the icons into the list, but the bit depth for 8-bit and 4-bit icons is returned as 0. The bit file for the 32-bit and 24-bit icon frames returned correctly.

The icon itself displays correctly when viewed ... only the bitrate is incorrect for the specified bits.

EDIT # 2 Some untested code added to TLama comment:

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 returns 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 an example of a little code:

 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;