VB6 - Capture any Window, even in background, with WinRT / Windows.Graphics.Capture

[VanGoghGaming]

This project is a VB6 implementation of the "Windows.Graphics.Capture" engine from the "Windows Runtime API". It demonstrates how to initialize the API, create a "CaptureItem" object for capturing either the whole monitor or a specific window, start the capture process and fire events whenever a new frame is available in the frame pool or when the capture target has changed size or was closed.

Here's a screenshot of capturing the whole monitor while moving the app window around, creating a cool "cascading" effect. The movement is very fluid, it takes only 4-5ms on average to capture, process and render each incoming frame in a PictureBox:



This is another screenshot of capturing the "VLC Player" window playing a movie in the background. The app automatically detects when the target window has changed size and resizes itself accordingly. It also detects when the target window was closed and stops the capture.



cCapture - declared "WithEvents", this class encapsulates the capturing and processing of frames:

Event CaptureSizeChanged(ByVal lCaptureWidth As Long, ByVal lCaptureHeight As Long, ByVal lWindowHandle As Long)
Event CaptureItemClosed(ByVal lWindowHandle As Long)
Event RenderNextFrame(picFrame As IPicture, ByVal lFrameWidth As Long, ByVal lFrameHeight As Long, ByVal pBitmapBits As Long, ByVal pBitmapInfo As Long)

Private Sub ICallback_TriggerEvent(Sender As Long, Optional Args As Long, Optional lParam As Long)
Dim lpIDirect3D11CaptureFrame As Long, lpIDirect3DSurface As Long, ContentSize As SizeInt32
    With CaptureItem(lParam)
        Select Case Sender
            Case .lpIDirect3D11CaptureFramePool
                If Not .bPause And m_bProcessNextFrame Then
                    StartTiming
                    InvokePtr Sender, IDirect3D11CaptureFramePool_TryGetNextFrame, VarPtr(lpIDirect3D11CaptureFrame)
                    If InvokePtr(.lpIGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(ContentSize)) = S_OK Then
                        If (ContentSize.Width <> .CaptureItemSize.Width) Or (ContentSize.Height <> .CaptureItemSize.Height) Then
                            .CaptureItemSize = ContentSize
                            InvokePtr Sender, IDirect3D11CaptureFramePool_Recreate, lpIDirect3DDevice, DXGI_FORMAT_B8G8R8A8_UNORM, 1&, .CaptureItemSize.Width, .CaptureItemSize.Height
                            ReleasePtr lpIDirect3D11CaptureFrame, True: Exit Sub
                        End If
                    End If
                    If InvokePtr(lpIDirect3D11CaptureFrame, IDirect3D11CaptureFrame_GetContentSize, VarPtr(ContentSize)) = S_OK Then
                        If (ContentSize.Width <> .FrameContentSize.Width) Or (ContentSize.Height <> .FrameContentSize.Height) Then
                            .FrameContentSize = ContentSize: SetBitmapSize lParam: RaiseEvent CaptureSizeChanged(.lFrameWidth, .lFrameHeight, .hWnd)
                        End If
                        If InvokePtr(lpIDirect3D11CaptureFrame, IDirect3D11CaptureFrame_GetSurface, VarPtr(lpIDirect3DSurface)) = S_OK Then
                            GetImageFromIDirect3DSurface lpIDirect3DSurface, lParam: ReleasePtr lpIDirect3DSurface, True
                            If m_lFPS > 0 Then m_bProcessNextFrame = False: m_eCaptureItem = lParam
                        End If
                    End If
                    ReleasePtr lpIDirect3D11CaptureFrame, True: RaiseEvent RenderNextFrame(Picture(lParam), .lFrameWidth, .lFrameHeight, .pBitmapBits, VarPtr(.bmiBitmapInfo))
                End If
            Case .lpIGraphicsCaptureItem
                CloseCaptureSession lParam: RaiseEvent CaptureItemClosed(lParam)
        End Select
    End With
End Sub

