capture user desktop

[jesu 3]

Hello. When a user gets an exception in my program I want to see his desktop to know exactly how it happened. I'm using this code called from ApplicationEventsException:

 

function FuncCapturaPantalla: TJpegImage;
var
  va_Desktop: TBitmap;
  vh_Escritorio: THandle;
  dc        : HDC;
  va_jpeg   : TJpegImage;
begin
  vh_Escritorio := GetDeskTopWindow;
  dc            := GetDC(vh_Escritorio);
  va_Desktop := TBitmap.Create;
  try
    va_Desktop.Width  := Screen.Width;
    va_Desktop.Height := Screen.Height;
    BitBlt(va_Desktop.Canvas.Handle , 0 , 0 , trunc(Screen.Width *1.25), trunc(Screen.Height* 1.25), dc , 0 , 0 , SRCCOPY);  // @ si cambian dpi no coge la pantalla entera
    va_Jpeg := TJpegImage.Create;
    try
      va_Jpeg.Assign(va_Desktop);
      va_Jpeg.CompressionQuality := 30;
      va_Jpeg.Compress;
      Result := va_jpeg;
    except
      va_Jpeg.Free; 
      raise;
    end;
  finally
    va_DeskTop.Free;
    ReleaseDC(vh_Escritorio , dc);
  end;
end;

 

Sometimes it works, sometimes  not. If a user has high DPI sometimes the window gets cut (I tried to multiply by 1.25 to see it that solved it). Other times I get an image of a desktop where I can't see my program at all, even though e.message shows that the error is in a form called by another one, so I should see both forms in the image.

What am I doing wrong?

Thanks.

 

[PeaShooter_OMO 38]

If you are willing to consider another route then have a look at MadExcept. It can do screenshots and is an extremely useful tool.

[Anders Melander 2053]

I think you need to work with monitors instead of "the screen".

Different monitors can have different DPI, and they might not align.

 

Here's some random code:

procedure TBitmapEditorToolScreenShot.TSnapShotList.Capture;
var
  i: integer;
  DesktopDC: HDC;
  Canvas: TCanvas;
begin
  if (FItems = nil) then
    FItems := TObjectList<TSnapShot>.Create
  else
    FItems.Clear;

  for i := 0 to Screen.MonitorCount-1 do
    FItems.Add(TSnapshot.Create(Screen.Monitors[i]));

  // Capture desktop
  DesktopDC := GetDC(HWND_DESKTOP);
  if (DesktopDC = 0) then
    RaiseLastOSError;
  try
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DesktopDC;

      for i := 0 to FItems.Count-1 do
        FItems[i].Capture(Canvas); // See TSnapShot class below
    finally
      Canvas.Free;
    end;
  finally
    ReleaseDC(HWND_DESKTOP, DesktopDC);
  end;
end;

All it does it to create a list of monitors and then it does a capture of each monitor into separate bitmaps.

 

Here's the class that represents a monitor and its bitmap and which does the actual capture:

type
  TBitmapEditorToolScreenShot = class(TCustomBitmapEditorTool, ICaptureController)
  strict private type
    TSnapShot = class
    private
      FMonitor: Forms.TMonitor;
      FBitmap: TBitmap;
    public
      constructor Create(AMonitor: Forms.TMonitor);
      destructor Destroy; override;
      procedure Capture(DesktopCanvas: TCanvas);
      property Monitor: Forms.TMonitor read FMonitor;
      property Bitmap: TBitmap read FBitmap;
    end;
    ...more stuff...
  end;

procedure TBitmapEditorToolScreenShot.TSnapShot.Capture(DesktopCanvas: TCanvas);
begin
  if (FBitmap = nil) then
    FBitmap := TBitmap.Create;

  FBitmap.SetSize(FMonitor.BoundsRect.Width, FMonitor.BoundsRect.Height);
  FBitmap.PixelFormat := pf24bit;
  FBitmap.Canvas.CopyRect(FBitmap.Canvas.ClipRect, DesktopCanvas, FMonitor.BoundsRect);
end;

constructor TBitmapEditorToolScreenShot.TSnapShot.Create(AMonitor: Forms.TMonitor);
begin
  inherited Create;
  FMonitor := AMonitor;
end;

destructor TBitmapEditorToolScreenShot.TSnapShot.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

 

[Anders Melander 2053]

2 minutes ago, PeaShooter_OMO said:

If you are willing to consider another route then have a look at MadExcept. It can do screenshots and is an extremely useful tool.

I second that.

I wouldn't dream of using my own code for something like this when we have madExcept. It even allows the user to annotate the screenshot AFAIR.

[Anders Melander 2053]

12 hours ago, jesu said:

Other times I get an image of a desktop where I can't see my program at all, even though e.message shows that the error is in a form called by another one, so I should see both forms in the image.

This might be because the Desktop Window Manager (DWM) ghosts your application and synthesizes an image of it. The same thing happens if your application isn't reading from the message queue (e.g. it's running in a tight loop, doing stuff); The application can't repaint itself so DWM takes over and displays an image of what it looked like the last time it was repainted.

 

I think that what we get when copying from the desktop DC isn't necessarily what is actually displayed on the screen. I think the DWM has an internal buffer that composes the image we see based on the desktop DC and whatever other things it thinks should be shown (e.g. ghosted windows).

There's probably an API somewhere that provides access to DWM.

Edited yesterday at 12:08 AM by Anders Melander

[jesu 3]

10 hours ago, Anders Melander said:

I think you need to work with monitors instead of "the screen".

 

Most users only have 1 monitor, but if that's not the case, I had supposed that Screen would return the size of the monitor where the program is shown. It seems that at least I should do something like:

  TotalWidth := 0;
  TotalHeight := 0;
  for i := 0 to Screen.MonitorCount - 1 do
  begin
    TotalWidth := TotalWidth + Screen.Monitors[i].Width;
    TotalHeight := Max(TotalHeight, Screen.Monitors[i].Height);
  end;

 

I'll need time to see if that solves the problem of not getting the whole window.

[Anders Melander 2053]

13 minutes ago, jesu said:

Most users only have 1 monitor

Not my users - but of course that's not really relevant to you.

 

14 minutes ago, jesu said:

I had supposed that Screen would return the size of the monitor where the program is shown.

"The program" isn't shown on a monitor; A window is and a program can have several windows, each positioned independently.

 

You can use TForm.Monitor to determine what monitor a form is currently positioned on.

 

Anyway, here's some reading material:

• https://learn.microsoft.com/en-us/windows/win32/gdi/the-virtual-screen
• https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getsystemmetrics#SM_CXVIRTUALSCREEN
• https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getsystemmetrics#SM_XVIRTUALSCREEN
• https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createdcw

  Quote

  If there are multiple monitors on the system, calling CreateDC(TEXT("DISPLAY"),NULL,NULL,NULL) will create a DC covering all the monitors.

[Remy Lebeau 1636]

1 hour ago, jesu said:

I had supposed that Screen would return the size of the monitor where the program is shown.

The Width/Height properties of the global Screen object return the size of the primary monitor only.  If you want the size of the monitor that your program is displayed on, use the Width/Height or DisplayRect properties of the TForm.Monitor property.

1 hour ago, jesu said:

It seems that at least I should do something like:

That code assumes all monitors are positioned only side-by-side horizontally, it does not account for monitors being stacked vertically.

 

To get the total Width/Height of the virtual screen, use the global Screen object's DesktopWidth/DesktopHeight or DesktopRect properties.

[jesu 3]

If that's the way it works, I would say that this code is wrong:

 

https://docwiki.embarcadero.com/CodeExamples/Athens/en/CropForms_(Delphi)

 

It shouldn't use Screen but TForm.Monitor, and it shouldn't suppose that negative values mean that the form is not visible. Am I right?