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