Save canvas as an image

问题

I am writing a program using Delphi XE2. I draw some lines and shapes on a Canvas. I want to save that Canvas as an image file using a save dialog.

So I have a save button on my form and by clicking it, it opens the save dialog. How should I proceed to be able to save the Canvas?

回答1:

At the moment you most likely have code in an OnPaint event for a TPaintBox or the form itself. That code might look like this:

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

We need to do a little re-factoring. We need to extract that paint code into a separate method. Pass that method a canvas so that it is agnostic of the canvas on which it draws.

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;

We are now back exactly where we started, but ready to strike at the real goal. Let's write a function to paint to a bitmap and then save to a file:

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;

This can naturally be extended to other image types like GIF, PNG, JPEG etc.

回答2:

I've done it like this (using VCL). You'll have to set up the SaveDialog properly (make the user select valid image file types etc) but you should be able to that on your own. You can obviously replace the TPngImage with TJpegImge / directly save it as BMP or whatnot, maybe you want to allow multiple image extensions and use the appropriate one based on the user input from the 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;

回答3:

DNR: Generalizing a little your code, we have

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;

来源：https://stackoverflow.com/questions/20359313/save-canvas-as-an-image

标签

Delphi

delphi-xe2