直接上代码:

'code by lichmama from cnblogs.com
'@vb6 camera control
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 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 DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOP = '摄像头显示窗口控制消息常数
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000 '摄像头控制消息参数
Private Const WM_USER = &H400 '用户消息开始号
Private Const WM_CAP_CONNECT = WM_USER + '连接一个摄像头
Private Const WM_CAP_DISCONNECT = WM_USER + '断开一个摄像头的连接
Private Const WM_CAP_SET_PREVIEW = WM_USER + '使预览模式有效或者失效
Private Const WM_CAP_SET_OVERLAY = WM_USER + '使窗口处于叠加模式,也会自动地使预览模式失效。
Private Const WM_CAP_SET_PREVIEWRATE = WM_USER + '设置在预览模式下帧的显示频率
Private Const WM_CAP_GRAB_FRAME = WM_USER + '抓取摄像头当前帧,并存入缓冲区
Private Const WM_CAP_GRAB_FRAME_NOSTOP = WM_USER + '抓取摄像头当前帧,并存入缓冲区(该行为不会暂停摄像头显示)
Private Const WM_CAP_EDIT_COPY = WM_USER + '将当前图像复制到剪贴板
Private Const WM_CAP_GET_STATUS = WM_USER + '获取摄像头状态
Private Const WM_CAP_SEQUENCE = WM_USER + '开始录像,录像未结束前不会返回。
Private Const WM_CAP_STOP = (WM_USER + ) '暂停录像
Private Const WM_CAP_ABORT = (WM_USER + ) '终止录像
Private Const WM_CAP_FILE_SET_CAPTURE_FILE = WM_USER + '设置当前的视频捕捉文件
Private Const WM_CAP_File_GET_CAPTURE_FILE = WM_USER + '得到当前的视频捕捉文件 Private Type POINTAPI
x As Long
y As Long
End Type '摄像头状态结构体
Private Type CAPSTATUS
uiImageWidth As Long '// Width of the image
uiImageHeight As Long '// Height of the image
fLiveWindow As Long '// Now Previewing video?
fOverlayWindow As Long '// Now Overlaying video?
fScale As Long '// Scale image to client?
ptScroll As POINTAPI '// Scroll position
fUsingDefaultPalette As Long '// Using default driver palette?
fAudioHardware As Long '// Audio hardware present?
fCapFileExists As Long '// Does capture file exist?
dwCurrentVideoFrame As Long '// # of video frames cap'td
dwCurrentVideoFramesDropped As Long '// # of video frames dropped
dwCurrentWaveSamples As Long '// # of wave samples cap'td
dwCurrentTimeElapsedMS As Long '// Elapsed capture duration
hPalCurrent As Long '// Current palette in use
fCapturingNow As Long '// Capture in progress?
dwReturn As Long '// Error value after any operation
wNumVideoAllocated As Long '// Actual number of video buffers
wNumAudioAllocated As Long '// Actual number of audio buffers
End Type Private hCapWnd As Long Private Sub Command1_Click()
'创建显示窗口,并连接摄像头
hCapWnd = capCreateCaptureWindow("mycapWnd", WS_VISIBLE Or WS_CHILD, &, &, &, &, Me.hwnd, &)
Call SendMessage(hCapWnd, WM_CAP_CONNECT, &, ByVal &) '重新设置显示窗口的大小
Dim caps As CAPSTATUS
Call SendMessage(hCapWnd, WM_CAP_GET_STATUS, Len(caps), ByVal VarPtr(caps))
Call SetWindowPos(hCapWnd, HWND_TOP, &, &, caps.uiImageWidth, caps.uiImageHeight, SWP_SHOWWINDOW) '设置摄像头显示模式为预览及其帧率(30fps)
Call SendMessage(hCapWnd, WM_CAP_SET_PREVIEW, &, ByVal &)
Call SendMessage(hCapWnd, WM_CAP_SET_PREVIEWRATE, &, ByVal &)
End Sub Private Sub Command2_Click()
'截取摄像头显示帧,并保存到剪切板
Call SendMessage(hCapWnd, WM_CAP_GRAB_FRAME_NOSTOP, &, ByVal &)
Call SendMessage(hCapWnd, WM_CAP_EDIT_COPY, &, ByVal &)
End Sub Private Sub Command3_Click()
'启动录像模式,并设置文件保存路径
'说明:启动录像模式后,摄像头会持续向目标文件写入,直到有终止操作发生。
' 其中终止操作包括:1、用户使用ESC键或鼠标按钮
' 2、当前应用程序退出或退出了捕获操作(WM_CAP_STOP/WM_CAP_ABORT)
' 3、本地磁盘空间不足
' *如果设置采样帧率过高,文件增长会比较快,请注意!
Call SendMessage(hCapWnd, WM_CAP_FILE_SET_CAPTURE_FILE, &, ByVal "c:\1.avi")
Call SendMessage(hCapWnd, WM_CAP_SEQUENCE, &, ByVal &)
End Sub Private Sub Command4_Click()
'终止录像行为
Call SendMessage(hCapWnd, WM_CAP_ABORT, &, ByVal &)
End Sub Private Sub Form_Unload(Cancel As Integer)
'断开摄像头连接,并销毁显示窗口
Call SendMessage(hCapWnd, WM_CAP_DISCONNECT, &, ByVal &)
Call DestroyWindow(hCapWnd)
End Sub
05-11 18:24