Private Sub Class_Initialize()
Dim i As Long, lpIGraphicsCaptureSessionStatics As Long
    InitIIDs
    For i = LBound(CaptureItem) To UBound(CaptureItem)
        With CaptureItem(i)
            With .bmiBitmapInfo.bmiHeader: .biSize = LenB(CaptureItem(i).bmiBitmapInfo.bmiHeader): .biPlanes = 1: .biBitCount = 32: End With
            With .PictDesc: .cbSizeofstruct = LenB(CaptureItem(i).PictDesc): .picType = vbPicTypeBitmap: End With
            .CaptureRegion.Back = 1
            With .IDirect3D11CaptureFramePool_FrameArrived: .pVTable = GetVTablePointer: .lUserData = i: .pIID_EventHandler = pIID(eITypedEventHandlerDirect3D11CaptureFramePool): Set .Callback = Me: End With
            With .IGraphicsCaptureItem_Closed: .pVTable = GetVTablePointer: .lUserData = i: .pIID_EventHandler = pIID(eITypedEventHandlerGraphicsCaptureItem): Set .Callback = Me: End With
        End With
    Next i
    If GetActivationFactory(WindowsGraphicsCaptureGraphicsCaptureSession, pIID(eIGraphicsCaptureSessionStatics), lpIGraphicsCaptureSessionStatics) Then
        If InvokePtr(lpIGraphicsCaptureSessionStatics, IGraphicsCaptureSessionStatics_IsSupported, VarPtr(m_bIsSupported)) = S_OK Then
            If m_bIsSupported Then
                If GetActivationFactory(WindowsGraphicsCaptureGraphicsCaptureItem, pIID(eIGraphicsCaptureItemInterop), lpIGraphicsCaptureItemInterop) Then
                    If GetActivationFactory(WindowsGraphicsCaptureDirect3D11CaptureFramePool, pIID(eIDirect3D11CaptureFramePoolStatics), lpIDirect3D11CaptureFramePoolStatics) Then
                        If D3D11CreateDevice(0, D3D_DRIVER_TYPE_HARDWARE, 0, D3D11_CREATE_DEVICE_BGRA_SUPPORT, 0, 0, D3D11_SDK_VERSION, VarPtr(lpID3D11Device), 0, VarPtr(lpID3D11ImmediateDeviceContext)) = S_OK Then
                            CreateDirect3D11DeviceFromDXGIDevice lpID3D11Device, VarPtr(lpIDirect3DDevice)
                        End If
                    End If
                End If
            End If
        End If
        ReleasePtr lpIGraphicsCaptureSessionStatics
    End If
End Sub

Private Sub Class_Terminate()
Dim i As Long
    For i = LBound(CaptureItem) To UBound(CaptureItem)
        With CaptureItem(i).PictDesc
            If .hBitmap Then DeleteObject .hBitmap
        End With
        CloseCaptureSession i
    Next i
    ReleasePtr lpIDirect3DDevice, True: ReleasePtr lpID3D11ImmediateDeviceContext: ReleasePtr lpID3D11Device: ReleasePtr lpIDirect3D11CaptureFramePoolStatics: ReleasePtr lpIGraphicsCaptureItemInterop
End Sub

Friend Property Get EnableCaptureCursor() As Boolean
    EnableCaptureCursor = m_bEnableCaptureCursor
End Property

Friend Property Let EnableCaptureCursor(bEnableCaptureCursor As Boolean)
    m_bEnableCaptureCursor = bEnableCaptureCursor
End Property

Friend Property Get EnableCaptureBorder() As Boolean
    EnableCaptureBorder = m_bEnableCaptureBorder
End Property

Friend Property Let EnableCaptureBorder(bEnableCaptureBorder As Boolean)
    m_bEnableCaptureBorder = bEnableCaptureBorder
End Property

Friend Property Get ExcludeWindowTitleBar() As Boolean
    ExcludeWindowTitleBar = m_bExcludeWindowTitleBar
End Property

Friend Property Let ExcludeWindowTitleBar(bExcludeWindowTitleBar As Boolean)
Dim rcWindowRect As RECT, rcClientRect As RECT, lBorderWidth As Long
    With CaptureItem(eWindow)
        If .hWnd Then
            m_bExcludeWindowTitleBar = bExcludeWindowTitleBar
            If m_bExcludeWindowTitleBar Then
                GetWindowRect .hWnd, VarPtr(rcWindowRect): GetClientRect .hWnd, VarPtr(rcClientRect)
                lBorderWidth = (rcWindowRect.Right - rcWindowRect.Left - rcClientRect.Right + rcClientRect.Left) \ 2
                .lTitleBarHeight = rcWindowRect.Bottom - rcWindowRect.Top - rcClientRect.Bottom + rcClientRect.Top - lBorderWidth
            Else
                .lTitleBarHeight = 0
            End If
        End If
    End With
