Graphics32 - сохранение прозрачного слоя рисования в png

Я рисую пунктирную линию на слое 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. Назначить (бм);

внутри функции 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) и рисую в Paint. В конце концов, я хочу сохранить содержимое этого слоя в формате PNG. Но похоже, что onPaint может рисовать где-то еще, а не на самом слое. Иначе я не понимаю, почему сохраненное изображение пустое. Итак, на этот раз полученный PNG не поврежден, но он пуст...


person user1137313    schedule 17.04.2015    source источник
comment
Я думаю, что проблема может заключаться в том, что при создании TPositionedLayer Bitmap32 никогда не создается, поэтому должно быть так, что у меня есть только пустой контейнер (слой) для bitmap32. И это должно быть причиной того, что я не могу присвоить растровое изображение слоя чему-либо...?!?! это звучит как возможная причина?   -  person user1137313    schedule 18.04.2015
comment
Я только что опубликовал ответ, когда заметил ваш комментарий здесь. Да, ваша догадка верна.   -  person Tom Brunberg    schedule 18.04.2015


Ответы (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, как раньше?


Изменить после комментариев пользователя 1137313

Вдохновленный решением, которое вы нашли сами (см. ваш комментарий), я предлагаю следующее, которое рисует слой в дополнительное растровое изображение только тогда, когда это необходимо для сохранения.

Начиная с пункта меню

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 рисуются только тогда, когда файл должен быть сохранен.

person Tom Brunberg    schedule 18.04.2015
comment
Тот факт, что код показывает использование TPositionedLayer, не означает, что я не пытался использовать TBitmapLayer. На самом деле мой текущий код создает TBitmapLayer. Однако ошибка та же. Растровое изображение последнего слоя все еще повреждено, поэтому что-то все еще не так. Пожалуйста, проверьте мой обновленный вопрос - person user1137313; 19.04.2015
comment
Тогда не стесняйтесь дать мне решение... прямо сейчас я добавил несколько строк кода для назначения буфера (из onPaint) растровому изображению слоя в конце OnPaint. Конечно, это не решение, но я хотел проверить, получает ли TBitmapLayer фактическое растровое изображение в onPaint, и могу ли я проверить это, сохранив его. И да, теперь я вижу PNG с содержимым. Теперь моя проблема: как я могу отбросить фактический рисунок на слой, а не рекурсивно. Поэтому мне, вероятно, нужно какое-то другое событие слоя, кроме onPaint, где я должен назначить ImgView.Buffer для Layer.Bitmap... а также только часть буфера. - person user1137313; 20.04.2015
comment
Я решил это самостоятельно. В onPaint Handler я рисую параллельно на 2 Bitmaps32. Я рисую в буфере, а также рисую на bmp32:Tbitmap32. В конце события onPaint я делаю (Sender as TBitmapLayer).Bitmap.Assign(bmp32); таким образом, слой закрашивается, поэтому, когда я сохраняю слой как PNG, в растровом изображении слоев есть содержимое. - person user1137313; 20.04.2015
comment
Несмотря на то, что я нашел свою проблему самостоятельно, а затем вы только подтвердили, что я был прав в своем предположении, я решил наградить вас правильным ответом. - person user1137313; 20.04.2015
comment
@ user1137313 Спасибо! Я отредактировал свой ответ, включив ваше решение с небольшой модификацией. - person Tom Brunberg; 21.04.2015
comment
@user1137313 user1137313 Ой, извините, у меня не было времени ответить раньше - person Tom Brunberg; 21.04.2015