-
Oct 18th, 2019, 07:36 AM
#1
Thread Starter
Hyperactive Member
[RESOLVED] Screen Capture of the active window
Found this example somewhere on how to capture screen/active window and save it to a .BMP file.
Code:
'Use the keybd_event api to do a screen shot.
'If you want the full screen set the second parameter to 0
'If you only want the active Form set the second parameter to 1
'this will copy the screen/active form to the clipboard
keybd_event vbKeySnapshot, 0&, 1&, 0&
'Yield the processing while the image is copied to clipboard
DoEvents
'Save the image from the clipboard
SavePicture Clipboard.GetData(vbCFBitmap), _
"C:\MM Logging\MM6" & _
"-" & strCaptureCounter & ".bmp"
It works sort of. I've tried setting the second parameter to 0 and 1 as suggested but it still capture the whole screen and not just the active window.
Any ideas why this would happen? Or am I doing something wrong somewhere?
-
Oct 18th, 2019, 07:37 AM
#2
Thread Starter
Hyperactive Member
Re: Screen Capture of the active window
Or is there a way to tell it to capture a specific form?
-
Oct 18th, 2019, 11:14 AM
#3
Hyperactive Member
Re: Screen Capture of the active window
Setting the second parameter to 1 snapshots the active Form. Don't know why you are having a problem with it
-
Oct 18th, 2019, 04:11 PM
#4
Thread Starter
Hyperactive Member
Re: Screen Capture of the active window
Got that set to 1 but still captures whole screen. I have dual monitors and it captures both. Below is a screen capture showing what it captured with second parameter set to 1.
-
Oct 18th, 2019, 04:46 PM
#5
Hyperactive Member
Re: Screen Capture of the active window
What is the second parameter in your mind
-
Oct 18th, 2019, 04:49 PM
#6
Thread Starter
Hyperactive Member
Re: Screen Capture of the active window
Hmmm! Am I changing the third parameter to 1 instead of the second parameter?
-
Oct 18th, 2019, 05:14 PM
#7
Thread Starter
Hyperactive Member
Re: Screen Capture of the active window
Man, I can make stupid mistakes sometimes
Still having an issue though.
The first time I do a screen capture I get a runtime error '380' - Invalid property value. Restart the program and do a screen capture and everything works. Gets the active window captured.
Then doing another capture still displays the capture of the first screen. Third capture then do correct capture of the second screen.
It looks as if the clipboard has the incorrect info when capture is done and the correct info get inserted in the clipboard after the file is saved.
Weird behaviour or another stupid mistake on my side? Will do some more testing and see I can get it sorted.
At least it's now capturing the active window and not the complete screen anymore.
-
Oct 19th, 2019, 01:34 AM
#8
Thread Starter
Hyperactive Member
Re: Screen Capture of the active window
Seems to be a timing issue. Added a half a second waiting period between keybd_event and the SavePicture and presto!
Code:
'Use the keybd_event api to do a screen shot.
'If you want the full screen set the second parameter to 0
'If you only want the active Form set the second parameter to 1
'this will copy the screen/active form to the clipboard
keybd_event vbKeySnapshot, 1&, 0&, 0&
'Yield the processing while the image is copied to clipboard
DoEvents
Sleep (500)
'Save the image from the clipboard
SavePicture Clipboard.GetData(vbCFBitmap), _
AppRoot & "MM Logging\MM" & _
App.Major & "-" & strCaptureCounter & ".bmp"
-
Oct 19th, 2019, 04:35 PM
#9
Re: [RESOLVED] Screen Capture of the active window
Here's a function that emulates pressing the Print Screen key without messing with the Clipboard or requiring DoEvents for synchronization:
Code:
Option Explicit
Private Type PICTDESC_BITMAP
cbSizeOfStruct As Long
picType As PictureTypeConstants
hBitmap As Long
hPal As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type REFIID
QWLo As Currency
QWHi As Currency
End Type
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As Long, ByVal nXDest As Long, ByVal nYDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal dwRop As RasterOpConstants) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC_BITMAP, ByRef riid As REFIID, ByVal fOwn As Long, ByRef lplpvObj As IPictureDisp) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hgdiobj As Long) As Long
'PrintScreen: Emulates pressing the Print Screen key (i.e. takes a screenshot)
'ForegroundWindowOnly: If True, captures foreground/active window only
'Return Value: StdPicture object containing a bitmap of the screenshot
'Reference: How To Capture and Print the Screen, a Form, or Any Window
' https://web.archive.org/web/20150311042915/http://support.microsoft.com/kb/161299
Public Function PrintScreen(Optional ByVal ForegroundWindowOnly As Boolean) As StdPicture
Dim Blitted As Boolean, RV As Long, SrcHeight As Long, SrcWidth As Long
Dim hBmpPrev As Long, hDCMem As Long, hDCWnd As Long, hWndDesk As Long
Dim R1 As RECT, R2 As RECT, IID_IPictureDisp As REFIID, PD As PICTDESC_BITMAP
hWndDesk = GetDesktopWindow
If hWndDesk Then
If GetWindowRect(hWndDesk, R1) Then
LSet R2 = R1
If ForegroundWindowOnly Then
hDCWnd = GetForegroundWindow
If hDCWnd Then RV = GetWindowRect(hDCWnd, R2): Debug.Assert RV
End If
If R1.Left < R2.Left Then R1.Left = R2.Left
If R1.Top < R2.Top Then R1.Top = R2.Top
If R1.Right > R2.Right Then R1.Right = R2.Right
If R1.Bottom > R2.Bottom Then R1.Bottom = R2.Bottom
SrcWidth = R1.Right - R1.Left
SrcHeight = R1.Bottom - R1.Top
hDCWnd = GetWindowDC(hWndDesk)
End If
End If
If hDCWnd Then
hDCMem = CreateCompatibleDC(hDCWnd)
If hDCMem Then
PD.hBitmap = CreateCompatibleBitmap(hDCWnd, SrcWidth, SrcHeight)
If PD.hBitmap Then
hBmpPrev = SelectObject(hDCMem, PD.hBitmap)
If hBmpPrev Then
Blitted = BitBlt(hDCMem, 0&, 0&, SrcWidth, SrcHeight, hDCWnd, R1.Left, R1.Top, vbSrcCopy) <> 0&
RV = SelectObject(hDCMem, hBmpPrev): Debug.Assert RV = PD.hBitmap
End If
End If
RV = DeleteDC(hDCMem): Debug.Assert RV
End If
RV = ReleaseDC(hWndDesk, hDCWnd): Debug.Assert RV
End If
If Blitted Then
PD.cbSizeOfStruct = LenB(PD)
PD.picType = vbPicTypeBitmap
IID_IPictureDisp.QWLo = 116045007755044.6977@ '{7BF80981-BF32-101A-8BBB-00AA00300CAB}
IID_IPictureDisp.QWHi = -612146501409303.8709@
RV = OleCreatePictureIndirect(PD, IID_IPictureDisp, -True, PrintScreen): Debug.Assert RV = 0&
End If
End Function
Code:
'Save the image from the clipboard
SavePicture PrintScreen(ForegroundWindowOnly:=True), _
AppRoot & "MM Logging\MM" & _
App.Major & "-" & strCaptureCounter & ".bmp"
Bonus Code
Here's a routine that will save a StdPicture object to a PNG file rather than to a BMP file as VB6's SavePicture statement does:
Code:
Option Explicit
Private Declare Function CopyBytes Lib "msvbvm60.dll" Alias "__vbaCopyBytes" (ByVal ByteLen As Long, ByRef Destination As Any, ByRef Source As Any) As Long
Public Sub SavePictureAsPNG(ByRef Picture As StdPicture, ByRef FileName As String)
Const FILTERID_CONVERT = "{42A6E907-1D2F-4b38-AC50-31ADBE2AB3C2}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Dim Bytes() As Byte, Offset As Long, oVector As Object
If Picture.Type <> vbPicTypeBitmap Then Exit Sub
With New PropertyBag
.WriteProperty "Picture", Picture, Nothing
Bytes = .Contents
End With
Offset = InStrB(Bytes, StrConv("BM", vbFromUnicode)) - 1&
If -1& < Offset And Offset < 100& Then
CopyBytes UBound(Bytes) - Offset, Bytes(0&), Bytes(Offset)
Set oVector = CreateObject("WIA.Vector")
oVector.BinaryData = Bytes
With CreateObject("WIA.ImageProcess")
With .Filters
.Add FILTERID_CONVERT
.Item(.Count).Properties("FormatID") = wiaFormatPNG
End With
With CreateObject("Scripting.FileSystemObject")
If .FileExists(FileName) Then .DeleteFile FileName, Force:=True
End With
.Apply(oVector.ImageFile).SaveFile FileName
End With
End If
End Sub
-
Oct 20th, 2019, 01:44 AM
#10
Re: [RESOLVED] Screen Capture of the active window
Victor Bravo,
That looks interesting.
Could it capture to JPG as well ?
-
Oct 20th, 2019, 05:31 AM
#11
Re: [RESOLVED] Screen Capture of the active window
Originally Posted by Bobbles
Victor Bravo,
That looks interesting.
Could it capture to JPG as well ?
Try with wiaFormatJPEG.
-
Oct 20th, 2019, 11:39 PM
#12
Re: [RESOLVED] Screen Capture of the active window
Originally Posted by Eduardo-
That appears to only apply to Vista and more recent.
I do all my VB6 development in my XP 32bit PC
But thanks for responding,
Rob
-
Oct 22nd, 2019, 05:59 AM
#13
Re: [RESOLVED] Screen Capture of the active window
Originally Posted by Bobbles
That appears to only apply to Vista and more recent.
I do all my VB6 development in my XP 32bit PC
While Windows Image Acquisition (WIA) Automation Layer v2.0 only ships by default on Vista and later OSs, Microsoft has in the past hosted the WIA SDK that comes with the documentation and the redistributable wiaaut.dll file. If you had managed to secure a copy of that SDK before Microsoft took it down, you can install and make use of WIA v2.0 on XP as well (SP1 and above only; Microsoft says earlier versions of Windows are not supported). But if you had not, then don't worry. Randy Birch's VBnet site has a copy of the zip file and so does this archived link from the Wayback Machine. VirusTotal reports that the wiaaut.dll in those zip files is, in fact, the official redistributable file published by Microsoft Corp., so you can rest assured it's malware-free.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|