?? frmvideocapture.frm
字號:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmVideoCapture
BackColor = &H8000000C&
Caption = "Video"
ClientHeight = 2775
ClientLeft = 2850
ClientTop = 3405
ClientWidth = 6165
Icon = "frmVideoCapture.frx":0000
LinkTopic = "Form1"
ScaleHeight = 185
ScaleMode = 3 'Pixel
ScaleWidth = 411
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox picRed
Height = 2145
Left = 2955
MousePointer = 2 'Cross
ScaleHeight = 204.412
ScaleMode = 0 'User
ScaleWidth = 187.097
TabIndex = 8
Top = 5010
Visible = 0 'False
Width = 2670
End
Begin VB.Frame Frame1
Height = 615
Left = 0
TabIndex = 4
Top = 2160
Width = 2655
Begin VB.CommandButton cmdStop
Enabled = 0 'False
Height = 495
Left = 480
Picture = "frmVideoCapture.frx":0442
Style = 1 'Graphical
TabIndex = 6
Top = 120
Width = 495
End
Begin VB.CommandButton cmdPlay
Height = 495
Left = 0
Picture = "frmVideoCapture.frx":086C
Style = 1 'Graphical
TabIndex = 5
Top = 120
Width = 495
End
Begin MSComctlLib.Slider sldSensitivity
Height = 375
Left = 1050
TabIndex = 7
Top = 195
Width = 1530
_ExtentX = 2699
_ExtentY = 661
_Version = 393216
Min = 50
Max = 99
SelStart = 50
TickStyle = 3
TickFrequency = 5
Value = 50
End
End
Begin VB.PictureBox picFaces
BackColor = &H00000000&
Height = 2160
Left = 30
MousePointer = 2 'Cross
ScaleHeight = 100
ScaleMode = 0 'User
ScaleWidth = 100
TabIndex = 3
Top = 0
Width = 2655
End
Begin VB.PictureBox picMotion
Height = 1080
Left = 510
MousePointer = 2 'Cross
ScaleHeight = 54.839
ScaleMode = 0 'User
ScaleWidth = 56.364
TabIndex = 2
Top = 5010
Visible = 0 'False
Width = 1455
End
Begin VB.Timer timGrab
Interval = 500
Left = 120
Top = 1440
End
Begin VB.PictureBox picCapture2
BackColor = &H00000000&
Height = 2160
Left = 2640
MousePointer = 2 'Cross
ScaleHeight = 100
ScaleMode = 0 'User
ScaleWidth = 100
TabIndex = 1
Top = 0
Width = 3495
End
Begin VB.PictureBox picCapture
Height = 2160
Left = 2640
MousePointer = 2 'Cross
ScaleHeight = 2100
ScaleWidth = 3435
TabIndex = 0
Top = 0
Width = 3495
End
Begin VB.Shape shaBorder2
BackColor = &H00808080&
BackStyle = 1 'Opaque
BorderColor = &H00808080&
FillColor = &H00404040&
Height = 3495
Left = 0
Top = 3360
Width = 2655
End
Begin VB.Shape shaBorder
BackColor = &H00808080&
BackStyle = 1 'Opaque
BorderColor = &H00808080&
FillColor = &H00404040&
Height = 3495
Left = 0
Top = 0
Width = 2655
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuRecognition
Caption = "&Recognition"
Begin VB.Menu mnuTraining
Caption = "&Training"
End
Begin VB.Menu mnuTesting
Caption = "T&esting"
End
End
Begin VB.Menu mnuOptions
Caption = "&Options"
Begin VB.Menu mnuFormat
Caption = "&Format..."
Enabled = 0 'False
End
Begin VB.Menu mnuSource
Caption = "S&ource..."
Enabled = 0 'False
End
Begin VB.Menu mnuDisplay
Caption = "&Display..."
Enabled = 0 'False
End
Begin VB.Menu mnuspacer5
Caption = "-"
End
Begin VB.Menu mnuCompression
Caption = "&Compression..."
End
Begin VB.Menu mnuspacer6
Caption = "-"
End
Begin VB.Menu mnuDriver
Caption = "<none>"
Enabled = 0 'False
Index = 0
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu mnuAbout
Caption = "&About"
End
End
End
Attribute VB_Name = "frmVideoCapture"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private hCapWnd As Long ' Handle to the Capture Windows
Private nDriverIndex As Long ' video driver index (default 0)
Private m_CapParams As CAPTUREPARMS
'Public property to prevent reentrancy in Form_Resize event
Public AutoSizing As Boolean
Public vidCapture As New ClassVideoCapture
Public LeftBorderWidth As Integer
Public minBorderHeight As Integer
Dim Busy As Boolean
Dim Play As Boolean
Dim VideoConnected As Boolean
Dim faces As New ClassFaceRecogniser
Public Property Get capwnd() As Long
'read-only public property to allow other forms to retrieve hwnd of Cap Window
capwnd = hCapWnd
End Property
Public Property Get MenuHeight() As Long
'read-only properties for sizing
MenuHeight = GetSystemMetrics(SM_CYMENU)
End Property
Public Property Get CaptionHeight() As Long
CaptionHeight = GetSystemMetrics(SM_CYCAPTION)
End Property
Public Sub grabFrame(pic As PictureBox)
Dim FileName As String
Dim retVal As Boolean
Busy = True
Call capGrabFrame(hCapWnd)
FileName = App.Path & "\bob.bmp"
retVal = capFileSaveDIB(hCapWnd, FileName)
If (retVal = False) Then
MsgBox "Problem saving frame", vbInformation, App.Title
End If
pic.Picture = LoadPicture(FileName)
Call vidCapture.update(pic)
Busy = False
End Sub
Private Sub cmdPlay_Click()
Play = True
cmdStop.Enabled = True
cmdPlay.Enabled = False
sldSensitivity.Enabled = False
End Sub
Private Sub cmdStop_Click()
Play = False
cmdStop.Enabled = False
cmdPlay.Enabled = True
sldSensitivity.Enabled = True
End Sub
Private Sub Form_Load()
Dim retVal As Boolean
Dim numDevs As Long
Dim FileName As String
Const image_Width = 25
Const image_Height = 25
Busy = True
Play = False
VideoConnected = False
frmVideoCapture.MousePointer = 11
FileName = App.Path & "\faces.rec"
Call faces.init
Call faces.load
sldSensitivity.Value = Int(faces.getRecognitionThreshold * 100)
LeftBorderWidth = shaBorder.width
minBorderHeight = shaBorder.height
Set vidCapture = New ClassVideoCapture
Call vidCapture.init(image_Width, image_Height)
vidCapture.processRGB = False
'detect hardware
numDevs = VBEnumCapDrivers(Me)
If (numDevs <> 0) Then
nDriverIndex = Val(GetSetting(App.Title, "driver", "index", "0"))
'if invalid entry is in registry use default (0)
If (mnuDriver.UBound < nDriverIndex) Then
nDriverIndex = 0
End If
mnuDriver(nDriverIndex).Checked = True
'Create Capture Window
hCapWnd = capCreateCaptureWindow("VB CAP WINDOW", WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, picCapture.hWnd, 0)
If (hCapWnd <> 0) Then
retVal = ConnectCapDriver(hCapWnd, nDriverIndex)
If (retVal = False) Then
MsgBox "could not connect to capture driver", vbInformation, App.Title
Else
#If (USECALLBACKS = 1) Then
'if we have a valid capwnd we can enable our status callback function
Call capSetCallbackOnStatus(hCapWnd, AddressOf StatusProc)
#End If
VideoConnected = True
End If
Else
MsgBox "could not create capture window", vbCritical, App.Title
End If
Else
MsgBox "No capture hardware detected", vbCritical, App.Title
End If
frmVideoCapture.MousePointer = 0
Busy = False
If (Not VideoConnected) Then
Unload frmVideoCapture
frmTesting.show
End If
End Sub
Public Sub Form_Resize()
Dim retVal As Boolean
Dim capStat As CAPSTATUS
'Get the capture window attributes
retVal = capGetStatus(hCapWnd, capStat)
If (retVal) Then
picCapture.left = LeftBorderWidth
picCapture.width = capStat.uiImageWidth
picCapture.ScaleWidth = picCapture.width
picCapture.height = capStat.uiImageHeight
picCapture.ScaleHeight = picCapture.height
picCapture2.left = LeftBorderWidth
picCapture2.width = capStat.uiImageWidth
picCapture2.ScaleWidth = 100
picCapture2.height = capStat.uiImageHeight
picCapture2.ScaleHeight = 100
'picFaces.left = LeftBorderWidth
'picFaces.width = capStat.uiImageWidth
'picFaces.ScaleWidth = 100
'picFaces.height = capStat.uiImageHeight
'picFaces.ScaleHeight = 100
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call faces.Free
If (VideoConnected) Then
'save trivial settings
If (Me.WindowState = vbDefault) Then
Call SaveSetting(App.Title, "preferences", "left", Me.left)
Call SaveSetting(App.Title, "preferences", "top", Me.top)
End If
'unsubclass if necessary
#If USECALLBACKS = 1 Then
'Disable status callback
Call capSetCallbackOnStatus(hCapWnd, 0&)
#End If
'disconnect VFW driver
Call basVFW.capDriverDisconnect(hCapWnd)
'destroy CapWnd
If (hCapWnd <> 0) Then Call DestroyWindow(hCapWnd)
End If
End Sub
Private Sub mnuAbout_Click()
frmAbout.show 1
End Sub
Private Sub mnuCompression_Click()
Call capDlgVideoCompression(hCapWnd)
End Sub
Private Sub mnuDisplay_Click()
Call capDlgVideoDisplay(hCapWnd)
End Sub
Private Sub mnuDriver_Click(Index As Integer)
Dim retVal As Boolean
retVal = ConnectCapDriver(hCapWnd, Index)
If (retVal = False) Then
MsgBox "could not connect to capture driver", vbInformation, App.Title
Else
Call SaveSetting(App.Title, "driver", "index", CStr(Index)) 'save selected device index
End If
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuFormat_Click()
Call capDlgVideoFormat(hCapWnd)
Call ResizeCaptureWindow(hCapWnd, LeftBorderWidth, minBorderHeight)
End Sub
Private Sub mnuSource_Click()
'Display the Video Source dialog when "Source" is selected from the menu bar
Call capDlgVideoSource(hCapWnd)
End Sub
Private Sub findFaces()
If (Play) Then
Call faces.IdentifyFaceWithinPicture(picCapture2, 0, 0, picCapture2.ScaleWidth, picCapture2.ScaleHeight)
End If
DoEvents
If (Play) Then
Call faces.showFaceProbabilities(picFaces)
End If
End Sub
Private Sub mnuTesting_Click()
frmTesting.show
Unload frmVideoCapture
End Sub
Private Sub mnuTraining_Click()
frmTraining.show
Unload frmVideoCapture
End Sub
Private Sub sldSensitivity_Change()
Call faces.setRecognitionThreshold(sldSensitivity.Value / 100)
End Sub
Private Sub timGrab_Timer()
If (Not Busy) And (Play) Then
Call grabFrame(picCapture2)
DoEvents
If (Play) Then
Call findFaces
End If
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -