@ארי
אני משתמש במצלמה מובנית.
תנסה לשנות את הקוד של @OdedDvir
להלן השינויים בחלק הראשון של הקוד:
'UX_WebCam : A WebCam API Class. By OdedDvir
Option Compare Database
Option Explicit
Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Const WM_USER As Long = &H400
Const WM_CAP_START As Long = WM_USER
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY As Long = WM_CAP_START + 30
Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Const WM_CAP_GRAB_FRAME As Long = WM_CAP_START + 60
Private Declare Function apiCapCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
(ByVal lpszWindowName As String, 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 apiSendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function apiGetFocus Lib "user32" Alias "GetFocus" () As Long
Private hCap As Long
Public Sub OpenWebCam(targethWnd As Long, Optional width = 640, Optional height = 480)
hCap = apiCapCreateCaptureWindow("Capture Window", WS_CHILD Or WS_VISIBLE, 0, 0, width, height, targethWnd, 0)
If hCap = 0 Then Exit Sub
apiSendMessage hCap, WM_CAP_DRIVER_CONNECT, 0, 0
apiSendMessage hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&
apiSendMessage hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&
End Sub
Public Sub TakeSnapshotToFile(fileName As String)
apiSendMessage hCap, WM_CAP_GRAB_FRAME, 0, 0
apiSendMessage hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&
apiSendMessage hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(fileName)
apiSendMessage hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&
End Sub
Public Sub OpenVideoFormatDialog()
apiSendMessage hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&
End Sub
Public Sub CaptureToClipboard()
apiSendMessage hCap, WM_CAP_GRAB_FRAME, 0, 0
apiSendMessage hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&
apiSendMessage hCap, WM_CAP_EDIT_COPY, 0, 0
apiSendMessage hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&
End Sub
Public Sub CloseWebCam()
apiSendMessage hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&
End Sub
אני מקווה שזה כל השינויים.
אם עדיין לא עובד נצטרך להמתין ל @OdedDvir עצמו.