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

Question

Я рисую пунктирную линию на слое ImgView32. Позже я хочу сохранить каждый слой в виде прозрачных PNG. Для любого другого слоя, который у меня есть, экономия работает отлично. Но для слоя рисования это не так.

Чтобы упростить понимание вопроса, возьмите код примера из библиотеки gr32, более конкретно, пример слоев. Одним из вариантов в главном меню является добавление пользовательского слоя чертежа (Новый пользовательский слой -> Простой уровень рисования). Затем попробуйте сохранить этот слой как прозрачное изображение PNG, и вы получите поврежденный PNG-файл (вы не можете открыть его с помощью любого другого средства просмотра изображений, например, Paint.net или Microsoft Photo Viewer). То же самое происходит, если вы пытаетесь сохранить bitmap32 слоя как растровое изображение, как вы можете видеть в следующем томе ...

Я пробовал два подхода для сохранения 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

Есть ли у вас какие-либо идеи, почему это происходит и как я могу это предотвратить?

EDIT

Я попытался с помощью 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

Ошибка в том, что в примерах создаются слои , которые не содержат растровое изображение. Вы не можете ввести CAST этого типа слоя в 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, как вы это делали раньше?

---

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