Graphics32 - saving transparent drawing layer to png

I draw a dotted line on a layer of an ImgView32. Later, I want to save each layer as transparent PNGs. For any other layer that I have, the saving works just fine. But for the drawing layer, it does not.

In order to make the question simpler to understand, take the example code from the gr32 library, more specifically the Layers example. One of the options in its main menu is to add a custom drawing layer (New Custom Layer -> Simple Drawing Layer). Then try to save that layer as a transparent PNG image and you will end up with a corrupted PNG file (you can't open it with any other picture viewer like for example Paint.net or Microsoft Photo Viewer). Same thing happens if you try to save the layer's bitmap32 as a bitmap as you can see in the bellow code...

I tried two approaches for saving Bitmap32 as a transparent PNG, so the first one is as follows:

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 into the layer like this:

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 with the code from the Layers example, the result is corrupted. Even if I try to save the layer as bitmap like this (though 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 corruption occurs. So, it's not like I receive an exception or anything... it just gets saved corrupted somehow;

I also tried other ways to save the Bitmap32 as transparent PNG, like for instance 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 an EAccessViolation when trying to save this particular layer. For any other layers (not drawing ones), it does not crash my project except for this custom drawing one. The access violation occurs at this line:

png.Assign(bm);

inside the Bitmap32ToPNG function

Do you have any idea why that happens and how can I prevent this?

EDIT

I tried using TBitmapLayer instead, because the TPositionedLayer might lack the Bitmap32 for some reason. So my code is like this:

// adding a BitmapLayer and setting it's 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(P.X - W, P.Y - H, P.X + W, P.Y + 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 use the default layers demo application. So this is just added code. I did not remove nor change anything in the demo code. So I create a new layer (TBitmapLayer) and onPaint I do my drawing. In the end I want to save the contents of that layer as PNG. But it seems like the onPaint might draw somewhere else instead of the actual layer. Otherwise I do not understand why the saved image is empty. So this time the resulted PNG is not corrupted, but it is empty...

The error is in the fact that the examples create TPositionedLayer layers which do not hold a bitmap. You can not type cast this layer type into a 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 you do something similar to save to .png file, although you did not show that code.

The examples (with TPositionedLayer layers) use ImgView.Buffer for drawing on the screen. You can save that to a .png file like this:

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

but I don't expect that to work satisfactorily for your separate layer images.

What is the reason you don't use TBitmapLayers as you have done before?

Edit after comments by user1137313

Inspired by the solution you found yourself (ref. your comment) I suggest the following which paints the layer to the extra bitmap only when needed for saving.

Starting from a menu item

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

You possibly want to call SaveLayerToPng() in a loop if you save several layers at the same time, and also change the file name(s) as needed.

Then the 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 to paint to bm32 which it then passes on to `SavePNGTransparentX() for actual saving.

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

The end result is same as your solution, just that the extra TBitmap32 is only painted when the file is to be saved.

Recommended topics

Hot tags