Problem source:
The fact, that the icon is a multi-size icon file doesn't matter in this case. The icon's bitmap info header is internally read in a different way than should be. Your icon is the PNG format file icon and those have no bitmap info header structure. The reason, why you are getting Out of system resources
exception, is because the internally used procedures expects from icon to have a TBitmapInfoHeader
structure and then tries to create a temporary bitmap based on this header information. For your icon it was read like this:
If you take a look closer on the header values, you calculate that the system would try to create a bitmap which would be in size 169478669 * 218103808 pixels at 21060 B per pixel, what would need to have at least 778.5 EB (exabytes)
of free memory :-)
Workaround:
That's of course impossible (at this time :-) and happens just because the PNG file format icons doesn't have this bitmap header, but instead contains directly a PNG image on that position. What you can do to workaround this is to check, if there's the PNG signature
on the first 8 bytes of the image data, which actually checks if there's a PNG image and if so, treat it as a PNG image, otherwise try to add the icon in a common way through the TIcon
object.
In the following code, the ImageListAddIconEx
function iterates all the icons in the icon file and when there's one which matches the image list dimensions it is processed. The processing first checks those 8 bytes if there's a PNG image on data offset position and if so, it adds this PNG image to the image list. If not, then the icon is added in a common way through the TIcon
object. This function returns index of the added icon in the image list if succeed, -1 otherwise:
uses
PNGImage;
type
TIconDirEntry = packed record
bWidth: Byte; // image width, in pixels
bHeight: Byte; // image height, in pixels
bColorCount: Byte; // number of colors in the image (0 if >= 8bpp)
bReserved: Byte; // reserved (must be 0)
wPlanes: Word; // color planes
wBitCount: Word; // bits per pixel
dwBytesInRes: DWORD; // image data size
dwImageOffset: DWORD; // image data offset
end;
TIconDir = packed record
idReserved: Word; // reserved (must be 0)
idType: Word; // resource type (1 for icons)
idCount: Word; // image count
idEntries: array[0..255] of TIconDirEntry;
end;
PIconDir = ^TIconDir;
function ImageListAddIconEx(AImageList: TCustomImageList;
AIconStream: TMemoryStream): Integer;
var
I: Integer;
Data: PByte;
Icon: TIcon;
IconHeader: PIconDir;
Bitmap: TBitmap;
PNGImage: TPNGImage;
PNGStream: TMemoryStream;
const
PNGSignature: array[0..7] of Byte = ($89, $50, $4E, $47, $0D, $0A, $1A, $0A);
begin
// initialize result to -1
Result := -1;
// point to the icon header
IconHeader := AIconStream.Memory;
// iterate all the icons in the icon file
for I := 0 to IconHeader.idCount - 1 do
begin
// if the icon dimensions matches to the image list, then...
if (IconHeader.idEntries[I].bWidth = AImageList.Width) and
(IconHeader.idEntries[I].bHeight = AImageList.Height) then
begin
// point to the stream beginning
Data := AIconStream.Memory;
// point with the Data pointer to the current icon image data
Inc(Data, IconHeader.idEntries[I].dwImageOffset);
// check if the first 8 bytes are PNG image signature; if so, then...
if CompareMem(Data, @PNGSignature[0], 8) then
begin
Bitmap := TBitmap.Create;
try
PNGImage := TPNGImage.Create;
try
PNGStream := TMemoryStream.Create;
try
// set the icon stream position to the current icon data offset
AIconStream.Position := IconHeader.idEntries[I].dwImageOffset;
// copy the whole PNG image from icon data to a temporary stream
PNGStream.CopyFrom(AIconStream,
IconHeader.idEntries[I].dwBytesInRes);
// reset the temporary stream position to the beginning
PNGStream.Position := 0;
// load the temporary stream data to a temporary TPNGImage object
PNGImage.LoadFromStream(PNGStream);
finally
PNGStream.Free;
end;
// assign temporary TPNGImage object to a temporary TBitmap object
Bitmap.Assign(PNGImage);
finally
PNGImage.Free;
end;
// to properly add the bitmap to the image list set the AlphaFormat
// to afIgnored, see e.g. https://mcmap.net/q/897789/-add-a-png-image-to-a-imagelist-in-runtime-using-delphi-xe
// if you don't have TBitmap.AlphaFormat property available, simply
// comment out the following line
Bitmap.AlphaFormat := afIgnored;
// and finally add the temporary TBitmap object to the image list
Result := AImageList.Add(Bitmap, nil);
finally
Bitmap.Free;
end;
end
// the icon is not PNG type icon, so load it to a TIcon object
else
begin
// reset the position of the input stream
AIconStream.Position := 0;
// load the icon and add it to the image list in a common way
Icon := TIcon.Create;
try
Icon.LoadFromStream(AIconStream);
Result := AImageList.AddIcon(Icon);
finally
Icon.Free;
end;
end;
// break the loop to exit the function
Break;
end;
end;
end;
And the usage:
procedure TForm1.Button1Click(Sender: TObject);
var
Index: Integer;
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile('d:\Icon.ico');
Index := ImageListAddIconEx(ImageList1, Stream);
if (Index <> -1) then
ImageList1.Draw(Canvas, 8, 8, Index);
finally
Stream.Free;
end;
end;
Conclusion:
I'd say if Microsoft recommends the PNG icon format to use (supported since Windows Vista), it would be fine to update the ReadIcon
procedure in Graphics.pas
to take this into account.
Something to read:
ImageList
). We shouldn't have to download files from other sites in order to get basic details for the question. :-) You should post that as an answer, since ImageLists have to contain only images that are the same size. – PhilanICONDIRENTRY
icon entry contains on itsdwImageOffset
PNG image header. I'll be right back with some code... – Commissariat