?? classimageprocessing.cls
字號:
Dim edgeFound As Boolean
Dim newedgeFound As Boolean
Dim pixel As Integer
Dim val As Byte
Dim edgePath(30000, 3)
Dim NoOfEdgePoints As Integer
Dim i As Integer
Dim j As Integer
Dim dx As Single
Dim dy As Single
Dim angle As Single
Dim Dist As Single
Dim xx As Integer
Dim yy As Integer
Dim edgeType As Integer
Dim intensity As Single
Dim histMax As Single
Dim edgeLocated As Boolean
Dim edgeCount As Integer
Dim trackLen As Long
Dim x1 As Single
Dim y1 As Single
Dim da As Single
Dim startEdge As Integer
Dim max_da As Single
Dim avAngle As Single
Dim totAngle As Single
Dim prevAngle As Single
Dim angleChange As Single
Const thresh = 20
For i = 0 To NoOfEdgeAngles - 1
EdgeHistogram(i) = 0
Next
For x = 0 To width - 1
For y = 0 To height - 1
edgeTraced(x, y) = False
Next
Next
noOfEdges = 0
noOfTracks = 0
maxEdgeLength = 1
histMax = 1
newedgeFound = True
edgeCount = 0
While (newedgeFound)
edgeFound = False
edgeLocated = False
x = 0
While (x < width) And (edgeFound = False)
y = 0
While (y < height) And (edgeFound = False)
If (image(x, y) > thresh) And (edgeTraced(x, y) = False) Then
edgeFound = True
Else
y = y + 1
End If
Wend
If (edgeFound = False) Then
x = x + 1
End If
Wend
newedgeFound = edgeFound
NoOfEdgePoints = 0
max_da = 0
x1 = -1
y1 = -1
prevAngle = -1
While (edgeFound)
edgeTraced(x, y) = True
pixel = 0
edgeFound = False
While (pixel < 24) And (Not edgeFound)
Select Case pixel
Case 0
If (y > 0) Then
If (image(x, y - 1) > thresh) And (Not edgeTraced(x, y - 1)) Then
y = y - 1
edgeFound = True
End If
End If
Case 1
If (x < width) 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 2
If (x < width) Then
If (image(x + 1, y) > thresh) And (Not edgeTraced(x + 1, y)) Then
x = x + 1
edgeFound = True
End If
End If
Case 3
If (x < width) And (y < height) 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 4
If (y < height) Then
If (image(x, y + 1) > thresh) And (Not edgeTraced(x, y + 1)) Then
y = y + 1
edgeFound = True
End If
End If
Case 5
If (x > 0) And (y < height) 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 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)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -