classfacerecogniser.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassFaceRecogniser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public faces As New ClassVisionObject
Public eyes As New ClassVisionObject
Public noses As New ClassVisionObject
Public mouths As New ClassVisionObject

Const faceImage_width = 25
Const faceImage_height = 25

Const eyeImage_width = 30
Const eyeImage_height = 20


Public Sub init()
  Call faces.init(faceImage_width, faceImage_height)
  Call eyes.init(eyeImage_width, eyeImage_height)
End Sub



Public Sub addFace(newFace As PictureBox)
  Call faces.addVisionObject(newFace)
End Sub


Public Sub addNonFace(newNonFace As PictureBox)
  Call faces.addNonVisionObject(newNonFace)
End Sub


Public Sub addEye(newEye As PictureBox)
  Call eyes.addVisionObject(newEye)
End Sub


Public Sub addNonEye(newNonEye As PictureBox)
  Call eyes.addNonVisionObject(newNonEye)
End Sub


Public Sub updateTemplates()
'update the templates
  Call faces.updateVisionObjectTemplate
  Call eyes.updateVisionObjectTemplate
End Sub


Public Sub showFaceTemplate(canvas As PictureBox)
  Call faces.showVisionObjectTemplate(canvas)
End Sub


Public Sub showEyeTemplate(canvas As PictureBox)
  Call eyes.showVisionObjectTemplate(canvas)
End Sub


Public Sub load()
  Call faces.load(App.Path & "\faces.rec")
  Call eyes.load(App.Path & "\eyes.rec")
  eyes.LocatorStepSize = 10
End Sub


Public Sub save()
  Call faces.save(App.Path & "\faces.rec")
  Call eyes.save(App.Path & "\eyes.rec")
End Sub


Public Sub learnFace()
  Call faces.Train
End Sub

Public Function learnFaceSuccess() As Single
  learnFaceSuccess = faces.Success
End Function


Public Sub learnEye()
  Call eyes.Train
End Sub

Public Function learnEyeSuccess() As Single
  learnEyeSuccess = eyes.Success
End Function


Public Sub Free()
  Call faces.Free
  Call eyes.Free
End Sub


Public Sub clearSkinColours()
  faces.NoOfSkinColours = 0
End Sub


Public Function IdentifyFaceWithinPicture(scene As PictureBox, topX As Integer, topY As Integer, width As Integer, height As Integer, Optional seekPicture As PictureBox) As String
  
  Const faceShrinkage = 2
  
  faces.LocatorStepSize = 8
  
  If (IsMissing(seekPicture)) Then
    Call faces.IdentifyFacesWithinPicture(scene, topX, topY, width, height, faceShrinkage)
    Else
    Call faces.IdentifyFacesWithinPicture(scene, topX, topY, width, height, faceShrinkage, seekPicture)
  End If

End Function


Public Function IdentifyEyesWithinPicture(scene As PictureBox, topX As Integer, topY As Integer, width As Integer, height As Integer, Optional seekPicture As PictureBox) As String
  
  Const eyeShrinkage = 2
  eyes.LocatorStepSize = 10
  
  If (IsMissing(seekPicture)) Then
    Call eyes.IdentifyWithinPictureLinear(scene, topX, topY, width, height, eyeShrinkage)
    Else
    Call eyes.IdentifyWithinPictureLinear(scene, topX, topY, width, height, eyeShrinkage, seekPicture)
  End If

End Function


Public Sub IdentifySkinWithinPicture(scene As PictureBox, topX As Integer, topY As Integer, width As Integer, height As Integer, Optional seekPicture As PictureBox)
  If (IsMissing(seekPicture)) Then
    Call faces.IdentifySkinWithinPicture(scene, topX, topY, width, height, seekPicture)
    Else
    Call faces.IdentifySkinWithinPicture(scene, topX, topY, width, height)
  End If
End Sub



Public Sub showFaceProbabilities(scene As PictureBox)
  Call faces.showProbabilities(scene)
End Sub

Public Sub showEyeProbabilities(scene As PictureBox)
  Call eyes.showProbabilities(scene)
End Sub


Public Sub addSkinColourTemplate(canvas As PictureBox, Optional Histogram_levels As Variant)
  If (IsMissing(Histogram_levels)) Then
    Call faces.addSkinColourTemplate(canvas)
    Else
    Call faces.addSkinColourTemplate(canvas, Histogram_levels)
  End If
End Sub


Public Sub showSkinColourHistogram(canvas As PictureBox, Index As Integer)
  Call faces.showSkinColourHistogram(canvas, Index)
End Sub


Public Sub setRecognitionThreshold(Threshold As Single)
  faces.Threshold = Threshold
  If (faces.Threshold < 0#) Then
    faces.Threshold = 0#
  End If
  If (faces.Threshold > 0.99) Then
    faces.Threshold = 0.99
  End If
End Sub

Public Function getRecognitionThreshold() As Single
  getRecognitionThreshold = faces.Threshold
End Function


Public Function isaFace(canvas As PictureBox, Optional topX As Variant, Optional topY As Variant, Optional width As Variant, Optional height As Variant) As Boolean
  Dim tx As Integer
  Dim ty As Integer
  Dim w As Integer
  Dim h As Integer
  
  If (IsMissing(topX)) Then
    tx = 0
    ty = 0
    w = canvas.ScaleWidth
    h = canvas.ScaleHeight
    Else
    tx = topX
    ty = topY
    w = width
    h = height
  End If
  
  isaFace = faces.IsaVisionObject(canvas, tx, ty, w, h)
End Function


Public Function isanEye(canvas As PictureBox, Optional topX As Variant, Optional topY As Variant, Optional width As Variant, Optional height As Variant) As Boolean
  Dim tx As Integer
  Dim ty As Integer
  Dim w As Integer
  Dim h As Integer
  
  If (IsMissing(topX)) Then
    tx = 0
    ty = 0
    w = canvas.ScaleWidth
    h = canvas.ScaleHeight
    Else
    tx = topX
    ty = topY
    w = width
    h = height
  End If
  
  isanEye = eyes.IsaVisionObject(canvas, tx, ty, w, h)
End Function


Public Sub showProbabilityMatrix(canvas As PictureBox)
  Call faces.showProbabilityMatrix(canvas)
End Sub