VB程序VB代碼：攝像頭視頻圖像的監(jiān)控、截圖、錄像(改進(jìn))

1、VB程序VB代碼：攝像頭視頻圖像的監(jiān)控、截圖、錄像（改進(jìn)）本程序是“實(shí)現(xiàn)USB攝像頭視頻圖像的監(jiān)控、截圖、錄像”的改進(jìn)?？蓪?shí)現(xiàn)對(duì)攝像頭視頻的監(jiān)控、截圖、錄像，可以分別保存為圖片文件和視頻（壓縮）文件。保存的視頻文件可以用媒體播放機(jī)（Windows Media Player）、 暴風(fēng)影音等軟件進(jìn)行播放，輕松實(shí)現(xiàn)家庭錄像制作。利用電腦配備的 USB 攝像頭進(jìn)行視頻控制，要用到兩個(gè) API 函數(shù)：capCreateCaptureWindow 和 SendMessage。其中，capCreateCaptureWindow 的作用是創(chuàng)建一個(gè)視頻窗口，攝像頭捕捉到的視頻圖像在此窗口內(nèi)顯示，函數(shù)返回值就是代

2、表此窗口的句柄。視頻窗口創(chuàng)建后，剩下的事情就是用 SendMessage 向該窗口發(fā)送各種消息，實(shí)現(xiàn)對(duì)攝像頭的控制。本程序特點(diǎn)主要有：1.實(shí)現(xiàn)對(duì)攝像頭視頻圖像的監(jiān)控、截圖，視頻錄像并保存為磁盤文件。2.可控制多個(gè)視頻攝像頭。例如，如果一臺(tái)電腦配置了兩個(gè)攝像頭，啟動(dòng)本程序兩次，單擊按鈕“源”，在彈出的“視頻源”對(duì)話框中選擇不同的捕獲源，兩個(gè)窗口就能同時(shí)顯示不同攝像頭獲得的圖像。如下圖所示：3.在“視頻源”對(duì)話框中，還可以設(shè)置視頻的亮度、對(duì)比度等許多參數(shù)：4.錄像時(shí)，如果采用默認(rèn)的 AVI 文件格式，得到的視頻文件會(huì)很大。單擊按鈕“壓”，在彈出的“視頻壓縮”對(duì)話框中選擇壓縮方式“MPEG-4”,這

3、樣得到的視頻文件會(huì)比默認(rèn)方式小 10 倍以上。5.本程序的視頻窗口有自動(dòng)大小和全屏功能。在全屏狀態(tài)時(shí)，工具欄會(huì)自動(dòng)隱藏。將鼠標(biāo)移動(dòng)到屏幕頂部，工具欄又會(huì)自動(dòng)顯示出來(lái)。遺憾的是，由于水平有限，本程序無(wú)法判斷是否使用了壓縮記錄方式，壓縮后的文件其擴(kuò)展名仍然是 AVI。當(dāng)然，這并不影響播放，錄像完成后也可以手動(dòng)將擴(kuò)展名修改為 mpg。其次，錄像狀態(tài)下改變視頻窗口大小，有時(shí)會(huì)出現(xiàn)莫名其妙的錯(cuò)誤。這個(gè)錯(cuò)誤時(shí)有時(shí)無(wú)，毫無(wú)規(guī)律，因此本程序不得不關(guān)閉了錄像狀態(tài)下視頻窗口自動(dòng)大小的功能。' '以下是窗體 Form1 的完整代碼，在 VB6 和 WindowsXP 下調(diào)試通過(guò)：'

4、在窗體放置4個(gè)控件：'    Command1：在屬性窗口將 Index 屬性設(shè)置為 0'    Check1：  在屬性窗口將 Index 屬性設(shè)置為 0，將 Style 屬性設(shè)置為 1'    Picture1：不必設(shè)置任何屬性'    Timer1：  不必設(shè)置任何屬性'程序調(diào)試時(shí)要注意：終止程序要用運(yùn)行中的 Form1 窗口關(guān)閉。不要使用 VB 主窗

5、口的菜單命令或 VB 工具欄上的關(guān)閉按鈕，這樣無(wú)法關(guān)閉打開(kāi)的視頻窗口，導(dǎo)致 VB 無(wú)響應(yīng)。如果 VB 無(wú)響應(yīng)，只有用系統(tǒng)任務(wù)管理器才能終止 VB 進(jìn)程，調(diào)試過(guò)程中所做的修改將丟失。'本人原創(chuàng)，轉(zhuǎn)載請(qǐng)注明來(lái)源：Public ctCapWin As Long, ctRec As Boolean, ctDir As String, ctF As String, ctAutoSize As BooleanDim ctRefresh As Boolean, ctConnect As Boolean, ctAutoHide As Boolean, IsFillScreen As BooleanPr

6、ivate Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As LongPrivate Type PointAPI     X As Long: Y As LongEnd TypePrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVa

7、l X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As LongConst HWND_Top = 0        'hWndInsertAfter 參數(shù)：Z序列的頂部Const HWND_TopMost = -1    '最前Const HWND_NoTopMost = -2  '不在最前Const HWN

8、D_Bottom = 1      '位于底層Const SWP_NoSize = &H1     'wFlags 參數(shù)Const SWP_NoMove = &H2Const SWP_NoZorder = &H4Const SWP_NoActivate = &H10Const SWP_ShowWindow = &H40Const SWP_HideWindow = &H80Pr

9、ivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"

10、 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As LongPrivate Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongConst WM_Close

11、 = &H10Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Integer, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As BooleanPrivate Declare Function capCreateCaptureWindow Lib "avica

12、p32.dll" Alias "capCreateCaptureWindowW" (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 LongConst WS_Child = &H40000000Const WS_V

13、isible = &H10000000Const WS_Caption = &HC00000Const WS_ThickFrame = &H40000Const GET_Frame = 1084Const WM_User = &H400        '用戶消息開(kāi)始號(hào)，偏移地址:1024Const WM_CAP_GET_CAPSTREAMPTR = WM_User + 1      &

14、#160;  'Const WM_CAP_SET_CALLBACK_ERROR = WM_User + 2       '當(dāng)出錯(cuò)回調(diào)函數(shù)Const WM_CAP_SET_CALLBACK_STATUS = WM_User + 3      '當(dāng)狀態(tài)（status）改變的時(shí)回調(diào)函數(shù)Const WM_CAP_SET_CALLBACK_YIELD = WM_User + 4    

15、0;  '在流捕獲期間的回調(diào)函數(shù)Const WM_CAP_SET_CALLBACK_FRAME = WM_User + 5       '幀預(yù)覽回調(diào)函數(shù)Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_User + 6 '在流捕獲期間，當(dāng)一個(gè)新的視頻緩存區(qū)可用的時(shí)候就調(diào)用它Const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_User + 7  '在流捕獲期間，當(dāng)一個(gè)新的音頻緩存區(qū)可用的時(shí)

16、候就調(diào)用它Const WM_CAP_GET_USER_DATA = WM_User + 8 '獲取：數(shù)據(jù)關(guān)聯(lián)到一個(gè)捕捉窗口Const WM_CAP_SET_USER_DATA = WM_User + 9 '設(shè)置：數(shù)據(jù)關(guān)聯(lián)到一個(gè)捕捉窗口Const WM_CAP_DLG_VideoFormat = WM_User + 41      '對(duì)話框：視頻格式Const WM_CAP_DLG_VideoSource = WM_User + 42      '

17、;對(duì)話框：視頻源，枚舉視頻源，控制顏色、對(duì)比度、飽和度的改變。需視頻驅(qū)動(dòng)程序支技Const WM_CAP_DLG_VideoDisplay = WM_User + 43     '對(duì)話框：視頻顯示？控制視頻捕捉過(guò)程中視頻在顯示器上的顯示。對(duì)捕捉數(shù)據(jù)無(wú)影響，但會(huì)影響數(shù)了信號(hào)表達(dá)式Const WM_CAP_DLG_VideoCompression = WM_User + 46 '對(duì)話框：視頻壓縮Private Enum enWinSet'  en_Copy = -1   es

18、_Show = 0   es_Hide   es_Close   es_Move   es_SizeEnd Enum'捕捉文件和緩存Const WM_Cap_File_Set_File = WM_User + 20 '設(shè)置當(dāng)前的捕捉文件Const WM_Cap_File_Get_File = WM_User + 21 '得到當(dāng)前的捕捉文件Const WM_CAP_FILE_ALLOCATE = WM_User + 22 '為捕捉文件預(yù)分配空間,

