Graphics32 - saving a transparent drawing layer in png

Question

I draw a dashed line on the ImgView32 layer. Later I want to save each layer as transparent PNG. For any other layer that I have, the savings work very well. But for the paint layer this is not so.

To simplify the understanding of the issue, take the sample code from the gr32 library, in particular the Layers example. One of the options in the main menu is to add a custom drawing layer (New custom layer → Simple drawing level). Then try to save this layer as a transparent PNG image and you will get a damaged PNG file (you cannot open it using any other image viewer, for example Paint.net or Microsoft Photo Viewer). The same thing happens if you try to save the bitmap32 layer as a bitmap, as you can see in the following code ...

I tried two approaches for saving Bitmap32 as a transparent PNG, so the first one looks like this:

procedure TMainForm.SavePNGTransparentX(bm32:TBitmap32; dest:string); var Y: Integer; X: Integer; Png: TPortableNetworkGraphic32; function IsBlack(Color32: TColor32): Boolean; begin Result:= (TColor32Entry(Color32).B = 0) and (TColor32Entry(Color32).G = 0) and (TColor32Entry(Color32).R = 0); end; function IsWhite(Color32: TColor32): Boolean; begin Result:= (TColor32Entry(Color32).B = 255) and (TColor32Entry(Color32).G = 255) and (TColor32Entry(Color32).R = 255); end; begin bm32.ResetAlpha; for Y := 0 to bm32.Height-1 do for X := 0 to bm32.Width-1 do begin // if IsWhite(bm32.Pixel[X, Y]) then // bm32.Pixel[X,Y]:=Color32(255,255,255, 0); if IsBlack(bm32.Pixel[X, Y]) then bm32.Pixel[X,Y]:=Color32( 0, 0, 0, 0); end; Png:= TPortableNetworkGraphic32.Create; try Png.Assign(bm32); Png.SaveToFile(dest); finally Png.Free; end; end; 

So the above method works if I have a PNG loaded in a layer as follows:

 mypng := TPortableNetworkGraphic32.Create; mypng.LoadFromStream(myStream); B := TBitmapLayer.Create(ImgView.Layers); with B do try mypng.AssignTo(B.Bitmap); ... 

But as soon as I try to save the layer created using the code from the Layers example, the result will be corrupted. Even if I try to save this layer as a bitmap (although this is not my intention, since I need them to be PNG):

 mylay := TBitmapLayer(ImgView.Layers.Items[i]); mylay.Bitmap.SaveToFile('C:\tmp\Layer'+IntToStr(i)+'.bmp'); 

the same damage occurs. So it doesn’t look like I am getting an exception or something else ... it is somehow restored, somehow damaged;

I also tried other ways to save Bitmap32 as transparent PNG, for example, the GR32_PNG approach:

 function SaveBitmap32ToPNG (sourceBitmap: TBitmap32;transparent: Boolean;bgColor32: TColor32;filename: String;compressionLevel: TCompressionLevel = 9;interlaceMethod: TInterlaceMethod = imNone): boolean; var png: TPNGImage; begin result := false; try png := Bitmap32ToPNG (sourceBitmap,false,transparent,WinColor(bgColor32),compressionLevel,interlaceMethod); try png.SaveToFile (filename); result := true; finally png.Free; end; except result := false; end; end; 

Where

 function Bitmap32ToPNG (sourceBitmap: TBitmap32;paletted, transparent: Boolean;bgColor: TColor;compressionLevel: TCompressionLevel = 9;interlaceMethod: TInterlaceMethod = imNone): TPNGImage; // TPNGObject var bm: TBitmap; png: TPNGImage;//TPngObject; TRNS: TCHUNKtRNS; p: pngImage.PByteArray; x, y: Integer; begin Result := nil; png := TPngImage.Create; // TPNGObject try bm := TBitmap.Create; try bm.Assign (sourceBitmap); // convert data into bitmap // force paletted on TBitmap, transparent for the web must be 8bit if paletted then bm.PixelFormat := pf8bit; png.interlaceMethod := interlaceMethod; png.compressionLevel := compressionLevel; png.Assign(bm); // convert bitmap into PNG // this is where the access violation occurs finally FreeAndNil(bm); end; if transparent then begin if png.Header.ColorType in [COLOR_PALETTE] then begin if (png.Chunks.ItemFromClass(TChunktRNS) = nil) then png.CreateAlpha; TRNS := png.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS; if Assigned(TRNS) then TRNS.TransparentColor := bgColor; end; if png.Header.ColorType in [COLOR_RGB, COLOR_GRAYSCALE] then png.CreateAlpha; if png.Header.ColorType in [COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA] then begin for y := 0 to png.Header.Height - 1 do begin p := png.AlphaScanline[y]; for x := 0 to png.Header.Width - 1 do p[x] := AlphaComponent(sourceBitmap.Pixel[x,y]); // TARGB(bm.Pixel[x,y]).a; end; end; end; Result := png; except png.Free; end; end; 

but using this approach, I get EAccessViolation when I try to keep this specific level. For any other layers (not for drawing) it does not break my project, except for this custom drawing. Access violation occurs on this line:

png.Assign (shm);

