PrintWindow API

Targets Windows
1

I am trying to use the PrintWindow function from the Windows API described at http://msdn.microsoft.com/en-us/library/windows/desktop/dd162869(v=vs.85).aspx

BOOL PrintWindow( HWND hwnd, HDC hdcBlt, UINT nFlags );

The call parameters are as follow :

[quote]hwnd
A handle to the window that will be copied.
hdcBlt
A handle to the device context.
nFlags
The drawing options. It can be one of the following values.
Value Meaning
PW_CLIENTONLY
Only the client area of the window is copied to hdcBlt. By default, the entire window is copied.[/quote]

Here is what I have so far, partly inspired from posts in the old forum :

[code] soft Declare Function PrintWindow Lib “user32” (hwnd As integer, hdcBlt As integer, nFlags As integer) As integer

Dim ret as Picture
Dim PichDC as integer
Dim tmphwnd as integer
Dim i as integer

ret = NewPicture( self.width, self.height, 32 )
PichDC = ret.Graphics.Handle(1)
tmphwnd = self.handle
i = PrintWindow( tmphwnd, PichDC, 1)
Canvas1.Backdrop = ret[/code]

tmphwnd is set to the window handle

The notion of Device Context from MS is a bit confusing. From discussions in the old forum, a member said that was the handle to a graphic object. Then the OP said it was working, but with no further detail :frowning:

In the LR, Graphics.Handle(HandleTypeHDC ) where HandleTypeHDC = 1 gives the Windows handle. So that is how I set PichDC.

The last parameter is to copy the whole screen (0), or just the window (1).

When I call the code, no error, but no image capture either. What could be wrong ?

I also looked at http://www.pinvoke.net/default.aspx/user32/PrintWindow.html for the VB method, as well as several others and everything matches. This API call is not using that many parameters. What could be wrong ?

If anybody has pointers, they will be greatly appreciated. TIA.

2

A little different approach, using BitBlt.

  dim winHDC, picHDC as Integer
  Dim width, height as Integer
  dim ret as Picture
  
  Declare Function GetDC Lib "User32" ( hwnd as Integer ) as Integer
  Declare Sub BitBlt Lib "GDI32" ( dest as Integer, x as Integer, y as Integer, width as Integer, height as Integer, _
  src as Integer, srcX as Integer, srcY as Integer, rops as Integer )
  
  width = self.width
  height = self.height
  ret = NewPicture( width, height, 32 )
  
  winHDC = GetDC( self.handle )
  picHDC = ret.Graphics.handle(1)
  
  // Copy the bitmap data
  Const CAPTUREBLT = &h40000000
  Const SRCCOPY = &hCC0020
  BitBlt( picHDC, 0, 0, width, height, winHDC, 0, 0, SRCCOPY + CAPTUREBLT )
3

Compatible with Windows, Mac OSX, and Linux :slight_smile:

Function ControlSnapShot(TheControl as RectControl, ParentWin as Window) As Picture
  #If TargetWin32 Then
    Declare Function GetDC Lib "User32" (HWND As Integer) As Integer
    Declare Function BitBlt Lib "GDI32" (DCdest As Integer, xDest As Integer, yDest As Integer, nWidth As Integer, nHeight As Integer, _
    DCdource As Integer, xSource As Integer, ySource As Integer, rasterOp As Integer) As Boolean
    Declare Function ReleaseDC Lib "User32" (HWND As Integer, DC As Integer) As Integer
    
    Const CAPTUREBLT = &h40000000
    Const SRCCOPY = &HCC0020
    
    Dim screenCap As New Picture(TheControl.Width, TheControl.Height, 32)
    Dim ViewerDC as Integer = GetDC(TheControl.Handle)
    
    Call BitBlt(screenCap.Graphics.Handle(1), 0, 0, TheControl.Width , TheControl.Height , ViewerDC, -2, -2, SRCCOPY or CAPTUREBLT)
    Call ReleaseDC(TheControl.Handle, ViewerDC)
    Return screenCap
    
  #else
    Dim takeSnap as new Shell
    Dim tStamp as new Date
    Dim SnapShotFile as FolderItem
    Dim SnapImage as Picture
    
    #if TargetCocoa or TargetLinux Then
      Dim ControlPortion as Picture = New Picture(TheControl.Width, TheControl.Height, 32)
    #else
      Dim ControlPortion as Picture = New Picture(TheControl.Width, TheControl.Height)
    #endif
    
    SnapShotFile =  SpecialFolder.Temporary.Child(TimeStamp(tStamp,true) +".png")
    
    #if TargetMacOS then
      takeSnap.Execute "screencapture -x " +SnapShotFile.ShellPath
    #elseif TargetLinux then
      takeSnap.Execute "import -window root" + SnapShotFile.ShellPath
    #endif
    
    if SnapShotFile.Exists then
      SnapImage = Picture.Open(SnapShotFile)
      ControlPortion.Graphics.DrawPicture(SnapImage, 0, 0, TheControl.Width, TheControl.Height, ParentWin.Left + TheControl.Left, ParentWin.Top + TheControl.Top, TheControl.Width,TheControl.Height)
      SnapShotFile.Delete
      Return ControlPortion
    else
      
      Return Nil
    end if
    
  #endif
End Function
4

missing functions are here: https://forum.xojo.com/8025-htmlviewer-image-to-canvas-question/20

5

BitBlt works brilliantly :slight_smile: Thank you Tim and Matthew.

Now just wondering : what would be the setting to capture the entire screen content ?

6

Replace (TheControl.Handle) with (getDeskTopWindow) (windows api) to get the screen handle instead of the control…for mac and linux…omit the cropping graphics functions…the screenshot is captured in its entirety in

screencapture -x

import -window root

:slight_smile:

7 
Dim ViewerDC as Integer = GetDC(GetDesktopWindow)
8

and of course adjust screenheight/width in bitblt

9

[quote=90345:@Matthew Combatti]for mac and linux…omit the cropping graphics functions…the screenshot is captured in its entirety in

screencapture -x[/quote]

Yes ; I have been using this in a while. Works fine. I tend to use CLI when available. Thank you.