Сделать фото с веб-камеры и сохранить на диск - VBA - Ответ 5992694

Private Const ws_child As Long = &H40000000
Private Const ws_visible As Long = &H10000000
 
Private Const WM_USER = 1024
Private Const wm_cap_driver_connect = WM_USER + 10
Private Const wm_cap_set_preview = WM_USER + 50
Private Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Private Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
 
Dim hwdc As Long
Dim startcap As Boolean
Private Sub cmdCapture_Click()
Dim temp As Long
  
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
  
  hwdc = capCreateCaptureWindow("Dixanta Vision System", ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
  If (hwdc <> 0) Then
    temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
    temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
    temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
    startcap = True
    Else
    MsgBox ("No Webcam found")
  End If
End Sub