[RESOLVED] GetActiveWindow question for screen capture app

[krtxmrtz]

I want to capture the active window by using its handle:

hnd = GetDC(GetActiveWindow)

and then copying to a picturebox:

BitBlt Picture1.hDC, 0, 0, width, height, hnd, 0, 0, SRCCOPY

but I don't know how to get the parameters width and height to adjust the size of Picture1.

[Siddharth Rout]

Something like this?

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Command1_Click()
    Dim lCurHwnd As Long
    lCurHwnd = GetWindowDC(GetActiveWindow)
    Picture1.Cls
    Picture1.Height = Me.ScaleHeight + 60
    Picture1.Width = Me.ScaleWidth + 60

    BitBlt Picture1.hDC, 0, 0, _
    Picture1.Height, Picture1.Width, lCurHwnd, 0, 0, vbSrcCopy
End Sub

[Siddharth Rout]

One more way to do what you want...

PS: Not my code...

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Private Sub Command1_Click()
    ' capture the contents of the active window to a picture box
    Set Picture1.Picture = GetScreenBitmap(True)
End Sub

Function GetScreenBitmap(Optional ActiveWindow As Boolean) As Picture
    ' save the current picture in the clipboard, if any
    Dim pic As StdPicture
    Set pic = Clipboard.GetData(vbCFBitmap)
    
    ' Alt-Print Screen captures the active window only
    If ActiveWindow Then
        ' Press the Alt key
        keybd_event vbKeyMenu, 0, 0, 0
    End If
    ' Press the Print Screen key
    keybd_event vbKeySnapshot, 0, 0, 0
    DoEvents

    ' Release the Print Screen key
    keybd_event vbKeySnapshot, 0, KEYEVENTF_KEYUP, 0
    If ActiveWindow Then
        ' Release the Alt key
        keybd_event vbKeyMenu, 0, KEYEVENTF_KEYUP, 0
    End If
    DoEvents
    
    ' return the bitmap now in the clipboard
    Set GetScreenBitmap = Clipboard.GetData(vbCFBitmap)
    ' restore the original contents of the clipboard
    Clipboard.SetData pic, vbCFBitmap
    
End Function

[krtxmrtz]

The problem is, the program delays the capture for a few seconds to allow the user to select any other window -sorry I forgot to mention this, so Me still refers to the app window and not to the selected one.

[Siddharth Rout]

Use a timer or use doevents?

[krtxmrtz]

Use a timer or use doevents?

I'm using the Timer function with DoEvents:

Private Sub Wait(sec As Single)
    'Pause sec seconds
    Dim tim As Single

    tim = Timer
    While Timer < tim + sec
        DoEvents
    Wend
End Sub

[Siddharth Rout]

I would suggest not to use DoEvents in a loop but to set the timer for specific number of seconds in the design time...

[krtxmrtz]

I would suggest not to use DoEvents in a loop but to set the timer for specific number of seconds in the design time...

Are you actually suggesting I use a timer control rather than the Timer function?

At any rate this is a side issue and the main question about how to retrieve the captured window dimensions remains open.

[Siddharth Rout]

Are you actually suggesting I use a timer control rather than the Timer function?

Yes

At any rate this is a side issue and the main question about how to retrieve the captured window dimensions remains open.

Let me create an example for you I am in the office so I have to multitask

[Edgemeal]

the main question about how to retrieve the captured window dimensions remains open.

dim rct as RECT
GetWindowRect handle, rct

Width = rct.right-rct.left
Height = rct.bottom-rct.top

EDIT Note those dimensions are in Pixels. Also when using BitBlt one normally uses ScaleWidth, ScaleHeight for pic boxes.

[krtxmrtz]

dim rct as RECT
GetWindowRect handle, rct

Width = rct.right-rct.left
Height = rct.bottom-rct.top

EDIT Note those dimensions are in Pixels. Also when using BitBlt one normally uses ScaleWidth, ScaleHeight for pic boxes.

It's very strange that rct dimensions below are all returned as 0. I wonder what I may be overlooking.

        hnd = GetDC(GetActiveWindow)
        GetWindowRect hnd , rct
        Picture1.Width = rct.Right - rct.Left
        Picture1.Height = rct.Bottom - rct.Top

[Edgemeal]

It's very strange that rct dimensions below are all returned as 0. I wonder what I may be overlooking.

Your passing the DC instead of the Window handle for GetWindowRect.


Win_hWnd = GetActiveWindow
GetWindowRect Win_hWnd , rct

[krtxmrtz]

Your passing the DC instead of the Window handle for GetWindowRect.


Win_hWnd = GetActiveWindow
GetWindowRect Win_hWnd , rct

Thanks.

Now it appears I was wrong, I thought GetActiveWindow would return the handle to any window I'd set the focus to (that's why I allowed a 2 second delay) but it fails, if I click on a different window from that of the app, it returns 0:

