classvisionobject.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 = "ClassVisionObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public imageWidth As Integer
Public imageHeight As Integer
Dim imageTranslation As Integer  'maximum image translation
Const TranslationRatio = 0.05

Public noOfVisionObjects As Integer
Dim VisionObject(1000) As classImageProcessing
Dim eigenVisionObject(1000) As classImageProcessing
Dim isVisionObject(1000) As Boolean

'the average VisionObject
Dim VisionObjectTemplate As classImageProcessing

Dim testVisionObject As classImageProcessing
Dim testEigenVisionObject As classImageProcessing
Dim testScene As classImageProcessing
Dim nnImage As classImageProcessing

Public NoOfSkinColours As Integer
Dim skinColourTemplate(10) As classImageProcessing

Dim ProbabilityMatrix As classImageProcessing
Public LocatorStepSize As Integer

'store the location and probabilities of likely VisionObjects within a picture
Public NoOfProbabilities As Integer
Dim VisionObjectProbability(10000, 8) As Single
Dim maxProbability As Single

Dim NNet As ClassBackprop
Const no_of_hiddens = 5

Public Success As Single
Dim good As Double
Dim bad As Double

'VisionObject probability threshold
Public Threshold As Single

Const CLASSIFICATION_VisionObject = 0
Const CLASSIFICATION_NONVisionObject = 1


Public Sub init(image_Width As Integer, image_height As Integer)
  imageWidth = image_Width
  imageHeight = image_height
  imageTranslation = 0 'Int(imageHeight * TranslationRatio)
  Set testVisionObject = New classImageProcessing
  Call testVisionObject.init(imageWidth + (imageTranslation * 2), imageHeight + (imageTranslation * 2))
  Set testEigenVisionObject = New classImageProcessing
  Call testEigenVisionObject.init(imageWidth + (imageTranslation * 2), imageHeight + (imageTranslation * 2))
  Set VisionObjectTemplate = New classImageProcessing
  Call VisionObjectTemplate.init(imageWidth + (imageTranslation * 2), imageHeight + (imageTranslation * 2))
  Set nnImage = New classImageProcessing
  Call nnImage.init(imageWidth + (imageTranslation * 2), imageHeight + (imageTranslation * 2))
  Set NNet = New ClassBackprop
  Call NNet.init((image_Width + (imageTranslation * 2)) * (image_height + (imageTranslation * 2)), no_of_hiddens, 2)
  NNet.learningRate = 0.3
  Success = 0
  Threshold = 0.95
  LocatorStepSize = 4
End Sub


Public Sub Free()
  Set testVisionObject = Nothing
  Set testEigenVisionObject = Nothing
  Set VisionObjectTemplate = Nothing
  Set nnImage = Nothing
  Set NNet = Nothing
End Sub


Public Sub showNNimage(canvas As PictureBox)
'displays the image loaded into the neural net inputs
  Call NNet.getImage(nnImage)
  Call nnImage.show(canvas)
End Sub


Public Sub showTrainingImage(canvas As PictureBox, index As Integer)
'displays the image loaded into the neural net inputs
  Call VisionObject(index).show(canvas)
End Sub



Public Sub Train()
  Dim VisionObjectIndex As Integer
  Dim classification As Integer
  
  VisionObjectIndex = Int(Rnd * noOfVisionObjects)
  Call NNet.setImage(eigenVisionObject(VisionObjectIndex), 0, 0, imageWidth, imageHeight, imageTranslation)
  If (isVisionObject(VisionObjectIndex)) Then
    Call NNet.setClassification(CLASSIFICATION_VisionObject)
    Else
    Call NNet.setClassification(CLASSIFICATION_NONVisionObject)
  End If
  
  Call NNet.update
  
  classification = NNet.getClassification
  If (isVisionObject(VisionObjectIndex)) Then
    If (classification = CLASSIFICATION_VisionObject) Then
      good = good + 1
      Else
      bad = bad + 1
    End If
    Else
    If (classification = CLASSIFICATION_NONVisionObject) Then
      good = good + 1
      Else
      bad = bad + 1
    End If
  End If
  Success = (good / (good + bad)) * 100
  
End Sub


Public Function TrainingError() As Single
  TrainingError = NNet.BPerrorTotal
End Function


Public Function IsaVisionObject(VisionObjectPic As PictureBox, Optional topX As Variant, Optional topY As Variant, Optional width As Variant, Optional height As Variant) As Boolean
  Dim x As Integer
  Dim y As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim dp As Integer
  
  If (IsMissing(topX)) Then
    Call testVisionObject.update(VisionObjectPic)
    Else
    Call testVisionObject.update(VisionObjectPic, topX, topY, width, height)
  End If
  
  'calculate the eigenVisionObject
  For x = 0 To imageWidth - 1
    For y = 0 To imageHeight - 1
      p1 = VisionObjectTemplate.getPoint(x, y)
      p2 = testVisionObject.getPoint(x, y)
      dp = Abs(p1 - p2)
      Call testEigenVisionObject.setPoint(x, y, CByte(dp))
    Next
  Next
  
  Call NNet.setImage(testEigenVisionObject, 0, 0, imageWidth + imageTranslation, imageHeight + imageTranslation)
  Call NNet.feedForward
  If (NNet.getClassification = CLASSIFICATION_VisionObject) Then
    IsaVisionObject = True
    Else
    IsaVisionObject = False
  End If
End Function


Public Sub addVisionObject(VisionObjectPicture As PictureBox)
  If (noOfVisionObjects < 1000) Then
    Set VisionObject(noOfVisionObjects) = New classImageProcessing
    Call VisionObject(noOfVisionObjects).init(imageWidth, imageHeight)
    Call VisionObject(noOfVisionObjects).update(VisionObjectPicture)
    isVisionObject(noOfVisionObjects) = True
    
    'create an eigenVisionObject
    Set eigenVisionObject(noOfVisionObjects) = New classImageProcessing
    Call eigenVisionObject(noOfVisionObjects).init(imageWidth, imageHeight)
    
    noOfVisionObjects = noOfVisionObjects + 1
    
    'update the average VisionObject template
    'Call updateVisionObjectTemplate
  End If
End Sub


Public Sub updateVisionObjectTemplate()
'calculates the average VisionObject
  Dim dp As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim av() As Double
  Dim p As Single
  Dim n As Integer
  
  'calculate the average object
  ReDim av(imageWidth, imageHeight)
  n = 0
  For i = 0 To noOfVisionObjects - 1
    If (isVisionObject(i)) Then
      n = n + 1
      For x = 0 To imageWidth - 1
        For y = 0 To imageHeight - 1
          p = VisionObject(i).getPoint(x, y)
          av(x, y) = av(x, y) + p
        Next
      Next
    End If
  Next
  
  'create the template
  For x = 0 To imageWidth - 1
    For y = 0 To imageHeight - 1
      Call VisionObjectTemplate.setPoint(x, y, CByte(av(x, y) / n))
    Next
  Next
  
  'update eigenVisionObjects
  For i = 0 To noOfVisionObjects - 1
    For x = 0 To imageWidth - 1
      For y = 0 To imageHeight - 1
        p1 = VisionObjectTemplate.getPoint(x, y)
        p2 = VisionObject(i).getPoint(x, y)
        dp = Abs(p1 - p2)
        Call eigenVisionObject(i).setPoint(x, y, CByte(dp))
      Next
    Next
  Next
  
End Sub


Public Sub showVisionObjectTemplate(canvas As PictureBox)
  Call VisionObjectTemplate.show(canvas)
End Sub


Public Sub addSkinColourTemplate(VisionObjectPicture As PictureBox, Optional Histogram_levels As Variant)
  If (NoOfSkinColours < 10) Then
    Set skinColourTemplate(NoOfSkinColours) = New classImageProcessing
    Call skinColourTemplate(NoOfSkinColours).init(1, 1)
    If (Not IsMissing(Histogram_levels)) Then
      Call skinColourTemplate(NoOfSkinColours).setHistogramLevels(Int(Histogram_levels))
    End If
    Call skinColourTemplate(NoOfSkinColours).updateColourHistogram(VisionObjectPicture)
    NoOfSkinColours = NoOfSkinColours + 1
  End If
End Sub


Public Sub addNonVisionObject(NonVisionObjectPicture As PictureBox)
  If (noOfVisionObjects < 1000) Then
    Set VisionObject(noOfVisionObjects) = New classImageProcessing
    Call VisionObject(noOfVisionObjects).init(imageWidth, imageHeight)
    Call VisionObject(noOfVisionObjects).update(NonVisionObjectPicture)
    isVisionObject(noOfVisionObjects) = False
    
    'create an eigenVisionObject
    Set eigenVisionObject(noOfVisionObjects) = New classImageProcessing
    Call eigenVisionObject(noOfVisionObjects).init(imageWidth, imageHeight)
        
    noOfVisionObjects = noOfVisionObjects + 1
  End If
End Sub


Public Sub showSkinColourHistogram(pic As PictureBox, index As Integer)
  If (NoOfSkinColours > index) Then
    Call skinColourTemplate(index).showColourHistogram(pic)
  End If
End Sub




Public Sub showProbabilities(canvas As PictureBox)
  Dim i As Integer
  Dim tx As Integer
  Dim ty As Integer
  Dim width As Integer
  Dim height As Integer
  Dim probability As Single
  
  Call testScene.show(canvas)
  
  'transparent fill style
  canvas.FillStyle = 1
  canvas.DrawWidth = 1
  
  For i = 0 To NoOfProbabilities - 1
    probability = VisionObjectProbability(i, 4)
    If (probability > maxProbability * Threshold) Then
      tx = VisionObjectProbability(i, 0)
      ty = VisionObjectProbability(i, 1)
      width = VisionObjectProbability(i, 2)
      height = VisionObjectProbability(i, 3)
    
      If (probability < maxProbability * 0.99) Then
        canvas.Line (tx, ty)-(tx + width, ty + height), RGB(255, 0, 0), B
        Else
        canvas.Line (tx, ty)-(tx + width, ty + height), RGB(0, 255, 0), B
      End If
    End If
  Next
  
End Sub


Private Sub calcProbabilityMatrix()
  Dim i As Integer
  Dim tx As Integer
  Dim ty As Integer
  Dim width As Integer
  Dim height As Integer
  Dim matrix_x As Integer
  Dim matrix_y As Integer
  Dim x As Integer
  Dim y As Integer
  Dim probability As Single
  Dim probs() As Single
  Dim minProb As Single
  
  'create a probability matrix based on the test scene
  Set ProbabilityMatrix = Nothing
  Set ProbabilityMatrix = New classImageProcessing
  Call ProbabilityMatrix.init(testScene.width / LocatorStepSize, testScene.height / LocatorStepSize)
  ReDim probs(ProbabilityMatrix.width, ProbabilityMatrix.height)
  
  'calculate
  minProb = 1
  For i = 0 To NoOfProbabilities - 1
    tx = VisionObjectProbability(i, 0)
    ty = VisionObjectProbability(i, 1)
    width = VisionObjectProbability(i, 2)
    height = VisionObjectProbability(i, 3)
        
    matrix_x = (tx + (width / 2)) / LocatorStepSize
    matrix_y = (ty + (height / 2)) / LocatorStepSize
        
    probability = probs(matrix_x, matrix_y)
    If (probability > 0) Then
      probability = (probability + VisionObjectProbability(i, 4)) / 2
      Else
      probability = VisionObjectProbability(i, 4)
    End If
    If (probability < minProb) Then
      minProb = probability
    End If
    probs(matrix_x, matrix_y) = probability