本人用VB編了1個Dijkstra演算法的最短路徑程式，運行出現問題，各位幫忙看看。
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
Private Sub Form_Load()
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
cols.Add points
Set points = New Point
points.sourcePoint = "A"
points.endPoint = "D"
points.PointLength = 2
cols.Add points
Set points = New Point
points.sourcePoint = "D"
points.endPoint = "E"
points.PointLength = 1
cols.Add points
Set points = New Point
points.sourcePoint = "B"
points.endPoint = "E"
points.PointLength = 4
cols.Add points
Set points = New Point
points.sourcePoint = "B"
points.endPoint = "C"
points.PointLength = 2
cols.Add points
Set points = New Point
points.sourcePoint = "C"
points.endPoint = "E"
points.PointLength = 1
cols.Add points
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
col.Add cols(index).endPoint
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
uj5u.com熱心網友回復：
代碼功能歸根結底不是別人幫自己看或講解或注釋出來的；而是被自己靜下心來花足夠長的時間和精力親自動手單步或設斷點或對執行到某步獲得的中間結果顯示或寫到日志檔案中一步一步分析出來的。提醒：再牛×的老師也無法代替學生自己領悟和上廁所！
uj5u.com熱心網友回復：
VB吧已經有人發了一個最短路徑的演算法了轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/88101.html
標籤：VB基礎類