End Property

Friend Property Get FrameRate() As Long
    FrameRate = m_lFPS
End Property

Friend Property Let FrameRate(lFPS As Long)
    If lFPS >= 0 Then m_lFPS = lFPS
End Property

Friend Property Get IsCaptureStarted(Optional eCaptureItem As CaptureItemEnum = eWindow) As Boolean
    IsCaptureStarted = CaptureItem(eCaptureItem).bStartCapture
End Property

Friend Property Get IsInitialized(Optional eCaptureItem As CaptureItemEnum = eWindow) As Boolean
    IsInitialized = CaptureItem(eCaptureItem).bIsInitialized
End Property

Friend Property Get IsSupported() As Boolean
    IsSupported = m_bIsSupported
End Property

Friend Property Get MonitorHandle() As Long
    MonitorHandle = CaptureItem(eMonitor).hMonitor
End Property

Friend Property Let MonitorHandle(hMonitor As Long)
    With CaptureItem(eMonitor)
        If lpIDirect3DDevice Then
            If .hMonitor = hMonitor Then Exit Property
            .hMonitor = hMonitor
            If .bStartCapture Then CloseCaptureSession eMonitor
            If InvokePtr(lpIGraphicsCaptureItemInterop, IGraphicsCaptureItemInterop_CreateForMonitor, .hMonitor, pIID(eIGraphicsCaptureItem), VarPtr(.lpIGraphicsCaptureItem)) = S_OK Then
                .bIsInitialized = InvokePtr(.lpIGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(.CaptureItemSize)) = S_OK
                If .bIsInitialized Then AddRemoveEventHandler eMonitor, .lpIGraphicsCaptureItem
            End If
        End If
    End With
End Property

Friend Property Get PauseCapture(Optional eCaptureItem As CaptureItemEnum = eWindow) As Boolean
    PauseCapture = CaptureItem(eCaptureItem).bPause
End Property

Friend Property Let PauseCapture(Optional eCaptureItem As CaptureItemEnum = eWindow, bPause As Boolean)
Dim lpIDirect3D11CaptureFrame As Long
    With CaptureItem(eCaptureItem)
        If (.bPause <> bPause) And .bStartCapture Then
            .bPause = bPause
            If Not .bPause Then
                InvokePtr .lpIDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_TryGetNextFrame, VarPtr(lpIDirect3D11CaptureFrame): ReleasePtr lpIDirect3D11CaptureFrame, True
                m_bProcessNextFrame = True: If m_lFPS > 0 Then Set TimerFPS = cTimer.CreatePeriodicTimer(1000 \ m_lFPS)
            Else
                m_bProcessNextFrame = False: Set TimerFPS = Nothing
            End If
        End If
    End With
End Property

Friend Property Get Picture(Optional eCaptureItem As CaptureItemEnum = eWindow) As IPicture
    OleCreatePictureIndirect VarPtr(CaptureItem(eCaptureItem).PictDesc), pIID(eIUnknown), APIFALSE, Picture
End Property

Friend Property Get WindowHandle() As Long
    WindowHandle = CaptureItem(eWindow).hWnd
End Property

Friend Property Let WindowHandle(hWnd As Long)
    With CaptureItem(eWindow)
        If lpIDirect3DDevice Then
            If IsWindow(hWnd) Then
                If .hWnd = hWnd Then Exit Property
                If Not IsMinimized(hWnd) Then
                    .hWnd = hWnd
                    If .bStartCapture Then CloseCaptureSession eWindow
                    If InvokePtr(lpIGraphicsCaptureItemInterop, IGraphicsCaptureItemInterop_CreateForWindow, .hWnd, pIID(eIGraphicsCaptureItem), VarPtr(.lpIGraphicsCaptureItem)) = S_OK Then
                        .bIsInitialized = InvokePtr(.lpIGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(.CaptureItemSize)) = S_OK
                        If .bIsInitialized Then AddRemoveEventHandler eWindow, .lpIGraphicsCaptureItem
                    End If
                End If
            End If
        End If
    End With
End Property

Friend Sub CaptureMonitor()
    With CaptureItem(eMonitor)
        If .hMonitor Then If .bIsInitialized Then StartCapture eMonitor
    End With
