Graphics32

Question

我在 ImgView32 的图层上画了一条虚线。稍后，我想将每一层保存为透明的 PNG。对于我拥有的任何其他图层，保存效果都很好。但是对于绘图层，它没有。

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

我尝试了两种将Bitmap32保存为透明PNG的方法，所以第一种如下：

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 加载到图层中，则上述方法有效：

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

但是当我尝试保存使用图层示例中的代码创建的图层时，结果已损坏。即使我尝试像这样将图层保存为位图（尽管这不是我的意图，因为我需要它们是 PNG）：

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

发生同样的损坏。所以，我并没有收到异常或任何东西……它只是以某种方式被损坏了；

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

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。对于任何其他层（不是绘图层），它不会使我的项目崩溃，除了这个自定义绘图层。访问冲突发生在这一行：

png.Assign(bm);

Bitmap32ToPNG 函数内部

您知道为什么会发生这种情况吗？我该如何预防？

编辑

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

// 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 没有损坏，但它是空的...

Answer 1

错误在于示例创建的 TPositionedLayer 层不包含位图。您不能将此图层类型转换为 TBitmapLayer 并期望它创建图层的位图图像，就像您在以下代码中所做的那样：

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

我假设你做了类似于保存到 .png 文件的操作，尽管你没有显示该代码。

示例（具有 TPositionedLayer 层）使用 ImgView.Buffer 在屏幕上绘图。您可以将其保存为 .png 文件，如下所示：

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

但我不希望您的单独图层图像能够令人满意地工作。

您没有像以前那样使用 TBitmapLayers 的原因是什么？

根据 user1137313 的评论进行编辑

受您自己找到的解决方案的启发（参考您的评论），我建议以下方法仅在需要保存时将图层绘制到额外的位图。

从菜单项开始

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

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

然后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() 以进行实际保存。

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

最终结果与您的解决方案相同，只是额外的 TBitmap32 仅在要保存文件时绘制。

Graphics32 - 将透明绘图层保存为 png

Graphics32 - saving transparent drawing layer to png

delphi

delphi-xe