CCD采集控件 vb源代碼

ID:220531 · 發表于 2017-7-18 14:00

CCD采集控件的界面顯示：

vb源程序如下:

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黑下載附件…………

復制代碼

所有資料51hei提供下載:

CCD采集控件代碼.rar (71 KB, 下載次數: 14)

帳號		自動登錄	找回密碼
密碼			立即注冊

久久久久久久999_99精品久久精品一区二区爱城_成人欧美一区二区三区在线播放_国产精品日本一区二区不卡视频_国产午夜视频_欧美精品在线观看免费

CCD采集控件 vb源代碼