Results 1 to 13 of 13

Thread: [RESOLVED] Screen Capture of the active window

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    Resolved [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?

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    Re: Screen Capture of the active window

    Or is there a way to tell it to capture a specific form?

  3. #3
    Hyperactive Member
    Join Date
    Mar 2017
    Posts
    500

    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

  4. #4

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    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.

    Name:  MM6-0001.jpg
Views: 2316
Size:  28.4 KB

  5. #5
    Hyperactive Member
    Join Date
    Mar 2017
    Posts
    500

    Re: Screen Capture of the active window

    What is the second parameter in your mind

  6. #6

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    Re: Screen Capture of the active window

    Hmmm! Am I changing the third parameter to 1 instead of the second parameter?

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    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.

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2007
    Location
    Roodepoort, South Africa
    Posts
    472

    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"

  9. #9
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    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

  10. #10
    Frenzied Member
    Join Date
    Dec 2008
    Location
    Melbourne Australia
    Posts
    1,487

    Re: [RESOLVED] Screen Capture of the active window

    Victor Bravo,
    That looks interesting.
    Could it capture to JPG as well ?

  11. #11
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,997

    Re: [RESOLVED] Screen Capture of the active window

    Quote Originally Posted by Bobbles View Post
    Victor Bravo,
    That looks interesting.
    Could it capture to JPG as well ?
    Try with wiaFormatJPEG.

  12. #12
    Frenzied Member
    Join Date
    Dec 2008
    Location
    Melbourne Australia
    Posts
    1,487

    Re: [RESOLVED] Screen Capture of the active window

    Quote Originally Posted by Eduardo- View Post
    Try with wiaFormatJPEG.
    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

  13. #13
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    380

    Re: [RESOLVED] Screen Capture of the active window

    Quote Originally Posted by Bobbles View Post
    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
  •  



Click Here to Expand Forum to Full Width