classimageprocessing.cls

vb做的摄像头程序

                y = y + 1
                edgeFound = True
              End If
            End If
          Case 6
            If (x > 0) Then
              If (image(x - 1, y) > thresh) And (Not edgeTraced(x - 1, y)) Then
                x = x - 1
                edgeFound = True
              End If
            End If
          Case 7
            If (x > 0) And (y > 0) Then
              If (image(x - 1, y - 1) > thresh) And (Not edgeTraced(x - 1, y - 1)) Then
                x = x - 1
                y = y - 1
                edgeFound = True
              End If
            End If
          
          Case 8
            If (y > 1) Then
              If (image(x, y - 2) > thresh) And (Not edgeTraced(x, y - 2)) Then
                y = y - 2
                edgeFound = True
              End If
            End If
          Case 9
            If (y > 1) And (x < width) Then
              If (image(x + 1, y - 2) > thresh) And (Not edgeTraced(x + 1, y - 2)) Then
                x = x + 1
                y = y - 2
                edgeFound = True
              End If
            End If
          Case 10
            If (y > 1) And (x < width - 1) Then
              If (image(x + 2, y - 2) > thresh) And (Not edgeTraced(x + 2, y - 2)) Then
                x = x + 2
                y = y - 2
                edgeFound = True
              End If
            End If
          Case 11
            If (y > 0) And (x < width - 1) Then
              If (image(x + 2, y - 1) > thresh) And (Not edgeTraced(x + 2, y - 1)) Then
                x = x + 2
                y = y - 1
                edgeFound = True
              End If
            End If
          Case 12
            If (x < width - 1) Then
              If (image(x + 2, y) > thresh) And (Not edgeTraced(x + 2, y)) Then
                x = x + 2
                edgeFound = True
              End If
            End If
          Case 13
            If (y < width) And (x < width - 1) Then
              If (image(x + 2, y + 1) > thresh) And (Not edgeTraced(x + 2, y + 1)) Then
                x = x + 2
                y = y + 1
                edgeFound = True
              End If
            End If
          Case 14
            If (y < width - 1) And (x < width - 1) Then
              If (image(x + 2, y + 2) > thresh) And (Not edgeTraced(x + 2, y + 2)) Then
                x = x + 2
                y = y + 2
                edgeFound = True
              End If
            End If
          Case 15
            If (y < width - 1) And (x < width) Then
              If (image(x + 1, y + 2) > thresh) And (Not edgeTraced(x + 1, y + 2)) Then
                x = x + 1
                y = y + 2
                edgeFound = True
              End If
            End If
          Case 16
            If (y < width - 1) Then
              If (image(x, y + 2) > thresh) And (Not edgeTraced(x, y + 2)) Then
                y = y + 2
                edgeFound = True
              End If
            End If
          Case 17
            If (y < width - 1) And (x > 0) Then
              If (image(x - 1, y + 2) > thresh) And (Not edgeTraced(x - 1, y + 2)) Then
                x = x - 1
                y = y + 2
                edgeFound = True
              End If
            End If
          Case 18
            If (y < width - 1) And (x > 1) Then
              If (image(x - 2, y + 2) > thresh) And (Not edgeTraced(x - 2, y + 2)) Then
                x = x - 2
                y = y + 2
                edgeFound = True
              End If
            End If
          Case 19
            If (y < width) And (x > 1) Then
              If (image(x - 2, y + 1) > thresh) And (Not edgeTraced(x - 2, y + 1)) Then
                x = x - 2
                y = y + 1
                edgeFound = True
              End If
            End If
          Case 20
            If (x > 1) Then
              If (image(x - 2, y) > thresh) And (Not edgeTraced(x - 2, y)) Then
                x = x - 2
                edgeFound = True
              End If
            End If
          Case 21
            If (y > 0) And (x > 1) Then
              If (image(x - 2, y - 1) > thresh) And (Not edgeTraced(x - 2, y - 1)) Then
                x = x - 2
                y = y - 1
                edgeFound = True
              End If
            End If
          Case 22
            If (y > 1) And (x > 1) Then
              If (image(x - 2, y - 2) > thresh) And (Not edgeTraced(x - 2, y - 2)) Then
                x = x - 2
                y = y - 2
                edgeFound = True
              End If
            End If
          Case 23
            If (y > 1) And (x > 0) Then
              If (image(x - 1, y - 2) > thresh) And (Not edgeTraced(x - 1, y - 2)) Then
                x = x - 1
                y = y - 2
                edgeFound = True
              End If
            End If
        End Select
        pixel = pixel + 1
      Wend
    
      If (edgeFound) Then
        edgePath(NoOfEdgePoints, EDGE_X) = x
        edgePath(NoOfEdgePoints, EDGE_Y) = y
        edgePath(NoOfEdgePoints, 2) = image(x, y)
        NoOfEdgePoints = NoOfEdgePoints + 1
        edgeTraced(x, y) = True
      End If
    
    Wend
    
    If (NoOfEdgePoints > minEdgeLength) Then
      i = 0
      pixel = 0
      avAngle = 0
      totAngle = 0
      max_da = 0
      TrackDetails(noOfTracks, TRACK_X) = 0
      TrackDetails(noOfTracks, TRACK_Y) = 0
      While (i < NoOfEdgePoints)
        intensity = intensity + edgePath(i, 2)
        If (pixel >= minEdgeLength) Then
        
          'angle from origin
          dx = edgePath(i - pixel, EDGE_X) - edgePath(i, EDGE_X)
          dy = edgePath(i - pixel, EDGE_Y) - edgePath(i, EDGE_Y)
          xx = edgePath(i, EDGE_X) + (dx / 2)
          yy = edgePath(i, EDGE_Y) + (dy / 2)
          dist = Sqr((dx * dx) + (dy * dy))
          angle = Acos(dy / dist)
                    
          da = Abs(avAngle - angle)
          If ((da > 0.06) Or (i = NoOfEdgePoints)) And (dist > minEdgeLength) Then
            edges(noOfEdges, EDGE_X) = xx
            edges(noOfEdges, EDGE_Y) = yy
            edges(noOfEdges, EDGE_X1) = edgePath(i, EDGE_X)
            edges(noOfEdges, EDGE_Y1) = edgePath(i, EDGE_Y)
            edges(noOfEdges, EDGE_X2) = edgePath(i - pixel, EDGE_X)
            edges(noOfEdges, EDGE_Y2) = edgePath(i - pixel, EDGE_Y)
            edges(noOfEdges, EDGE_LENGTH) = dist
            trackLen = trackLen + edges(noOfEdges, EDGE_LENGTH)
            
            If (prevAngle > -1) Then
              angleChange = (angle - prevAngle) / 3.1415927 * 180
              edges(noOfEdges, EDGE_ANGLECHANGE) = Abs(angleChange)
              Else
              edges(noOfEdges, EDGE_ANGLECHANGE) = 0
            End If
            prevAngle = angle
            
            If (dx < 0) Then
              avAngle = (2 * 3.1415927) - avAngle
            End If
            edges(noOfEdges, EDGE_ANGLE) = avAngle
            If (x1 = -1) Then
              'store the start position of the track
              x1 = edges(noOfEdges, EDGE_X2)
              y1 = edges(noOfEdges, EDGE_Y2)
            End If
                                                
            
