CCD采集控件 vb源代码 - - Powered by Discuz!

VERSION 5.00
Object = "{DF6D6558-5B0C-11D3-9396-008029E9B3A6}#1.0#0"; "ezvidc60.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 9030
ClientLeft = 45
ClientTop = 375
ClientWidth = 9585
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 9030
ScaleWidth = 9585
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 615
Left = 2235
TabIndex = 8
Top = 7440
Width = 1335
End
Begin VB.Timer Timer3
Enabled = 0 'False
Interval = 500
Left = 360
Top = 7537
End
Begin VB.TextBox Text1
Height = 390
Left = 1320
Locked = -1 'True
TabIndex = 6
Top = 8280
Width = 8295
End
Begin VB.Timer Timer2
Enabled = 0 'False
Left = 7080
Top = 8280
End
Begin VB.Timer Timer1
Interval = 1000
Left = 8400
Top = 8280
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 5
Top = 8655
Width = 9585
_ExtentX = 16907
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 7117
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
AutoSize = 1
Object.Width = 7117
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
AutoSize = 2
TextSave = "15:18"
EndProperty
EndProperty
End
Begin VB.CommandButton Command5
Caption = "Command5"
Height = 615
Left = 4125
TabIndex = 4
Top = 7440
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 615
Left = 6015
TabIndex = 3
Top = 7440
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 615
Left = 7905
TabIndex = 2
Top = 7440
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 615
Left = 345
TabIndex = 1
Top = 7440
Width = 1335
End
Begin vbVidC60.ezVidCap ezVidCap1
Height = 7200
Left = 0
TabIndex = 0
Top = 0
Width = 9600
_ExtentX = 16933
_ExtentY = 12700
CenterVideo = 0 'False
MakeUserConfirmCapture= 0
AbortLeftMouse = 0
AbortRightMouse = 0
YieldEventEnabled= -1 'True
UsePreciseCaptureControls= -1 'True
End
Begin VB.Label Label1
Caption = "文件路径："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 7
Top = 8348
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public strFileAVI As String '保存视频的文件名
Public strFileBMP As String
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function sndPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1 '允许异步
Private Sub Command1_Click()
Dim Filename
ezVidCap1.CaptureAudio = True
If Command1.Caption = "开始录像" Then
Command1.Caption = "停止录像"
Filename = Format(Now, "yyyymmddhhmmss") '生成日期时间序列
CreateFolder App.Path & "\Temp" '调过函数创建临时文件夹
strFileAVI = App.Path & "\Temp\" & Filename & ".AVI" '保存的视频文件名,下面一句也可以
'strFileAVI = App.Path & "\TEMP\" & Minute(Now) & Second(Now) & ".AVI" '保存的视频文件名
With ezVidCap1
.CaptureFile = strFileAVI '捕获视频文件名
.Preview = True '打开预览
.PreviewRate = 15 '预览速率
.CaptureVideo '开始录制视频
End With
Else
ezVidCap1.CaptureEnd
Command1.Caption = "开始录像"
End If
End Sub
Private Sub Command2_Click()
Dim exit_ As Integer
exit_ = exit1
If exit_ = 11 Or exit_ = 10 Then
Timer3.Enabled = True
End If
End Sub
Private Sub Command3_Click()
ezVidCap1.About
End Sub
Private Sub Command4_Click()
Dim Filename
Dim SaveimageOK As Boolean
Filename = Format(Now, "yyyymmddhhmmss") '生成日期时间序列
CreateFolder App.Path & "\Image" '调过函数创建临时文件夹
strFileBMP = App.Path & "\Image\" & Filename & ".bmp" '生新保存图片文件的名称
On Error Resume Next '错误处理
SaveimageOK = ezVidCap1.SaveDIB(strFileBMP) '保存图片
If SaveimageOK = True Then
sndPlaySound App.Path & "\shutter.wav", 0
Text1.Text = strFileBMP
End If
If Err Then '若有错误
Beep 1000, 100
MsgBox "请先停止录像，再拍照，" & Chr(13) & "错误代码：" & Err.Description, vbInformation, App.Title '显示错误信息
End If
End Sub
Private Sub Command5_Click()
ezVidCap1.ShowDlgVideoSource
End Sub
Private Sub ezVidCap1_CaptureYield() '捕获事件
DoEvents
End Sub
Private Sub Form_Load()
If App.PrevInstance Then
Beep 1000, 100
fanhuizhi = MsgBox("程序正在运行，请关闭本程序", vbOKOnly, "警告")
If fanhuizhi = 1 Then
End
End If
End If
Text1.Text = "显示最后一次拍照、录制或者正在录制文件的路径"
Form1.Caption = "ccd采集控件可录像和截图（自行研究）"
Command1.Caption = "开始录像"
Command2.Caption = "退出"
Command3.Caption = "关于控件"
Command4.Caption = "拍照"
Command5.Caption = "选择视频源"
End Sub
Private Sub ezVidCap1_StatusMessage(ByVal StatCode As Long, ByVal StatString As String)
'捕获状态事件
If StatCode <> 0 Then '状态码不为0
StatusBar1.Panels(1).Text = Left(StatString, InStr(StatString, ")")) '显示状态信息
' If StatCode = 301 Then '若是结束状态
' mnuRecStart.Caption = "开始录制" '修改菜单标题
' frmCamera.Hide '隐藏摄像头窗体
' frmVideo.Show '显示预览窗体
' End If
End If
DoEvents
End Sub
Private Sub ezVidCap1_PreRollComplete() '准备开始录制
Dim lRet As Long
lRet = MsgBox("单击“确定”按钮开始录制！" & Chr(13) & "单击“取消”按钮取消录制！", vbOKCancel, App.Title) '显示确认信息
If lRet = vbOK Then '单击“确定”按钮
ezVidCap1.PreciseCaptureStart '开始录制
Text1.Text = strFileAVI
Else '单击“取消”按钮
ezVidCap1.PreciseCaptureCancel '放弃录制
Timer2.Enabled = True '错开文件是否被占用时间
Timer2.Interval = 500
End If
End Sub
Private Sub DeleteFile(FilePath As String)
……………………
…………限于本文篇幅余下代码请从51黑下载附件…………

复制代码