Take low res screenshot

Targets Windows
1

Hello,

i am using this function to take screenshots on windows:

  #If TargetWindows Then
  Declare Function GetDesktopWindow Lib "User32" () As Integer
  Declare Function GetDC Lib "User32" (HWND As Integer) As Integer
  Declare Function BitBlt Lib "GDI32" (DCdest As Integer, xDest As Integer, yDest As Integer, Width As Integer, _
  Height 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 SRCCOPY = &h00CC0020
  Const CAPTUREBLT = &h40000000
  
  If Width = 0 Or Height = 0 Then Return Nil
  Dim screenCap As Picture = New Picture(Width, Height,32)
  Dim HWND As Integer = GetDesktopWindow()
  Dim SourceDC As Integer = GetDC(HWND)
  Dim DestDC As Integer = screenCap.Graphics.Handle(screenCap.Graphics.HandleTypeHDC)
  Call BitBlt(DestDC, 0, 0, Width, Height, SourceDC, X, Y, SRCCOPY Or CAPTUREBLT)
  Call ReleaseDC(HWND, SourceDC)
  Return screenCap
  
  #Endif

because i take screenshots when 4K Video is playing, is there anything to lower qualtiy, to take a low res screenshot e.g by changing constants?

Marco

2

You could create a picture with a lower depth, which would make the picture smaller.

3

Why not simply resize the Screenshot/Picture afterwards?

1 Like
4

that’s what I do afterwards… but the machine is busy with decoding the 4K movie (98% CPU) and at the time I take the snapshot with the function above the movie stutters so I would like to take a very cpu saving low res screenshot…

Changing the depth does not result in lower cpu usage at the time the screenshot is taken
Dim screenCap As Picture = New Picture(Width, Height,8)

5

Call StretchBlt instead of BitBlt, remember to call SetStretchBltMode before you do to set up the stretching mode.

6

Hey Julian,
that sounds interesting, do you mind giving me an example of how to implement StretchBlt/SetStretchBltMode for my function above?

Thank you

7 
Public Function Screenshot(Width As Integer, Height As Integer, X As Integer, Y As Integer, OutputWidth As Integer, OutputHeight As Integer) As Picture
  #If TargetWindows Then
    Declare Function GetDesktopWindow Lib "User32" () As Integer
    Declare Function GetDC Lib "User32" (HWND As Integer) As Integer
    Declare Function BitBlt Lib "GDI32" (DCdest As Integer, xDest As Integer, yDest As Integer, Width As Integer, _
    Height 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
    Declare Function StretchBlt Lib "Gdi32.dll" Alias "StretchBlt" ( _
    hdcDest As Integer, _
    xDest As Int32, _
    yDest As Int32, _
    wDest As Int32, _
    hDest As Int32, _
    hdcSrc As Integer, _
    xSrc As Int32, _
    ySrc As Int32, _
    wSrc As Int32, _
    hSrc As Int32, _
    rop As UInt32 _
    ) As Int32
    Declare Function SetStretchBltMode Lib "Gdi32.dll" Alias "SetStretchBltMode" ( _
    hdc As Integer, _
    mode As Int32 _
    ) As Int32
    Declare Function SetBrushOrgEx Lib "Gdi32.dll" Alias "SetBrushOrgEx" ( _
    hdc As Integer, _
    x As Int32, _
    y As Int32, _
    lppt As Ptr _
    ) As Int32
    
    Const SRCCOPY = &h00CC0020
    Const CAPTUREBLT = &h40000000
    
    Const HALFTONE = 4
    
    If Width = 0 Or Height = 0 Or OutputWidth = 0 Or OutputHeight = 0 Then Return Nil
    Dim screenCap As Picture = New Picture(OutputWidth, OutputHeight, 32)
    Dim HWND As Integer = GetDesktopWindow()
    Dim SourceDC As Integer = GetDC(HWND)
    Dim DestDC As Integer = screenCap.Graphics.Handle(screenCap.Graphics.HandleTypeHDC)
    'Call BitBlt(DestDC, 0, 0, Width, Height, SourceDC, X, Y, SRCCOPY Or CAPTUREBLT)
    Call SetStretchBltMode(DestDC, HALFTONE) 
    Call SetBrushOrgEx(DestDC, 0, 0, Nil)
    Call StretchBlt(DestDC, 0, 0, OutputWidth, OutputHeight, SourceDC, X, Y, Width, Height, SRCCOPY Or CAPTUREBLT) 
    Call ReleaseDC(HWND, SourceDC)
    Return screenCap
    
  #EndIf
End Function
1 Like
8

Thanks, Julian! I’ve got a little problem, i’ll execute the function with:

p=Screenshot(Screen.ScreenAt(0).AvailableWidth,Screen.ScreenAt(0).AvailableHeight,0,0,226,141)
s=p.ToData(Picture.Formats.JPEG,Picture.Qualitylow)

and then send it via TCPSocket
it receives but it returns only a white area? What am i doing wrong?

edit: i can display the screenshot in the app where the function was called but when sending via tcpsocket it is only a white area…

9

Using Xojo :wink:

It’s a known bug related to <https://xojo.com/issue/54028> which is coming up on 3 years since discovery and 5 since it was introduced.

To get around it, DrawPicture it into another picture and call ToData on that picture.

Kind of defeats the purpose of using StretchBlt in the first place, but it might might be quicker doing it this way than using Xojo’s resize. Reuse your pictures by adding them as properties to your window/container to save yourself some time if they are always the same size and you might get away with no hitching.

1 Like
10

Julian! Man, that f… works :grinning:
Didn’t thougth that this could be a bug…

Thank you very, very, very much!

2 Likes