Printable View
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.
Something like this?
Code: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
One more way to do what you want...
PS: Not my code...
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
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.
Use a timer or use doevents?
I'm using the Timer function with DoEvents:Quote:
Originally Posted by koolsid
Code:Private Sub Wait(sec As Single)
'Pause sec seconds
Dim tim As Single
tim = Timer
While Timer < tim + sec
DoEvents
Wend
End Sub
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?Quote:
Originally Posted by koolsid
At any rate this is a side issue and the main question about how to retrieve the captured window dimensions remains open.
Yes :)Quote:
Are you actually suggesting I use a timer control rather than the Timer function?
Let me create an example for you :) I am in the office so I have to multitask :lol:Quote:
At any rate this is a side issue and the main question about how to retrieve the captured window dimensions remains open.
dim rct as RECTQuote:
Originally Posted by krtxmrtz
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.Quote:
Originally Posted by Edgemeal
Code:hnd = GetDC(GetActiveWindow)
GetWindowRect hnd , rct
Picture1.Width = rct.Right - rct.Left
Picture1.Height = rct.Bottom - rct.Top
Your passing the DC instead of the Window handle for GetWindowRect.Quote:
Originally Posted by krtxmrtz
Win_hWnd = GetActiveWindow
GetWindowRect Win_hWnd , rct
Thanks.Quote:
Originally Posted by Edgemeal
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:
Maybe GetActiveWindow is not the right function to be used !?VB Code:
You can try the GetForegroundWindow API.
It works, but:Quote:
Originally Posted by dee-u
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
VB Code:
GetDC does the client area. GetWindowDC does the entire window. May consider PrintWindow API?
Thanks for the clarification. Also, PrintWindow works satisfactorily:Quote:
Originally Posted by LaVolpe
Now, if I only want the client area GetWindowRect does not yield the correct dimensions. Is there such a thing as GetWindowClientRect or similar?VB Code:
VB Code:
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.Quote:
Originally Posted by LaVolpe
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.VB Code:
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.Quote:
Originally Posted by krtxmrtz
VB Code:
Note: If you use GetDC or GetWindowDC, you should use ReleaseDC also for each hDC you retrieve.
Thanks, I'd forgotten about this.Quote:
Originally Posted by LaVolpe
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.
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
Note: If wanting the entire window, simply do not offset the DC & use GetWindowRect dimensions vs. GetClientRectCode: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
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
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.
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?Quote:
Originally Posted by Me
So I did as I explained in my previous post and it finally worked:
...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.VB Code:
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.Quote:
Originally Posted by 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.