视频捕捉/采集

开发平台：
Visual Basic

frmMain.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.MDIForm frmMain 
   BackColor       =   &H8000000C&
   Caption         =   "摄像头监视系统"
   ClientHeight    =   3390
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   5580
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.StatusBar sbStatusBar 
      Align           =   2  'Align Bottom
      Height          =   270
      Left            =   0
      TabIndex        =   0
      Top             =   3120
      Width           =   5580
      _ExtentX        =   9843
      _ExtentY        =   476
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   4180
            Text            =   "状态"
            TextSave        =   "状态"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   2
            TextSave        =   "2009-1-3"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "22:08"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList imlToolbarIcons 
      Left            =   720
      Top             =   1200
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   7
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0000
            Key             =   "key"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":031A
            Key             =   "rec"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":2A26
            Key             =   "capt"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":5311
            Key             =   "full"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":7932
            Key             =   "set"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":9FB4
            Key             =   "stop"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":C890
            Key             =   "pre"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar tbToolBar 
      Align           =   1  'Align Top
      Height          =   660
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   5580
      _ExtentX        =   9843
      _ExtentY        =   1164
      ButtonWidth     =   1032
      ButtonHeight    =   1005
      Appearance      =   1
      ImageList       =   "imlToolbarIcons"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   8
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "预览"
            Object.ToolTipText     =   "预览视频"
            ImageKey        =   "pre"
            Style           =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "全屏"
            Object.ToolTipText     =   "全屏显示"
            ImageKey        =   "full"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "录制"
            Object.ToolTipText     =   "录制视频"
            ImageKey        =   "rec"
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "停止"
            Object.ToolTipText     =   "停止录制视频"
            ImageKey        =   "stop"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "拍照"
            Object.ToolTipText     =   "抓拍单帧视频"
            ImageKey        =   "capt"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "设置"
            Object.ToolTipText     =   "设置视频格式"
            ImageKey        =   "set"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileAVI 
         Caption         =   "视频文件(&A)"
      End
      Begin VB.Menu mnuFileBMP 
         Caption         =   "图片文件(&B)"
      End
      Begin VB.Menu mnuBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "视图(&V)"
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "工具栏(&T)"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "状态栏(&B)"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuSet 
      Caption         =   "设置(&S)"
      Begin VB.Menu mnuSetVedio 
         Caption         =   "视频格式(&A)"
      End
      Begin VB.Menu mnuSetDisp 
         Caption         =   "视频设置(&S)"
      End
      Begin VB.Menu mnuSetCompress 
         Caption         =   "视频压缩(&Z)"
      End
      Begin VB.Menu mnuSetRate 
         Caption         =   "设置帧率(&F)"
      End
      Begin VB.Menu mnuSetAudio 
         Caption         =   "音频格式(&U)"
      End
      Begin VB.Menu mnuSetSource 
         Caption         =   "选择视频源(&C)"
      End
   End
   Begin VB.Menu mnuPre 
      Caption         =   "预览(&P)"
      Begin VB.Menu mnuPre1 
         Caption         =   "预览(&P)"
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuPreFull 
         Caption         =   "全屏(&F)"
         Shortcut        =   {F3}
      End
   End
   Begin VB.Menu mnuRec 
      Caption         =   "录制(&R)"
      Begin VB.Menu mnuRecStart 
         Caption         =   "开始录制(&R)"
         Shortcut        =   {F4}
      End
      Begin VB.Menu mnuRecAudio 
         Caption         =   "允许录制声音(&A)"
      End
      Begin VB.Menu mnuRecSec 
         Caption         =   "录制时长(&T)"
      End
      Begin VB.Menu mnuBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRecCapt 
         Caption         =   "拍照(&C)"
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuBar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRecShow 
         Caption         =   "回放录制(&S)"
         Shortcut        =   {F6}
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
         Shortcut        =   {F1}
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)   '设置窗体左边坐标
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000) '设置窗体顶端坐标
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500) '设置窗体宽度
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)   '设置窗体高度
    CreateFolder App.Path & "TEMP"    '调过函数创建临时文件夹
    EnableMenu  '调用过程设置各菜单的可用状态
    sngTime = 0 '设置录制时长为0(不限时长)
    strFileBMP = App.Path & "TEMPTMP.BMP" '保存的图片文件名
    strFileAVI = App.Path & "TEMPTMP.AVI"    '保存的视频文件名
    Me.sbStatusBar.Panels(1).Text = "摄像头版本：" & _
        frmCamera.ezVidCap1.GetDriverVersion()  '在状态栏显示摄像头型号
    Load frmCamera  '载入摄像头窗体
    frmCamera.ezVidCap1.TimeLimitEnabled = False    '禁止摄像头控件的录取时间限制
    frmCamera.Hide  '隐藏摄像头窗体
    Load frmVideo   '载入预览窗体
    frmVideo.Show   '显示预览窗体
    mnuPre1.Checked = True  '选中预览菜单
    Me.tbToolBar.Buttons(1).Value = tbrPressed  '设置“预览”按钮为按下状态
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left  '保存窗体左边坐标
        SaveSetting App.Title, "Settings", "MainTop", Me.Top    '保存窗体顶端坐标
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width    '保存窗体宽度
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height  '保存窗体高度
    End If
    End '结束应用程序
