# VB的Dijkstra算法

luoshuishuishang 2015-09-24 06:40:20

``````
Option Explicit
Private cols As Collection
Private beginPoint As String
Private endPoint As String
Private desert() As String
Private source() As String

Private Sub Command1_Click()
ReDim desert(0)
desert(0) = "A"
Cal "D"
End Sub

InitMap ("A")
End Sub
Private Sub InitMap(ByVal begin As String)
Dim points As Point
Dim index1 As Integer
Dim index2 As Integer
Dim index3 As Integer
Dim tempArray(2) As String
Dim find As Boolean
Set cols = New Collection

Set points = New Point
points.sourcePoint = "A"
points.endPoint = "B"
points.PointLength = 1

Set points = New Point
points.sourcePoint = "A"
points.endPoint = "D"
points.PointLength = 2

Set points = New Point
points.sourcePoint = "D"
points.endPoint = "E"
points.PointLength = 1

Set points = New Point
points.sourcePoint = "B"
points.endPoint = "E"
points.PointLength = 4

Set points = New Point
points.sourcePoint = "B"
points.endPoint = "C"
points.PointLength = 2

Set points = New Point
points.sourcePoint = "C"
points.endPoint = "E"
points.PointLength = 1
ReDim source(0)
ReDim desert(0)
desert(0) = begin
'查找出节点
For index1 = 1 To cols.Count
tempArray(0) = cols(index1).sourcePoint
tempArray(1) = cols(index1).endPoint
For index2 = 0 To 1
find = False
If (tempArray(index2) <> begin) Then
For index3 = LBound(source) To UBound(source)
If (tempArray(index2) = source(index3)) Then
find = True
Exit For
End If
Next
If (find = False) Then
If (UBound(source) > 0 Or index2 > 0) Then
ReDim Preserve source(UBound(source) + 1)
End If
source(UBound(source)) = tempArray(index2)
End If
End If
Next
Next

End Sub

Private Sub Cal(ByVal endNode As String)
Dim temp As Collection
Dim index As Long
Dim minlen As Long
Dim tempLen As Long
Dim sourcePoint As String
Dim desertPoint As String
minlen = 0
While (UBound(desert) <> UBound(source))
Set temp = New Collection
GetChildNodes desert(UBound(desert)), temp
minlen = 0
For index = 1 To temp.Count
'计算最短路径
tempLen = FindLen(desert(UBound(desert)), temp(index))
If (minlen = 0) Then
minlen = tempLen
desertPoint = temp(index)
Else
If (minlen > tempLen) Then
desertPoint = temp(index)
End If
End If
Next
If (desertPoint <> "") Then
ReDim Preserve desert(UBound(desert) + 1)
desert(UBound(desert)) = desertPoint
If (desertPoint = endNode) Then
Exit Sub
End If
End If
Wend
End Sub
Private Sub GetChildNodes(ByVal sourcePoint As String, ByRef col As Collection)
Dim index As Integer
For index = 1 To cols.Count
If (cols(index).sourcePoint = sourcePoint) Then
End If
Next
End Sub
Private Function FindLen(ByVal sourcePoint As String, ByVal endPoint As String) As Long
Dim index As Long
For index = 1 To cols.Count
If (cols(index).sourcePoint = sourcePoint And cols(index).endPoint = endPoint) Then
FindLen = cols(index).PointLength
Exit For
End If

Next
End Function``````

...全文
103 2 打赏 收藏 举报

2 条回复

VB吧已经有人发了一个最短路径的算法了
• 打赏
• 举报

• 打赏
• 举报

7617

VB 基础类

2015-09-24 06:40