Save canvas as image

Question

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

So, I have a save button in my form and, clicking it, opens a save dialog. How do I proceed to save the canvas?

Answer 1

At the moment, you most likely have code in the event OnPaintfor TPaintBoxor the form itself. This 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 rephrase a little. We need to extract this paint code into a separate method. Pass this canvas method so that it is an 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;

, , . , :

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 2

( VCL). SaveDialog ( ..), . , , TPngImage TJpegImge/ 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 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;