classimageprocessing.cls

vb做的摄像头程序

  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, ByRef x As Single, ByRef y As Single)
  Dim x1 As Single
  Dim y1 As Single
  Dim h As Single
  Dim dx As Single
  Dim dy As Single
  Dim startPoint As Integer
  
  ang = TrackDetails(TrackNo, TRACK_AXIS)
  startPoint = TrackDetails(TrackNo, TRACK_START)
  x1 = edges(startPoint, EDGE_X2)
  y1 = edges(startPoint, EDGE_Y2)
  Call getTrackDistancePosition(TrackNo, dist, x, y)
  If (x > -1) Then
    dx = x1 - x
    dy = y1 - y
    h = Sqr((dx * dx) + (dy * dy))
    If (h > 0) Then
      ang = Acos(dy / h)
      If (dx < 0) Then
        ang = (2 * 3.1415927) - ang
      End If
    End If
    
    'make the angle relative to the axis of the track
    ang = ang - TrackDetails(TrackNo, TRACK_AXIS)
    If (ang < 0) Then
      ang = (2 * 3.1415927) + ang
    End If
    If (ang > 2 * 3.1415927) Then
      ang = ang - (2 * 3.1415927)
    End If
    ang = ang / 3.1415927 * 180
    ang = (ang Mod 180) * 3.1415927
  End If

End Sub



Public Sub createFeatureVectors(radius As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim dx As Single
  Dim dy As Single
  Dim dist As Single
  Dim category As Integer
  Dim max As Single
  
  For i = 0 To noOfEdges - 1
    
    For j = 0 To NoOfFeatureCategories - 1
      FeatureVector(i, j) = 0
    Next

    max = 0
    For j = 0 To noOfEdges - 1
      If (i <> j) Then
        dx = edges(i, EDGE_X) - edges(j, EDGE_X)
        dy = edges(i, EDGE_Y) - edges(j, EDGE_Y)
        dist = Sqr((dx * dx) + (dy * dy))
        If (dist < radius) Then
          category = Int(dist / (radius / NoOfFeatureCategories))
          FeatureVector(i, category) = FeatureVector(i, category) + edges(j, EDGE_LENGTH)
          If (FeatureVector(i, category) > max) Then
            max = FeatureVector(i, category)
          End If
        End If
      End If
    Next
    
    If (max > 0) Then
      For j = 0 To NoOfFeatureCategories - 1
        FeatureVector(i, j) = FeatureVector(i, j) / max
      Next
    End If
  Next
  
End Sub


Public Sub NormalizeTracks()
'puts all tracks into a normalised format
  Dim i As Integer
  Dim j As Integer
  Dim x As Single
  Dim y As Single
  Dim trackLength As Long
  Dim dist As Single
  Dim ang As Single
  
  For i = 0 To noOfTracks - 1
    trackLength = TrackDetails(i, TRACK_LENGTH)
    For j = 1 To NoOfTrackPositions - 1
      dist = (trackLength / NoOfTrackPositions) * j
      Call getTrackDistanceAngle(i, dist, ang, x, y)
      TrackPositions(i, j, 0) = ang / (2 * 3.1415927)
      TrackPositions(i, j, 1) = x
      TrackPositions(i, j, 2) = y
    Next
  Next
End Sub





Public Sub mergeEdges(neighbourhoodRadius As Integer)
'connects adjacent edges together
  Dim i As Integer
  Dim j As Integer
  Dim dist As Single
  Dim dx As Single
  Dim dy As Single
  
  For i = 0 To noOfEdges - 1
    For j = 0 To noOfEdges - 1
      If (i <> j) Then
        
        dx = edges(i, EDGE_X1) - edges(j, EDGE_X1)
        dy = edges(i, EDGE_Y1) - edges(j, EDGE_Y1)
        dist = Sqr((dx * dx) + (dy * dy))
        If (dist <= neighbourhoodRadius) Then
          edges(j, EDGE_X1) = edges(j, EDGE_X1) + (dx / 2)
          edges(j, EDGE_Y1) = edges(j, EDGE_Y1) + (dy / 2)
          edges(i, EDGE_X1) = edges(i, EDGE_X1) - (dx / 2)
          edges(i, EDGE_Y1) = edges(i, EDGE_Y1) - (dy / 2)
        End If
        
        dx = edges(i, EDGE_X2) - edges(j, EDGE_X2)
        dy = edges(i, EDGE_Y2) - edges(j, EDGE_Y2)
        dist = Sqr((dx * dx) + (dy * dy))
        If (dist <= neighbourhoodRadius) Then
          edges(j, EDGE_X2) = edges(j, EDGE_X2) + (dx / 2)
          edges(j, EDGE_Y2) = edges(j, EDGE_Y2) + (dy / 2)
          edges(i, EDGE_X2) = edges(i, EDGE_X2) - (dx / 2)
          edges(i, EDGE_Y2) = edges(i, EDGE_Y2) - (dy / 2)
        End If
            
      End If
    Next
  Next
  
End Sub


Public Sub getBlobs(BlobThreshold As Single)
  Dim i As Integer
  
  NoOfBlobs = 0
  For i = 5 To width / 4
    If (NoOfBlobs < 30000) Then
      Call findBlobsRadius(i, BlobThreshold)
    End If
  Next
End Sub



Private Sub findBlobsRadius(BlobRadius As Integer, BlobThreshold As Single)
  Dim e As Integer
  Dim matches As Long
  Dim x As Integer
  Dim y As Integer
  Dim dx As Single
  Dim dy As Single
  Dim dist As Single
  Dim eDist As Single
  Dim boundaryDist As Single
  Dim pixels As Single
  Dim angle As Single
  Dim edgeangle As Single
  Dim da As Single
  
  pixels = 4 * BlobRadius * BlobRadius
  boundaryDist = (BlobRadius * 0.7)
  boundaryDist = boundaryDist * boundaryDist
  For x = BlobRadius To width - BlobRadius - 1 Step 3
    For y = BlobRadius To height - BlobRadius - 1 Step 3
      
      eDist = 0
      matches = 0
      For e = 0 To noOfEdges - 1
        dx = edges(e, EDGE_X) - x
        dy = edges(e, EDGE_Y) - y
        dist = (dx * dx) + (dy * dy)
        If (dist < BlobRadius * BlobRadius) And (dist > boundaryDist) Then
          angle = dy / Acos(dist)
          angle = angle / 3.131592 * 180
          edgeangle = ((edges(e, EDGE_ANGLE) + (3.1415927 / 2)) / 3.1415927 * 180) Mod 180
          d