Screen Capture a Form??

[Ian Branch 121]

Hi Team,

Need some help.  Using D12, 32bit App.

I would like to capture just the current form, in some format, and send it to the clipboard, so the User can then paste it into an email.

I found this code:

procedure TMainForm.CaptureDialogToClipboard(WindowHandle: HWND);
var
  dcWindow: HDC;
  dcMem: HDC;
  bmp: TBitmap;
begin
  dcWindow := GetDC(WindowHandle);
  try
    dcMem := CreateCompatibleDC(dcWindow);
    try
      bmp := TBitmap.Create;
      try
        bmp.Width := GetSystemMetrics(SM_CXSCREEN);
        bmp.Height := GetSystemMetrics(SM_CYSCREEN);
        SelectObject(dcMem, bmp.Canvas.Handle);
        PrintWindow(WindowHandle, dcMem, PW_CLIENTONLY); // Adjust options as needed
        Clipboard.SetAsHandle(CF_BITMAP, bmp.Handle);
      finally
        bmp.Free;
      end;
    finally
      DeleteDC(dcMem);
    end;
  finally
    ReleaseDC(WindowHandle, dcWindow);
  end;
end;

Which I think will do the job, but I can't find out where/how PW_CLIENTONLY is declared/defined.

What unit do I need to add???

 

Regards & TIA,

Ian

[Brian Evans 83]

7 minutes ago, Ian Branch said:

Which I think will do the job, but I can't find out where/how PW_CLIENTONLY is declared/defined.

What unit do I need to add???

 

Regards & TIA,

Ian

It's a Windows API call. 

 

https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-printwindow

[JonRobertson 39]

28 minutes ago, Ian Branch said:

Which I think will do the job, but I can't find out where/how PW_CLIENTONLY is declared/defined.

What unit do I need to add???

I do not see it in standard Delphi RTL/VCL units. However I did find it defined elsewhere.

const PW_CLIENTONLY = $1;

 

[Ian Branch 121]

Hi Team,

I'm not having much luck here.  I now have this code:

procedure TMainForm.CaptureDialog(WindowHandle: HWND; SaveToClipboard: Boolean; FileName: string = '');
var
  dcWindow: HDC;
  dcMem: HDC;
  bmp: TBitmap;
begin
  dcWindow := GetDC(WindowHandle);
  try
    dcMem := CreateCompatibleDC(dcWindow);
    try
      bmp := TBitmap.Create;
      try
        bmp.Width := GetSystemMetrics(SM_CXSCREEN);
        bmp.Height := GetSystemMetrics(SM_CYSCREEN);
        SelectObject(dcMem, bmp.Canvas.Handle);
        // Adjust PrintWindow options as needed
        PrintWindow(WindowHandle, dcMem, $1);

        if SaveToClipboard then
        begin
          Clipboard.SetAsHandle(CF_BITMAP, bmp.Handle);
        end;

        if FileName <> '' then
        begin
          bmp.SaveToFile(FileName);
        end;
      finally
        bmp.Free;
      end;
    finally
      DeleteDC(dcMem);
    end;
  finally
    ReleaseDC(WindowHandle, dcWindow);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  CaptureDialog(Application.ActiveFormHandle, False, GetDesktopPath+'ScreenCapture2015.bmp');
end;

When I click the button on the form I get an 'image' saved OK but it is all white and looks suspiciously like an all white screen. 😞

Thoughts/suggestions appreciated.

 

Regards & TIA,

Ian

[JonRobertson 39]

Take a look at PrintWindowExample. I opened the project in D11, hit F9, and it worked. It does not take a screenshot of the current app, but hopefully it will help you with your code.

[Ian Branch 121]

Yes, I am playing with it att with mixed results.

[Ian Branch 121]

Hi Team,

I came across this code and it works straight-up.  I just need to do some tweaks:

procedure ScreenShot(activeWindow: bool; destBitmap: TBitmap);
var
  w, h: integer;
  DC: HDC;
  hWin: Cardinal;
  r: TRect;
begin
  if activeWindow then
  begin
    hWin := GetForegroundWindow;
    dc := GetWindowDC(hWin);
    GetWindowRect(hWin, r);
    w := r.Right - r.Left;
    h := r.Bottom - r.Top;
  end
  else
  begin
    hWin := GetForegroundWindow;
    dc := GetDC(hWin);
    w := GetDeviceCaps(DC, HORZRES);
    h := GetDeviceCaps(DC, VERTRES);
  end;

  try
    destBitmap.Width := w;
    destBitmap.Height := h;
    BitBlt(destBitmap.Canvas.Handle, 0, 0, destBitmap.Width, destBitmap.Height, DC, 0, 0, SRCCOPY);
  finally
    ReleaseDC(hWin, DC);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  path: string;
  b: TBitmap;
begin
  //
  b := TBitmap.Create;
  try
    ScreenShot(TRUE, b);
    Clipboard.SetAsHandle(CF_BITMAP, b.Handle);
    b.SaveToFile(GetDesktopPath + 'Screenshot_1.bmp');
  finally
    b.FreeImage;
    FreeAndNil(b);
  end;
  //
end;

Thank you all for your input.  Appreciated.

Regards,

Ian

[KHJ 8]

Have a look at the utils folder from Rob.

SCapture.pas has everything you need.
https://github.com/rlove/robstechcorner