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

Const NoOfFeatureCategories = 10
Dim FeatureVector(30000, NoOfFeatureCategories) As Single

Public mergeEdgesRadius As Integer

Public noOfEdges As Integer
Dim edges(30000, 12) As Single
Dim TrackDetails(30000, 6) As Single
Public noOfTracks As Integer
Public primaryEdge As Integer
Public minEdgeLength As Integer
Dim maxEdgeLength As Integer
Const NoOfTrackPositions = 10
Dim TrackPositions(30000, NoOfTrackPositions, 3) As Single
Const EDGE_X = 0
Const EDGE_Y = 1
Const EDGE_LENGTH = 2
Const EDGE_ANGLE = 3
Const EDGE_PROBABILITY = 4
Const EDGE_TRACK = 5
Const EDGE_X1 = 6
Const EDGE_Y1 = 7
Const EDGE_X2 = 8
Const EDGE_Y2 = 9
Const EDGE_ARC = 10
Const EDGE_ANGLECHANGE = 11
Const TRACK_EDGES = 0
Const TRACK_START = 1
Const TRACK_LENGTH = 2
Const TRACK_AXIS = 3
Const TRACK_X = 4
Const TRACK_Y = 5

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
Public NoOfEdgeAngles As Integer
Dim EdgeHistogram() As Single

'colour histogram levels
Dim Histogram_levels As Integer
Dim ColourHistogram() As Double
Dim Hist() As Double

'snake
Public NoOfSnakePoints As Integer
Dim SnakePoint() As Single
Dim snakeEnergy As Single
Dim elasticity As Single
Dim SnakeStationaryPoints As Integer
Public SnakeComplete As Boolean
Dim prevSnakeStationaryPoints As Integer
Dim snakeStationary As Integer
Const SNAKE_X = 0
Const SNAKE_Y = 1
Const SNAKE_DX = 2
Const SNAKE_DY = 3
Const SNAKE_DIST = 4
Const SNAKE_ANGLE = 5

'blobs
Public NoOfBlobs As Integer
Dim Blob(30000, 4) As Single
Const BLOB_X = 0
Const BLOB_Y = 1
Const BLOB_RADIUS = 2
Const BLOB_PROBABILITY = 3

Public NoOfStereoMatches As Integer
Public StereoPatchSize As Integer
Dim stereoMatch(30000, 8) As Single



