VB6之摄像头控制

参考文献：http://www.cnblogs.com/xidongs/archive/2009/07/17/1525584.html

 

直接上代码：

'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()
    '启动录像模式，并设置文件保存路径
    '说明：启动录像模式后，摄像头会持续向目标文件写入，直到有终止操做发生。
    '   其中终止操做包括：一、用户使用ESC键或鼠标按钮
    '                     二、当前应用程序退出或退出了捕获操做(WM_CAP_STOP/WM_CAP_ABORT)
    '                     三、本地磁盘空间不足
    '                     *若是设置采样帧率太高，文件增加会比较快，请注意！
    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