frmtraining.frm

优秀的面部识别程序,用VB开发的

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