1、VB 代码 VB 小程序：实现 USB 摄像头视频图像的监控、截图、录像2012-04-19 weikong66 文章来源 阅 2583 转 81转藏到我的图书馆微信分享：VB 代码 VB 小程序：实现 USB 摄像头视频图像的监控、截图、录像2010-10-10 0:36当前位置：首页 VB 小程序 实现 USB 摄像头视频图像的监控、截图、录像54. 实现 USB 摄像头视频图像的监控、截图、录像本程序是“摄像头视频监控”的改进，仅用四个按钮实现对摄像头视频的监控、截图、录像，可以分别保存为图片文件和视频文件。保存的视频文件可以用媒体播放机（Windows Media Player）、 暴
2、风影音等软件进行播放，轻松实现家庭录像制作。利用电脑配备的 USB 摄像头进行视频控制，要用到两个 API 函数：capCreateCaptureWindow 和 SendMessage。capCreateCaptureWindow 的作用是创建一个视频窗口，摄像头捕捉到的视频图像在此窗口内显示，函数返回值就是代表此窗口的句柄。此函数的 VB 声明：Private Declare Function capCreateCaptureWindow Lib “avicap32.dll“ Alias “capCreateCaptureWindowA“ (ByVal lpszWindowName As
3、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 LongDim ctCapWin As Long各参数意义如下：lpszWindowName 视频窗口的窗口标题dwStyle 窗口模式，设置值可用下面数值，也可组合使用：WS_Child：视频窗口是子窗口，位于应用程序主窗口内。否则是独立的窗口。WS_Visible：视频窗口可见W
4、S_Caption：视频窗口有标题栏WS_ThickFrame：视频窗口有边框X 视频窗口位置 x 坐标Y 视频窗口位置 y 坐标nWidth 视频窗口宽度nHeight 视频窗口高度hwndParent 创建视频窗口的主窗口，设置为：Me.hWndnID 视频 ID视频窗口创建后，剩下的事情就是用 SendMessage 向该窗口发送各种消息，实现对摄像头的控制。 以下是完整代码，在 VB6 和 WindowsXP 下调试通过：在窗体放置 4 个控件：Command1、Command2、Command3、Command4程序调试时要注意：终止程序要用运行中的 Form1 窗口关闭。不要使用
5、VB 主窗口的菜单命令或 VB 工具栏上的关闭按钮，这样无法关闭打开的视频窗口，导致 VB 无响应。如果 VB 无响应，只有用系统任务管理器才能终止 VB 进程，调试过程中所做的修改将丢失。本人原创，转载请注明来源：http:/ 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 capCreateCap
6、tureWindow 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 LongDim ctCapWin As Long, ctAviPath As String, ctPicPat
7、h As String, ctConnect As Boolean视频窗口控制消息常数Const WS_Child = &H40000000: Const WS_Visible = &H10000000Const WS_Caption = &HC00000: Const WS_ThickFrame = &H40000Const WM_User = &H400 用户消息开始号Const WM_CAP_Connect = WM_User + 10 连接一个摄像头Const WM_CAP_DisConnect = WM_User + 11 断开一个摄像头的连接Const WM_CAP_Set_Pre
8、View = WM_User + 50 使预览模式有效或者失效Const WM_CAP_Set_Overlay = WM_User + 51 使窗口处于叠加模式，也会自动地使预览模式失效。Const WM_CAP_Set_PreViewRate = WM_User + 52 设置在预览模式下帧的显示频率Const WM_CAP_Edit_Copy = WM_User + 30 将当前图像复制到剪贴板Const WM_CAP_Sequence = WM_User + 62 开始录像，录像未结束前不会返回。Const WM_Cap_File_Set_File = WM_User + 20 设置当前
9、的视频捕捉文件Const WM_Cap_File_Get_File = WM_User + 21 得到当前的视频捕捉文件Private Sub Form_Load()设置按钮及位置，实际可以在控件设计期间完成Dim H1 As LongMe.Caption = “摄像头控制“Command1.Caption = “连接“: Command1.ToolTipText = “连接摄像头“Command2.Caption = “断开“: Command2.ToolTipText = “断开与摄像头的连接“Command3.Caption = “截图“: Command3.ToolTipText =
10、“将当前图像保存为图片文件“Command4.Caption = “录像“: Command4.ToolTipText = “开始录像，保存为视频文件“H1 = Me.TextHeight(“A“)Command1.Move H1 * 0.5, H1 * 0.5, H1 * 4, H1 * 2Command2.Move H1 * 5, H1 * 0.5, H1 * 4, H1 * 2Command3.Move H1 * 10, H1 * 0.5, H1 * 4, H1 * 2Command4.Move H1 * 15, H1 * 0.5, H1 * 4, H1 * 2读出用户设置Call Re
11、adSaveSetKjEnabled TrueEnd SubPrivate Sub Command1_Click()创建视频窗口和连接摄像头Dim nStyle As Long, T As LongIf ctCapWin = 0 Then 创建一个视频窗口，大小：640*480T = Me.ScaleY(Command1.Top + Command1.Height * 1.1, Me.ScaleMode, 3) 视频窗口垂直位置：像素nStyle = WS_Child + WS_Visible + WS_Caption + WS_ThickFrame 子窗口(在Form1 内)+可见+标题栏+
12、边框nStyle = WS_Child + WS_Visible 视频窗口无标题栏和边框nStyle = WS_Visible 视频窗口为独立窗口，关闭主窗口视频窗口也会自动关闭ctCapWin = capCreateCaptureWindow(“我创建的视频窗口“, nStyle, 0, T, 640, 480, Me.hWnd, 0)End If将视频窗口连接到摄像头，如无后面两条语句视频窗口画面不会变化SendMessage ctCapWin, WM_CAP_Connect, 0, 0 连接摄像头SendMessage ctCapWin, WM_CAP_Set_PreView, 1, 0
13、 第三个参数：1-预览模式有效,0-预览模式无效SendMessage ctCapWin, WM_CAP_Set_PreViewRate, 30, 0 第三个参数：设置预览显示频率为每秒 30 帧ctConnect = True: KjEnabled True“请检检查摄像头连接，并确定没有其他用户和程序使用。“End SubPrivate Sub Command2_Click()SendMessage ctCapWin, WM_CAP_DisConnect, 0, 0 断开摄像头连接ctConnect = False: KjEnabled TrueEnd SubPrivate Sub Com
14、mand3_Click()截图,保存为图片文件Dim F As String, S As Long, nPath As String, nStr As StringnPath = Trim(ctPicPath)If nPath = “ Then nPath = App.Path & “MyPic“If Right(nPath, 1) “ ThenIf vbCancel = MsgBox(“文件已存在，覆盖此文件吗？“ & vbCrLf & F, vbInformation + vbOKCancel, “截图 - 文件覆盖“) Then Exit SubOn Error GoTo CuoSetA
15、ttr F, 0Kill FOn Error GoTo 0End IfClipboard.Clear: SendMessage ctCapWin, WM_CAP_Edit_Copy, 0, 0 将当前图像复制到剪贴板SavePicture Clipboard.GetData, F 保存为 Bmp 图像，要保存为 jpg 格式，参见：将图片保存或转变为 JPG 格式Exit SubCuo:MsgBox “无法写文件：“ & vbCrLf & F, vbInformation, “保存文件“End SubPrivate Sub Command4_Click()用摄像头录像，并保存为视频文件如果不设
16、置文件路径和名称，或路径不存在，视频窗口会使用默认文件名 C:CAPTURE.AVIDim F As String, S As Long, nPath As String, nStr As StringnPath = Trim(ctAviPath)If nPath = “ Then nPath = App.Path & “MyVideo“If Right(nPath, 1) “ ThenIf vbCancel = MsgBox(“文件已存在，覆盖此文件吗？“ & vbCrLf & F, vbInformation + vbOKCancel, “视频 - 文件覆盖“) Then Exit Sub
17、On Error GoTo CuoSetAttr F, 0Kill FOn Error GoTo 0End IfMe.Caption = “摄像头控制 - 正在录像（任意位置单击鼠标停止）“: KjEnabled False: DoEventsSendMessage ctCapWin, WM_Cap_File_Set_File, 0, ByVal F 设置录像保存的文件SendMessage ctCapWin, WM_CAP_Sequence, 0, 0 开始录像。录像未结束前不会返回Me.Caption = “摄像头控制“: KjEnabled TrueExit SubCuo:MsgBox
18、“无法写文件：“ & vbCrLf & F, vbInformation, “保存文件“End SubPrivate Function CutPathFile(nStr As String, nPath As String, nFile As String)分解出文件和目录Dim I As Long, S As LongFor I = 1 To Len(nStr)If Mid(nStr, I, 1) = “ Then S = I 查找最后一个目录分隔符NextIf S 0 ThennPath = Left(nStr, S): nFile = Mid(nStr, S + 1)ElsenPath = “: nFile = nStrEnd IfEnd FunctionPrivate Function MakePath(ByVal nPath As String) As Boolean逐级建立目录,成功返回 TDim I As Long, Path1 As String, IsPath As BooleannPath = Trim(nPath)If Right(nPath, 1) VB 小程序 USB 摄像头视频图像的监控、截图、录像
