?? frmtraining.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmTraining
BackColor = &H00000000&
Caption = "Neural Net Training"
ClientHeight = 2280
ClientLeft = 165
ClientTop = 450
ClientWidth = 3855
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "frmTraining.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2280
ScaleWidth = 3855
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame1
Height = 615
Left = 0
TabIndex = 4
Top = 1680
Width = 3855
Begin VB.CommandButton cmdTest
Height = 465
Left = 975
Picture = "frmTraining.frx":0442
Style = 1 'Graphical
TabIndex = 9
Top = 120
Width = 495
End
Begin VB.TextBox txtTrainingSuccess
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Enabled = 0 'False
BeginProperty Font
Name = "Comic Sans MS"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 405
Left = 2610
TabIndex = 7
Text = "0"
Top = 120
Width = 1215
End
Begin VB.CommandButton cmdPlay
Height = 495
Left = 0
Picture = "frmTraining.frx":0884
Style = 1 'Graphical
TabIndex = 6
Top = 120
Width = 495
End
Begin VB.CommandButton cmdStop
Enabled = 0 'False
Height = 495
Left = 480
Picture = "frmTraining.frx":0D27
Style = 1 'Graphical
TabIndex = 5
Top = 120
Width = 495
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Accuracy"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 1560
TabIndex = 8
Top = 180
Width = 975
End
End
Begin MSComDlg.CommonDialog Dialog
Left = 120
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "Open a new Test Image"
End
Begin VB.Frame Frame2
BackColor = &H00C0C0C0&
ForeColor = &H00FFFFFF&
Height = 1755
Left = 0
TabIndex = 0
Top = 0
Width = 3855
Begin VB.PictureBox picEyes
Height = 375
Left = 960
Picture = "frmTraining.frx":1151
ScaleHeight = 20
ScaleMode = 0 'User
ScaleWidth = 30
TabIndex = 10
Top = 480
Width = 495
End
Begin VB.PictureBox pic
Height = 660
Index = 0
Left = 1680
Picture = "frmTraining.frx":14CA
ScaleHeight = 40
ScaleMode = 0 'User
ScaleWidth = 29
TabIndex = 1
Top = 360
Width = 495
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Input Image"
ForeColor = &H00000000&
Height = 255
Left = 120
TabIndex = 3
Top = 1080
Width = 3615
End
Begin VB.Label lblisaface
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "This is a face"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 120
TabIndex = 2
Top = 1320
Visible = 0 'False
Width = 3615
End
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuExit
Caption = "&Exit"
End
End
Begin VB.Menu mnuRecognition
Caption = "&Recognition"
Begin VB.Menu mnuTesting
Caption = "&Testing"
End
Begin VB.Menu mnuCamera
Caption = "&Video"
End
End
Begin VB.Menu mnuTraining
Caption = "Trainin&g"
Begin VB.Menu mnuData
Caption = "&Data Sets"
End
Begin VB.Menu mnuStart
Caption = "&Start"
End
Begin VB.Menu mnuStop
Caption = "St&op"
End
Begin VB.Menu mnuTest
Caption = "T&est"
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu mnuAbout
Caption = "&About"
End
End
End
Attribute VB_Name = "frmTraining"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim faces As New ClassFaceRecogniser
Dim finish As Boolean
Dim Training As Boolean
Private Sub StartTraining()
Dim FileName As String
lblisaface.Caption = ""
Training = True
mnuStart.Enabled = False
mnuStop.Enabled = True
mnuTest.Enabled = False
cmdStop.Enabled = True
cmdPlay.Enabled = False
cmdTest.Enabled = False
Call init
Call faces.load
Call loadSkinColours
Call faces.updateTemplates
Call faces.showFaceTemplate(pic(0))
Call faces.showEyeTemplate(picEyes)
finish = False
While (Not finish)
DoEvents
Call faces.learnFace
'If (Me.WindowState = 1) Then
' Me.Caption = Int(faces.learnFaceSuccess * 100) / 100 & "%"
' Else
' txtTrainingSuccess = Int(faces.learnFaceSuccess * 100) / 100 & "%"
'End If
DoEvents
Call faces.learnEye
If (Me.WindowState = 1) Then
Me.Caption = Int(faces.learnEyeSuccess * 100) / 100 & "%"
Else
txtTrainingSuccess = Int(faces.learnEyeSuccess * 100) / 100 & "%"
End If
Wend
Call faces.save
mnuStart.Enabled = True
mnuTest.Enabled = True
Training = False
End Sub
Private Sub loadFace(Index As Integer, picbox As PictureBox)
On Error GoTo loadImages_err
Dim FileName As String
FileName = App.Path & "\isface" & Trim(CStr(Index)) & ".jpg"
If (Dir$(FileName) <> "") Then
picbox.Picture = LoadPicture(FileName)
End If
loadImages_exit:
Exit Sub
loadImages_err:
MsgBox "frmMain/loadFace/" & Error$(Err)
Resume loadImages_exit
End Sub
Private Sub loadEye(Index As Integer, picbox As PictureBox)
On Error GoTo loadImages_err
Dim FileName As String
FileName = App.Path & "\iseye" & Trim(CStr(Index)) & ".jpg"
If (Dir$(FileName) <> "") Then
picbox.Picture = LoadPicture(FileName)
End If
loadImages_exit:
Exit Sub
loadImages_err:
MsgBox "frmMain/loadEye/" & Error$(Err)
Resume loadImages_exit
End Sub
Private Sub loadNonFace(Index As Integer, picbox As PictureBox)
On Error GoTo loadImages_err
Dim FileName As String
FileName = App.Path & "\nonface" & Trim(CStr(Index)) & ".jpg"
If (Dir$(FileName) <> "") Then
picbox.Picture = LoadPicture(FileName)
End If
loadImages_exit:
Exit Sub
loadImages_err:
MsgBox "frmMain/loadNonFace/" & Error$(Err)
Resume loadImages_exit
End Sub
Private Sub init()
Dim i As Integer
Call faces.init
For i = 0 To 120
Call loadFace(i, pic(0))
Call faces.addFace(pic(0))
Next
For i = 0 To 130
Call loadNonFace(i, pic(0))
Call faces.addNonFace(pic(0))
Next
For i = 0 To 50
Call loadEye(i, picEyes)
Call faces.addEye(picEyes)
Next
For i = 0 To 130
Call loadNonFace(i, picEyes)
Call faces.addNonEye(picEyes)
Next
End Sub
Private Sub stopTraining()
cmdStop.Enabled = False
cmdPlay.Enabled = True
cmdTest.Enabled = True
finish = True
mnuStop.Enabled = False
End Sub
Private Sub TestTraining()
Dim randomFace As Integer
Call faces.init
Call faces.load
If (Int(Rnd * 2) = 1) Then
randomFace = 1 + Int(Rnd * 70)
Call loadFace(randomFace, pic(0))
Else
randomFace = 1 + Int(Rnd * 70)
Call loadNonFace(randomFace, pic(0))
End If
If (faces.isaFace(pic(0))) Then
lblisaface.Caption = "This is a face"
Else
lblisaface.Caption = "This is not a face"
End If
lblisaface.Visible = True
End Sub
Private Sub cmdPlay_Click()
Call StartTraining
End Sub
Private Sub cmdStop_Click()
Call stopTraining
End Sub
Private Sub cmdTest_Click()
Call TestTraining
End Sub
Private Sub Form_Load()
mnuStop.Enabled = False
Training = False
End Sub
Private Sub Form_Resize()
If (Me.WindowState <> 1) Then
Me.Caption = "Neural Net Training"
End If
End Sub
Private Sub mnuAbout_Click()
frmAbout.show 1
End Sub
Private Sub mnuCamera_Click()
On Error GoTo mnuCamera_Click_err
frmTraining.MousePointer = 11
Call stopTraining
Unload frmTraining
frmVideoCapture.show
mnuCamera_Click_exit:
Exit Sub
mnuCamera_Click_err:
If (Err = 364) Then 'object was unloaded
Resume mnuCamera_Click_exit
End If
MsgBox Error$(Err) & " " & Err, , "Error"
Resume mnuCamera_Click_exit
End Sub
Private Sub loadSkinColours()
'loads skin colours
Dim i As Integer
Dim FileName As String
Call faces.clearSkinColours
For i = 1 To 5
FileName = App.Path & "\skin" & Trim(Str(i)) & ".jpg"
pic(0).Picture = LoadPicture(FileName)
Call faces.addSkinColourTemplate(pic(0), 90)
Next
End Sub
Private Sub mnuData_Click()
Me.MousePointer = 11
Call stopTraining
frmDataSets.show
Unload frmTraining
End Sub
Private Sub mnuExit_Click()
Call stopTraining
End
End Sub
Private Sub mnuOpen_Click()
Dialog.Filter = "JPEG Files|*.JPG|GIF Files|*.GIF|Bitmaps|*.BMP"
Dialog.InitDir = "E:\gfx\FaceRec" 'App.Path
Dialog.FilterIndex = 1
Dialog.ShowOpen
If (Dialog.FileName <> "") Then
End If
End Sub
Private Sub mnuStart_Click()
Call StartTraining
End Sub
Private Sub mnuStop_Click()
Call stopTraining
End Sub
Private Sub mnuTest_Click()
Call TestTraining
End Sub
Private Sub mnuTesting_Click()
Call stopTraining
frmTesting.show
Unload frmTraining
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -