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

Public width As Integer
Public height As Integer
Dim image() As Byte

Dim edgeTraced() As Boolean
Dim temp() As Boolean
Public TraceEdgesThresh As Integer
Public minEdgeLength As Integer
Dim traceDirection As Single
Dim traceRadius As Integer
Dim traceX As Single
Dim traceY As Single

Dim angleHistogram(18) As Integer

Public edgesWidth As Integer
Public edgesHeight As Integer
Dim Edges() As Byte

Public processType As Integer

Public EdgeThreshold As Single
Dim averageContrast As Double

Const image_raw = 0
Const image_red = 1
Const image_green = 2
Const image_blue = 3
Const image_edges = 4
Const IMAGE_MOVEMENT = 5


Public scanInterval As Integer


'masks used for edge detection
Const NO_OF_EDGE_MASKS = 14
Dim EdgeMask(NO_OF_EDGE_MASKS)
Const NO_OF_EDGE_TYPES = 5
Dim EdgeHistogram(NO_OF_EDGE_TYPES) As Integer

Const EDGE_VECTOR_LENGTH = 200
Dim EdgeVector(5, EDGE_VECTOR_LENGTH) As Single
Dim currEdgeVector As Integer
Dim maxEdgeVectorIntensity As Integer



Private Function traceSearch(Optional beginSearch As Boolean) As Boolean
'move the trace point in a curcular motion until a new feature is found
'returns TRUE when a new feature is located
  
  Dim tx As Integer
  Dim ty As Integer
  
  traceSearch = False
  
  If (beginSearch) Then
    traceDirection = 0
    traceRadius = 90
  End If
  
  traceX = traceX + Cos((traceDirection / 180) * 3.14)
  traceY = traceY + Sin((traceDirection / 180) * 3.14)
  traceDirection = traceDirection + traceRadius
  If (traceDirection > 360) Then
    traceDirection = 0
    traceRadius = traceRadius - 1
    If (traceRadius < 0) Then
      traceRadius = 0
    End If
  End If
  
  If (traceX < 0) Then
    traceX = 0
  End If
  If (traceX >= width) Then
    traceX = width - 1
  End If
  If (traceY < 0) Then
    traceY = 0
  End If
  If (traceY >= height) Then
    traceY = height - 1
  End If
  
  tx = Int(traceX)
  ty = Int(traceY)
  
  If ((image(tx, ty) > TraceEdgesThresh) And (Not edgeTraced(tx, ty))) Then
    traceSearch = True
  End If
End Function


Private Sub calcAngleHistogram()
'calculates a histogram from the angles of edge traces
  Dim i As Integer
  Dim dx As Integer
  Dim dy As Integer
  Dim length As Integer
  Dim angle As Single
  Dim intensity As Single
  
  
  For i = 0 To 17
    angleHistogram(i) = 0
  Next
    
  For i = 0 To currEdgeVector - 1
    dx = EdgeVector(0, i) - EdgeVector(2, i)
    dy = Abs(EdgeVector(1, i) - EdgeVector(3, i))
    length = Sqr((dx * dx) + (dy * dy))
    If (length > 0) Then
      angle = (Acos(dy / length) / 3.14) * 180
      If (dx < 0) Then
        angle = 180 - angle
      End If
      angle = Int(angle / 10)
      intensity = 1 'EdgeVector(4, i) / 255
      angleHistogram(angle) = angleHistogram(angle) + (length * intensity)
    End If
  Next
  
End Sub


Private Sub initEdgeMasks()
'defines edge masks
' 1 = horizontal
' 2 = vertical
' 3 = diagonal left
' 4 = diagonal right
' 5 = cross
  
  Dim mask
  Dim i As Integer
  Dim mstr As String
    
  'Lines -
  EdgeMask(0) = Array(1, 1, 1, _
                      0, 0, 0, _
                      0, 0, 0, _
                      1)
  EdgeMask(1) = Array(0, 0, 0, _
                      1, 1, 1, _
                      0, 0, 0, _
                      1)
  EdgeMask(2) = Array(0, 0, 0, _
                      0, 0, 0, _
                      1, 1, 1, _
                      1)
  'Lines |
  EdgeMask(3) = Array(1, 0, 0, _
                      1, 0, 0, _
                      1, 0, 0, _
                      2)
  EdgeMask(4) = Array(0, 1, 0, _
                      0, 1, 0, _
                      0, 1, 0, _
                      2)
  EdgeMask(5) = Array(0, 0, 1, _
                      0, 0, 1, _
                      0, 0, 1, _
                      2)
  'Diagonals
  EdgeMask(6) = Array(0, 0, 1, _
                      0, 1, 0, _
                      1, 0, 0, _
                      3)
  EdgeMask(7) = Array(0, 1, 0, _
                      1, 0, 0, _
                      0, 0, 0, _
                      3)
  EdgeMask(8) = Array(0, 0, 0, _
                      0, 0, 1, _
                      0, 1, 0, _
                      3)
  EdgeMask(9) = Array(1, 0, 0, _
                      0, 1, 0, _
                      0, 0, 1, _
                      4)
  EdgeMask(10) = Array(0, 1, 0, _
                      0, 0, 1, _
                      0, 0, 0, _
                      4)
  EdgeMask(11) = Array(0, 0, 0, _
                      1, 0, 0, _
                      0, 1, 0, _
                      4)
  'Crosses
  EdgeMask(12) = Array(1, 0, 1, _
                      0, 1, 0, _
                      1, 0, 1, _
                      5)
  EdgeMask(13) = Array(0, 1, 0, _
                      1, 1, 1, _
                      0, 1, 0, _
                      5)
  'nothing
  'EdgeMask(14) = Array(0, 0, 0, _
  '                     0, 0, 0, _
  '                     0, 0, 0, _
  '                     0) 'last number indicates edge type
  'EdgeMask(15) = Array(1, 1, 1, _
  '                     1, 1, 1, _
  '                     1, 1, 1, _
  '                     0)
End Sub


Private Sub initEdgeMasks_old()
'defines edge masks
' 0 = horizontal
' 1 = vertical
' 2 = diagonal left
' 3 = diagonal right
' 4 = cross
  
  Dim mask
  Dim i As Integer
  Dim mstr As String
    
  'Lines -
  EdgeMask(0) = Array(1, 1, 1, _
                      0, 0, 0, _
                      0, 0, 0, _
                      1)
  EdgeMask(1) = Array(0, 0, 0, _
                      1, 1, 1, _
                      0, 0, 0, _
                      1)
  EdgeMask(2) = Array(0, 0, 0, _
                      0, 0, 0, _
                      1, 1, 1, _
                      1)
  'Lines double -
  EdgeMask(3) = Array(1, 1, 1, _
                      1, 1, 1, _
                      0, 0, 0, _
                      1)
  EdgeMask(4) = Array(0, 0, 0, _
                      1, 1, 1, _
                      1, 1, 1, _
                      1)
  'Lines |
  EdgeMask(5) = Array(1, 0, 0, _
                      1, 0, 0, _
                      1, 0, 0, _
                      2)
  EdgeMask(6) = Array(0, 1, 0, _
                      0, 1, 0, _
                      0, 1, 0, _
                      2)
  EdgeMask(7) = Array(0, 0, 1, _
                      0, 0, 1, _
                      0, 0, 1, _
                      2)
  EdgeMask(8) = Array(1, 1, 0, _
                      1, 1, 0, _
                      1, 1, 0, _
                      2)
  EdgeMask(9) = Array(0, 1, 1, _
                      0, 1, 1, _
                      0, 1, 1, _
                      2)
  'Diagonals
  EdgeMask(10) = Array(0, 0, 1, _
                       0, 1, 0, _
                       1, 0, 0, _
                       3)
  EdgeMask(11) = Array(0, 0, 1, _
                       0, 1, 1, _
                       1, 1, 0, _
                       3)
  EdgeMask(12) = Array(0, 1, 1, _
                       1, 1, 0, _
                       1, 0, 0, _
                       3)
  EdgeMask(13) = Array(1, 0, 0, _
                       0, 1, 0, _
                       0, 0, 1, _
                       4)
  EdgeMask(14) = Array(1, 1, 0, _
                       0, 1, 1, _
                       0, 0, 1, _
                       4)
  EdgeMask(15) = Array(1, 0, 0, _
                       1, 1, 0, _
                       0, 1, 1, _
                       4)
  'Crosses
  EdgeMask(16) = Array(1, 0, 1, _
                       0, 1, 0, _
                       1, 0, 1, _
                       5)
  EdgeMask(17) = Array(0, 1, 0, _
                       1, 1, 1, _
                       0, 1, 0, _
                       5)
  'nothing
  EdgeMask(18) = Array(0, 0, 0, _
                       0, 0, 0, _
                       0, 0, 0, _
                       0) 'last number indicates edge type
  EdgeMask(19) = Array(1, 1, 1, _
                       1, 1, 1, _
                       1, 1, 1, _
                       0)
End Sub


Public Sub traceEdges()
'traces edges within the image
  Dim finished As Boolean
  Dim x As Integer
  Dim y As Integer
  Dim traced As Boolean
  
  finished = False
  traced = False
  x = 0
  y = 0
  While (Not finished)
    x = x + 1
    If (x = width) Then
      y = y + 1
      x = 0
    End If
    If (y < height) Then
      If ((edgeTraced(x, y) = False) And (image(x, y) > TraceEdgesThresh)) Then
        traced = traceEdgesFromPoint(x, y, 0)
      End If
      Else
      x = 0
      y = 0
      If (Not traced) Then
        finished = True
      End If
      traced = False
    End If
  Wend
  
  Call sortEdgeVector
  Call calcAngleHistogram
  
End Sub


Public Sub traceEdges_old()
'traces edges within the image
  
  Dim x As Integer
  Dim y As Integer
  
  traceX = 0
  traceY = 0
  Call traceSearch(True)
  While (traceRadius > 0)
    If (traceSearch()) Then
      traceRadius = 90
      x = Int(traceX)
      y = Int(traceY)
      If (traceEdgesFromPoint(x, y, 0)) Then
        traceX = x
        traceY = y
      End If
    End If
  Wend
  
  'Call sortEdgeVector
  Call calcAngleHistogram
  
End Sub


Private Sub diffuseEdges()
'diffuses edges information
'this allows edge tracing to be more noise tollerant
  Dim x As Integer
  Dim y As Integer
  Dim i As Integer
  Dim value As Integer
  
  For i = 0 To 1
    For x = 1 To width - 2
      For y = 1 To height - 2
        If (image(x, y) > TraceEdgesThresh) Then
          image(x, y) = 255
          
          'value = image(x - 1, y - 1)
          'value = value + image(x - 1, y)
          'value = value + image(x - 1, y + 1)
          'value = value + image(x + 1, y - 1)
          'value = value + image(x + 1, y)
          'value = value + image(x + 1, y + 1)
          'value = value + image(x, y + 1)
          'value = value + image(x, y - 1)
          'value = value / 8
          'image(x, y) = value
        End If
      Next
    Next
  Next
  
End Sub


Public Function traceEdgesFromPoint(ByRef x As Integer, ByRef y As Integer, ByRef edgeLength As Integer) As Boolean
'traces along edges starting at the given point
  Dim i As Integer
  Dim j As Integer
  Dim sx As Integer
  Dim sy As Integer
  Dim xx As Integer
  Dim yy As Integer
  Dim pathFound As Boolean
  Dim initialEdgeLength As Integer
  Dim mindirection As Single
  Dim maxdirection As Single
  Dim initialX As Integer
  Dim initialY As Integer
  Dim max As Integer
  Dim value As Integer
  Dim intensity As Single
  Dim direction As Integer
  Static averagedirection As Single
  Dim directionDifference As Integer
  Dim thresh As Integer
    
  initialX = x
  initialY = y
  xx = initialX
  yy = initialY
  initialEdgeLength = edgeLength
  intensity = 0
  thresh = 0 ' TraceEdgesThresh / 2
  
  If (initialEdgeLength = 0) Then
    For i = 0 To width - 1
      For j = 0 To height - 1
        temp(i, j) = False
      Next