End Sub
Private Sub mnuFileAVI_Click()  '视频文件
    With frmFile    '设置显示窗体的属性
        .Caption = "设置保存视频的文件名称" '窗体标题
        .Label1.Caption = "视频文件名："    '标签控件显示的内容
        .strSaveType = "AVI"    '保存类型
        .strFilter = "视频文件(*.avi)|*.avi"    '过滤字符串
        .txtFile.Text = strFileAVI  '文本框的默认值
        .Show vbModal   '显示窗体
    End With
End Sub
Private Sub mnuFileBMP_Click()  '图片文件
    With frmFile   '设置显示窗体的属性
        .Caption = "设置图片的文件开始字符" '窗体标题
        .Label1.Caption = "图片文件名："  '标签控件显示的内容
        .strSaveType = "BMP"  '保存类型
        .strFilter = "位图文件(*.bmp,*.dib)|*.bmp"   '过滤字符串
        .txtFile.Text = strFileBMP '文本框的默认值
        .Show vbModal  '显示窗体
    End With
End Sub
Private Sub mnuPre1_Click() '预览
    mnuPre1.Checked = Not mnuPre1.Checked   '反选菜单项
    If mnuPre1.Checked Then '若选中菜单
        Me.tbToolBar.Buttons(1).Value = tbrPressed  '设置“预览”按钮为按下状态
        frmVideo.Show   '显示预览窗体
    Else    '若未选中菜单
        Me.tbToolBar.Buttons(1).Value = tbrUnpressed    '设置“预览”按钮为未按下状态
        frmVideo.Hide   '隐藏预览窗体
    End If
End Sub
Private Sub mnuPreFull_Click()  '全屏
    frmFull.Show
End Sub
Private Sub mnuRecAudio_Click() '录制声音
    mnuRecAudio.Checked = Not mnuRecAudio.Checked   '反选项单项
    If mnuRecAudio.Checked Then '若选中了录制声音菜单
        frmCamera.ezVidCap1.CaptureAudio = True '设置控件捕获声音
    Else
        frmCamera.ezVidCap1.CaptureAudio = False    '设置控件不捕获声音
    End If
End Sub
Private Sub mnuRecCapt_Click()  '拍照
    Dim str1 As String, str2 As String, i As Integer
    If frmCamera.ezVidCap1.Capturing Then Exit Sub  '若正在录制状态，则退出
    If Trim(strFileBMP) = "" Then   '若未设置保存图片的文件
        Call mnuFileBMP_Click   '调用设置图片文件名菜单的代码
    End If
    If strFileBMP = "" Then Exit Sub    '若文件名为空，则退出
    str2 = Left(strFileBMP, Len(strFileBMP) - 4) '去掉扩展名
    i = InStr(1, str2, "_") '查找下划线
    If i > 0 Then   '若有下划线
        str2 = Left(str2, InStr(1, str2, "_") - 1)  '获取下划线左侧的字符
    End If
    str1 = Format(Now, "yyyymmddhhmmss")    '生成日期时间序列
    strFileBMP = str2 & "_" & str1 & ".bmp" '生新保存图片文件的名称
    On Error Resume Next    '错误处理
    Call frmCamera.ezVidCap1.SaveDIB(strFileBMP)    '保存图片
    Beep    '响铃提示
    If Err Then '若有错误
        MsgBox Err.Description, vbInformation, App.Title    '显示错误信息
    End If
End Sub
Private Sub mnuRecSec_Click()   '录制时长
    frmTime.Show
End Sub
Private Sub mnuRecShow_Click()
    frmShow.Show
