直接上代码:
'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 = 0 '摄像头显示窗口控制消息常数 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 + 10 '连接一个摄像头 Private Const WM_CAP_DISCONNECT = WM_USER + 11 '断开一个摄像头的连接 Private Const WM_CAP_SET_PREVIEW = WM_USER + 50 '使预览模式有效或者失效 Private Const WM_CAP_SET_OVERLAY = WM_USER + 51 '使窗口处于叠加模式,也会自动地使预览模式失效。 Private Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52 '设置在预览模式下帧的显示频率 Private Const WM_CAP_GRAB_FRAME = WM_USER + 60 '抓取摄像头当前帧,并存入缓冲区 Private Const WM_CAP_GRAB_FRAME_NOSTOP = WM_USER + 61 '抓取摄像头当前帧,并存入缓冲区(该行为不会暂停摄像头显示) Private Const WM_CAP_EDIT_COPY = WM_USER + 30 '将当前图像复制到剪贴板 Private Const WM_CAP_GET_STATUS = WM_USER + 54 '获取摄像头状态 Private Const WM_CAP_SEQUENCE = WM_USER + 62 '开始录像,录像未结束前不会返回。 Private Const WM_CAP_STOP = (WM_USER + 68) '暂停录像 Private Const WM_CAP_ABORT = (WM_USER + 69) '终止录像 Private Const WM_CAP_FILE_SET_CAPTURE_FILE = WM_USER + 20 '设置当前的视频捕捉文件 Private Const WM_CAP_File_GET_CAPTURE_FILE = WM_USER + 21 '得到当前的视频捕捉文件 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, 0&, 0&, 320&, 240&, Me.hwnd, 0&) Call SendMessage(hCapWnd, WM_CAP_CONNECT, 0&, ByVal 0&) '重新设置显示窗口的大小 Dim caps As CAPSTATUS Call SendMessage(hCapWnd, WM_CAP_GET_STATUS, Len(caps), ByVal VarPtr(caps)) Call SetWindowPos(hCapWnd, HWND_TOP, 0&, 0&, caps.uiImageWidth, caps.uiImageHeight, SWP_SHOWWINDOW) '设置摄像头显示模式为预览及其帧率(30fps) Call SendMessage(hCapWnd, WM_CAP_SET_PREVIEW, 1&, ByVal 0&) Call SendMessage(hCapWnd, WM_CAP_SET_PREVIEWRATE, 30&, ByVal 0&) End Sub Private Sub Command2_Click() '截取摄像头显示帧,并保存到剪切板 Call SendMessage(hCapWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0&, ByVal 0&) Call SendMessage(hCapWnd, WM_CAP_EDIT_COPY, 0&, ByVal 0&) 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, 0&, ByVal "c:1.avi") Call SendMessage(hCapWnd, WM_CAP_SEQUENCE, 0&, ByVal 0&) End Sub Private Sub Command4_Click() '终止录像行为 Call SendMessage(hCapWnd, WM_CAP_ABORT, 0&, ByVal 0&) End Sub Private Sub Form_Unload(Cancel As Integer) '断开摄像头连接,并销毁显示窗口 Call SendMessage(hCapWnd, WM_CAP_DISCONNECT, 0&, ByVal 0&) Call DestroyWindow(hCapWnd) End Sub