19、從而可以減少被漏掉的幀Const WM_CAP_FILE_SaveAs = WM_User + 23 '將捕捉文件保存為另一個(gè)用戶指定的文件。這個(gè)消息不會(huì)改變捕捉文件的名字和內(nèi)容,                                  &#

20、160;     '由于捕捉文件保留它最初的文件名，因此必須指定個(gè)新的文件的文件名來(lái)保存Const WM_CAP_FILE_SET_INFOCHUNK = WM_User + 24 '可以把信息塊例如文本或者自定義數(shù)據(jù)插入avi文件。同樣用這個(gè)消息也可以清除avi文件中的信息塊Const WM_CAP_FILE_SaveDIB = WM_User + 25 '把從幀緩存中復(fù)制出圖像存為設(shè)備無(wú)關(guān)位圖書(shū)館（DIB),應(yīng)用程序也可以使用這兩個(gè)單幀捕捉消息來(lái)編輯幀序列，     

21、                                    '或者創(chuàng)建一個(gè)慢速攝影序列Const WM_CAP_Edit_Copy = WM_User + 30 '1054：把緩存中圖像復(fù)制到剪貼板中Const

22、WM_CAP_SET_AUDIOFORMAT = WM_User + 35 '設(shè)置音頻格式。設(shè)置時(shí)傳入一個(gè)WAVEFORMAT、WAVEFORMATEX、或PCMWAVEOFMAT結(jié)構(gòu)的指針Const WM_CAP_GET_AUDIOFORMAT = WM_User + 36 '來(lái)得到音頻數(shù)據(jù)的格式和該格式結(jié)構(gòu)體的大小。默認(rèn)的捕捉音頻格式是mono、8-bit和11kHZ PCMConst WM_CAP_Get_VideoFormat = WM_User + 44 '給捕捉窗口來(lái)得到視頻格式的結(jié)構(gòu)和該結(jié)構(gòu)的大小。Const WM_CAP_SET_VideoFormat

23、= WM_User + 45 '用來(lái)設(shè)置視頻格式Const WM_CAP_SET_PreView = WM_User + 50 '發(fā)送給捕捉窗口來(lái)使預(yù)覽模式有效或者失效Const WM_CAP_SET_Overlay = WM_User + 51 '使窗口處于疊加模式。使疊加模式有效也會(huì)自動(dòng)地使預(yù)覽模式失效Const WM_CAP_SET_PreViewRate = WM_User + 52 '發(fā)送給捕捉窗口來(lái)設(shè)置在預(yù)覽模式下幀的顯示頻率Const WM_CAP_SET_Scale = WM_User + 53 '來(lái)使預(yù)覽模式的縮放有效或者無(wú)效Const

24、 WM_CAP_SET_SCROLL = WM_User + 55 '如果是在預(yù)覽模式或者疊加模式，還可以通過(guò)本消息發(fā)送給窗口，                                      

25、0;'在窗口里的用戶區(qū)域設(shè)置視頻幀的滾動(dòng)條的位置Private Type BitMapInfoHeader 'tagBitMapInfoHeader Structure     biSize As Long        '     biWidth As Long     biHeight As Long   &#

26、160;  'LONG DWORD     biPlanes As Integer   'WORD     biBitCount As Integer     biCompression As Long     biSizeImage As Long     biXPelsPerMe

27、ter As Long     biYPelsPerMeter As Long     biClrUsed As Long     biClrImportant As LongEnd TypePrivate Type BitMapInfo    bmiHeader As BitMapInfoHeader '    bmiColors As Byte 

28、  'RGBQUADEnd Type'基本視頻捕獲消息-Const WM_CAP_Connect = WM_User + 10    '連接一個(gè)視頻驅(qū)動(dòng)，成功返回真(1)。連接驅(qū)動(dòng)后，不一定就能顯示視頻，還要保證攝像頭硬件連接良好、未被其他程序使用。Const WM_CAP_DisConnect = WM_User + 11 '斷開(kāi)視頻窗口與驅(qū)動(dòng)的連接'   wParam：視頻設(shè)備序號(hào)，從 0 到 9Const WM_CAP_Sequence = WM_User +

