Graphics32 -节省透明绘图层到png
我在ImgView32的一层上画了一条虚线。稍后，我想将每一层保存为透明的PNG。对于我所拥有的任何其他层，保存工作都很好。但对于绘图层，则不是。
为了使问题更容易理解，请从gr32库中获取示例代码，更具体地说是层示例。其主菜单中的选项之一是添加自定义绘图层(新自定义层->简单绘图层)。然后尝试将该层保存为透明的PNG图像，您将得到一个损坏的PNG文件(您不能使用任何其他图片查看器打开它，例如Paint.net或)。如果您试图将图层的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函数中
你知道为什么会发生这种事吗?我怎样才能防止这种情况发生？
编辑
我尝试使用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没有被破坏，但是它是空的.
回答 1
Stack Overflow用户
发布于 2015-04-18 08:20:39
错误在于，这些示例创建了不包含位图的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。
https://stackoverflow.com/questions/29705278
复制相似问题
腾讯云开发者
