1
我在ImgView32的圖層上畫一條虛線。之後，我想將每個圖層保存爲透明PNG。 對於我有的任何其他層，節能工作得很好。但是對於繪圖層而言，它並不是。Graphics32 - 將透明繪圖層保存爲PNG
爲了使問題更容易理解，請參閱gr32庫中的示例代碼，更具體地說是Layers示例。其主菜單中的一個選項是添加自定義繪圖圖層（新自定義圖層 - >簡單繪圖圖層）。 然後嘗試將該圖層保存爲透明的PNG圖像，並最終得到損壞的PNG文件（無法用任何其他圖片查看器（例如Paint.net或Microsoft照片查看器）打開它）。同樣的事情發生，如果你試圖保存層的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），並繪製了我的繪圖。最後，我想將該圖層的內容保存爲PNG。但是，似乎onPaint可能會繪製其他地方而不是實際的圖層。否則，我不明白爲什麼保存的圖像是空的。 所以這次所得到的PNG沒有損壞，但它是空的...
我認爲問題可能是通過創建一個TPositionedLayer，一個Bitmap32永遠不會被創建，所以它必須是我只有一個空的容器（層）爲bitmap32。這一定是我無法將圖層的位圖分配給任何東西的原因......？！？！這聽起來像是一個可能的原因？ – user1137313
當我在這裏發現您的評論時，我剛發佈了一個答案。是的，你的猜測是正確的。 –