Graphics32 - сохранение прозрачного слоя рисунка в png
Я рисую пунктирную линию на слое ImgView32. Позже я хочу сохранить каждый слой в виде прозрачных PNG. Для любого другого слоя сохранение отлично работает. Но для слоя рисования это не так.
Чтобы упростить понимание вопроса, возьмите пример кода из библиотеки gr32, точнее, пример Layers. Одним из параметров в его главном меню является добавление пользовательского слоя для рисования (Новый пользовательский слой -> Простой слой для рисования). Затем попытайтесь сохранить этот слой как прозрачное изображение PNG, и в результате вы получите поврежденный файл PNG (вы не можете открыть его с помощью любого другого средства просмотра изображений, например Paint.net или Microsoft Photo Viewer). То же самое происходит, если вы пытаетесь сохранить битовую карту слоя в виде битовой карты, как вы можете видеть в приведенном ниже коде...
Я попробовал два подхода для сохранения 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);
...
Но как только я пытаюсь сохранить слой, созданный с помощью кода из примера Layers, результат искажается. Даже если я попытаюсь сохранить слой как растровое изображение, как это (хотя это не мое намерение, поскольку мне нужно, чтобы они были в формате 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 (шм);
внутри функции 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) и наПокраска я делаю мой рисунок. В конце я хочу сохранить содержимое этого слоя в формате PNG. Но кажется, что onPaint может рисовать где-то еще вместо реального слоя. В противном случае я не понимаю, почему сохраненное изображение пусто. Так что на этот раз полученный PNG не поврежден, но пуст...
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 окрашивается только тогда, когда файл должен быть сохранен.