TBitmap.SaveToFile produces invalid image file

[dwrbudr 12]

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 September 16 by dwrbudr

[David Heffernan 2492]

submit a report to QP

[Anders Melander 2133]

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 12]

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 2133]

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.

[dwrbudr 12]

@Anders Melander It seems the issue is much more broader that I initially thought. The change proposed by you fixes the issue above, e.g. calling SaveToFile/SaveToStream twice. But the following code produces black bitmap even if the fix is included.
I have attached the sample project, but in order to test it Vcl.Graphics.pas has to be patched as described in the post above.

As you said, TBitmap has to be almost entirelly rewritten from scratch.

    bmp := TBitmap.Create;
    bmp2 := TBitmap.Create;
    png := TPNGImage.create;

    png.LoadFromFile('in.png');

    bmp.Assign(png);

    ms := TMemoryStream.Create;
    bmp.SaveToStream(ms);

    bmp2.LoadFromStream(ms);
    bmp2.SaveToFile('out.bmp'); // out.bmp is entirelly black

 

BmpTest.zip

[ToddFrankson 15]

51 minutes ago, dwrbudr said:

@Anders Melander It seems the issue is much more broader that I initially thought. The change proposed by you fixes the issue above, e.g. calling SaveToFile/SaveToStream twice. But the following code produces black bitmap even if the fix is included.
I have attached the sample project, but in order to test it Vcl.Graphics.pas has to be patched as described in the post above.

As you said, TBitmap has to be almost entirelly rewritten from scratch.

 

    bmp := TBitmap.Create;
    bmp2 := TBitmap.Create;
    png := TPNGImage.create;

    png.LoadFromFile('in.png');

    bmp.Assign(png);

    ms := TMemoryStream.Create;
    bmp.SaveToStream(ms);

    bmp2.LoadFromStream(ms);
    bmp2.SaveToFile('out.bmp'); // out.bmp is entirelly black

 

BmpTest.zip

Have  you tried adding 

 

ms.position:=0; 

 

Between

 

bmp.SaveToStream(ms);

 

and

bmp2.LoadFromStream(ms);

 

[dwrbudr 12]

Yes, I've missed that from the sample project, but using ms.Position := 0 doesn't change the outcome - black or invalid bitmap file.

[ToddFrankson 15]

This code works perfect for me in D12.3 and D13:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, vcl.Imaging.pngimage;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var
  Bmp,Bmp2:TBitmap;
  Png:TPngImage;
  Ms:TMemoryStream;
begin
    bmp := TBitmap.Create;
    bmp2 := TBitmap.Create;
    png := TPNGImage.create;

    png.LoadFromFile('usdot.png');

    bmp.Assign(png);

    ms := TMemoryStream.Create;
    bmp.SaveToStream(ms);
    Ms.Position:=0;
    bmp2.LoadFromStream(ms);
    bmp2.SaveToFile('out.bmp'); // out.bmp is entirelly black

    Bmp.Free;
    Bmp2.Free;
    Png.Free;
    Ms.Free;

end;

end.

 

Bitmap.rar

[dwrbudr 12]

@ToddFrankson In order to reproduce the issue, the PNG file has to be 8bit and probably grayscale. Try to reproduce the issue with the PNG file from the sample project I've attached.

[ToddFrankson 15]

3 hours ago, dwrbudr said:

@ToddFrankson In order to reproduce the issue, the PNG file has to be 8bit and probably grayscale. Try to reproduce the issue with the PNG file from the sample project I've attached.

Gotcha.

 

Interesting.....looking at the bmp in hex it almost looks right, the header is what should be.