'            If (da > max_da) Then
'              max_da = da
'              TrackDetails(noOfTracks, TRACK_X) = edges(noOfEdges, EDGE_X)
'              TrackDetails(noOfTracks, TRACK_Y) = edges(noOfEdges, EDGE_Y)
'            End If
            If (maxEdgeLength < edges(noOfEdges, EDGE_LENGTH)) Then
              maxEdgeLength = edges(noOfEdges, EDGE_LENGTH)
            End If
            edges(noOfEdges, EDGE_PROBABILITY) = Int(intensity / pixel)
            edges(noOfEdges, EDGE_TRACK) = noOfTracks
            edgeType = Int((Abs(edges(noOfEdges, EDGE_ANGLECHANGE)) / 180) * NoOfEdgeAngles)
            EdgeHistogram(edgeType) = EdgeHistogram(edgeType) + edges(noOfEdges, EDGE_LENGTH)
            If (EdgeHistogram(edgeType) > histMax) Then
              histMax = EdgeHistogram(edgeType)
            End If
            intensity = 0
            noOfEdges = noOfEdges + 1
            pixel = 0
            edgeLocated = True
            edgeCount = edgeCount + 1
          End If
          
          If (pixel = minEdgeLength) Then
            avAngle = angle
            totAngle = angle
            Else
            If (pixel > minEdgeLength) Then
              'If (angle < 0) Then
              '  angle = 3.1415927 + angle
              'End If
              
              totAngle = totAngle + angle
              avAngle = (totAngle + angle) / (pixel - minEdgeLength + 1)
            End If
          End If
        
        End If
        pixel = pixel + 1
        i = i + 1
      Wend
    End If

    If (edgeLocated) Then
      TrackDetails(noOfTracks, TRACK_EDGES) = edgeCount
      TrackDetails(noOfTracks, TRACK_START) = noOfEdges - edgeCount
      TrackDetails(noOfTracks, TRACK_LENGTH) = trackLen
      
      'calculate the axis of the track
      dx = edges(noOfEdges - 1, EDGE_X1) - x1
      dy = edges(noOfEdges - 1, EDGE_Y1) - y1
      dist = Sqr((dx * dx) + (dy * dy))
      angle = Acos(dy / dist)
      If (dx < 0) Then
        angle = (2 * 3.1415927) - angle
      End If
      TrackDetails(noOfTracks, TRACK_AXIS) = angle
      noOfTracks = noOfTracks + 1
      edgeCount = 0
      prevAngle = -1
      trackLen = 0
      edgeLocated = False
    End If
    
  Wend
  
  Call mergeEdges(mergeEdgesRadius)
  'Call getJunctions(2)
  
  For i = 0 To NoOfEdgeAngles - 1
    EdgeHistogram(i) = EdgeHistogram(i) / histMax
  Next
  