Dim hWnd As Long
    Dim rct As RECT
    '...
    '(A delay function has been used to allow the
    'user to click-select a different window)
    '...
    hWnd = GetActiveWindow
    'hWnd is 0 !!!
    GetWindowRect hWnd, rct

Maybe GetActiveWindow is not the right function to be used !?

[dee-u]

You can try the GetForegroundWindow API.

[krtxmrtz]

You can try the GetForegroundWindow API.

It works, but:

1. It captures only the client area (no titlebar which I meant to include, though this could be left as a selectable option to the user)
2. GetWindowRect returns the size including the titlebar so, the final captured image is the client area plus an extra bit of the desktop background at the bottom and right -the latter I don't understand, as there's no such thing as a titlebar or similar at the left

hWnd = GetForegroundWindow()
GetWindowRect hWnd, rct
ret = GetDC(hWnd)
'Form scalemode is twips, Tx and Ty are the screen twips per pixel x and y
Picture1.Width = (rct.Right - rct.left) * Tx
Picture1.Height = (rct.Bottom - rct.Top) * Ty
Picture1.Cls
BitBlt Picture1.hDC, 0, 0, Picture1.Width \ Tx, Picture1.Height \ Ty, ret, 0, 0, SRCCOPY

[LaVolpe]

GetDC does the client area. GetWindowDC does the entire window. May consider PrintWindow API?

[krtxmrtz]

GetDC does the client area. GetWindowDC does the entire window. May consider PrintWindow API?

Thanks for the clarification. Also, PrintWindow works satisfactorily:

'This part works nicely
        hWnd = GetForegroundWindow()
        GetWindowRect hWnd, rct
        ret = GetWindowDC(hWnd)
        PicAux.Width = (rct.Right - rct.left) * Tx
        PicAux.Height = (rct.Bottom - rct.Top) * Ty
        PicAux.Cls
        PrintWindow hWnd, PicAux.hDC, 0

Now, if I only want the client area GetWindowRect does not yield the correct dimensions. Is there such a thing as GetWindowClientRect or similar?

'...but this doesn't
        hWnd = GetForegroundWindow()        
        GetWindowRect hWnd, rct
        ret = GetDC(hWnd)
        PicAux.Width = (rct.Right - rct.left) * Tx
        PicAux.Height = (rct.Bottom - rct.Top) * Ty
        PicAux.Cls
        PrintWindow hWnd, PicAux.hDC, PW_CLIENTONLY

[LaVolpe]

Yes, GetClientRect. The left/top values will almost always be zero. So, if you need the client coordinates relative to the screen, you could use ClientToScreen API.

[krtxmrtz]

Yes, GetClientRect. The left/top values will almost always be zero. So, if you need the client coordinates relative to the screen, you could use ClientToScreen API.

I know I'm a bit thickheaded, I can't figure out how to get the the proper metrics.

'What's wrong with this code???
        hwnd = GetForegroundWindow()
        ret = GetDC(hwnd)
        GetClientRect hwnd, rct
        point.x = rct.Right - rct.left
        point.y = rct.Bottom - rct.Top
        ClientToScreen hwnd, point
        PicAux.Width = point.x * Tx
        PicAux.Height = point.y * Ty
        PicAux.Cls
        PrintWindow hwnd, PicAux.hDC, PW_CLIENTONLY

I'm always getting captured images larger and even much larger then the original window. See the attached images: left, the (entire) window correctly captured with the code I included in my previous post, right, the wrongly captured client area.

[LaVolpe]

I know I'm a bit thickheaded, I can't figure out how to get the the proper metrics.

Since you are using the ClientRect for sizing purpopses, you don't need to mess with ClientToScreen. ClientToScreen is useful if you need to capture the client image from the desktop DC, but in this case not applicable.

hwnd = GetForegroundWindow()
'        ret = GetDC(hwnd)
        GetClientRect hwnd, rct
'        point.x = rct.Right - rct.left
'        point.y = rct.Bottom - rct.Top
'        ClientToScreen hwnd, point
        PicAux.Width = (rct.Right - rct.left) * Tx
        PicAux.Height = ( rct.Bottom - rct.Top) * Ty
        PicAux.Cls
        PrintWindow hwnd, PicAux.hDC, PW_CLIENTONLY

Note: If you use GetDC or GetWindowDC, you should use ReleaseDC also for each hDC you retrieve.

[krtxmrtz]

...
Note: If you use GetDC or GetWindowDC, you should use ReleaseDC also for each hDC you retrieve.

Thanks, I'd forgotten about this.

The picturebox seems to have the right size but it's the entire window that's captured, only it's offset. Attached, again, see the entire window and what should be the client area right below it.

[LaVolpe]

I see what your are talking about. Obviously the PW_CLIENTONLY flag does not work as expected
I've seen other posts on the net similar to yours with no resolutions. I can think of a few workarounds:

1. Don't use PrintWindow and
a) do it the way your were before with GetDC/GetWindowDC
b) Use SendMessage with WM_PRINT but doesn't work all the time, depends if window processes it
c) Use SendMessage with WM_PAINT but doesn't work all the time, depends if window processes it

2. Use PrintWindow (XP & above)
If wanting just the client area, you will want to offset the DC before you call the API, then reset the offset. I trust you can find the API declarations

    Dim pt As POINTAPI, rctW As RECT
    Dim theHwnd As Long
    
    theHwnd = &HAC03DC ' &H460450
    
    GetClientRect theHwnd, rctW
    
    ' size picturebox/destination DC. Note that picbox is borderless here
    Picture1.Move Picture1.Left, Picture1.Top, (rctW.Right - rctW.Left) * Screen.TwipsPerPixelX, (rctW.Bottom - rctW.Top) * Screen.TwipsPerPixelY
    
    pt.x = rctW.Left: pt.y = rctW.Top
    ClientToScreen theHwnd, pt          ' convert client coords to screen coords
    GetWindowRect theHwnd, rctW         ' get entire window dimensions
    pt.x = rctW.Left - pt.x             ' calculate offset of client rect to window rect
    pt.y = rctW.Top - pt.y
                                        ' offset DC, call PrintWindow, reset offset
    SetViewportOrgEx Picture1.hdc, pt.x, pt.y, pt
    PrintWindow theHwnd, Picture1.hdc, 0 ' do not use PW_CLIENTONLY
    SetViewportOrgEx Picture1.hdc, pt.x, pt.y, pt

Note: If wanting the entire window, simply do not offset the DC & use GetWindowRect dimensions vs. GetClientRect
Also note that thru some tests, PrintWindow will sometimes print the client in black! More research may be needed.
Edited: Adding a DoEvents after resizing the picturebox seems to produce consistent results
Edited Yet Again: Is this PrintWindow anamoly only applicable on themed windows? You may want to test that

[krtxmrtz]

What are these constants?
theHwnd = &HAC03DC ' &H460450

GetClientRect theHwnd, rctW returns a rectangle with all zeros.

However, if I place this statement at the very beginning,

hWnd = GetForegroundWindow()

then it works, except the resulting size is the maximum of all previously captured windows, see attached image. Also, as you point out, sometimes the captured window is black.

The code for capturing the entire window works satisfactorily so, maybe it would be easier if the dimensions of the client area could be somehow calculated / retrieved. Then a BitBlt would easily do the trick.

[krtxmrtz]

...
...if the dimensions of the client area could be somehow calculated / retrieved...

Of course this would be immediate by substracting the coordinates produced by GetWindowRect and GetClientRect if the coordinates of the client area were relative to the upper left corner of the entire window. My question is, can it be assumed that the client area is horizontally centered, i.e. that the thicknesses of the left and right borders of the main window are the same? And as for the vertical corrdinates, I wonder if all that has to be done is substracting the height of the titlebar. Do the menus fall into the client area or not?

[krtxmrtz]

So I did as I explained in my previous post and it finally worked:

'Working code:
        hwnd = GetForegroundWindow()
        GetWindowRect hwnd, rctW
        GetClientRect hwnd, rctC
        Picture2.Width = (rctW.Right - rctW.left) * Screen.TwipsPerPixelX
        Picture2.Height = (rctW.Bottom - rctW.Top) * Screen.TwipsPerPixelY
        Picture2.Cls
        PrintWindow hwnd, Picture2.hDC, 0    'Now Picture2 has the complete window
        'x offset of client area = window border thickness
        offx = (rctW.Right - rctW.left) - rctC.Right
        offx = offx \ 2
        'y offset for client area
        offy = (rctW.Bottom - rctW.Top) - (rctC.Bottom + offx)
        'Resize the destination picturebox to the client area
        PicAux.Cls
        PicAux.Width = rctC.Right * TwipsPerPixelX
        PicAux.Height = rctC.Bottom * TwipsPerPixelY
        'Copy the client area
        BitBlt PicAux.hDC, 0, 0, sct.Right, sct.Bottom, Picture2.hDC, offx, offy, SRCCOPY

...only I had to use a second picturebox, because BitBlt'ing PicAux onto itself produced unwanted effects. It showed the correctly captured client area, but its Image property which I later use to save to a file (SavePicture instruction) couldn't be resized.

[LaVolpe]

What are these constants?
theHwnd = &HAC03DC ' &H460450

Just hWnds to test the code against, that's all. You would supply your valid hWnds, either hardcoded for testing or via a function that selects the window.

[krtxmrtz]

There must be tons of screen save applications and examples around, but since you guys (and other people from these forums some time ago) have been lending a hand I think I should post my work, which is a revision of an old project I already posted some time ago. Probably it can benefit from some makeup and refurbishing, especially in the save-to-file part, but here it is anyway.