TBitmap.SaveToFile produces invalid image file

[dwrbudr 10]

The following code with this specific type of image (8-bit grayscale PNG) produces invalid .bmp (out_2.bmp) file if TBitmap.SaveToFile/SaveToStream is used more than once.
The corrupt file cannot be opened in Windows Photo Viewer, FastStone Image Viewer, etc.
BmpHeaderViewer shows this for out_1.bmp
 

File Name:	out_1.bmp
File Size:	52.9 KB
------------------------------------------------------------------------
Type:		BM
Size:		54214 bytes
Reserved1:	0
Reserved2:	0
OffBits:	1078 bytes
------------------------------------------------------------------------
Size:		40 bytes
Width:		143 pixels
Height:		123 pixels
Planes:		1
BitCount:	24 bpp
Compression:	RGB
SizeImage:	53136 bytes
XPelsPerMeter:	0
YPelsPerMeter:	0
ClrUsed:	256
ClrImportant:	0
------------------------------------------------------------------------

And this for the corrupted out_2.bmp

File Name:	out_2.bmp
File Size:	52.9 KB
------------------------------------------------------------------------
Type:		BM
Size:		55238 bytes
Reserved1:	0
Reserved2:	0
OffBits:	2102 bytes
------------------------------------------------------------------------
Size:		40 bytes
Width:		143 pixels
Height:		123 pixels
Planes:		1
BitCount:	24 bpp
Compression:	RGB
SizeImage:	53136 bytes
XPelsPerMeter:	0
YPelsPerMeter:	0
ClrUsed:	256
ClrImportant:	0
------------------------------------------------------------------------
Gap to pixels:	1024 bytes
------------------------------------------------------------------------
Image corrupt or truncated.
========================================================================

Tested on Delphi 12.3/13.0
Is this a known issue or what is possibly wrong in VCL, is it Vcl.Graphics.Pas or PNGImage.pas AssignTo method wrong?
 

procedure TForm69.FormCreate(Sender: TObject);
var bmp: TBitmap;
    png: TPNGImage;
begin
    bmp := TBitmap.Create;
    png := TPNGImage.create;

    png.LoadFromFile('in.png');

    bmp.Assign(png);
    bmp.SaveToFile('out_1.bmp');
    bmp.SaveToFile('out_2.bmp');
end;

Sample project to reproduce the issue is attached.

 

BmpTest.zip

Edited 15 hours ago by dwrbudr

[David Heffernan 2482]

submit a report to QP

[Anders Melander 2114]

Here's the algorithm used when saving a TBitmap:

1. Calculate Size based on HeaderSize, the number of pixels, color depth, and current value of BitmapInfoHeader.biClrUsed (number of entries in the palette).
2. Calculate number of entries in the palette: ColorCount
3. Adjust Size with the value of ColorCount: Size := Size + ColorCount * SizeOf(Pixel)
4. Set BitmapFileHeader.bfSize = Size
5. Write BitmapFileHeader to file
6. Set BitmapInfoHeader.biClrUsed = ColorCount
7. Write BitmapInfoHeader to file
8. Write palette entries
9. Write pixels

BitmapFileHeader is a local variable that is nilled and initialized each time. BitmapInfoHeader is a class variable that is used to store the bitmap properties.

 

Can you spot the bug?

 

The first time the bitmap is saved, BitmapInfoHeader.biClrUsed=0.

The second time the bitmap is saved, BitmapInfoHeader.biClrUsed=ColorCount, so the palette size is counted twice.



[dwrbudr 10]

Thanks @Anders Melander

What do you think is the safest fix? Probably to call InternalGetDIBSizes passing 0 instead of FDIB.dsbmih.biClrUsed

Another "fix" is to set the Bitmap.Palette := 0 after the Assign call.

Strangely though after assigning 8bit grayscale PNG to bitmap, the bitmap becames 24bit with palette. Is that a common use at all?

[Anders Melander 2114]

minutes ago, dwrbudr said:

What do you think is the safest fix?

Fix or work-around? The safest work-around is to not call TBitmap.SaveTo* more than once on the same bitmap:

bmp.Assign(png);
bmp.SaveToFile('out_1.bmp');
bmp.Assign(png);
bmp.SaveToFile('out_2.bmp');

I would guess (I would need to examine the logic more than I have time for, to be sure) the quick-fix is to modify TBitmap.WriteStream so it only counts the palette size once:

if (FDIB.dsbmih.biBitCount > 8) and (FDIB.dsbmih.biClrUsed = 0) then
begin  // optional color palette for hicolor images (non OS2)
  Inc(Size, ColorCount * SizeOf(TRGBQuad));
  Inc(HeaderSize, ColorCount * SizeOf(TRGBQuad));
end;

but to be honest, if this was my code, I would throw out the current TBitmap.WriteStream implementation and rewrite it from scratch. It's a horrible mess.