VB程序VB代码：摄像头视频图像的监控、截图、录像(改进)

1、VB程序VB代码：摄像头视频图像的监控、截图、录像（改进）本程序是“实现USB摄像头视频图像的监控、截图、录像”的改进。可实现对摄像头视频的监控、截图、录像，可以分别保存为图片文件和视频（压缩）文件。保存的视频文件可以用媒体播放机（Windows Media Player）、 暴风影音等软件进行播放，轻松实现家庭录像制作。利用电脑配备的 USB 摄像头进行视频控制，要用到两个 API 函数：capCreateCaptureWindow 和 SendMessage。其中，capCreateCaptureWindow 的作用是创建一个视频窗口，摄像头捕捉到的视频图像在此窗口内显示，函数返回值就是代

2、表此窗口的句柄。视频窗口创建后，剩下的事情就是用 SendMessage 向该窗口发送各种消息，实现对摄像头的控制。本程序特点主要有：1.实现对摄像头视频图像的监控、截图，视频录像并保存为磁盘文件。2.可控制多个视频摄像头。例如，如果一台电脑配置了两个摄像头，启动本程序两次，单击按钮“源”，在弹出的“视频源”对话框中选择不同的捕获源，两个窗口就能同时显示不同摄像头获得的图像。如下图所示：3.在“视频源”对话框中，还可以设置视频的亮度、对比度等许多参数：4.录像时，如果采用默认的 AVI 文件格式，得到的视频文件会很大。单击按钮“压”，在弹出的“视频压缩”对话框中选择压缩方式“MPEG-4”,这

3、样得到的视频文件会比默认方式小 10 倍以上。5.本程序的视频窗口有自动大小和全屏功能。在全屏状态时，工具栏会自动隐藏。将鼠标移动到屏幕顶部，工具栏又会自动显示出来。遗憾的是，由于水平有限，本程序无法判断是否使用了压缩记录方式，压缩后的文件其扩展名仍然是 AVI。当然，这并不影响播放，录像完成后也可以手动将扩展名修改为 mpg。其次，录像状态下改变视频窗口大小，有时会出现莫名其妙的错误。这个错误时有时无，毫无规律，因此本程序不得不关闭了录像状态下视频窗口自动大小的功能。' '以下是窗体 Form1 的完整代码，在 VB6 和 WindowsXP 下调试通过：'

4、在窗体放置4个控件：'    Command1：在属性窗口将 Index 属性设置为 0'    Check1：  在属性窗口将 Index 属性设置为 0，将 Style 属性设置为 1'    Picture1：不必设置任何属性'    Timer1：  不必设置任何属性'程序调试时要注意：终止程序要用运行中的 Form1 窗口关闭。不要使用 VB 主窗

5、口的菜单命令或 VB 工具栏上的关闭按钮，这样无法关闭打开的视频窗口，导致 VB 无响应。如果 VB 无响应，只有用系统任务管理器才能终止 VB 进程，调试过程中所做的修改将丢失。'本人原创，转载请注明来源：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 参数：Z序列的顶部Const HWND_TopMost = -1    '最前Const HWND_NoTopMost = -2  '不在最前Const HWN

8、D_Bottom = 1      '位于底层Const SWP_NoSize = &H1     'wFlags 参数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        '用户消息开始号，偏移地址:1024Const WM_CAP_GET_CAPSTREAMPTR = WM_User + 1      &

14、#160;  'Const WM_CAP_SET_CALLBACK_ERROR = WM_User + 2       '当出错回调函数Const WM_CAP_SET_CALLBACK_STATUS = WM_User + 3      '当状态（status）改变的时回调函数Const WM_CAP_SET_CALLBACK_YIELD = WM_User + 4    

15、0;  '在流捕获期间的回调函数Const WM_CAP_SET_CALLBACK_FRAME = WM_User + 5       '帧预览回调函数Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_User + 6 '在流捕获期间，当一个新的视频缓存区可用的时候就调用它Const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_User + 7  '在流捕获期间，当一个新的音频缓存区可用的时

16、候就调用它Const WM_CAP_GET_USER_DATA = WM_User + 8 '获取：数据关联到一个捕捉窗口Const WM_CAP_SET_USER_DATA = WM_User + 9 '设置：数据关联到一个捕捉窗口Const WM_CAP_DLG_VideoFormat = WM_User + 41      '对话框：视频格式Const WM_CAP_DLG_VideoSource = WM_User + 42      '

