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:
![Name: WindowsGraphicsCapture1.jpg
Views: 87
Size: 95.2 KB]()
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.
![Name: WindowsGraphicsCapture2.jpg
Views: 86
Size: 56.6 KB]()
cCapture - declared "WithEvents", this class encapsulates the capturing and processing of frames:
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" (the keyboard shortcut for the "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! ;)
Here's the demo project: WindowsGraphicsCapture.zip
Special thanks to -Franky- for exploring the WinRT API for the VB6 community! :D
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:
Code:
Event CaptureSizeChanged(lCaptureWidth As Long, lCaptureHeight As Long, lWindowHandle As Long)
Event CaptureItemClosed(eCaptureItem As CaptureItemEnum)
Event RenderNextFrame(picFrame As IPicture)
Private Sub On_ITypedEvent(ByVal eCaptureItem As CaptureItemEnum, ByVal eITypedEventHandler As ITypedEventHandlerEnum)
Dim IDirect3D11CaptureFrame As IUnknown, IDirect3DSurface As IUnknown, ContentSize As SizeInt32
Select Case eITypedEventHandler
Case eITypedEventCaptureFramePool_FrameArrived
StartTiming
With CaptureItem(eCaptureItem)
If OleInvoke(.IGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(ContentSize)) = S_OK Then
If (ContentSize.Width <> .CaptureItemSize.Width) Or (ContentSize.Height <> .CaptureItemSize.Height) Then
.CaptureItemSize = ContentSize
OleInvoke .IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_Recreate, ObjPtr(IDirect3DDevice), DXGI_FORMAT_B8G8R8A8_UNORM, 1&, .CaptureItemSize.Width, .CaptureItemSize.Height
OleInvoke .IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_TryGetNextFrame, VarPtr(IDirect3D11CaptureFrame)
OleInvoke OleQueryInterface(IDirect3D11CaptureFrame, pIID_IClosable), IClosable_Close: Exit Sub
End If
End If
OleInvoke .IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_TryGetNextFrame, VarPtr(IDirect3D11CaptureFrame)
If OleInvoke(IDirect3D11CaptureFrame, IDirect3D11CaptureFrame_GetContentSize, VarPtr(ContentSize)) = S_OK Then
If (ContentSize.Width <> .FrameContentSize.Width) Or (ContentSize.Height <> .FrameContentSize.Height) Then
.FrameContentSize = ContentSize: SetBitmapSize eCaptureItem: RaiseEvent CaptureSizeChanged(.FrameContentSize.Width, .FrameContentSize.Height, .hWnd)
End If
If OleInvoke(IDirect3D11CaptureFrame, IDirect3D11CaptureFrame_GetSurface, VarPtr(IDirect3DSurface)) = S_OK Then
GetImageFromIDirect3DSurface IDirect3DSurface, eCaptureItem
OleInvoke OleQueryInterface(IDirect3DSurface, pIID_IClosable), IClosable_Close
End If
End If
OleInvoke OleQueryInterface(IDirect3D11CaptureFrame, pIID_IClosable), IClosable_Close
RaiseEvent RenderNextFrame(.Picture)
End With
Case eITypedEventGraphicsCaptureItem_Closed
CloseCaptureSession eCaptureItem: RaiseEvent CaptureItemClosed(eCaptureItem)
End Select
End Sub
Private Sub ITypedEventHandlerVTable(ByVal eCaptureItem As CaptureItemEnum, ByVal eITypedEventHandler As ITypedEventHandlerEnum, ByVal AddrQueryInterface As Long, ByVal AddrAddRef As Long, ByVal AddrRelease As Long, ByVal AddrInvoke As Long)
With CaptureItem(eCaptureItem).ITypedEventHandlers(eITypedEventHandler).InterfaceVTable
.VTable(0) = AddrQueryInterface: .VTable(1) = AddrAddRef: .VTable(2) = AddrRelease: .VTable(3) = AddrInvoke
End With
End Sub
Private Sub Class_Initialize()
Dim bIsSupported As Boolean, i As Long, j As Long, IGraphicsCaptureSessionStatics As IUnknown
InitIIDs IID_IUnknown, pIID_IUnknown, IID_IClosable, pIID_IClosable, IID_IDXGIDevice, pIID_IDXGIDevice, IID_IDirect3DDevice, pIID_IDirect3DDevice, IID_IGraphicsCaptureSession, pIID_IGraphicsCaptureSession, _
IID_IGraphicsCaptureSession_2, pIID_IGraphicsCaptureSession_2, IID_IGraphicsCaptureSession_3, pIID_IGraphicsCaptureSession_3, IID_IGraphicsCaptureSessionStatics, pIID_IGraphicsCaptureSessionStatics, _
IID_IGraphicsCaptureItemInterop, pIID_IGraphicsCaptureItemInterop, IID_IGraphicsCaptureItem, pIID_IGraphicsCaptureItem, IID_IDirect3D11CaptureFramePoolStatics, pIID_IDirect3D11CaptureFramePoolStatics, _
IID_IDirect3D11CaptureFramePoolStatics2, pIID_IDirect3D11CaptureFramePoolStatics2, IID_ID3D11Texture2D, pIID_ID3D11Texture2D, IID_IDirect3DDxgiInterfaceAccess, pIID_IDirect3DDxgiInterfaceAccess, _
IID_ITypedEventHandlerDirect3D11CaptureFramePool, pIID_ITypedEventHandlerDirect3D11CaptureFramePool, IID_ITypedEventHandlerGraphicsCaptureItem, pIID_ITypedEventHandlerGraphicsCaptureItem
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
For j = LBound(.ITypedEventHandlers) To UBound(.ITypedEventHandlers)
With .ITypedEventHandlers(j): .Interface.pVTable = VarPtr(.InterfaceVTable): .This = VarPtr(.Interface): End With
Next j
CreateITypedEventHandler i, eITypedEventCaptureFramePool_FrameArrived, .ITypedEventHandlers(eITypedEventCaptureFramePool_FrameArrived).This, ObjPtr(Me), pIID_ITypedEventHandlerDirect3D11CaptureFramePool
CreateITypedEventHandler i, eITypedEventGraphicsCaptureItem_Closed, .ITypedEventHandlers(eITypedEventGraphicsCaptureItem_Closed).This, ObjPtr(Me), pIID_ITypedEventHandlerGraphicsCaptureItem
End With
Next i
m_hDC = GetDC(0)
If GetActivationFactory(WindowsGraphicsCaptureGraphicsCaptureSession, pIID_IGraphicsCaptureSessionStatics, VarPtr(IGraphicsCaptureSessionStatics)) Then
If OleInvoke(IGraphicsCaptureSessionStatics, IGraphicsCaptureSessionStatics_IsSupported, VarPtr(bIsSupported)) = S_OK Then
If bIsSupported Then
If GetActivationFactory(WindowsGraphicsCaptureGraphicsCaptureItem, pIID_IGraphicsCaptureItemInterop, VarPtr(IGraphicsCaptureItemInterop)) Then
If GetActivationFactory(WindowsGraphicsCaptureDirect3D11CaptureFramePool, pIID_IDirect3D11CaptureFramePoolStatics, VarPtr(IDirect3D11CaptureFramePoolStatics)) Then
If D3D11CreateDevice(0, D3D_DRIVER_TYPE_HARDWARE, 0, D3D11_CREATE_DEVICE_BGRA_SUPPORT, 0, 0, D3D11_SDK_VERSION, VarPtr(ID3D11Device), 0, VarPtr(ID3D11DeviceContext)) = S_OK Then
If CreateDirect3D11DeviceFromDXGIDevice(ObjPtr(OleQueryInterface(ID3D11Device, pIID_IDXGIDevice)), VarPtr(IInspectable)) = S_OK Then
Set IDirect3DDevice = OleQueryInterface(IInspectable, pIID_IDirect3DDevice)
End If
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Class_Terminate()
Dim i As Long
If m_hDC Then m_hDC = ReleaseDC(0, m_hDC)
For i = LBound(CaptureItem) To UBound(CaptureItem)
With CaptureItem(i)
If .PictDesc.hBitmap Then .PictDesc.hBitmap = DeleteObject(.PictDesc.hBitmap)
End With
CloseCaptureSession i
Next i
OleInvoke OleQueryInterface(IDirect3DDevice, pIID_IClosable), IClosable_Close: Set IDirect3DDevice = Nothing
OleInvoke OleQueryInterface(IInspectable, pIID_IClosable), IClosable_Close: Set IInspectable = Nothing
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 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 MonitorHandle() As Long
MonitorHandle = CaptureItem(eMonitor).hMonitor
End Property
Friend Property Let MonitorHandle(hMonitor As Long)
With CaptureItem(eMonitor)
If Not (IDirect3DDevice Is Nothing) Then
If .hMonitor = hMonitor Then Exit Property
.hMonitor = hMonitor
If .bStartCapture Then CloseCaptureSession eMonitor
If OleInvoke(IGraphicsCaptureItemInterop, IGraphicsCaptureItemInterop_CreateForMonitor, .hMonitor, pIID_IGraphicsCaptureItem, VarPtr(.IGraphicsCaptureItem)) = S_OK Then
.bIsInitialized = OleInvoke(.IGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(.CaptureItemSize)) = S_OK
If .EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed) = 0 Then
OleInvoke .IGraphicsCaptureItem, IGraphicsCaptureItem_AddClosed, .ITypedEventHandlers(eITypedEventGraphicsCaptureItem_Closed).This, VarPtr(.EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed))
End If
End If
End If
End With
End Property
Friend Property Get Picture(Optional eCaptureItem As CaptureItemEnum = eWindow) As IPicture
Set Picture = CaptureItem(eCaptureItem).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 Not (IDirect3DDevice Is Nothing) Then
If IsWindow(hWnd) Then
If .hWnd = hWnd Then Exit Property
If Not IsMinimized(hWnd) Then
.hWnd = hWnd
If .bStartCapture Then CloseCaptureSession eWindow
If OleInvoke(IGraphicsCaptureItemInterop, IGraphicsCaptureItemInterop_CreateForWindow, .hWnd, pIID_IGraphicsCaptureItem, VarPtr(.IGraphicsCaptureItem)) = S_OK Then
.bIsInitialized = OleInvoke(.IGraphicsCaptureItem, IGraphicsCaptureItem_GetSize, VarPtr(.CaptureItemSize)) = S_OK
If .EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed) = 0 Then
OleInvoke .IGraphicsCaptureItem, IGraphicsCaptureItem_AddClosed, .ITypedEventHandlers(eITypedEventGraphicsCaptureItem_Closed).This, VarPtr(.EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed))
End If
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 StopCapture(Optional eCaptureItem As CaptureItemEnum = eWindow)
With CaptureItem(eCaptureItem)
If .bStartCapture Then CloseCaptureSession eCaptureItem: .hWnd = 0: .hMonitor = 0
End With
End Sub
Private Sub StartCapture(Optional eCaptureItem As CaptureItemEnum = eWindow)
With CaptureItem(eCaptureItem)
If .IDirect3D11CaptureFramePool Is Nothing Then
If OleInvoke(IDirect3D11CaptureFramePoolStatics, IDirect3D11CaptureFramePoolStatics_Create, ObjPtr(IDirect3DDevice), DXGI_FORMAT_B8G8R8A8_UNORM, 1&, .CaptureItemSize.Width, .CaptureItemSize.Height, VarPtr(.IDirect3D11CaptureFramePool)) = S_OK Then
If .EventRegistrationToken(eITypedEventCaptureFramePool_FrameArrived) = 0 Then
OleInvoke .IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_AddFrameArrived, .ITypedEventHandlers(eITypedEventCaptureFramePool_FrameArrived).This, VarPtr(.EventRegistrationToken(eITypedEventCaptureFramePool_FrameArrived))
End If
If .IGraphicsCaptureSession Is Nothing Then
If OleInvoke(.IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_CreateCaptureSession, ObjPtr(.IGraphicsCaptureItem), VarPtr(.IGraphicsCaptureSession)) = S_OK Then
OleInvoke OleQueryInterface(.IGraphicsCaptureSession, pIID_IGraphicsCaptureSession_2), IGraphicsCaptureSession2_PutIsCursorCaptureEnabled, m_bEnableCaptureCursor
OleInvoke OleQueryInterface(.IGraphicsCaptureSession, pIID_IGraphicsCaptureSession_3), IGraphicsCaptureSession3_PutIsBorderRequired, m_bEnableCaptureBorder
.bStartCapture = OleInvoke(.IGraphicsCaptureSession, IGraphicsCaptureSession_StartCapture) = S_OK
End If
End If
End If
End If
End With
End Sub
Private Sub GetImageFromIDirect3DSurface(IDirect3DSurface As IUnknown, Optional eCaptureItem As CaptureItemEnum = eWindow)
Dim ID3D11Texture2D As IUnknown, D3D11Texture2DDesc As D3D11_TEXTURE2D_DESC, D3D11MappedSubresource As D3D11_MAPPED_SUBRESOURCE, i As Long, lRowWidth As Long, lFrameWidth As Long, lFrameHeight As Long
If OleInvoke(OleQueryInterface(IDirect3DSurface, pIID_IDirect3DDxgiInterfaceAccess), IDirect3DDxgiInterfaceAccess_GetInterface, pIID_ID3D11Texture2D, VarPtr(ID3D11Texture2D)) = S_OK Then
With CaptureItem(eCaptureItem)
lFrameWidth = .FrameContentSize.Width: lFrameHeight = .FrameContentSize.Height: lRowWidth = lFrameWidth * 4
If .ID3D11Texture2DCopy Is Nothing Then
OleInvoke ID3D11Texture2D, ID3D11Texture2D_GetDesc, VarPtr(D3D11Texture2DDesc)
With D3D11Texture2DDesc: .Usage = D3D11_USAGE_STAGING: .CPUAccessFlags = D3D11_CPU_ACCESS_READ: .BindFlags = 0: .MiscFlags = 0: End With
OleInvoke ID3D11Device, ID3D11Device_CreateTexture2D, VarPtr(D3D11Texture2DDesc), 0&, VarPtr(.ID3D11Texture2DCopy)
End If
If Not (.ID3D11Texture2DCopy Is Nothing) Then
If OleInvoke(ID3D11DeviceContext, ID3D11DeviceContext_CopyResource, ObjPtr(.ID3D11Texture2DCopy), ObjPtr(ID3D11Texture2D)) = S_OK Then
If OleInvoke(ID3D11DeviceContext, ID3D11DeviceContext_Map, ObjPtr(.ID3D11Texture2DCopy), 0&, D3D11_MAP_READ, 0&, VarPtr(D3D11MappedSubresource)) = S_OK Then
For i = 0 To lFrameHeight - 1
CopyMemory ByVal VarPtr(.laPixelData(i * lFrameWidth)), ByVal D3D11MappedSubresource.pData + i * D3D11MappedSubresource.RowPitch, lRowWidth
Next i
OleInvoke ID3D11DeviceContext, ID3D11DeviceContext_Unmap, ObjPtr(.ID3D11Texture2DCopy), 0&
SetDIBits m_hDC, .PictDesc.hBitmap, 0, lFrameHeight, ByVal VarPtr(.laPixelData(0)), ByVal VarPtr(.bmiBitmapInfo), DIB_RGB_COLORS
OleCreatePictureIndirect VarPtr(.PictDesc), pIID_IUnknown, APIFALSE, VarPtr(.Picture)
End If
End If
End If
End With
End If
End Sub
Private Sub CloseCaptureSession(Optional eCaptureItem As CaptureItemEnum = eWindow)
With CaptureItem(eCaptureItem)
If .EventRegistrationToken(eITypedEventCaptureFramePool_FrameArrived) Then
OleInvoke .IDirect3D11CaptureFramePool, IDirect3D11CaptureFramePool_RemoveFrameArrived, .EventRegistrationToken(eITypedEventCaptureFramePool_FrameArrived)
.EventRegistrationToken(eITypedEventCaptureFramePool_FrameArrived) = 0
End If
If .EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed) Then
OleInvoke .IGraphicsCaptureItem, IGraphicsCaptureItem_RemoveClosed, .EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed)
.EventRegistrationToken(eITypedEventGraphicsCaptureItem_Closed) = 0
End If
OleInvoke OleQueryInterface(.IGraphicsCaptureSession, pIID_IClosable), IClosable_Close: Set .IGraphicsCaptureSession = Nothing
OleInvoke OleQueryInterface(.IDirect3D11CaptureFramePool, pIID_IClosable), IClosable_Close: Set .IDirect3D11CaptureFramePool = Nothing
Set .IGraphicsCaptureItem = Nothing: Set .ID3D11Texture2DCopy = Nothing: .bIsInitialized = False: .bStartCapture = False
End With
End Sub
Private Sub SetBitmapSize(Optional eCaptureItem As CaptureItemEnum = eWindow)
With CaptureItem(eCaptureItem)
If .PictDesc.hBitmap Then DeleteObject .PictDesc.hBitmap
.PictDesc.hBitmap = CreateCompatibleBitmap(m_hDC, .FrameContentSize.Width, .FrameContentSize.Height)
.bmiBitmapInfo.bmiHeader.biWidth = .FrameContentSize.Width: .bmiBitmapInfo.bmiHeader.biHeight = -.FrameContentSize.Height
ReDim .laPixelData(0 To .FrameContentSize.Width * .FrameContentSize.Height - 1): Set .ID3D11Texture2DCopy = Nothing
End With
End Sub
Private Function IsMinimized(hWnd As Long) As Boolean
IsMinimized = GetWindowLong(hWnd, GWL_STYLE) And WS_MINIMIZE
End Function
Private Function GetActivationFactory(ClassName As String, lpIID As Long, pFactory As Long) As Boolean
Dim hString As Long
If WindowsCreateString(StrPtr(ClassName), Len(ClassName), hString) = S_OK Then
If hString Then
GetActivationFactory = RoGetActivationFactory(hString, lpIID, pFactory) = S_OK
hString = WindowsDeleteString(hString)
End If
End If
End FunctionAt 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" (the keyboard shortcut for the "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! ;)
Here's the demo project: WindowsGraphicsCapture.zip
Special thanks to -Franky- for exploring the WinRT API for the VB6 community! :D