End Sub


Public Function getDistanceBetweenTracks(TrackNo1 As Integer, TrackNo2 As Integer) As Single
'returns the distance between the two tracks relative to the length of the first track
  Dim dx As Single
  Dim dy As Single
  Dim dist As Single
  
  If (TrackDetails(TrackNo1, TRACK_LENGTH) > 0) Then
    dx = TrackDetails(TrackNo1, TRACK_X) - TrackDetails(TrackNo2, TRACK_X)
    dy = TrackDetails(TrackNo1, TRACK_Y) - TrackDetails(TrackNo2, TRACK_Y)
    dist = Sqr((dx * dx) + (dy * dy))
    getDistanceBetweenTracks = dist / TrackDetails(TrackNo1, TRACK_LENGTH)
    Else
    getDistanceBetweenTracks = 0
  End If
End Function


Public Sub getEdgeAttraction(x As Integer, y As Integer, minDistance As Integer, ByRef ax As Single, ByRef ay As Single)
'returns the attraction towards edges at the given point
'ax and ay are always between -1 and +1
  Dim minDist2 As Long
  Dim i As Integer
  Dim dist As Single
  Dim dx As Single
  Dim dy As Single
  Dim instances As Single
  
  ax = 0
  ay = 0
  instances = 0
  minDist2 = minDistance * minDistance
  For i = 0 To noOfEdges - 1
    dx = edges(i, EDGE_X1) - x
    dy = edges(i, EDGE_Y1) - y
    dist = (dx * dx) + (dy * dy)
    If (dist < minDist2) Then
      ax = ax + (1 - (dx / minDistance))
      ay = ay + (1 - (dy / minDistance))
      instances = instances + 1
    End If

    dx = edges(i, EDGE_X2) - x
    dy = edges(i, EDGE_Y2) - y
    dist = (dx * dx) + (dy * dy)
    If (dist < minDist2) Then
      ax = ax + (1 - (dx / minDistance))
      ay = ay + (1 - (dy / minDistance))
      instances = instances + 1
    End If
  Next
  If (instances > 0) Then
    ax = ax / instances
    ay = ay / instances
  End If

End Sub


Public Sub getTrackPosition(TrackNo As Integer, Position As Integer, ByRef Value As Single, ByRef x As Single, ByRef y As Single)
  Value = TrackPositions(TrackNo, Position, 0)
  x = TrackPositions(TrackNo, Position, 1)
  y = TrackPositions(TrackNo, Position, 2)
End Sub

Public Function getFeaturePosition(FeatureNo As Integer, Position As Integer) As Single
  getFeaturePosition = FeatureVector(FeatureNo, Position)
End Function