End Sub

Friend Sub CaptureWindow()
    With CaptureItem(eWindow)
        If .hWnd Then If Not IsMinimized(.hWnd) Then If .bIsInitialized Then StartCapture eWindow
    End With
End Sub

Friend Function GetCaptureSize(lWidth As Long, lHeight As Long, Optional eCaptureItem As CaptureItemEnum = eWindow)
    With CaptureItem(eCaptureItem): lWidth = .FrameContentSize.Width: lHeight = .FrameContentSize.Height: End With
End Function

Friend Sub SetCaptureRegion(Optional lLeft As Long, Optional lTop As Long, Optional lWidth As Long, Optional lHeight As Long)
Dim i As Long
    For i = LBound(CaptureItem) To UBound(CaptureItem)
        With CaptureItem(i)
            If lWidth * lHeight Then
                .CaptureRegion.Left = lLeft: .CaptureRegion.Top = lTop + .lTitleBarHeight: .CaptureRegion.Right = lLeft + lWidth: .CaptureRegion.Bottom = .CaptureRegion.Top + lHeight: .bCaptureRegion = True
            Else
                .bCaptureRegion = False
            End If
        End With
    Next i
End Sub

Friend Sub StopCapture(Optional eCaptureItem As CaptureItemEnum = eWindow)
    With CaptureItem(eCaptureItem)
        If .bStartCapture Then CloseCaptureSession eCaptureItem
    End With
End Sub

Private Sub AddRemoveEventHandler(eCaptureItem As CaptureItemEnum, Sender As Long, Optional bRemove As Boolean)
    If Sender Then
        With CaptureItem(eCaptureItem)
            Select Case Sender
                Case .lpIDirect3D11CaptureFramePool
                    With .IDirect3D11CaptureFramePool_FrameArrived
                        If bRemove Then
                            If .EventRegistrationToken Then InvokePtr Sender, IDirect3D11CaptureFramePool_RemoveFrameArrived, .EventRegistrationToken
                        Else
                            If .EventRegistrationToken = 0 Then
                                InvokePtr Sender, IDirect3D11CaptureFramePool_AddFrameArrived, VarPtr(.pVTable), VarPtr(.EventRegistrationToken)
                                Set .Callback = Me
                            End If
                        End If
                    End With
                Case .lpIGraphicsCaptureItem
                    With .IGraphicsCaptureItem_Closed
                        If bRemove Then
                            If .EventRegistrationToken Then InvokePtr Sender, IGraphicsCaptureItem_RemoveClosed, .EventRegistrationToken
                        Else
                            If .EventRegistrationToken = 0 Then
                                InvokePtr Sender, IGraphicsCaptureItem_AddClosed, VarPtr(.pVTable), VarPtr(.EventRegistrationToken)
                                Set .Callback = Me
                            End If
                        End If
                    End With
            End Select
        End With
    End If
End Sub

Private Sub StartCapture(Optional eCaptureItem As CaptureItemEnum = eWindow)
    With CaptureItem(eCaptureItem)
        If .lpIDirect3D11CaptureFramePool = 0 Then
            If InvokePtr(lpIDirect3D11CaptureFramePoolStatics, IDirect3D11CaptureFramePoolStatics_Create, lpIDirect3DDevice, DXGI_FORMAT_B8G8R8A8_UNORM, 1&, .CaptureItemSize.Width, .CaptureItemSize.Height, VarPtr(.lpIDirect3D11CaptureFramePool)) = S_OK Then
                AddRemoveEventHandler eCaptureItem, .lpIDirect3D11CaptureFramePool
                If .lpIGraphicsCaptureSession = 0 Then
                    If InvokePtr(.lpIDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_CreateCaptureSession, .lpIGraphicsCaptureItem, VarPtr(.lpIGraphicsCaptureSession)) = S_OK Then
                        InvokeObj QueryInterfacePtr(.lpIGraphicsCaptureSession, pIID(eIGraphicsCaptureSession2)), IGraphicsCaptureSession2_PutIsCursorCaptureEnabled, m_bEnableCaptureCursor
                        InvokeObj QueryInterfacePtr(.lpIGraphicsCaptureSession, pIID(eIGraphicsCaptureSession3), GetWindowsVersion > 10), IGraphicsCaptureSession3_PutIsBorderRequired, m_bEnableCaptureBorder
                        .bStartCapture = InvokePtr(.lpIGraphicsCaptureSession, IGraphicsCaptureSession_StartCapture) = S_OK
                        If .bStartCapture Then m_bProcessNextFrame = True: If m_lFPS > 0 Then Set TimerFPS = cTimer.CreatePeriodicTimer(1000 \ m_lFPS)
                    End If
                End If
            End If
        End If
    End With
End Sub

Private Sub GetImageFromIDirect3DSurface(lpIDirect3DSurface As Long, Optional eCaptureItem As CaptureItemEnum = eWindow)
Dim lpID3D11Texture2D As Long, i As Long, lRowWidth As Long
    If InvokeObj(QueryInterfacePtr(lpIDirect3DSurface, pIID(eIDirect3DDxgiInterfaceAccess)), IDirect3DDxgiInterfaceAccess_GetInterface, pIID(eID3D11Texture2D), VarPtr(lpID3D11Texture2D)) = S_OK Then
        With CaptureItem(eCaptureItem)
            If .lpID3D11Texture2DCopy = 0 Then
                InvokePtr lpID3D11Texture2D, ID3D11Texture2D_GetDesc, VarPtr(D3D11Texture2DDesc)
                If .bCaptureRegion Then
                    CaptureRegion = .CaptureRegion
                Else
                    CaptureRegion.Left = 0: CaptureRegion.Right = .lFrameWidth: CaptureRegion.Bottom = .lFrameHeight + .lTitleBarHeight: CaptureRegion.Top = .lTitleBarHeight: CaptureRegion.Back = 1
                End If
                If (.lTitleBarHeight <> 0) Or .bCaptureRegion Then D3D11Texture2DDesc.Width = .lFrameWidth: D3D11Texture2DDesc.Height = .lFrameHeight
                With D3D11Texture2DDesc: .Usage = D3D11_USAGE_STAGING: .CPUAccessFlags = D3D11_CPU_ACCESS_READ: .BindFlags = 0: .MiscFlags = 0: End With
                InvokePtr lpID3D11Device, ID3D11Device_CreateTexture2D, VarPtr(D3D11Texture2DDesc), 0&, VarPtr(.lpID3D11Texture2DCopy)
            End If
            If .lpID3D11Texture2DCopy Then
                If (.lTitleBarHeight <> 0) Or .bCaptureRegion Then
                    InvokePtr lpID3D11ImmediateDeviceContext, ID3D11DeviceContext_CopySubresourceRegion, .lpID3D11Texture2DCopy, 0&, 0&, 0&, 0&, lpID3D11Texture2D, 0&, VarPtr(CaptureRegion)
                Else
                    InvokePtr lpID3D11ImmediateDeviceContext, ID3D11DeviceContext_CopyResource, .lpID3D11Texture2DCopy, lpID3D11Texture2D
                End If
                If InvokePtr(lpID3D11ImmediateDeviceContext, ID3D11DeviceContext_Map, .lpID3D11Texture2DCopy, 0&, D3D11_MAP_READ, 0&, VarPtr(D3D11MappedSubresource)) = S_OK Then
                    lRowWidth = .lFrameWidth * 4
                    If lRowWidth <> D3D11MappedSubresource.RowPitch Then
                        For i = 0 To .lFrameHeight - 1
                            CopyBytes lRowWidth, ByVal .pBitmapBits + i * lRowWidth, ByVal D3D11MappedSubresource.pData + i * D3D11MappedSubresource.RowPitch
                        Next i
                    Else
                        CopyBytes lRowWidth * .lFrameHeight, ByVal .pBitmapBits, ByVal D3D11MappedSubresource.pData
                    End If
                    InvokePtr lpID3D11ImmediateDeviceContext, ID3D11DeviceContext_Unmap, .lpID3D11Texture2DCopy, 0&
                End If
            End If
        End With
        ReleasePtr lpID3D11Texture2D
    End If
End Sub

