How to take a screenshot of the Active Window in Delphi?

Question

For full screenshots, I use this code:

form1.Hide;
sleep(500);
bmp := TBitmap.Create;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
DCDesk := GetWindowDC(GetDesktopWindow);
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DCDesk, 0, 0, SRCCOPY);
form1.Show ;
FileName := 'Screenshot_'+FormatDateTime('mm-dd-yyyy-hhnnss',now());
bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
ReleaseDC(GetDesktopWindow, DCDesk);
bmp.Free;

How can I convert that to take a screenshot of only the active window.

Solution 1

1. First of all you have to get the right window. As sharptooth already noted you should use GetForegroundWindow instead of GetDesktopWindow. You have done it right in your improved version.
2. But then you have to resize your bitmap to the actual size of the DC/Window. You haven't done this yet.
3. And then make sure you don't capture some fullscreen window!

When I executed your code, my Delphi IDE was captured and as it is on fullscreen by default, it created the illusion of a fullscreen screenshot. (Even though your code is mostly correct)

Considering the above steps, I was successfully able to create a single-window screenshot with your code.

Just a hint: You can GetDC instead of GetWindowDC if you are only interested in the client area. (No window borders)

EDIT: Here's what I made with your code:

You should not use this code! Look at the improved version below.

procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  hWin: HWND;
  dc: HDC;
  bmp: TBitmap;
  FileName: string;
  r: TRect;
  w: Integer;
  h: Integer;
begin
  form1.Hide;
  sleep(500);
  hWin := GetForegroundWindow;

  if FullWindow then
  begin
    GetWindowRect(hWin,r);
    dc := GetWindowDC(hWin) ;
  end else
  begin
    Windows.GetClientRect(hWin, r);
    dc := GetDC(hWin) ;
  end;

  w := r.Right - r.Left;
  h := r.Bottom - r.Top;

  bmp := TBitmap.Create;
  bmp.Height := h;
  bmp.Width := w;
  BitBlt(bmp.Canvas.Handle, 0, 0, w, h, DC, 0, 0, SRCCOPY);
  form1.Show ;
  FileName := 'Screenshot_'+FormatDateTime('mm-dd-yyyy-hhnnss',now());
  bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
  ReleaseDC(hwin, DC);
  bmp.Free;
end;

EDIT 2: As requested I'm adding a better version of the code, but I'm keeping the old one as a reference. You should seriously consider using this instead of your original code. It'll behave much nicer in case of errors. (Resources are cleaned up, your form will be visible again, ...)

procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  Win: HWND;
  DC: HDC;
  Bmp: TBitmap;
  FileName: string;
  WinRect: TRect;
  Width: Integer;
  Height: Integer;
begin
  Form1.Hide;
  try
    Application.ProcessMessages; // Was Sleep(500);
    Win := GetForegroundWindow;

    if FullWindow then
    begin
      GetWindowRect(Win, WinRect);
      DC := GetWindowDC(Win);
    end else
    begin
      Windows.GetClientRect(Win, WinRect);
      DC := GetDC(Win);
    end;
    try
      Width := WinRect.Right - WinRect.Left;
      Height := WinRect.Bottom - WinRect.Top;

      Bmp := TBitmap.Create;
      try
        Bmp.Height := Height;
        Bmp.Width := Width;
        BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
        FileName := 'Screenshot_' + 
          FormatDateTime('mm-dd-yyyy-hhnnss', Now());
        Bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
      finally
        Bmp.Free;
      end;
    finally
      ReleaseDC(Win, DC);
    end;
  finally
    Form1.Show;
  end;
end;

Solution 2

Your code could be a lot simpler. When you have decided on which form you want to save, try the code I use:

procedure SaveFormBitmapToBMPFile( AForm : TCustomForm; AFileName : string = '' );
// Copies this form's bitmap to the specified file
var
  Bitmap: TBitMap;
begin
  Bitmap := AForm.GetFormImage;
  try
    Bitmap.SaveToFile( AFileName );
  finally
    Bitmap.Free;
  end;
end;

Solution 3

This combines all the approaches described so far. It also handles multiple-monitor scenarios.

Pass in the kind of screenshot you want, and a TJpegImage, and it will assign your requested screenshot to that image.

///////////
uses
  Jpeg;

type  //define an ENUM to describe the possible screenshot types.
  TScreenShotType = (sstActiveWindow, sstActiveClientArea,
    sstPrimaryMonitor, sstDesktop);
///////////

procedure TfrmMain.GetScreenShot(shotType: TScreenShotType;
  var img: TJpegImage);
var
  w,h: integer;
  DC: HDC;
  hWin: Cardinal;
  r: TRect;
  tmpBmp: TBitmap;
begin
  hWin := 0;
  case shotType of
    sstActiveWindow:
      begin
        //only the active window
        hWin := GetForegroundWindow;
        dc := GetWindowDC(hWin);
        GetWindowRect(hWin,r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end;  //sstActiveWindow
    sstActiveClientArea:
      begin
        //only the active client area (active window minus title bars)
        hWin := GetForegroundWindow;
        dc := GetDC(hWin);
        GetWindowRect(hWin,r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end;  //sstActiveClientArea
    sstPrimaryMonitor:
      begin
        //only the primary monitor.  If 1 monitor, same as sstDesktop.
        hWin := GetDesktopWindow;
        dc := GetDC(hWin);
        w := GetDeviceCaps(DC,HORZRES);
        h := GetDeviceCaps(DC,VERTRES);
      end;  //sstPrimaryMonitor
    sstDesktop:
      begin
        //ENTIRE desktop (all monitors)
        dc := GetDC(GetDesktopWindow);
        w := Screen.DesktopWidth;
        h := Screen.DesktopHeight;
      end;  //sstDesktop
    else begin
      Exit;
    end;  //case else
  end;  //case

  //convert to jpg
  tmpBmp := TBitmap.Create;
  try
    tmpBmp.Width := w;
    tmpBmp.Height := h;
    BitBlt(tmpBmp.Canvas.Handle,0,0,tmpBmp.Width,
      tmpBmp.Height,DC,0,0,SRCCOPY);
    img.Assign(tmpBmp);
  finally
    ReleaseDC(hWin,DC);
    FreeAndNil(tmpBmp);
  end;  //try-finally
end;

Solution 4

JCL comes to the rescue once again..

    hwnd := GetForegroundWindow;
    Windows.GetClientRect(hwnd, r);
    JclGraphics.ScreenShot(theBitmap, 0, 0, r.Right - r.Left, r.Bottom - r.Top, hwnd);

    // use theBitmap...

Solution 5

Thank you for this useful submission I thought I might make the code offered into a unit to use all over my application, here is the code I have running on DX10.2 Tokyo. Please note the example, watch out for memory leaks.

unit ScreenCapture;
interface

uses Windows, Vcl.Controls, Vcl.StdCtrls, VCL.Graphics,VCL.Imaging.JPEG, VCL.Forms;

function getScreenCapture(  FullWindow: Boolean = True ) : TBitmap;

implementation

function getScreenCapture( FullWindow: Boolean ) : TBitmap;
var
  Win: HWND;
  DC: HDC;

  WinRect: TRect;
  Width: Integer;
  Height: Integer;

begin
  Result := TBitmap.Create;

  //Application.ProcessMessages; // Was Sleep(500);
  Win := GetForegroundWindow;

  if FullWindow then
  begin
    GetWindowRect(Win, WinRect);
    DC := GetWindowDC(Win);
  end
    else
  begin
    Windows.GetClientRect(Win, WinRect);
    DC := GetDC(Win);
  end;
  try
    Width := WinRect.Right - WinRect.Left;
    Height := WinRect.Bottom - WinRect.Top;

    Result.Height := Height;
    Result.Width := Width;
    BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
  finally
    ReleaseDC(Win, DC);
  end;
end;
end.

Example :

//Any event or button click, screenCapture is a TBitmap
screenCapture := getScreenCapture();
try
  //Do some things with screen capture
  Image1.Picture.Graphic := screenCapture; 
finally 
  screenCapture.Free;
end;

View more solutions

Comments

[PuppyKevin]

Ok now I have this: pastebin.com/m2e334a4a It still takes the fullscreen though.

[sharptooth]

Check what the handle value is. If it's null there's no active window and you effectively dump the entire desktop.

[PuppyKevin]

I'm confused. What is the handle value? Also, how do I check it?

[sharptooth]

I hope you have a variable that you assign the result of GetForegroundWindow(). You can add a watch to see the actual value of that variable.

[PuppyKevin]

Here, this is my entire procedure: pastebin.com/m711bc0c4 No, I don't have a variable that has the result of GetForegroundWindow()

[sharptooth]

You need a variable to store the value which GetForegroundWindow() returns anyway. How do you think your code will work if active window changes between the GetWindowDC() and ReleaseDC() calls?

[PuppyKevin]

Ok, this is my current code now: pastebin.com/m43958302 This is how the picture turns out: i43.tinypic.com/xpcvw1.jpg Any suggestions?

[Daniel Rikowski]

You have to be more careful :) 1. You are exchanging the height and width at BitBlt. 2. You are capturing the client area, but you are sizing the bitmap according to the full width.

[Daniel Rikowski]

That would only work with forms belonging to the same application. But in that case it's waaay better than messing with the Windows API.

[PuppyKevin]

DR, could you show me what you made from my code? I think I can learn better if I see someone else's work.

[mghie]

@PuppyKevin: Show us first that you made some effort. Your code is halfway there, you just need to do what DR told you. And replace the Sleep() call with Application.ProcessMessages() to let the other forms redraw themselves.

[PuppyKevin]

DR, I must say, I tip my hat to you. You are one very helpful person :) The code you gave me was very close to what I had after some revision, I was just missing a few things. Also, sorry for my beginner skills, I'm still trying to learn.

[mghie]

@DR: Now that you have gotten the deserved up votes and accepted check mark, could you please make your code really helpful for beginners: Use try and finally, dispose off resources in the reverse order they were acquired, and so on? Thanks.

[Daniel Rikowski]

@PuppyKevin: No problem, I once was a beginner, too, and there have been others helping me, too, so I'm just glad to help :)

[mghie]

@DR: Thanks, now you got another +1 ;-)

[Fr0sT]

Very nice but this only saves client area of the form

[Alex Hide]

With this code you will get GDI handle leak. Run it like 100 or 1000 times and check it via ProcessExplorer. GDI Handles number will rise until it reaches limit

[Daniel Rikowski]

Do you have an idea which one of the handles or what kind of handle is leaking? Perhaps I'm missing something, but the code seems to close all handles it creates...

[Alex Hide]

@DanielRikowski I'm not sure why this happens. I was checking the error one of the users reported to me and found that it creates a handle after using bitblt and not frees it. I was also surprised and confused that this code has handle leaks, unfortunately it has (at least on Delphi 10.2.3). I solved it by adding CreateCompatibleDC and CreateCompatibleBitmap, leaks are gone after that.