29、 62 '開(kāi)始錄像Const WM_CAP_Stop = WM_User + 68     '終止視頻捕獲Const WM_CAP_Abort = WM_User + 69    '暫停錄像捕獲？，成功返回真Const WM_CAP_Set_Sequence_Setup = WM_User + 64Const WM_CAP_Get_Sequence_Setup = WM_User + 65'錄像參數(shù)設(shè)置和獲取'Dim nParms As CaptureParms&#

30、39;SendMessage ctCapWin, WM_CAP_Get_Sequence_Setup, Len(nParms), nParms'獲取參數(shù)的設(shè)置'nParms.fAbortLeftMouse = False '關(guān)閉：?jiǎn)螕羰髽?biāo)停止錄像的功能。'SendMessage ctCapWin, WM_CAP_Set_Sequence_Setup, Len(nParms), nParms'重新設(shè)置參數(shù)Private Type CaptureParms '    dwRequestMicroSecPerFr

31、ame As Long  'DWORD    fMakeUserHitOKToCapture As Boolean '開(kāi)始錄像時(shí)，是否顯示確認(rèn)對(duì)話框，默認(rèn)為假    wPercentDropForError As Long '每毫秒捕捉幀率，默認(rèn)66667，即每秒15幀    fYield As Boolean          &#

32、160; 'BOOL:如果為TRUE，將產(chǎn)生一個(gè)后臺(tái)線程來(lái)進(jìn)行視頻捕捉    dwIndexSize As Long          'DWORD:視頻文件最大的索引入口數(shù)    wChunkGranularity As Long    'UINT:以字節(jié)為單位表示AVI文件的大小    fUsingD

33、OSMemory As Boolean   'BOOL:未使用    wNumVideoRequested As Long   'UINT:分配視頻緩沖區(qū)的最大數(shù)量    fCaptureAudio As Boolean     '是否捕獲音頻流，默認(rèn)值由具體的硬件設(shè)置    wNumAudioRequested As Long &#

34、160; '分配的音頻緩沖區(qū)的最大數(shù)量    vKeyAbort As Long            '結(jié)束錄像的按鍵，默認(rèn)為 VK_ESCAPE（Esc鍵）    fAbortLeftMouse As Boolean   '單擊鼠標(biāo)左鍵停止錄像，默認(rèn)為真    fAbortRightMous

35、e As Boolean  '單擊鼠標(biāo)右鍵停止錄像，默認(rèn)為假    fLimitEnabled As Boolean     '是否開(kāi)啟捕獲時(shí)間限制，默認(rèn)為真    wTimeLimit As Long           '捕獲時(shí)間限制（秒），fLimitEnabled 為真時(shí)有效  

36、0; fMCIControl As Boolean       'BOOL:為TRUE，控制MCI（媒體設(shè)備接口）兼容的視頻源    fStepMCIDevice As Boolean    'BOOL    dwMCIStartTime As Long       'DWORD:以毫秒為單位標(biāo)識(shí)MCI設(shè)

37、備視頻捕捉序列的起始位置，如果fMCIControl成員為FALSE，該成員被忽略    dwMCIStopTime As Long        'DWORD:以毫秒為單位標(biāo)識(shí)MCI設(shè)備視頻捕捉序列的停止位置，如果fMCIControl成員為FALSE，該成員被忽略    fStepCaptureAt2x As Boolean  'BOOL:為TRUE，捕捉的視頻幀使用兩個(gè)分辨率 

38、0;  wStepCaptureAverageFrames As Long ':在捕捉時(shí)每幀圖像使用的時(shí)間大小    dwAudioBufferSize As Long     '音頻緩沖大小，默認(rèn)0    fDisableWriteCache As Boolean 'Win32系統(tǒng)未使用    AVStreamMaster As Long   

39、0;    '確定在寫(xiě)入AVI文件時(shí)，音頻流是否控制時(shí)鐘End Type'視頻窗口消息-'Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" ( _'ByVal wDriver As Integer, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boole

