classfacerecogniser.cls

实现 USB 图象采集 实现 USB 图象采集

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 imageWidth As Integer
Public imageHeight As Integer

Public NoOfFaces As Integer
Dim Face(1000) As classImageProcessing
Dim EigenFace(1000) As classImageProcessing
Dim NameOfFace(1000) As String

Dim faceTemplate() As Single

Dim testFace As classImageProcessing
Dim testEigenFace As classImageProcessing

Public Identity As classImageProcessing


Public Sub init(image_Width As Integer, image_Height As Integer)
  imageWidth = image_Width
  imageHeight = image_Height
  ReDim faceTemplate(imageWidth, imageHeight)
End Sub


Public Sub addFace(facePicture As PictureBox, faceName As String)
  Set Face(NoOfFaces) = New classImageProcessing
  Set EigenFace(NoOfFaces) = New classImageProcessing
  Set testFace = New classImageProcessing
  Set testEigenFace = New classImageProcessing
  Call Face(NoOfFaces).init(imageWidth, imageHeight)
  Call EigenFace(NoOfFaces).init(imageWidth, imageHeight)
  Call testFace.init(imageWidth, imageHeight)
  Call testEigenFace.init(imageWidth, imageHeight)
  
  Call Face(NoOfFaces).update(facePicture)
  NameOfFace(NoOfFaces) = faceName
  NoOfFaces = NoOfFaces + 1
  
  Call updateFaceTemplate
  Call updateEigenFaces
End Sub


Private Sub updateFaceTemplate()
'calculates an average face template
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  
  For i = 0 To NoOfFaces - 1
    For x = 0 To imageWidth - 1
      For y = 0 To imageHeight - 1
        If (i > 0) Then
          faceTemplate(x, y) = faceTemplate(x, y) + Face(i).getPoint(x, y)
          Else
          faceTemplate(x, y) = Face(i).getPoint(x, y)
        End If
      Next
    Next
  Next
  
  For x = 0 To imageWidth - 1
    For y = 0 To imageHeight - 1
      faceTemplate(x, y) = Int(faceTemplate(x, y) / NoOfFaces)
    Next
  Next
End Sub


Private Sub updateEigenFaces()
'updates all the eigenfaces
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim df As Integer
  
  For i = 0 To NoOfFaces - 1
    For x = 0 To imageWidth - 1
      For y = 0 To imageHeight - 1
        df = Face(i).getPoint(x, y) - faceTemplate(x, y)
        If (df < 0) Then
          df = 0
        End If
        Call EigenFace(i).setPoint(x, y, CByte(df))
      Next
    Next
  Next
End Sub


Public Function Identify(facePicture As PictureBox) As String
'identifies the given image
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim df As Integer
  Dim Distance As Long
  Dim minDistance As Long
  Dim retval As String
  Dim a As Integer
  Dim b As Integer
  
  retval = ""
  Call testFace.update(facePicture)
  
  'calculate the eigenface
  For x = 0 To imageWidth - 1
    For y = 0 To imageHeight - 1
      df = testFace.getPoint(x, y) - faceTemplate(x, y)
      If (df < 0) Then
        df = 0
      End If
      Call testEigenFace.setPoint(x, y, CByte(df))
    Next
  Next
  
  'compare it to other eigenfaces
  minDistance = 99999999#
  For i = 0 To NoOfFaces - 1
    Distance = 0
    For x = 0 To imageWidth - 1
      For y = 0 To imageHeight - 1
        a = EigenFace(i).getPoint(x, y)
        b = testEigenFace.getPoint(x, y)
        df = Abs(a - b)
        Distance = Distance + df
      Next
    Next
    
    If (Distance < minDistance) Then
      minDistance = Distance
      retval = NameOfFace(i)
      Set Identity = Face(i)
    End If
  Next
  
  Identify = retval
  
End Function