VB的Dijkstra算法

[luoshuishuishang]

本人用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

[赵4老师]

代码功能归根结底不是别人帮自己看或讲解或注释出来的；而是被自己静下心来花足够长的时间和精力亲自动手单步或设断点或对执行到某步获得的中间结果显示或写到日志文件中一步一步分析出来的。 提醒：再牛×的老师也无法代替学生自己领悟和上厕所！

[红牛工作室]

VB吧已经有人发了一个最短路径的算法了