classimageprocessing.cls

这是一个立体视觉程序

      Next
      
    End If
  Next
End Sub


Public Sub showStereoChart(chart As MSChart)
  Dim x As Single
  Dim y As Single
  Dim z As Single
  Dim i As Integer
  
  'chart.chartType = VtChChartType3dArea
  chart.RandomFill = False
  
  chart.RowCount = width + 1
  chart.ColumnCount = 100 + 1
  chart.Refresh
  
  For x = 1 To width + 1
    For y = 1 To 101
      chart.Row = x
      chart.Column = y
      chart.Data = 0
      
      chart.Plot.SeriesCollection(y). _
         DataPoints(-1).Brush.FillColor. _
         Set 255, 0, 0
    Next
  Next
  
  For i = 0 To NoOfStereoMatches - 1
    
    x = stereoMatch(i, 0)
    y = stereoMatch(i, 1)
    z = stereoMatch(i, 7)
    
    chart.Row = x + 1
    chart.Column = Int(z * 100) + 1
    chart.Data = y + 1
      
  Next
  chart.Refresh
End Sub


Public Sub saveStereoAsVRML(filename As String, objectName As String)
  On Error GoTo saveStereoAsVRML_err
  
  Dim vrmlStr As String
  Dim i As Integer
  Dim filenumber As Integer
  
  vrmlStr = "#VRML V2.0 utf8" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "DEF " & objectName & " Group" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  children" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "    [" & Chr(13) & Chr(10)

  For i = 0 To NoOfStereoMatches - 1
    vrmlStr = vrmlStr & saveStereoAsVRMLpoint(i)
  Next
  vrmlStr = vrmlStr & "    ]" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "  }" & Chr(13) & Chr(10)
  
  filenumber = FreeFile
  Open filename For Output As #filenumber
  Print #filenumber, vrmlStr
  Close #filenumber

saveStereoAsVRML_exit:
  Exit Sub
saveStereoAsVRML_err:
  MsgBox "classImageProcessing/saveStereoAsVRML/" & Error$(Err) & "/" & Err, , "Error"
  Resume saveStereoAsVRML_exit
End Sub


Private Function saveStereoAsVRMLpoint(pointNo As Integer) As String

  Dim vrmlStr As String
  Dim x As Single
  Dim y As Single
  Dim z As Single
      
  x = stereoMatch(pointNo, 0)
  y = stereoMatch(pointNo, 1)
  z = 50 - (stereoMatch(pointNo, 7) * stereoMatch(pointNo, 7) * 50)
      
  vrmlStr = ""
  vrmlStr = vrmlStr & "    Transform" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      children Shape" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        appearance Appearance" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          material Material" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            {" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            diffuseColor " & (1 - stereoMatch(pointNo, 7)) & " 0.1 " & stereoMatch(pointNo, 7) & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            emissiveColor 0.5 0.5 0.5" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            transparency 0" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            ambientIntensity 0.5" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "            shininess 1" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "            }" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "          material Material {}" & Chr(13) & Chr(10)
  'vrmlStr = vrmlStr & "          # texture ImageTexture {}" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "          }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        geometry Box { size 5 5 5 }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "        }" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      translation " & x & " " & y & " " & " " & z & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      scale 1 1 1" & Chr(13) & Chr(10)
  vrmlStr = vrmlStr & "      }," & Chr(13) & Chr(10)
  saveStereoAsVRMLpoint = vrmlStr

End Function


Public Sub showGradientField(canvas As PictureBox)
  Dim x As Integer
  Dim y As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim c As Long
  Dim ax As Single
  Dim ay As Single
  Dim Value As Integer
  
  canvas.Cls
  canvas.FillStyle = 0
  Call showEdges(canvas, False)
  For x = 0 To width - 1 Step 4
    For y = 0 To height - 1 Step 4
      Value = getEdgeGradient(x, y, width, ax, ay) * 255
      c = RGB(0, Value, 0)
      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
      
      screenX(1) = ((x + (ax * 4)) / width) * canvas.ScaleWidth
      screenY(1) = ((y + (ay * 4)) / height) * canvas.ScaleHeight
      canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
    Next
  Next
End Sub



Public Sub showSnake(canvas As PictureBox)
  Dim i As Integer
  Dim screenX(2) As Single
  Dim screenY(2) As Single
  Dim originX As Single
  Dim originY As Single
  Dim c As Long
  
  canvas.Cls
  canvas.FillStyle = 0
  c = RGB(0, 255, 0)
  For i = 0 To NoOfSnakePoints - 1
    screenX(0) = (SnakePoint(i, SNAKE_X) / width) * canvas.ScaleWidth
    screenY(0) = (SnakePoint(i, SNAKE_Y) / height) * canvas.ScaleHeight
    'canvas.Circle (screenX(0), screenY(0)), 1, c
    If (i > 0) Then
      canvas.Line (screenX(0), screenY(0))-(screenX(1), screenY(1)), c
      If (i = NoOfSnakePoints - 1) Then
        canvas.Line (screenX(0), screenY(0))-(originX, originY), c
      End If
      Else
      originX = screenX(0)
      originY = screenY(0)
    End If
    screenX(1) = screenX(0)
    screenY(1) = screenY(0)
  Next
End Sub


Public Sub centreOfEdges(ByRef x As Integer, ByRef y As Integer)
'returns the centre of edges within the image
  Dim i As Integer
  Dim av_x As Single
  Dim av_y As Single
  
  If (noOfEdges > 0) Then
    av_x = 0
    av_y = 0
    For i = 0 To noOfEdges - 1
      av_x = av_x + edges(i, EDGE_X)
      av_y = av_y + edges(i, EDGE_Y)
    Next
    x = Int(av_x / noOfEdges)
    y = Int(av_y / noOfEdges)
    Else
    x = width / 2
    y = height / 2
  End If
End Sub




Public Sub showEdges(canvas As PictureBox, showTracks As Boolean)
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim x2 As Integer
  Dim y2 As Integer
  Dim xx As Integer
  Dim yy As Integer
  Dim r As Integer
  Dim ang As Single
  Dim c As Long
  Dim prob As Integer
  Dim scalex As Single
  Dim scaley As Single
  Dim track As Integer
  Dim prev_track As Integer
  
  scalex = canvas.ScaleWidth / width
  scaley = canvas.ScaleHeight / height
  
  canvas.Cls
  canvas.FillStyle = 0
  canvas.FillColor = RGB(0, 255, 0)
  c = RGB(255, 255, 255)
  canvas.ForeColor = c
  For i = 0 To noOfEdges - 1
    x = edges(i, EDGE_X1) * scalex
    y = edges(i, EDGE_Y1) * scaley
    x2 = edges(i, EDGE_X2) * scalex
    y2 = edges(i, EDGE_Y2) * scaley
    r = edges(i, EDGE_LENGTH) / 2
    prob = edges(i, EDGE_PROBABILITY)
    track = edges(i, EDGE_TRACK)
    ang = edges(i, EDGE_ANGLE)
    xx = Int(r * Sin(ang)) * scalex
    yy = Int(r * Cos(ang)) * scaley
    If (xx = 0) Then
      xx = 1
    End If
    If (yy = 0) Then
      yy = 1
    End If
    'canvas.PSet (x, y)
    If (Not showTracks) Then
      c = RGB(prob, prob, prob)
      Else
      If (track <> prev_track) Then
        c = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
      End If
    End If
    'canvas.Line (x - xx, y - yy)-(x + xx, y + yy), c
    
    If (edges(i, EDGE_ARC) = 1) Then
      c = RGB(0, 255, 0)
      Else
      c = RGB(255, 255, 255)
    End If
    
    If (edges(i, EDGE_ANGLECHANGE) > 50) And (edges(i, EDGE_ANGLECHANGE) < 130) Then
      canvas.Circle (x2, y2), 1 * scalex, c
    End If
        
    canvas.Line (x, y)-(x2, y2), c
    prev_track = track
  Next
  
End Sub


Public Sub showEdgeTrack(canvas As PictureBox, TrackNo As Integer)
  Dim i As Integer
  Dim x As Integer
  Dim y As Integer
  Dim x2 As Integer
  Dim y2 As Integer
  Dim c As Long
  Dim scalex As Single
  Dim scaley As Single
  
  If (TrackDetails(TrackNo, TRACK_EDGES) > 2) Then
  
    scalex = canvas.ScaleWidth / width
    scaley = canvas.ScaleHeight / height
  
    'canvas.Cls
    canvas.FillStyle = 0
    c = RGB(255, 255, 255)
    canvas.ForeColor = c
    i = 0
    While (edges(i, EDGE_TRACK) <> TrackNo) And (i < noOfEdges)
      i = i + 1
    Wend
    While (edges(i, EDGE_TRACK) = TrackNo) And (i < noOfEdges)
      x = edges(i, EDGE_X1) * scalex
      y = edges(i, EDGE_Y1) * scaley
      x2 = edges(i, EDGE_X2) * scalex
      y2 = edges(i, EDGE_Y2) * scaley
      canvas.Line (x, y)-(x2, y2), c
      i = i + 1
    Wend
  End If
End Sub


Public Sub showTrackPositions(TrackNo As Integer, canvas As PictureBox)
  Dim i As Integer
  Dim x1 As Integer
  Dim y1 As Integer
  Dim x2 As Integer
  Dim y2 As Integer
  Dim c As Long
  Dim scalex As Single
  Dim scaley As Single
  
  scalex = canvas.ScaleWidth
  scaley = canvas.ScaleHeight
  
  canvas.Cls
  canvas.FillStyle = 0
  c = RGB(255, 255, 255)
  canvas.ForeColor = c
  
  For i = 0 To NoOfTrackPositions - 1
    x1 = (i / NoOfTrackPositions) * scalex
    y1 = scaley
    x2 = ((i + 1) / NoOfTrackPositions) * scalex
    y2 = scaley - (TrackPositions(TrackNo, i, 0) * scaley)
    canvas.Line (x1, y1)-(x2, y2), c, B
  Next
  
End Sub


Public Sub showTrackLocation(TrackNo As Integer, canvas As PictureBox)
  Dim x As Single
  Dim y As Single
  Dim c As Long
  Dim scalex As Single
  Dim scaley As Single
  
  scalex = canvas.ScaleWidth / width
  scaley = canvas.ScaleHeight / height
  
  canvas.FillStyle = 0
  c = RGB(255, 255, 255)
  canvas.ForeColor = c
  canvas.FillColor = c
  
  x = TrackDetails(TrackNo, TRACK_X) * scalex
  y = TrackDetails(TrackNo, TRACK_Y) * scaley
  canvas.Circle (x, y), 1 * scalex, c
  
End Sub


Public Sub showBlobs(canvas As PictureBox)
  Dim i As Integer
  Dim x As Single
  Dim y As Single
  Dim c As Long
  Dim scalex As Single
  Dim scaley As Single
  
  scalex = canvas.ScaleWidth / width
  scaley = canvas.ScaleHeight / height
  
  canvas.FillStyle = 1
  c = RGB(0, 255, 0)
  canvas.ForeColor = c
  canvas.FillColor = c
  
  For i = 0 To NoOfBlobs - 1
    x = Blob(i, BLOB_X) * scalex
    y = Blob(i, BLOB_Y) * scaley
    canvas.Circle (x, y), Blob(i, BLOB_RADIUS) * scalex, c
  Next
  
End Sub


Public Sub showEdgeHistogram(pic As PictureBox)
'displays edge histogram using MS chart control
  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 NoOfEdgeAngles - 1
    x = (pic.ScaleWidth / NoOfEdgeAngles) * i
    y = pic.ScaleHeight - (pic.ScaleHeight * EdgeHistogram(i))
    If (i > 1) Then
      pic.Line (prev_x, prev_y)-(x, y), c
    End If
    prev_x = x
    prev_y = y
  Next
  
End Sub





Private Function getRGBvalue(RGBColour As Long, ColourIndex As Integer) As Byte
'returns either the red green or blue component of the given colour
  Dim rgbsource As RGBthingy
  Dim rgbdest As RGBpoint
  
  rgbsource.Value = RGBColour
  Call CopyMemory(rgbdest, rgbsource, 3)
  
  Select Case ColourIndex
    Case 0  'red
      getRGBvalue = rgbdest.Red
    Case 1  'green
      getRGBvalue = rgbdest.Green
    Case 2  'blue
      getRGBvalue = rgbdest.Blue
  End Select
  
End Function


Private Function getSpectrumValue(Red As Byte, Green As Byte, Blue As Byte) As Double
'returns a value between 0 and 1 indicating a point in a continuous colour spectrum
  Dim r As Single
  Dim g As Single
  Dim b As Single
  
  r = Red
  g = Green
  b = Blue
  getSpectrumValue = ((r * r) + (g * g) + (b * b)) / 195075
End Function


Private Sub getTrackDistancePosition(TrackNo As Integer, Dist As Single, ByRef x As Single, ByRef y As Single)
'returns the position at a point along the track
  Dim i As Integer
  Dim max As Integer
  Dim d As Single
  Dim d2 As Single
  Dim dd As Single
  
  x = -1
  y = -1
  i = TrackDetails(TrackNo, TRACK_START)
  max = i + TrackDetails(TrackNo, TRACK_EDGES)
  d = 0
  d2 = 0
  While (i < max) And (d2 < Dist)
    d2 = d + edges(i, EDGE_LENGTH)
    If (d2 < Dist) Then
      d = d2
      i = i + 1
    End If
  Wend
  If (i < max) Then
    dd = Dist - d
    x = edges(i, EDGE_X2) + (dd * Sin(edges(i, EDGE_ANGLE)))
    y = edges(i, EDGE_Y2) + (dd * Cos(edges(i, EDGE_ANGLE)))
  End If
  
End Sub


Private Sub getTrackDistanceAngle(TrackNo As Integer, Dist As Single, ByRef ang As Single,