17、;对话框：视频源，枚举视频源，控制颜色、对比度、饱和度的改变。需视频驱动程序支技Const WM_CAP_DLG_VideoDisplay = WM_User + 43     '对话框：视频显示？控制视频捕捉过程中视频在显示器上的显示。对捕捉数据无影响，但会影响数了信号表达式Const WM_CAP_DLG_VideoCompression = WM_User + 46 '对话框：视频压缩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 '设置当前的捕捉文件Const WM_Cap_File_Get_File = WM_User + 21 '得到当前的捕捉文件Const WM_CAP_FILE_ALLOCATE = WM_User + 22 '为捕捉文件预分配空间,

19、从而可以减少被漏掉的帧Const WM_CAP_FILE_SaveAs = WM_User + 23 '将捕捉文件保存为另一个用户指定的文件。这个消息不会改变捕捉文件的名字和内容,                                  &#

20、160;     '由于捕捉文件保留它最初的文件名，因此必须指定个新的文件的文件名来保存Const WM_CAP_FILE_SET_INFOCHUNK = WM_User + 24 '可以把信息块例如文本或者自定义数据插入avi文件。同样用这个消息也可以清除avi文件中的信息块Const WM_CAP_FILE_SaveDIB = WM_User + 25 '把从帧缓存中复制出图像存为设备无关位图书馆（DIB),应用程序也可以使用这两个单帧捕捉消息来编辑帧序列，     

21、                                    '或者创建一个慢速摄影序列Const WM_CAP_Edit_Copy = WM_User + 30 '1054：把缓存中图像复制到剪贴板中Const

22、WM_CAP_SET_AUDIOFORMAT = WM_User + 35 '设置音频格式。设置时传入一个WAVEFORMAT、WAVEFORMATEX、或PCMWAVEOFMAT结构的指针Const WM_CAP_GET_AUDIOFORMAT = WM_User + 36 '来得到音频数据的格式和该格式结构体的大小。默认的捕捉音频格式是mono、8-bit和11kHZ PCMConst WM_CAP_Get_VideoFormat = WM_User + 44 '给捕捉窗口来得到视频格式的结构和该结构的大小。Const WM_CAP_SET_VideoFormat

23、= WM_User + 45 '用来设置视频格式Const WM_CAP_SET_PreView = WM_User + 50 '发送给捕捉窗口来使预览模式有效或者失效Const WM_CAP_SET_Overlay = WM_User + 51 '使窗口处于叠加模式。使叠加模式有效也会自动地使预览模式失效Const WM_CAP_SET_PreViewRate = WM_User + 52 '发送给捕捉窗口来设置在预览模式下帧的显示频率Const WM_CAP_SET_Scale = WM_User + 53 '来使预览模式的缩放有效或者无效Const

24、 WM_CAP_SET_SCROLL = WM_User + 55 '如果是在预览模式或者叠加模式，还可以通过本消息发送给窗口，                                      

25、0;'在窗口里的用户区域设置视频帧的滚动条的位置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    '连接一个视频驱动，成功返回真(1)。连接驱动后，不一定就能显示视频，还要保证摄像头硬件连接良好、未被其他程序使用。Const WM_CAP_DisConnect = WM_User + 11 '断开视频窗口与驱动的连接'   wParam：视频设备序号，从 0 到 9Const WM_CAP_Sequence = WM_User +

29、 62 '开始录像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'录像参数设置和获取'Dim nParms As CaptureParms&#

30、39;SendMessage ctCapWin, WM_CAP_Get_Sequence_Setup, Len(nParms), nParms'获取参数的设置'nParms.fAbortLeftMouse = False '关闭：单击鼠标停止录像的功能。'SendMessage ctCapWin, WM_CAP_Set_Sequence_Setup, Len(nParms), nParms'重新设置参数Private Type CaptureParms '    dwRequestMicroSecPerFr

31、ame As Long  'DWORD    fMakeUserHitOKToCapture As Boolean '开始录像时，是否显示确认对话框，默认为假    wPercentDropForError As Long '每毫秒捕捉帧率，默认66667，即每秒15帧    fYield As Boolean          &#

32、160; 'BOOL:如果为TRUE，将产生一个后台线程来进行视频捕捉    dwIndexSize As Long          'DWORD:视频文件最大的索引入口数    wChunkGranularity As Long    'UINT:以字节为单位表示AVI文件的大小    fUsingD