Private Sub CloseCaptureSession(Optional eCaptureItem As CaptureItemEnum = eWindow)
    With CaptureItem(eCaptureItem)
        AddRemoveEventHandler eCaptureItem, .lpIDirect3D11CaptureFramePool, True: AddRemoveEventHandler eCaptureItem, .lpIGraphicsCaptureItem, True
        ReleasePtr .lpIGraphicsCaptureSession, True: ReleasePtr .lpIDirect3D11CaptureFramePool, True
        ReleasePtr .lpIGraphicsCaptureItem: ReleasePtr .lpID3D11Texture2DCopy
        With .CaptureItemSize: .Width = 0: .Height = 0: End With
        With .FrameContentSize: .Width = 0: .Height = 0: End With
        .hWnd = 0: .hMonitor = 0: .bIsInitialized = False: .bPause = False: .bStartCapture = False: Set TimerFPS = Nothing
    End With
End Sub

Private Sub SetBitmapSize(Optional eCaptureItem As CaptureItemEnum = eWindow)
    With CaptureItem(eCaptureItem)
        If .bCaptureRegion Then
            .lFrameWidth = .CaptureRegion.Right - .CaptureRegion.Left: .lFrameHeight = .CaptureRegion.Bottom - .CaptureRegion.Top
        Else
            .lFrameWidth = .FrameContentSize.Width: .lFrameHeight = .FrameContentSize.Height - .lTitleBarHeight
        End If
        If .PictDesc.hBitmap Then DeleteObject .PictDesc.hBitmap
        .bmiBitmapInfo.bmiHeader.biWidth = .lFrameWidth: .bmiBitmapInfo.bmiHeader.biHeight = -.lFrameHeight
        .PictDesc.hBitmap = CreateDIBSection(0, VarPtr(.bmiBitmapInfo), DIB_RGB_COLORS, .pBitmapBits, 0, 0): ReleasePtr .lpID3D11Texture2DCopy
    End With
End Sub

Private Function IsMinimized(hWnd As Long) As Boolean
    IsMinimized = GetWindowLongW(hWnd, GWL_STYLE) And WS_MINIMIZE
End Function

Private Sub TimerFPS_Elapsed(bCancel As Boolean)
Dim lpIDirect3D11CaptureFrame As Long
    With CaptureItem(m_eCaptureItem)
        If Not .bPause And .bStartCapture Then
            If Not m_bProcessNextFrame Then
                m_bProcessNextFrame = True
                InvokePtr .lpIDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_TryGetNextFrame, VarPtr(lpIDirect3D11CaptureFrame): ReleasePtr lpIDirect3D11CaptureFrame, True
            End If
        End If
    End With
End Sub

There's also a property that can enable capturing the "Mouse Pointer" (set to "False" by default) if you want a visual aid about something that happens during the capture process.

At the moment, the project is set up to capture the monitor or window that is currently beneath the mouse pointer. Obviously if you click the "Start Capture" button, it will capture the app window since that contains the button you've just clicked. In case you're wondering, even though the button itself is a "window" (since it has a hWnd!), the "Windows.Graphics.Capture" engine can capture only "Top-Level Windows" so the app looks at the "hWnd" you've just clicked and then goes up the chain until it finds the root owner window and starts the capturing process on that one instead!

So if you want to capture another window (for testing purposes), you need to keep the app window in the foreground, hover the mouse over your desired target window and press "Alt-S" or just "Enter" (the keyboard shortcut for the default "Start Capture" button) and that will initiate the capture process. If you prefer subclassing then it's very easy to install a generic "HotKey" and have the main form watch for "WM_HOTKEY" messages so that it can initiate captures without being in the foreground!

Update: In this version I've added an "ExcludeWindowTitleBar" property (to remove the title bar when capturing a window) and a "SetCaptureRegion" function where you can specify a rectangular region to capture from either a window or the whole monitor. The following screenshot shows the capture of a 400x300 region with the top left corner at the (100:200) coordinates relative to the window being captured:



Update: This version includes a major code overhaul to streamline the usage of WinRT event handlers in VB6. Now you can Pause and Resume the capture process as well as select a custom FPS value (play with the FPS scrollbar in the demo project below). The FPS scrollbar goes from 0 to 100 (with zero meaning disabled, running at maximum possible FPS).

There is also an option to scale down the capture output to display it in a smaller size (using the "Render" method of the Picture object). The second scrollbar goes from 10 to 100 (percent of the original capture size). You can also make the smaller capture look smoother by using "StretchDIBits" in "Halftone" mode at the expense of slightly more processing power.



Here's the demo project: WindowsGraphicsCapture.zip

Special thanks to -Franky- for exploring the WinRT API for the VB6 community!