Public Sub getTrackLocation(TrackNo As Integer, ByRef x As Single, ByRef y As Single)
  x = TrackDetails(TrackNo, TRACK_X)
  y = TrackDetails(TrackNo, TRACK_Y)
End Sub

Public Sub getFeatureLocation(FeatureNo As Integer, ByRef x As Single, ByRef y As Single)
  x = edges(FeatureNo, EDGE_X)
  y = edges(FeatureNo, EDGE_Y)
End Sub


Public Function getEdgeGradient(px As Integer, py As Integer, minDistance As Integer, ByRef ax As Single, ByRef ay As Single) As Single
'returns the attraction towards edges at the given point
'ax and ay are always between -1 and +1
  Dim i As Integer
  Dim j As Integer
  Dim dist As Single
  Dim dx As Single
  Dim dy As Single
  Dim grad As Single
  Dim d2 As Single
  Dim g As Single
  Dim ang As Single
  Dim instances As Single
  
  grad = 0
  ax = 0
  ay = 0
  instances = 0
  For i = 0 To noOfEdges - 1
    'For j = 0 To 2 Step 2
      dx = edges(i, EDGE_X1 + j) - px
      dy = edges(i, EDGE_Y1 + j) - py
      dist = Sqr((dx * dx) + (dy * dy))
      If (dist > 0) And (dist < minDistance) Then
        d2 = dist / minDistance
        d2 = d2 * d2
        g = 1 / (1 + d2)
        grad = grad + g
        ang = Acos(dy / dist)
        If (dx < 0) Then
          ang = (2 * 3.1415927) - ang
        End If
    
        ax = ax + ((g) * Sin(ang) * 1 * (edges(i, EDGE_LENGTH) / 10))
        ay = ay + ((g) * Cos(ang) * 1 * (edges(i, EDGE_LENGTH) / 10))
        'ax = ax + (d2 * Sin(ang) * (edges(i, EDGE_LENGTH) / maxEdgeLength) * 100)
        'ay = ay + (d2 * Cos(ang) * (edges(i, EDGE_LENGTH) / maxEdgeLength) * 100)
        instances = instances + 1
      End If
    'Next
  Next
  
  If (noOfEdges > 0) Then
    grad = grad / noOfEdges
    ax = ax / noOfEdges
    ay = ay / noOfEdges
  End If
  getEdgeGradient = grad
  
End Function



Public Function averageIntensity() As Single
'returns the average pixel intensity
  Dim x As Integer
  Dim y As Integer
  Dim av As Single
  
  av = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      av = av + image(x, y)
    Next
  Next
  av = av / (width * height)
  
  averageIntensity = av
End Function


Public Sub showTestCard(pic As PictureBox)
  Dim x As Integer
  Dim maxcol As Long
  Dim col As Long
  
  pic.Cls
  maxcol = RGB(255, 255, 255)
  For x = 0 To pic.ScaleWidth
    col = (maxcol / pic.ScaleWidth) * x
    pic.Line (x, 0)-(x, pic.ScaleHeight), col
  Next
End Sub


Public Function colourSimilarity(pic As PictureBox, topX As Integer, topY As Integer, areaWidth As Integer, areaHeight As Integer) As Single
'compares an area of an image to the colour histogram
  Dim x As Integer
  Dim y As Integer
  Dim RGBvalue As Long
  Dim maxValue As Double
  Dim index As Integer
  Dim max As Double
  Dim similarity As Single
  Dim fract As Single
  Dim i As Integer
  Dim dc As Single
  Dim redValue As Byte
  Dim greenValue As Byte
  Dim blueValue As Byte
  
  'get histogram
  maxValue = RGB(255, 255, 255)
  For x = 0 To areaWidth - 1
    For y = 0 To areaHeight - 1
      RGBvalue = pic.Point(topX + x, topY + y)
      
      If (RGBvalue > 0) Then
        redValue = getRGBvalue(RGBvalue, 0)
        greenValue = getRGBvalue(RGBvalue, 1)
        blueValue = getRGBvalue(RGBvalue, 2)
        index = Int(getSpectrumValue(redValue, greenValue, blueValue) * Histogram_levels)
      
        Hist(index) = Hist(index) + 1
        If (Hist(index) > max) Then
          max = Hist(index)
        End If
      End If
    Next