How to get a screen shot of a control #24

Solution 1

Not only can you make screen shots of the whole screen but you can also save the image of controls too. The only catch is that the following functions is for controls that are descended from TWinControl. Most standard components in Delphi are. The following function takes an object as parameter and returns a bitmap containing it's image. Have fun!

uses
  Graphics;
...
function Control2Bitmap(Control_: TWinControl): TBitmap;
begin
  Result := TBitmap.Create;
  with Result do begin
    Height := Control_.Height;
    Width  := Control_.Width;
    Canvas.Handle := CreateDC(nil, nil, nil, nil);
    Canvas.Lock;
    Control_.PaintTo(Canvas.Handle, 0, 0);
    Canvas.Unlock;
    DeleteDC(Canvas.Handle);
  end;
end;

Demo code

A ready made project containing this demo code is available. View the project.

Here's a little demo code that takes a picture of a button as it is pressed and displays it in an image control.

Create a new Delphi VCL project and drop a TImage and a TButton on the form. Create an OnClick event handler for the button. Name the form "Form1" and save the form unit as Unit1.pas. Now code Unit1 as follows:

unit Unit1;

interface

uses
  // XPMan,
  Forms, Controls, StdCtrls, Classes, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses
  Windows, Graphics;

{$R *.dfm}

function Control2Bitmap(Control_: TWinControl): TBitmap;
begin
  Result := TBitmap.Create;
  with Result do begin
    Height := Control_.Height;
    Width  := Control_.Width;
    Canvas.Handle := CreateDC(nil, nil, nil, nil);
    Canvas.Lock;
    Control_.PaintTo(Canvas.Handle, 0, 0);
    Canvas.Unlock;
    DeleteDC(Canvas.Handle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := Control2Bitmap(Button1);
  try
    Image1.Picture.Bitmap := Bmp;
  finally
    Bmp.Free;
  end;
end;

end.

You can uncomment the XPMan unit in the form's uses clause to use XP and later themes where available. You can then check that the code works OK when themes are enabled.

Demo by Peter Johnson

This solution by an unknown author.

Solution 2

The first solution can fail with several controls, including TRichEdit. Here is an alternative solution:

procedure PrintControl(AControl :TWinControl;AOut:TBitmap);
var
  DC: HDC;
begin
  if not Assigned(AOut) then Exit;
  if not Assigned(AControl) then Exit;

  DC :=GetWindowDC(AControl.Handle);
  AOut.Width  :=AControl.Width;
  AOut.Height :=AControl.Height;
  with AOut do
  BitBlt(
    Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SrcCopy
  );

  ReleaseDC(AControl.Handle, DC);
end;

This solution by Montor.

Author:	Various
Added:	2007/06/02
Last updated:	2011/01/16