将画布另存为图像

Question

我正在使用Delphi XE2编写程序。我在画布上绘制一些线条和形状。我想使用保存对话框将该Canvas保存为图像文件。

因此，我在窗体上有一个保存按钮，通过单击它可打开保存对话框。我应该如何继续保存Canvas？

Answer 1

我已经这样做了（使用VCL）。你必须正确设置SaveDialog（使用户选择有效的图像文件类型等），但你应该可以自己做到这一点。你可以很明显地用TJpegImge替换TPngImage /直接将它保存为BMP或者其他东西，也许你想允许多个图像扩展，并根据SaveDialog的用户输入使用适当的图像扩展。

procedure TForm2.Button1Click(Sender: TObject); 
    var Bmp: TBitmap; 
     Png: TPngImage; 
begin 
    if SaveDialog1.Execute then 
    begin 
    Bmp := TBitmap.Create; 
    try 
     Bmp.SetSize(Canvas.ClipRect.Right, Canvas.ClipRect.Bottom); 
     BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); 
     Png := TPngImage.Create; 
     try 
     Png.Assign(Bmp); 
     Png.SaveToFile(SaveDialog1.FileName + '.png'); 
     finally 
     Png.Free; 
     end; 
    finally 
     Bmp.Free; 
    end; 
    end; 
end; 

Answer 2

此刻的你最有可能在OnPaint事件的TPaintBox或窗体本身的代码。该代码可能如下所示：

procedure TMyForm.PaintBox1Paint(Sender: TObject); 
begin 
    with PaintBox1.Canvas do 
    begin 
    MoveTo(0, 0); 
    LineTo(42, 666); 
    // and so on. 
    end; 
end; 

我们需要做一些重新分解。我们需要将该代码提取到单独的方法中。将该方法传递给画布，以使其不受画布的影响。

procedure TMyForm.PaintToCanvas(Canvas: TCanvas); 
begin 
    with Canvas do 
    begin 
    MoveTo(0, 0); 
    LineTo(42, 666); 
    // and so on. 
    end; 
end; 

procedure TMyForm.PaintBox1Paint(Sender: TObject); 
begin 
    PaintToCanvas(PaintBox1.Canvas); 
end; 

我们现在回到刚刚开始的地方，但准备好打击真正的目标。让我们写一个函数来绘制成位图，然后保存到一个文件：

procedure TMyForm.PaintToFile(const FileName: string); 
var 
    Bitmap: TBitmap; 
begin 
    Bitmap := TBitmap.Create; 
    try 
    Bitmap.SetSize(Paintbox1.Width, Paintbox1.Height); 
    PaintToCanvas(Bitmap.Canvas); 
    Bitmap.SaveToFile(FileName); 
    finally 
    Bitmap.Free; 
    end; 
end; 

这当然也可以扩展到其他图像类型，如GIF，PNG，JPEG等

Answer 3

DNR：泛化一点你代码中，我们有

uses Vcl.Imaging.pngimage 

procedure TfrmPrincipalTest.PrintCanvas(aCanvas: TCanvas; aRect: TRect); 
    var Bmp: TBitmap; 
     Png: TPngImage; 
begin 
    if sSaveDialog1.Execute then 
    begin 
    Bmp := TBitmap.Create; 
    try 
     Bmp.SetSize(aCanvas.ClipRect.Right, aCanvas.ClipRect.Bottom); 
     BitBlt(Bmp.Canvas.Handle, aRect.Top, aRect.Left, aRect.Right, aRect.Bottom, aCanvas.Handle, 0, 0, SRCCOPY); 
     Png := TPngImage.Create; 
     try 
     Png.Assign(Bmp); 
     Png.SaveToFile(sSaveDialog1.FileName + '.png'); 
     finally 
     Png.Free; 
     end; 
    finally 
     Bmp.Free; 
    end; 
    end; 
end; 

procedure TfrmPrincipalTest.I1Click(Sender: TObject); 
var vRect: TRect; 
begin 
    vRect.Top:=0; 
    vRect.Left:=0; 
    vRect.Right:=sPageControl1.Width; 
    vRect.Bottom:=sPageControl1.Height; 
    PrintCanvas(sPageControl1.Canvas, vRect); 
end;