33、OSMemory As Boolean   'BOOL:未使用    wNumVideoRequested As Long   'UINT:分配视频缓冲区的最大数量    fCaptureAudio As Boolean     '是否捕获音频流，默认值由具体的硬件设置    wNumAudioRequested As Long &#

34、160; '分配的音频缓冲区的最大数量    vKeyAbort As Long            '结束录像的按键，默认为 VK_ESCAPE（Esc键）    fAbortLeftMouse As Boolean   '单击鼠标左键停止录像，默认为真    fAbortRightMous

35、e As Boolean  '单击鼠标右键停止录像，默认为假    fLimitEnabled As Boolean     '是否开启捕获时间限制，默认为真    wTimeLimit As Long           '捕获时间限制（秒），fLimitEnabled 为真时有效  

36、0; fMCIControl As Boolean       'BOOL:为TRUE，控制MCI（媒体设备接口）兼容的视频源    fStepMCIDevice As Boolean    'BOOL    dwMCIStartTime As Long       'DWORD:以毫秒为单位标识MCI设

37、备视频捕捉序列的起始位置，如果fMCIControl成员为FALSE，该成员被忽略    dwMCIStopTime As Long        'DWORD:以毫秒为单位标识MCI设备视频捕捉序列的停止位置，如果fMCIControl成员为FALSE，该成员被忽略    fStepCaptureAt2x As Boolean  'BOOL:为TRUE，捕捉的视频帧使用两个分辨率 

38、0;  wStepCaptureAverageFrames As Long ':在捕捉时每帧图像使用的时间大小    dwAudioBufferSize As Long     '音频缓冲大小，默认0    fDisableWriteCache As Boolean 'Win32系统未使用    AVStreamMaster As Long   

39、0;    '确定在写入AVI文件时，音频流是否控制时钟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 获取所有驱动程序名称和版本信息。例子：'   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 '获得驱动程序名称和版本信息'      S = S + 1'   LoopConst WM_CAP_Get_Status = WM_User + 54 '获取捕捉窗口的当前状态Private Type CapStatus '?    uiImageWidth As Long      

42、60;     '图像宽度，像素    uiImageHeight As Long           '图像高度，像素    fLiveWindow As Boolean          '视频显示是否使用预览  

43、;  fOverlayWindow As Boolean       '视频显示是否使用硬件    fScale As Boolean               '图像是否随窗口大小自动缩放    ptScroll As PointAPI  

44、          'POINT?    fUsingDefaultPalette As Boolean '是否使用默认调色板    fAudioHardware As Boolean       '是否安装了音频波形硬件    fCapFileExists As Boolean

45、60;      '是否生成了正确的捕获文件    dwCurrentVideoFrame As Long    dwCurrentVideoFramesDropped As Long    dwCurrentWaveSamples As Long    dwCurrentTimeElapsedMS As Long   '视频流已录

46、像时间（毫秒）    hPalCurrent As Long              'HPALETTE 当前调色板句柄    fCapturingNow As Boolean         '是否正在进行捕获    dwRetu

47、rn As Long                 '错误返回值，根据这个数值可以调用一个错误回调函数    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  '获取参数的设置  'nParms.fMakeUserHitOKToCapture = True '开始录像时，是否显示确认对话框 &#

49、160;nParms.fYield = True '用一个后台线程来进行视频捕捉  nParms.fAbortLeftMouse = False  '关闭：单击鼠标左键停止录像的功能。  nParms.fAbortRightMouse = False '关闭：单击鼠标右键停止录像的功能  SendMessage ctCapWin, WM_CAP_Set_Sequence_Setup, Len(nParms), nParms '重新设置参数   '

50、ff = SendMessageLong(ctCapWin, WM_CAP_SET_CALLBACK_STATUS, 0, AddressOf CallBackStatus) '状态回调函数'ff = SendMessageLong(ctCapWin, WM_CAP_SET_CALLBACK_FRAME, 0, AddressOf MyFrameCallback) '帧回调函数'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    '如果路径不存在，用默认文件名 C:

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

53、1) <> "" Then nDir = nDir & ""    If Not MakePath(nDir) Then       MsgBox "在指定的位置无法建立目录：" & vbCrLf & nPath, vbInformation, "保存视频文件"       Exit Sub    End If