Graphics32-将透明图形图层保存为png [英] Graphics32 - saving transparent drawing layer to png

问题描述

我在ImgView32的一层上画了一条虚线.以后，我想将每个图层另存为透明的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.

为了使问题更易于理解，请使用gr32库中的示例代码，尤其是Layers示例.其主菜单中的选项之一是添加自定义绘图层(新建自定义层->简单绘图层"). 然后尝试将该层另存为透明的PNG图像，最终将得到一个损坏的PNG文件(您无法使用任何其他图片查看器(例如Paint.net或Microsoft Photo Viewer)打开它.如果您尝试将图层的bitmap32保存为位图(在下面的代码中看到)，也会发生同样的事情...

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...

我尝试了两种方法将Bitmap32保存为透明PNG，因此第一种方法如下:

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;

因此，如果我将PNG加载到这样的层中，则上述方法将起作用:

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);
      ...

但是，一旦我尝试保存使用图层"示例中的代码创建的图层，结果就会损坏. 即使我尝试像这样将图层另存为位图(尽管这不是我的意图，因为我需要将其设为PNG):

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;

我还尝试了其他方法将Bitmap32保存为透明PNG，例如GR32_PNG方法:

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;

其中

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;

但是使用这种方法，尝试保存此特定层时会收到EAccessViolation.对于任何其他图层(不是绘图图层)，除了此自定义绘图图层外，它不会使我的项目崩溃. 访问冲突发生在此行:

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);

png.Assign(bm);

在Bitmap32ToPNG函数内部

inside the Bitmap32ToPNG function

您是否知道为什么会发生这种情况，以及如何防止这种情况发生?

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

编辑

我尝试改用TBitmapLayer，因为TPositionedLayer出于某些原因可能缺少Bitmap32. 所以我的代码是这样的:

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;

请记住，我使用默认的图层演示应用程序.因此，这只是添加的代码.我没有删除或更改演示代码中的任何内容. 因此，我创建了一个新图层(TBitmapLayer)，并在onPaint上进行了绘制.最后，我想将该层的内容另存为PNG.但是似乎onPaint可能会在其他地方而不是实际图层上绘制.否则我不明白为什么保存的图像为空. 因此，这次生成的PNG没有损坏，但是为空...

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...

推荐答案

错误在于，这些示例创建了不包含位图的TPositionedLayer图层.您不能像下面的代码中那样将类型转换为TBitmapLayer并期望它创建该层的位图图像:

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');

我假设您执行了与保存到.png文件相似的操作，尽管您没有显示该代码.

I assume you do something similar to save to .png file, although you did not show that code.

示例(具有TPositionedLayer层)使用ImgView.Buffer在屏幕上绘制.您可以将其保存为.png文件，如下所示:

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.

您为什么不像以前那样使用TBitmapLayers是什么原因?

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

在user1137313评论后编辑

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.

从菜单项开始

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

如果您同时保存多个图层，并可能根据需要更改文件名，则可能要循环调用SaveLayerToPng().

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.

然后SaveLayerToPng()过程

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;

它将调用现有的PaintSimpleDrawingHandler(Sender: TObject; buffer: TBitmap32)过程以将其绘制为bm32，然后将其传递到`SavePNGTransparentX()进行实际保存.

It calls the existing PaintSimpleDrawingHandler(Sender: TObject; buffer: TBitmap32) procedure to paint to bm32 which it then passes on to `SavePNGTransparentX() for actual saving.

我使用了Graphics32示例的绘制处理程序，但是您的PaintMy3Handler()也可以使用.

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

最终结果与您的解决方案相同，只是多余的TBitmap32仅在要保存文件时才绘制.

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

这篇关于Graphics32-将透明图形图层保存为png的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！