classimageprocessing.cls

这是一个立体视觉程序

  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
  Next
  
  'normalize
  If (max > 0.01) Then
    For index = 0 To Histogram_levels - 1
      Hist(index) = Hist(index) / max
    Next
  End If
  
  'compare
  similarity = 0
  i = 0
  For index = 0 To Histogram_levels - 1
    If (ColourHistogram(index) > 0) And (Hist(index) > 0) Then
      dc = Abs(Hist(index) - ColourHistogram(index))
      similarity = similarity + (1 - (dc * dc))
      i = i + 1
    End If
  Next
  If (i > 0) Then
    similarity = similarity / i
  End If
  
  colourSimilarity = similarity
End Function









Public Sub showColourHistogram(pic As PictureBox)
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim prev_x As Integer
  Dim prev_y As Integer
  Dim c As Long
  
  pic.Cls
  c = RGB(255, 255, 255)
  pic.DrawWidth = 1
  For i = 0 To Histogram_levels
    If (ColourHistogram(i) <= 1) And (ColourHistogram(i) >= 0) Then
      x = (pic.ScaleWidth / Histogram_levels) * i
      y = pic.ScaleHeight - (pic.ScaleHeight * ColourHistogram(i))
      If (i > 0) Then
        pic.Line (prev_x, prev_y)-(x, y), c
      End If
      prev_x = x
      prev_y = y
    End If
  Next
  
End Sub


Public Function getEdgeHistogramValue(index As Integer) As Single
  getEdgeHistogramValue = EdgeHistogram(index)
End Function


Public Sub applyThreshold(Value As Byte)
'applies a threshold to the image
  Dim x As Integer
  Dim y As Integer
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      If (image(x, y) < Value) Then
        image(x, y) = 0
      End If
    Next
  Next
End Sub






Private Function Dist(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
  Dim dx As Single
  Dim dy As Single
  
  dx = x1 = x2
  dy = y1 - y2
  Dist = Sqr((dx * dx) + (dy * dy))
End Function











Public Sub getEdge(index As Integer, ByRef x As Integer, ByRef y As Integer, ByRef angle As Integer, ByRef edgeLength As Integer, ByRef probability As Integer, ByRef TrackNumber As Integer)
  If (index < noOfEdges) Then
    x = edges(index, EDGE_X)
    y = edges(index, EDGE_Y)
    angle = edges(index, EDGE_ANGLE) * (180 / NoOfEdgeAngles)
    edgeLength = edges(index, EDGE_LENGTH)
    probability = edges(index, EDGE_PROBABILITY)
    TrackNumber = edges(index, EDGE_TRACK)
  End If
End Sub



Public Sub init(imageWidth As Integer, imageHeight As Integer)
  width = imageWidth
  height = imageHeight
  ReDim image(width, height)
  ReDim edgeTraced(width, height)
  
  NoOfEdgeAngles = 18
  ReDim EdgeHistogram(NoOfEdgeAngles)
  minEdgeLength = 6
  
  scanInterval = 2
  
  EdgeThreshold = 0
  processType = 0
  averageContrast = 1
  Histogram_levels = 40
  ReDim ColourHistogram(Histogram_levels)
  ReDim Hist(Histogram_levels)
  mergeEdgesRadius = 3
End Sub


Public Sub setHistogramLevels(levels As Integer)
  Histogram_levels = levels
  ReDim ColourHistogram(Histogram_levels)
  ReDim Hist(Histogram_levels)
End Sub


Public Sub Save(filenumber As Integer)
'save the image
  Dim x As Integer
  Dim y As Integer
  
  Print #filenumber, width
  Print #filenumber, height
  For x = 0 To width - 1
    For y = 0 To height - 1
      Print #filenumber, image(x, y)
    Next
  Next
End Sub


Public Sub Load(filenumber As Integer)
'save the image
  Dim x As Integer
  Dim y As Integer
  Dim b As Byte
  
  Input #filenumber, width
  Input #filenumber, height
  Call init(width, height)
  For x = 0 To width - 1
    For y = 0 To height - 1
      Input #filenumber, b
      image(x, y) = b
    Next
  Next
End Sub


Public Sub whiteNoise()
  Dim x As Integer
  Dim y As Integer
  
  For x = 0 To width - 1
    For y = 0 To height - 1
      image(x, y) = Rnd * 255
    Next
  Next
End Sub


Public Sub Normalize()
'normalizes the image
  Dim max As Integer
  Dim x As Integer
  Dim y As Integer
  Dim p As Integer
  
  max = 0
  For x = 0 To width - 1
    For y = 0 To height - 1
      If (image(x, y) > max) Then
        max = image(x, y)
      End If
    Next
  Next
  
  If (max > 0) Then
    For x = 0 To width - 1
      For y = 0 To height - 1
        p = image(x, y)
        p = p / max * 255
        image(x, y) = p
      Next
    Next
  End If
  
End Sub


Public Function getPoint(x As Integer, y As Integer) As Byte
  getPoint = image(x, y)
End Function


Public Function setPoint(x As Integer, y As Integer, Value As Byte)
  image(x, y) = Value
End Function


Public Sub update(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)
'import a picture
'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 xx As Integer
  Dim yy 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
  Dim rgbsource As RGBthingy
  Dim rgbdest As RGBpoint
  Dim r As Single
  Dim g As Single
  Dim b 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)
          rgbsource.Value = RGBval
          Call CopyMemory(rgbdest, rgbsource, 3)
          r = rgbdest.Red
          g = rgbdest.Green
          b = rgbdest.Blue
          Select Case processType
            Case 0  'greyscale
              Value = Value + ((r + g + b) / 765)
            Case 1  'red
              Value = Value + (r / 255)
            Case 2  'green
              Value = Value + (g / 255)
            Case 3  'blue
              Value = Value + (b / 255)
            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 updateColourHistogram(canvas As PictureBox, Optional left As Variant, Optional top As Variant, Optional wdth As Variant, Optional hght As Variant)

  Dim x As Integer
  Dim y As Integer
  Dim RGBval As Long
  Dim maxcol As Long
  Dim screenWidth As Single
  Dim screenHeight As Single
  Dim screenLeft As Single
  Dim screenTop As Single
  Dim index As Integer
  Dim max As Long
  Dim redValue As Byte
  Dim greenValue As Byte
  Dim blueValue As Byte
  
  If (Not IsMissing(left)) And (Not IsMissing(top)) Then
    screenLeft = left
    screenTop = top
    screenWidth = wdth
    screenHeight = hght
    Else
    screenLeft = 0
    screenTop = 0