Screenshot behind a full screen Form results in a black screen

Question

I want to capture an image of a desktop that ignores my form when captured. I like this answer, but have not been able to capture the desktop content, only a black screen.

So, I need of help to try fix this trouble.

Here is my version with little changes:

private
    { Private declarations }
    DesktopBMP: TBitmap;
    procedure WMEraseBkgnd( var Message: TWMEraseBkgnd ); message WM_ERASEBKGND;
  public
    { Public declarations }
    protected
    procedure Paint; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
DesktopBMP := TBitmap.Create;
  DesktopBMP.SetSize( Screen.Width, Screen.Height );
  DoubleBuffered := True;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  Width := 0;
  Height := 0;
  Width := Screen.Width;
  Height := Screen.Height;
end;

procedure TForm1.Paint;
begin
  inherited;
  //Canvas.Draw( 0, 0, DesktopBMP );
  DesktopBMP.SaveToFile('c:\tela.bmp');
end;

procedure TForm1.WMEraseBkgnd( var Message: TWMEraseBkgnd );
var
  DesktopDC: HDC;
  DesktopHwnd: Hwnd;
  DesktopCanvas: TCanvas;
begin
  DesktopHwnd := GetDesktopWindow;
  DesktopDC := GetDC( DesktopHwnd );
  try
    DesktopCanvas := TCanvas.Create;
    DesktopCanvas.Handle := DesktopDC;
    DesktopBMP.Canvas.CopyRect( Rect( 0, 0, Screen.Width, Screen.Height ), DesktopCanvas, Rect( 0, 0, Screen.Width, Screen.Height ) );
  finally
    DesktopCanvas.Free;
    ReleaseDc( DesktopHwnd, DesktopDC );
  end;
  Message.Result := 1;
  inherited;
end;

Answer 1

Here's a solution based on the code you presented.

The overlay form is a borderless one (BorderStyle = bsNone), and it has two buttons, one to take a screenshot of the underlying screen and one to terminate the application (as we have no buttons in the caption).

The main changes to your code are

Two private fields in the form

DoSnapShot: boolean; // to control when to copy the screen
ScreenRect: TRect;   // to hold the rectangle of the overlay

and a procedure

procedure TakeScreenShot;

TakeScreenShotreplaces the OnTimer handler you had in your code, and adds setting the boolean DoSnapShot = True just before resetting the Width and Height

WMEraseBkgnd is modified to only attempt to copy the underlying screen if DoSnapShot = True.

Complete code follows

type
  TForm3 = class(TForm)
    ScreenBtn: TButton;
    ExitBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ScreenBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
  private
    DesktopBMP: TBitmap;
    DoSnapShot: boolean; // to control when to copy the screen
    ScreenRect: TRect;   // to hold the rectangle of the overlay
    procedure TakeScreenShot;
    procedure WMEraseBkgnd( var Message: TWMEraseBkgnd ); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.ScreenBtnClick(Sender: TObject);
begin
  TakeScreenShot;
end;

procedure TForm3.ExitBtnClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  Left := 0;
  Top := 0;
  Width := Screen.Width;
  Height := Screen.Height-10;

  ScreenRect := Rect(Left, Top, Width, Height);

  DesktopBMP := TBitmap.Create;
  DesktopBMP.SetSize( Width, Height );
end;

procedure TForm3.Paint;
begin
  inherited;
  Canvas.Draw( 0, 0, DesktopBMP );
end;

procedure TForm3.TakeScreenShot;
begin
  Width := 0;   // will not trigger copying
  Height := 0;  //
  DoSnapShot := True;  // now enable copying the underlying screen
  Width := ScreenRect.Width;    //
  Height := ScreenRect.Height;  // and trigger it in WMEraseBkgnd
end;

procedure TForm3.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  DesktopDC: HDC;
  DesktopHwnd: Hwnd;
  DesktopCanvas: TCanvas;
begin
  if DoSnapShot then
  begin
    DoSnapShot := False; // Disable repeated copying
    DesktopHwnd := GetDesktopWindow;
    DesktopDC := GetDC( DesktopHwnd );
    try
      DesktopCanvas := TCanvas.Create;
      DesktopCanvas.Handle := DesktopDC;
      DesktopBMP.Canvas.CopyRect( ScreenRect , DesktopCanvas, ScreenRect );
    finally
      DesktopCanvas.Free;
      ReleaseDc( DesktopHwnd, DesktopDC );
    end;
  end;
  Message.Result := 1;
  inherited;
end;

end.

And the .dfm:

object Form3: TForm3
  Left = 0
  Top = 0
  BorderStyle = bsNone
  Caption = 'Form3'
  ClientHeight = 139
  ClientWidth = 225
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ScreenBtn: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'ScreenShot'
    TabOrder = 0
    OnClick = ScreenBtnClick
  end
  object ExitBtn: TButton
    Left = 8
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Exit'
    TabOrder = 1
    OnClick = ExitBtnClick
  end
end