Search code examples
formsdelphiscreenshotcapturebehind

How do I capture desktop screenshot behind full screen form?


I have a full screen form to block all inputs. How to capture screenshot of all desktop behind this form? In other words, how to take a printscreen without appearing this form that is in front of the screen?

I'm writing a remote access software. I need show info of technical support in screen and block all inputs during access for analysts work quietly - VNC for example have option to turn off the monitor, Dameware have option to block input.

There is another way to work remotely behind this lock screen?


Solution

  • While I am fully in line with the commenters, that it is not a good idea to block user input with a full screen form, here is some code to get you started. The code assumes a screen size of 1920 x 1200.

    unit Unit152;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls;
    
    type
      TForm152 = class( TForm )
        Timer1: TTimer;
        procedure Timer1Timer( Sender: TObject );
        procedure FormCreate( Sender: TObject );
      private
        { Private declarations }
        DesktopBMP: TBitmap;
        procedure WMEraseBkgnd( var Message: TWMEraseBkgnd ); message WM_ERASEBKGND;
      protected
        procedure Paint; override;
      public
        { Public declarations }
    
      end;
    
    var
      Form152: TForm152;
    
    implementation
    
    {$R *.dfm}
    { TForm152 }
    
    procedure TForm152.FormCreate( Sender: TObject );
    begin
      DesktopBMP := TBitmap.Create;
      DesktopBMP.SetSize( 1920, 1200 );
    end;
    
    procedure TForm152.Paint;
    begin
      inherited;
      Canvas.Draw( 0, 0, DesktopBMP );
    end;
    
    procedure TForm152.Timer1Timer( Sender: TObject );
    begin
      // alternatively a simple Invalidate would do here, but then
      // all other windows would not redraw
      Width := 0;
      Height := 0;
      Width := 1920;
      Height := 1200;
    end;
    
    procedure TForm152.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, 1919, 1199 ), DesktopCanvas, Rect( 0, 0, 1919, 1199 ) );
      finally
        DesktopCanvas.Free;
        ReleaseDc( DesktopHwnd, DesktopDC );
      end;
      Message.Result := 1;
      inherited;
    end;
    
    end.
    

    The DFM looks like this:

    object Form152: TForm152
      Left = 2296
      Top = 103
      BorderStyle = bsNone
      Caption = 'Form152'
      ClientHeight = 699
      ClientWidth = 1289
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      WindowState = wsMaximized
      OnCreate = FormCreate
      PixelsPerInch = 96
      TextHeight = 13
      object Timer1: TTimer
        Interval = 10
        OnTimer = Timer1Timer
        Left = 640
        Top = 360
      end
    end