Private Declare Function capGetDriverDescription Lib "avicap32.dll" Alias "capGetDriverDescriptionA" (ByVal wDriverIndex As Long, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Long
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 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 WS_CHILD = &H40000000
Private Const WS_THICKFRAME = &H40000
Private Const WS_VISIBLE = &H10000000
Private Const WS_CAPTION = &HC00000
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_DRIVER_DISCONNECT = WM_CAP_START + 11
Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Private Const WM_CAP_SET_OVERLAY = WM_CAP_START + 51
Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
lwnd 为摄像头句柄
1,获取所有驱动 capGetDriverDescription
2,创建窗口 capCreateCaptureWindow
3,连接驱动 SendMessage(lwnd,WM_CAP_DRIVER_CONNECT,0, 0)
4,设置是否自动适应 SendMessage(lwnd, WM_CAP_SET_SCALE,true,0)
5,设置速率 SendMessage(lwnd, WM_CAP_SET_PREVIEWRATE,66, 0)
6,开始预览 SendMessage(lwnd, WM_CAP_SET_PREVIEW,true, 0)
8,停止连接 SendMessage(lwnd,WM_CAP_DRIVER_DISCONNECT, 0, 0)
Dim hwndDlg As Long
Private Sub Command1_Click()
'开始
Dim strName As String * 100
Dim strVersion As String * 100
Dim j As Long
Call capGetDriverDescription(0, strName, 100, strVersion, 100)
hwndDlg = capCreateCaptureWindow(strName, WS_CHILD Or WS_THICKFRAME Or WS_VISIBLE, 0, 0, 320, 240,
Picture1.hwnd, 0)
j = SendMessage(hwndDlg, WM_CAP_DRIVER_CONNECT, 0, 0)
Dim bTrue As Boolean
bTrue = True
j = SendMessage(hwndDlg, WM_CAP_SET_SCALE, bTrue, 0)
j = SendMessage(hwndDlg, WM_CAP_SET_PREVIEWRATE, 60, 0)
j = SendMessage(hwndDlg, WM_CAP_SET_PREVIEW, bTrue, 0)
End Sub
Private Sub Command2_Click()
'停止
If hwndDlg > 0 Then
Dim j As Long
j = SendMessage(hwndDlg, WM_CAP_DRIVER_DISCONNECT, 0, 0)
End If
End Sub
Private Sub Command3_Click()
'退出
End Sub