40、an   '可利用此 API 獲取所有驅(qū)動(dòng)程序名稱和版本信息。例子：'   Dim S As Long'   Dim lpszName As String * 128'   Dim lpszVer As String * 128''   Do'      If Not capGetDriverDescriptionA(S, lpsz

41、Name, 128, lpszVer, 128) Then Exit Do '獲得驅(qū)動(dòng)程序名稱和版本信息'      S = S + 1'   LoopConst WM_CAP_Get_Status = WM_User + 54 '獲取捕捉窗口的當(dāng)前狀態(tài)Private Type CapStatus '?    uiImageWidth As Long      

42、60;     '圖像寬度，像素    uiImageHeight As Long           '圖像高度，像素    fLiveWindow As Boolean          '視頻顯示是否使用預(yù)覽  

43、;  fOverlayWindow As Boolean       '視頻顯示是否使用硬件    fScale As Boolean               '圖像是否隨窗口大小自動(dòng)縮放    ptScroll As PointAPI  

44、          'POINT?    fUsingDefaultPalette As Boolean '是否使用默認(rèn)調(diào)色板    fAudioHardware As Boolean       '是否安裝了音頻波形硬件    fCapFileExists As Boolean

45、60;      '是否生成了正確的捕獲文件    dwCurrentVideoFrame As Long    dwCurrentVideoFramesDropped As Long    dwCurrentWaveSamples As Long    dwCurrentTimeElapsedMS As Long   '視頻流已錄

46、像時(shí)間（毫秒）    hPalCurrent As Long              'HPALETTE 當(dāng)前調(diào)色板句柄    fCapturingNow As Boolean         '是否正在進(jìn)行捕獲    dwRetu

47、rn As Long                 '錯(cuò)誤返回值，根據(jù)這個(gè)數(shù)值可以調(diào)用一個(gè)錯(cuò)誤回調(diào)函數(shù)    wNumVideoAllocated As Long       '視頻緩沖    wNumAudioAllocated As Long &#

48、160;     '音頻緩沖End TypePrivate Sub CloseMouse()  Dim nParms As CaptureParms  SendMessage ctCapWin, WM_CAP_Get_Sequence_Setup, Len(nParms), nParms  '獲取參數(shù)的設(shè)置  'nParms.fMakeUserHitOKToCapture = True '開(kāi)始錄像時(shí)，是否顯示確認(rèn)對(duì)話框 &#

49、160;nParms.fYield = True '用一個(gè)后臺(tái)線程來(lái)進(jìn)行視頻捕捉  nParms.fAbortLeftMouse = False  '關(guān)閉：?jiǎn)螕羰髽?biāo)左鍵停止錄像的功能。  nParms.fAbortRightMouse = False '關(guān)閉：?jiǎn)螕羰髽?biāo)右鍵停止錄像的功能  SendMessage ctCapWin, WM_CAP_Set_Sequence_Setup, Len(nParms), nParms '重新設(shè)置參數(shù)   '

50、ff = SendMessageLong(ctCapWin, WM_CAP_SET_CALLBACK_STATUS, 0, AddressOf CallBackStatus) '狀態(tài)回調(diào)函數(shù)'ff = SendMessageLong(ctCapWin, WM_CAP_SET_CALLBACK_FRAME, 0, AddressOf MyFrameCallback) '幀回調(diào)函數(shù)'ff = SendMessageLong(ctCapWin, WM_CAP_SET_CALLBACK_YIELD, 0, AddressOf CallbackYield)End SubP

51、rivate Sub NoRecord()   SendMessage ctCapWin, WM_CAP_Stop, 0, 0 '停止錄像   ctRec = False: Call SetCaption(" ")End SubPrivate Sub StartRecord()   Dim F As String, nDir As String, nF As String    '如果路徑不存在，用默認(rèn)文件名 C:

52、CAPTURE.AVI    nDir = Trim(ctDir)    If nDir = "" Or nDir = "<>" Or nDir = "<默認(rèn)>" Then nDir = App.Path & "videos"    If Right(nDir,

53、1) <> "" Then nDir = nDir & ""    If Not MakePath(nDir) Then       MsgBox "在指定的位置無(wú)法建立目錄：" & vbCrLf & nPath, vbInformation, "保存視頻文件"       Exit Sub    End If