End Sub
Private Sub mnuRecStart_Click() '开始录制
    Dim str1 As String, str2 As String, i As Integer
    If mnuRecStart.Caption = "开始录制" And frmCamera.ezVidCap1.Capturing = False Then    '若菜单为“开始录制”状态
        If Trim(strFileAVI) = "" Then   '若未设置保存视频的文件
            Call mnuFileAVI_Click    '调用设置视频文件名菜单的代码
        End If
        If Trim(strFileAVI) = "" Then Exit Sub    '若文件名为空，则退出
        str2 = Left(strFileAVI, Len(strFileAVI) - 4) '去掉扩展名
        i = InStr(1, str2, "_") '查找下划线
        If i > 0 Then   '若有下划线
            str2 = Left(str2, InStr(1, str2, "_") - 1)  '获取下划线左侧的字符
        End If
        str1 = Format(Now, "yyyymmddhhmmss")    '生成日期时间序列
        strFileAVI = str2 & "_" & str1 & ".AVI" '生新保存视频文件的名称
        mnuRecStart.Caption = "停止录制"    '修改菜单标题
        frmCamera.Show  '显示摄像头控件窗体
        With frmVideo
            .timer1.Enabled = False '禁止时钟控件
            .Hide   '隐藏预览窗体
        End With
        With frmCamera.ezVidCap1    '设置摄像头控件属性
            .CaptureFile = strFileAVI   '捕获视频文件名
            .Preview = True '打开预览
            .PreviewRate = 15   '预览速率
            .CaptureVideo   '开始录制视频
        End With
    Else    '若菜单为“停止录制”状态
        mnuRecStart.Caption = "开始录制"    '修改菜单标题
        frmCamera.ezVidCap1.CaptureEnd  '结束录制
        frmCamera.Hide  '隐藏摄像头窗体
        With frmVideo
            .Show   '显示预览窗体
            .timer1.Enabled = True  '允许时钟控件
        End With
    End If
End Sub
Private Sub mnuSetAudio_Click() '音频格式
    frmCamera.ezVidCap1.ShowDlgAudioFormat    '显示声音格式对话框
End Sub
Private Sub mnuSetCompress_Click()
    frmCamera.ezVidCap1.ShowDlgCompressionOptions '显示“视频压缩”对话框
End Sub
Private Sub mnuSetDisp_Click()
    frmCamera.ezVidCap1.ShowDlgVideoDisplay   '显示视频设置对话框
End Sub
Private Sub mnuSetRate_Click()  '设置帧率
    frmCaptureRate.Show '显示设置帧率的窗体
End Sub
Private Sub mnuSetSource_Click()    '选择视频源
    frmCamera.ezVidCap1.ShowDlgVideoSource
End Sub
Private Sub mnuSetVedio_Click() '视频格式
    frmCamera.ezVidCap1.ShowDlgVideoFormat  '显示视频格式对话框
    If mnuPre1.Checked Then '若选中了预览菜单
        Unload frmVideo '卸载预览窗体
        frmVideo.Show   '显示预览窗体
        mnuPre1.Checked = True  '选中预览菜单
        Me.tbToolBar.Buttons(1).Value = tbrPressed  '按下“预览”按钮
    End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)   '处理工具按钮
    On Error Resume Next
    Select Case Button.Key
        Case "预览"
            Call mnuPre1_Click  '调用预览菜单的单击事件代码
        Case "全屏"
            Call mnuPreFull_Click   '调用全屏菜单的单击事件代码
        Case "录制"
            Call mnuRecStart_Click  '调用录制菜单的单击事件代码
        Case "停止"
            Call mnuRecStart_Click  '调用录制菜单的单击事件代码
        Case "拍照"
            Call mnuRecCapt_Click   '调用拍照菜单的单击事件代码
        Case "设置"
            Call mnuSetVedio_Click  '调用视频格式菜单的单击事件代码
    End Select
End Sub
Private Sub mnuHelpAbout_Click()    '关于
    frmAbout.Show vbModal, Me   '显示关于窗体
End Sub
Private Sub mnuViewStatusBar_Click()    '状态栏
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked '反选状态栏菜单项
    sbStatusBar.Visible = mnuViewStatusBar.Checked  '设置状态栏的显示状态
End Sub
Private Sub mnuViewToolbar_Click()  '工具栏
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked '反选工具栏菜单项
    tbToolBar.Visible = mnuViewToolbar.Checked  '设置工具栏的显示状态
End Sub
Private Sub mnuFileExit_Click() '退出
    Unload Me    '卸载窗体
End Sub
Private Sub EnableMenu() '检查菜单可用状态
    mnuSetAudio.Enabled = False '禁止音频设置菜单项
    mnuSetVedio.Enabled = False    '禁止视频格式菜单项
    mnuSetDisp.Enabled = False  '禁止视频设置菜单项
    mnuSetSource.Enabled = False    '禁止选择视频源菜单项
    mnuSetCompress.Enabled = False  '禁止视频压缩菜单项
    With frmCamera.ezVidCap1    '设置摄像头控件属性
        .Preview = True '打开预览
        .PreviewRate = 15   '设置预览速率
        If .NumCapDevs > 0 Then '若摄像头速度大于0
            mnuSetCompress.Enabled = True   '允许视频压缩菜单项
        End If
        If .HasAudio Then mnuSetAudio.Enabled = True    '允许音频设置菜单项
        If .HasDlgFormat Then mnuSetVedio.Enabled = True    '允许视频格式菜单项
        If .HasDlgDisplay Then mnuSetDisp.Enabled = True    '允许视频设置菜单项
        If .HasDlgSource Then mnuSetSource.Enabled = True   '允许选择视频源菜单项
    End With
End Sub

						