?? classfacerecogniser.cls
字號:
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -