classimageprocessing.cls

这是一种利用神经网络来进行人脸识别的算法。

  Dim value As Double
  Dim RGBval As Long
  Dim pixels As Double
  Dim maxCol As Long
  Dim edgeValue As Single
  Dim screenWidth As Single
  Dim screenHeight As Single
  Dim screenLeft As Single
  Dim screenTop As Single
  
  If (Not IsMissing(left)) And (Not IsMissing(top)) Then
    screenLeft = left
    screenTop = top
    screenWidth = wdth
    screenHeight = hght
    Else
    screenLeft = 0
    screenTop = 0
    screenWidth = canvas.ScaleWidth
    screenHeight = canvas.ScaleHeight
  End If
  
  w = CInt(screenWidth / width)
  If (w < 1) Then
    w = 1
  End If
  h = CInt(screenHeight / height)
  If (h < 1) Then
    h = 1
  End If

  pixels = w * h
  maxCol = RGB(255, 255, 255)
  For x = 0 To width - 1
    For y = 0 To height - 1
      edgeTraced(x, y) = False
      screenX = screenLeft + ((x / width) * screenWidth)
      screenY = screenTop + ((y / height) * screenHeight)
      value = 0
      For xx = screenX To screenX + w - 1 Step scanInterval
        For yy = screenY To screenY + h - 1 Step scanInterval
          
          RGBval = canvas.Point(xx, yy)
          Select Case processType
            Case 0  'greyscale
              value = value + (RGBval / maxCol)
            Case 1  'red
              value = value + ((RGBval And 255) / 255)
            Case 2  'green
              value = value + ((RGBval And 65280) / 65280)
            Case 3  'blue
              value = value + ((RGBval And 16711680) / 16711680)
            Case 5  'motion
              value = value + (RGBval / maxCol)
          End Select
          
        Next
      Next
      value = (value / pixels) * 255
            
      If (processType <> 5) Then
        image(x, y) = value
        Else
        'difference between successive images
        image(x, y) = Abs(value - image(x, y))
      End If
      
    Next
  Next

End Sub


Public Sub updateDirect(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)
'import a picture pixel-for-pixel without any scaling
'processtype = 0   greyscale
'              1   red
'              2   green
'              3   blue
'              4   edges
'              5   movement

  Dim x As Integer
  Dim y As Integer
  Dim screenX As Integer
  Dim screenY As Integer
  Dim w As Integer
  Dim h As Integer
  Dim value As Double
  Dim RGBval As Long
  Dim pixels As Double
  Dim maxCol As Long
  Dim edgeValue As Single
  Dim screenWidth As Single
  Dim screenHeight As Single
  Dim screenLeft As Single
  Dim screenTop As Single
  
  If (Not IsMissing(left)) And (Not IsMissing(top)) Then
    screenLeft = left
    screenTop = top
    screenWidth = wdth
    screenHeight = hght
    Else
    screenLeft = 0
    screenTop = 0
    screenWidth = canvas.ScaleWidth
    screenHeight = canvas.ScaleHeight
  End If
  
  w = CInt(screenWidth / width)
  If (w < 1) Then
    w = 1
  End If
  h = CInt(screenHeight / height)
  If (h < 1) Then
    h = 1
  End If

  pixels = w * h
  maxCol = RGB(255, 255, 255)
  For x = 0 To width - 1
    For y = 0 To height - 1
      edgeTraced(x, y) = False
      screenX = screenLeft + ((x / width) * screenWidth)
      screenY = screenTop + ((y / height) * screenHeight)
      RGBval = canvas.Point(screenX, screenY)
      Select Case processType
        Case 0  'greyscale
          value = (RGBval / maxCol)
        Case 1  'red
          value = ((RGBval And 255) / 255)
        Case 2  'green
          value = ((RGBval And 65280) / 65280)
        Case 3  'blue
          value = ((RGBval And 16711680) / 16711680)
      End Select
      
      image(x, y) = value
    Next
  Next

End Sub



Public Sub getImageEdges(rawImage As classImageProcessing)
'extracts edges from the given image
  Dim x As Integer
  Dim y As Integer
  Dim value As Single
  Dim scalex As Single
  Dim scaley As Single
  Dim xx As Integer
  Dim yy As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim avContrast As Double
  
  scalex = rawImage.width / width
  scaley = rawImage.height / height
  
  currEdgeVector = 0
  maxEdgeVectorIntensity = 0
  
  avContrast = 0
  For x = 1 To width - 1
    For y = 1 To height - 1
      edgeTraced(x, y) = False
      xx = x * scalex
      yy = y * scaley
      If ((xx >= 1) And (yy >= 1)) Then
        p1 = rawImage.getPoint(xx, yy)
        p2 = rawImage.getPoint(xx - 1, yy)
        value = Abs(p1 - p2)
        p2 = rawImage.getPoint(xx, yy - 1)
        value = value + Abs(p1 - p2)
        value = value / (255 * 2)
        avContrast = avContrast + value
        'If (Abs(value - averageContrast) < EdgeThreshold) Then
        If (value < EdgeThreshold) Then
          value = 0
          Else
          value = 255 * value
        End If
        image(x, y) = value
      End If
    Next
  Next
  
  'calc average contast
  avContrast = avContrast / (width * height)
  averageContrast = avContrast
  If (averageContrast < 0.01) Then
    averageContrast = 0.01
  End If
  
  'calc threshold used for tracing along edges
  TraceEdgesThresh = (averageContrast * 255) * 0.1
  
  'Call diffuseEdges
  
  'Call getEdges
  Call traceEdges
  
End Sub


Public Sub getImageContours(rawImage As classImageProcessing)
'extracts edges from the given image
  Dim x As Integer
  Dim y As Integer
  Dim value As Single
  Dim scalex As Single
  Dim scaley As Single
  Dim xx As Integer
  Dim yy As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim value2 As Single
  Dim max As Single
  
  scalex = rawImage.width / width
  scaley = rawImage.height / height
  
  currEdgeVector = 0
  maxEdgeVectorIntensity = 0
  max = 1 - EdgeThreshold
  
  For x = 1 To width - 1
    For y = 1 To height - 1
      edgeTraced(x, y) = False
      xx = x * scalex
      yy = y * scaley
      If ((xx >= 1) And (yy >= 1)) Then
        p1 = rawImage.getPoint(xx, yy)
        p2 = rawImage.getPoint(xx - 1, yy)
        value = Abs(p1 - p2)
        p2 = rawImage.getPoint(xx, yy - 1)
        value = value + Abs(p1 - p2)
        value = value / (255 * 2)
        value2 = value - EdgeThreshold
        If (value2 < 0) Then
          value = 0
          Else
          value = 255 - (255 * (value2 / max))
        End If
        image(x, y) = value
      End If
    Next
  Next
    
End Sub




Public Sub show(canvas As PictureBox)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim value As Byte
  Dim c As Long
  Dim i As Integer
  
  If (processType <> 4) Then
  
  canvas.FillStyle = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      value = image(x, y)
      Select Case processType
        Case 1 'red
          c = RGB(value, 0, 0)
        Case 2 'green
          c = RGB(0, value, 0)
        Case 3 'blue
          c = RGB(0, 0, value)
        Case 4 'edges
          value = 255 - value
          c = RGB(value, value, value)
        Case Else
          c = RGB(value, value, value)
      End Select
      canvas.FillColor = c
      screenX(0) = (x / width) * canvas.ScaleWidth
      screenY(0) = (y / height) * canvas.ScaleHeight
      screenX(1) = ((x + 1) / width) * canvas.ScaleWidth
      screenY(1) = ((y + 1) / height) * canvas.ScaleHeight
      canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
    Next
  Next
  
  Else
  
    'Call showEdges(canvas)
    canvas.Cls
    Call showEdgeTraces(canvas)
  
  End If
  
End Sub


Public Sub showEdgeTraces(canvas As PictureBox)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim value As Byte
  Dim c As Long
  Dim i As Integer
  
  'canvas.Cls
  canvas.FillStyle = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      If (edgeTraced(x, y) = True) Then
        c = RGB(230, 230, 230)
        canvas.FillColor = c
        screenX(0) = (x / width) * canvas.ScaleWidth
        screenY(0) = (y / height) * canvas.ScaleHeight
        screenX(1) = ((x + 1) / width) * canvas.ScaleWidth
        screenY(1) = ((y + 1) / height) * canvas.ScaleHeight
        canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c, B
      End If
    Next
  Next
  
  Call showEdgeVector(canvas)
  
End Sub

Public Sub showEdgeVector(canvas As PictureBox)
  Dim x1 As Integer
  Dim y1 As Integer
  Dim x2 As Integer
  Dim y2 As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim value As Byte
  Dim c As Long
  Dim i As Integer
  Dim radius As Integer
  
  'canvas.Cls
  canvas.FillStyle = 0
  canvas.DrawWidth = 1
  radius = (canvas.ScaleWidth / width) / 2
  For i = 0 To currEdgeVector - 1
    x1 = EdgeVector(0, i)
    y1 = EdgeVector(1, i)
    x2 = EdgeVector(2, i)
    y2 = EdgeVector(3, i)
    
    'c = RGB((EdgeVector(4, i) / maxEdgeVectorIntensity) * 255, 0, 0)
    c = RGB(i, 0, 0)
    canvas.FillColor = c
    screenX(0) = (x1 / width) * canvas.ScaleWidth
    screenY(0) = (y1 / height) * canvas.ScaleHeight
    screenX(1) = (x2 / width) * canvas.ScaleWidth
    screenY(1) = (y2 / height) * canvas.ScaleHeight
    If (i > 0) Then
      canvas.Line -(screenX(0), screenY(0)), c
    End If
    canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
    'canvas.Circle (screenX(0), screenY(0)), radius, c
    'canvas.Circle (screenX(1), screenY(1)), radius, c
  Next
  
End Sub



Public Sub showEdges(canvas As PictureBox)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim edgeType As Byte
  Dim c As Long
  Dim i As Integer
  
  canvas.Cls
  canvas.FillStyle = 0
  c = RGB(0, 0, 0)
  For x = 0 To edgesWidth - 1
    For y = 0 To edgesHeight - 1
      
      screenX(0) = (x / edgesWidth) * canvas.ScaleWidth
      screenY(0) = (y / edgesHeight) * canvas.ScaleHeight
      screenX(1) = ((x + 1) / edgesWidth) * canvas.ScaleWidth
      screenY(1) = ((y + 1) / edgesHeight) * canvas.ScaleHeight
      
      edgeType = Edges(x, y)
      Select Case edgeType
        Case 1 'horizontal line
          canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(0)), c
        Case 2 'vertical line
          canvas.Line (screenX(0), screenY(0))-(screenX(0), screenY(1)), c
        Case 3 'diagonal /
          canvas.Line (screenX(0), screenY(1))-(screenX(1), screenY(0)), c
        Case 4 'diagonal \
          canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
        Case 5 'cross
          canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(0)), c
          canvas.Line (screenX(0), screenY(0))-(screenX(0), screenY(1)), c
      End Select
    Next
  Next
  
End Sub


Public Sub showEdgeHistogram(chart As Object)
'displays edge histogram using MS chart control
  
  Dim i As Integer
  Dim estr As String

  chart.chartType = 7
  chart.RowCount = NO_OF_EDGE_TYPES
  chart.ColumnCount = 1
  
  estr = ""
  For i = 0 To chart.RowCount - 1
    chart.Row = i + 1
    chart.Data = EdgeHistogram(i)
    estr = estr & EdgeHistogram(i) & ", "
  Next
  chart.Refresh
  'MsgBox estr
  
End Sub


Public Sub showAngleHistogram(chart As Object)
'displays angle histogram using MS chart control
  
  Dim i As Integer
  Dim estr As String

  chart.chartType = 7
  chart.RowCount = 18
  chart.ColumnCount = 1
  
  estr = ""
  For i = 0 To chart.RowCount - 1
    chart.Row = i + 1
    chart.Data = angleHistogram(i)
    estr = estr & angleHistogram(i) & ", "
  Next
  chart.Refresh
  'MsgBox estr
  
End Sub