Public Sub Snake(NoOfSnakePts As Integer, tx As Integer, ty As Integer, w As Integer, h As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim sidePoints As Integer
  
  NoOfSnakePoints = NoOfSnakePts
  ReDim SnakePoint(NoOfSnakePoints, 6)
  
  'initialise the snake
  sidePoints = NoOfSnakePoints / 4
  For i = 0 To sidePoints
    For j = 0 To 4
      Select Case j
        Case 0
          SnakePoint(i, SNAKE_X) = tx + ((w / sidePoints) * i)
          SnakePoint(i, SNAKE_Y) = ty
        Case 1
          SnakePoint(i + (sidePoints * 1), SNAKE_X) = tx + w
          SnakePoint(i + (sidePoints * 1), SNAKE_Y) = ty + ((h / sidePoints) * i)
        Case 2
          SnakePoint(i + (sidePoints * 2), SNAKE_X) = tx + w - ((w / sidePoints) * i)
          SnakePoint(i + (sidePoints * 2), SNAKE_Y) = ty + h
        Case 3
          SnakePoint(i + (sidePoints * 3), SNAKE_X) = tx
          SnakePoint(i + (sidePoints * 3), SNAKE_Y) = ty + h - ((h / sidePoints) * i)
      End Select
    Next
  Next
    
  snakeEnergy = ((w * 2) + (h * 2)) / NoOfSnakePoints
  'snakeEnergy = 0.1
  elasticity = 0.4
  SnakeComplete = False
  prevSnakeStationaryPoints = 0
  snakeStationary = 0
  
End Sub


Public Sub updateSnake()
  Dim i As Integer
  Dim j As Integer
  Dim dx As Single
  Dim dy As Single
  Dim sidePoints As Integer
  Dim distNext As Single
  Dim distPrevious As Single
  Dim px As Single
  Dim py As Single
  Dim mx As Single
  Dim my As Single
  Dim distBase As Single
  Dim dp As Single
    
  SnakeStationaryPoints = 0
  
  'calculate distances between snake points
  For i = 0 To NoOfSnakePoints - 1
    If (i > 0) Then
      dx = SnakePoint(i, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
      dy = SnakePoint(i, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
      Else
      dx = SnakePoint(i, SNAKE_X) - SnakePoint(NoOfSnakePoints - 1, SNAKE_X)
      dy = SnakePoint(i, SNAKE_Y) - SnakePoint(NoOfSnakePoints - 1, SNAKE_Y)
    End If
    SnakePoint(i, SNAKE_DX) = dx
    SnakePoint(i, SNAKE_DY) = dy
    SnakePoint(i, SNAKE_DIST) = Sqr((dx * dx) + (dy * dy))
        
    If (SnakePoint(i, SNAKE_DIST) > 0) Then
      SnakePoint(i, SNAKE_ANGLE) = Acos(dy / SnakePoint(i, SNAKE_DIST))
      If (dy < 0) Then
        SnakePoint(i, SNAKE_ANGLE) = (2 * 3.1415927) - SnakePoint(i, SNAKE_ANGLE)
      End If
      Else
      SnakePoint(i, SNAKE_ANGLE) = 0
    End If
     
  Next
   
  For i = 0 To NoOfSnakePoints - 1
  
    If (i < NoOfSnakePoints - 1) Then
      distNext = SnakePoint(i + 1, SNAKE_DIST)
      If (i > 1) Then
        dx = SnakePoint(i + 1, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
        dy = SnakePoint(i + 1, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
        j = i + 1
        Else
        dx = SnakePoint(i + 1, SNAKE_X) - SnakePoint(NoOfSnakePoints - 1, SNAKE_X)
        dy = SnakePoint(i + 1, SNAKE_Y) - SnakePoint(NoOfSnakePoints - 1, SNAKE_Y)
        j = i + 1
      End If
      Else
      dx = SnakePoint(0, SNAKE_X) - SnakePoint(i - 1, SNAKE_X)
      dy = SnakePoint(0, SNAKE_Y) - SnakePoint(i - 1, SNAKE_Y)
      distNext = SnakePoint(0, SNAKE_DIST)
      j = 0
    End If
    distBase = Sqr((dx * dx) + (dy * dy))
    distPrevious = SnakePoint(i, SNAKE_DIST)
    
    dp = (distPrevious - snakeEnergy) * 0.5
    distPrevious = distPrevious - dp
    distNext = distNext + dp
    mx = SnakePoint(j, SNAKE_X) - (dx * (distPrevious / distNext))
    my = SnakePoint(j, SNAKE_Y) - (dy * (distPrevious / distNext))
    
    dx = ((SnakePoint(i, SNAKE_X) - mx) * elasticity) + ((Rnd - 0.5) * 1)
    dy = ((SnakePoint(i, SNAKE_Y) - my) * elasticity) + ((Rnd - 0.5) * 1)
      
    If (dx > 1) Then
      dx = 1
    End If
    If (dy > 1) Then
      dy = 1
    End If
    If (dx < -1) Then
      dx = -1
    End If
    If (dy < -1) Then
      dy = -1
    End If
    px = SnakePoint(i, SNAKE_X) - dx
    py = SnakePoint(i, SNAKE_Y) - dy
    If (px >= 0) And (px < width) And (py >= 0) And (py < height) Then
      If (image(px, py) = 0) Then
        SnakePoint(i, SNAKE_X) = px
        SnakePoint(i, SNAKE_Y) = py
        Else
        SnakeStationaryPoints = SnakeStationaryPoints + 1
      End If
    End If
  Next
    
  If (snakeEnergy > 0.1) Then
    snakeEnergy = snakeEnergy * 0.99
  End If
  
  If (prevSnakeStationaryPoints = SnakeStationaryPoints) Then
    snakeStationary = snakeStationary + 1
    Else
    snakeStationary = 0
  End If
  If ((SnakeStationaryPoints / NoOfSnakePoints) > 0.2) And (snakeStationary > 2) Then
    SnakeComplete = True
  End If
  prevSnakeStationaryPoints = SnakeStationaryPoints
  
End Sub





Public Sub stereoEigenImage(LeftImage As classImageProcessing, RightImage As classImageProcessing, Threshold As Integer)
'calculates the difference between two stereo images
  Dim x As Integer
  Dim y As Integer
  Dim p1 As Integer
  Dim p2 As Integer
  Dim p As Integer
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      p1 = LeftImage.getPoint(x, y)
      p2 = RightImage.getPoint(x, y)
      p = (p1 + p2) / 2
      If (Abs(p - p1) > Threshold) Then
        image(x, y) = 255 - p
        Else
        image(x, y) = 0
      End If
    Next
  Next

End Sub



Public Sub stereoCompare(otherImage As classImageProcessing, patchsize As Integer, SmoothnessThreshold As Single, matchThreshold As Single, searchHorizontal As Integer, searchVertical As Integer)
'compares this image with another image to find stereo matches
'images must be of the same size
  Dim x As Integer
  Dim y As Integer
  Dim xx As Integer
  Dim yy As Integer
  Dim eDist As Single
  Dim dp As Single
  Dim diff As Single
  Dim patchPixels As Single
  Dim featurePoint() As Boolean
  Dim a As Integer
  Dim b As Integer
  Dim featuresX As Integer
  Dim featuresY As Integer
  Dim px As Integer
  Dim py As Integer
  Dim minDist As Single
  Dim matchFound As Boolean
  Dim p1 As Integer
  Dim p2 As Integer
  Dim i As Integer
  Dim dx As Integer
  Dim dy As Integer
  
  featuresX = Int(width / patchsize)
  featuresY = Int(height / patchsize)
  ReDim featurePoint(featuresX, featuresY)
  
  StereoPatchSize = patchsize
  patchPixels = patchsize * patchsize
  
  'look for suitable feature points
  a = 0
  For x = 0 To width - 1 Step patchsize
    b = 0
    For y = 0 To height - 1 Step patchsize
      
      diff = 0
      For xx = x + 1 To x + patchsize - 1
        For yy = y To y + patchsize - 1
          p1 = image(xx, yy)
          p2 = image(xx - 1, yy)
          dp = (p1 - p2) / 255
          diff = diff + (dp * dp)
        Next
      Next
      diff = diff / patchPixels
      
      If (diff > SmoothnessThreshold) Then
        featurePoint(a, b) = True
      End If
      b = b + 1
    Next
    a = a + 1
  Next
  
  'match the feature points in the other image
  NoOfStereoMatches = 0
  a = 0
  For x = 0 To width - 1 Step patchsize
    b = 0
    For y = 0 To height - 1 Step patchsize
      If (featurePoint(a, b)) Then
        
        stereoMatch(NoOfStereoMatches, 0) = x
        stereoMatch(NoOfStereoMatches, 1) = y
        
        matchFound = False
        minDist = matchThreshold
        For xx = x - searchHorizontal To x + searchHorizontal
          If (xx > 0) And (xx < width - patchsize) Then
            For yy = y - searchVertical To y + searchVertical
              If (yy > 0) And (yy < height - patchsize) Then
                
                eDist = 0
                For px = xx To xx + patchsize - 1
                  For py = yy To yy + patchsize - 1
                    p1 = image(px - xx + x, py - yy + y)
                    p2 = otherImage.getPoint(px, py)
                    dp = (p1 - p2) / 255
                    eDist = eDist + (dp * dp)
                  Next
                Next
                eDist = eDist / patchPixels
                If (eDist < minDist) And (Not ((px = x) And (py = y))) Then
                  minDist = eDist
                  stereoMatch(NoOfStereoMatches, 2) = px
                  stereoMatch(NoOfStereoMatches, 3) = py
                  stereoMatch(NoOfStereoMatches, 4) = eDist
                  matchFound = True
                End If
                
              End If
            Next
          End If
        Next
        
        If (matchFound) Then
          NoOfStereoMatches = NoOfStereoMatches + 1
        End If
        
      End If
      b = b + 1
    Next
    a = a + 1
  Next
  
  'calculate positions and distances
  For i = 0 To NoOfStereoMatches - 1
    dx = stereoMatch(i, 2) - stereoMatch(i, 0)
    dy = stereoMatch(i, 3) - stereoMatch(i, 1)
    stereoMatch(i, 5) = stereoMatch(i, 0) + (dx / 2)
    stereoMatch(i, 6) = stereoMatch(i, 1) + (dy / 2)
    
    'calculate a normalised distance between 0 and 1
    'stereoMatch(i, 7) = 1 - (Sqr((dx * dx) + (dy * dy)) / width)
    stereoMatch(i, 7) = 1 - (Abs(dx) / width)
  Next
  
End Sub




Public Sub Diffuse(diffuseConstant As Single, diffuseSteps As Integer)
  Dim x As Integer
  Dim y As Integer
  Dim i As Integer
  Dim index As Integer
  Dim diffValue() As Single
  Dim Value As Single
  Dim dv As Single
  Dim max As Single
  
  ReDim diffValue(width, height, 2)
  For x = 0 To width - 1
    For y = 0 To height - 1
      diffValue(x, y, 0) = image(x, y)
    Next
  Next
  
  index = 1
  max = 1
  For i = 1 To diffuseSteps
    For x = 1 To width - 2
      For y = 1 To height - 2
        Value = diffValue(x, y + 1, 1 - index) + diffValue(x + 1, y + 1, 1 - index) + diffValue(x + 1, y, 1 - index) + diffValue(x + 1, y - 1, 1 - index)
        Value = Value + diffValue(x, y - 1, 1 - index) + diffValue(x - 1, y - 1, 1 - index) + diffValue(x - 1, y, 1 - index) + diffValue(x - 1, y + 1, 1 - index)
        dv = (Value / 8) - diffValue(x, y, 1 - index)
        diffValue(x, y, index) = diffValue(x, y, 1 - index) + (diffuseConstant * dv)
        If (diffValue(x, y, index) < 0) Then
          diffValue(x, y, index) = 0
        End If
        If (diffValue(x, y, index) > 255) Then
          diffValue(x, y, index) = 255
        End If
        If (i = diffuseSteps) Then
          If (diffValue(x, y, index) > max) Then
            max = diffValue(x, y, index)
          End If
        End If
      Next
    Next
        
    If (i = diffuseSteps) Then
      For x = 1 To width - 2
        For y = 1 To height - 2
          image(x, y) = CByte(diffValue(x, y, index) / max * 255)
        Next
      Next
    End If
    
    If (index = 1) Then
      index = 0
      Else
      index = 1
    End If
  Next
  
  
  
End Sub


Public Sub getEdges()
  Dim x As Integer
  Dim y As Integer