Hallo... Christian
'Hier ein kleines Lösungsbeispiel : Zugriff auf eine WebCam oder ähnlichem.
' Teil 3/n
'Hinweis : Getestet mit einer LogiTech WebCam am USB Port.
'
'(c) NG.: 16.02.03.do.
'
'Durch den Aufruf der Funktion <capCreateCaptureWindow> wird ein Fenster
' realisiert
'indem der Videotreiber eine Vorschau darstellt.
Private Declare Function capCreateCaptureWindow 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 Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Private Const WM_USER = &H400
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
Private Enum PosSize
mLeft = 0
mTop = 0
mWidth = 320
mHeight = 240
End Enum
Private mhwnd As Long
Private Sub Command1_Click()
GetPreviewSequence Picture1.hwnd
End Sub
Private Sub Command3_Click()
If mhwnd <> 0 Then
Command1.Enabled = True
lRet = SendMessage(mhwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
Debug.Print lRet
Command3.Enabled = False
End If
End Sub
Private Sub GetPreviewSequence(ByVal Outhwnd As Long)
Dim hwnd As Long
Dim lRet As Long
hwnd = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, _
PosSize.mLeft, _
PosSize.mTop, _
PosSize.mWidth, _
PosSize.mHeight, _
Outhwnd, 1)
Debug.Print hwnd
mhwnd = hwnd
If hwnd <> 0 Then
Command1.Enabled = False
Command3.Enabled = True
Call SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, 0, 0)
Call SendMessage(hwnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
Call SendMessage(hwnd, WM_CAP_SET_OVERLAY, 1, 0)
Call SendMessage(hwnd, WM_CAP_SET_PREVIEW, 1, 0)
Else
Debug.Print "Fehler bei der Initialisierung des Previewfensters..."
Exit Sub
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
With Picture1
.ScaleMode = 3
End With
Command3.Enabled = False
End Sub
'MfG
'Frank |