inside the Bitmap32ToPNG function

Do you have any idea why this is happening and how I can prevent this?

EDIT

I tried using TBitmapLayer because TPositionedLayer might not have enough Bitmap32 for some reason. So my code is as follows:

 // adding a BitmapLayer and setting it onPaint event to my handler procedure TMainForm.Mynewlayer1Click(Sender: TObject); var B: TBitmapLayer; P: TPoint; W, H: Single; begin B := TBitmapLayer.Create(ImgView.Layers); with B do try Bitmap.SetSize(100,200); Bitmap.DrawMode := dmBlend; with ImgView.GetViewportRect do P := ImgView.ControlToBitmap(GR32.Point((Right + Left) div 2, (Top + Bottom) div 2)); W := Bitmap.Width * 0.5; H := Bitmap.Height * 0.5; with ImgView.Bitmap do Location := GR32.FloatRect(PX - W, PY - H, PX + W, PY + H); Scaled := True; OnMouseDown := LayerMouseDown; OnPaint := PaintMy3Handler; except Free; raise; end; Selection := B; end; // and the PaintHandler is as follows: procedure TMainForm.PaintMy3Handler(Sender: TObject;Buffer: TBitmap32); var Cx, Cy: Single; W2, H2: Single; const CScale = 1 / 200; begin if Sender is TBitmapLayer then with TBitmapLayer(Sender).GetAdjustedLocation do begin // Five black pixels, five white pixels since width of the line is 5px Buffer.SetStipple([clBlack32, clBlack32, clBlack32, clBlack32, clBlack32, clWhite32, clWhite32, clWhite32, clWhite32, clWhite32]); W2 := (Right - Left) * 0.5; H2 := (Bottom - Top) * 0.5; Cx := Left + W2; Cy := Top + H2; W2 := W2 * CScale; H2 := H2 * CScale; Buffer.PenColor := clRed32; Buffer.StippleCounter := 0; Buffer.MoveToF(Cx-2,Top); Buffer.LineToFSP(Cx-2 , Bottom); Buffer.StippleCounter := 0; Buffer.MoveToF(Cx-1,Top); Buffer.LineToFSP(Cx-1 , Bottom); Buffer.StippleCounter := 0; Buffer.MoveToF(Cx,Top); Buffer.LineToFSP(Cx , Bottom); Buffer.StippleCounter := 0; Buffer.MoveToF(Cx+1,Top); Buffer.LineToFSP(Cx+1 , Bottom); Buffer.StippleCounter := 0; Buffer.MoveToF(Cx+2,Top); Buffer.LineToFSP(Cx+2 , Bottom); end; end; 

Keep in mind that I am using the default demo level app. So this is just the added code. I did not delete or modify anything in the demo code. So I create a new layer (TBitmapLayer) and onPaint, which I draw. In the end, I want to save the contents of this layer as PNG. But it looks like onPaint can draw somewhere else instead of the actual layer. Otherwise, I do not understand why the saved image is empty. So, this time the PNG is not damaged, but it is empty ...

Answer 1

The error is that the examples create TPositionedLayer layers that do not contain a bitmap. You cannot type the type of this layer in TBitmapLayer and expect it to create a bitmap image of the layer, as you do in this code:

  mylay := TBitmapLayer(ImgView.Layers.Items[i]); mylay.Bitmap.SaveToFile('C:\tmp\Layer'+IntToStr(i)+'.bmp'); 

I assume that you are doing something similar to saving to a .png file, although you have not shown this code.

In the examples (with TPositionedLayer layers) use ImgView.Buffer to draw on the screen. You can save this in a .png file as follows:

  SavePNGTransparentX(ImgView.Buffer, 'c:\tmp\imgs\buffer.png'); 

but I do not expect this to work satisfactorily for your individual layer images.

What is the reason you are not using TBitmapLayers , as you did before?

---

Edit after comments by user1137313

Inspired by the solution you found (link to your comment), I propose the following, which paints a layer into an additional bitmap only when it is necessary for saving.

Starting menu item

 procedure TMainForm.mnFileSaveClick(Sender: TObject); begin SaveLayerToPng(ImgView.Layers[ImgView.Layers.Count-1], 'c:\tmp\imgs\buffer.png'); end; 

You might want to call SaveLayerToPng() in a loop if you save several levels at the same time, and also change the file name if necessary.

Then SaveLayerToPng() procedure

 procedure TMainForm.SaveLayerToPng(L: TCustomLayer; FileName: string); var bm32: TBitmap32; begin bm32:= TBitmap32.Create; try bm32.SetSizeFrom(ImgView.Buffer); PaintSimpleDrawingHandler(L, bm32); SavePNGTransparentX(bm32, FileName); finally bm32.Free; end; end; 

It calls the existing PaintSimpleDrawingHandler(Sender: TObject; buffer: TBitmap32) procedure PaintSimpleDrawingHandler(Sender: TObject; buffer: TBitmap32) to paint on bm32 , which then goes to `SavePNGTransparentX () to actually save.

I used the Graphics32 example paint handler, but your PaintMy3Handler() can be used as well.

The end result will be the same as your solution, just add the extra TBitmap32 when the file is saved.