Как получить доступ к веб-камере и сделать снимок - VB

Option Explicit
 
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const CW_USEDEFAULT = &H80000000
Private Const WM_CAP_START As Long = &H400
Private Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Private Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Private Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Private Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Private Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
 
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowW" (ByVal wn As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
 
Dim hwndCap As Long
 
Private Sub Form_Load()
    hwndCap = capCreateCaptureWindow(StrPtr("Take a Camera Shot"), WS_CHILD Or WS_VISIBLE, 0, 0, CW_USEDEFAULT, CW_USEDEFAULT, Me.hwnd, 0)
    If hwndCap = 0 Then End
    If SendMessage(hwndCap, WM_CAP_DRIVER_CONNECT, 0, ByVal 0&) = False Then End
    SendMessage hwndCap, WM_CAP_SET_PREVIEWRATE, 66, ByVal 0&
    SendMessage hwndCap, WM_CAP_SET_PREVIEW, 1, ByVal 0&
    SendMessage hwndCap, WM_CAP_SET_SCALE, 1, ByVal 0&
    If Not SetSize(1600, 1200) Then
        MsgBox "Не поддерживается"
    End If
End Sub
 
Private Function SetSize(ByVal w As Long, ByVal h As Long) As Boolean
    ' Задаем формат
    Dim buf()   As Long
    Dim c       As Long
    c = SendMessage(hwndCap, WM_CAP_GET_VIDEOFORMAT, 0, ByVal 0&)
    ReDim buf(c \ 4)
    buf(0) = 40         ' BITMAPINFO.biSize
    buf(1) = w          ' BITMAPINFO.biWidth
    buf(2) = h          ' BITMAPINFO.biHeight
    buf(3) = &H180001   ' BITMAPINFO.biPlanes = 1: BITMAPINFO.biBitCount = 24
    buf(4) = 0          ' BITMAPINFO.biCompression = 0 ' Без компрессии
    SetSize = SendMessage(hwndCap, WM_CAP_SET_VIDEOFORMAT, c, buf(0))
End Function
Private Sub Form_Resize()
    Dim RC(3) As Long
    GetClientRect Me.hwnd, RC(0)
    MoveWindow hwndCap, 0, 0, RC(2), RC(3), False
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    SendMessage hwndCap, WM_CAP_DRIVER_DISCONNECT, 0, ByVal 0&
End Sub