form1.frm

dijkstra算法源代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   9630
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10080
   LinkTopic       =   "Form1"
   ScaleHeight     =   9630
   ScaleWidth      =   10080
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text3 
      Height          =   4095
      Left            =   6000
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   9
      Text            =   "Form1.frx":0000
      Top             =   5520
      Width           =   3975
   End
   Begin VB.TextBox Text2 
      Height          =   4215
      Left            =   6000
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      Text            =   "Form1.frx":0006
      Top             =   840
      Width           =   3975
   End
   Begin VB.TextBox Text1 
      Height          =   9015
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Text            =   "Form1.frx":000C
      Top             =   600
      Width           =   5775
   End
   Begin VB.ComboBox Combo2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   3240
      TabIndex        =   4
      Text            =   "终点站"
      Top             =   120
      Width           =   1215
   End
   Begin VB.ComboBox Combo1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   960
      TabIndex        =   3
      Text            =   "起讫站"
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "最短路径"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "DST 与邻接点之间的距离"
      Height          =   255
      Left            =   6000
      TabIndex        =   8
      Top             =   5160
      Width           =   2415
   End
   Begin VB.Label Label3 
      Caption         =   "LJD 邻节点的编号"
      Height          =   255
      Left            =   6000
      TabIndex        =   7
      Top             =   600
      Width           =   2055
   End
   Begin VB.Label Label1 
      Caption         =   "起点"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   240
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "终点"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2400
      TabIndex        =   0
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim start, ends As Long
Dim JLH(1 To 300) As Long
Dim LJD(1 To 300, 1 To 4) As Long    '邻接点的编号
Dim DST(1 To 300, 1 To 4) As Long    '与邻接点的距离
Dim BH(1 To 300) As Long             '节点编号
Dim ADD(1 To 300) As String          '节点名称

Dim n As Integer
Dim vertexnum As Integer    '图的顶点数
Dim edgenum As Integer      '图的边数
Const max = 100000
Dim graph(0 To 300, 0 To 300) As Long   '从i点与其邻接点j的距离
Dim visited(0 To 300) As Integer
Dim path(0 To 300) As Integer
Dim distance(0 To 90000) As Long

Private Function dijkstra(begin As Integer)

    Dim minedge As Long
    Dim vertex As Integer
    Dim i, j, n, m As Integer
    Dim edges As Integer
    
    edges = 1
    visited(begin) = 1
    
    For i = 1 To vertexnum     '计算begin点到所有邻点的距离
        distance(i) = graph(begin, i)
       ' Debug.Print distance(i)
    Next i
    
    distance(begin) = 0
              
    While (edges < vertexnum - 1)
    
        edges = edges + 1
        
        minedge = max
        
        For j = 1 To vertexnum    '遍历所有点
        
            If visited(j) = 0 And minedge > distance(j) Then '判断未标记和直接相连的点  距离最小的点j
            
                vertex = j              '记录begin点到所有邻接点距离最小的点j
                minedge = distance(j)   '记录begin点到所有邻接点距离最小的点j的距离
                
            End If
            
        Next j
        
        visited(vertex) = 1            '标记点j
                
        For n = 1 To vertexnum
        
            If visited(n) = 0 And (distance(vertex) + graph(vertex, n)) < distance(n) Then
                'visited(n) = 0表示编号为n的点未标记，(distance(vertex) + graph(vertex, n)) < distance(n)
                distance(n) = distance(vertex) + graph(vertex, n)
                path(n) = vertex
            End If
            
        Next
        
    Wend
End Function


Private Sub Command1_Click()
    Dim i, j As Integer
    Dim k As Integer
    Dim addname(1 To 100) As String
    
    Text1 = ""
    
    If start = 0 Or ends = 0 Then
        MsgBox "请选择起始站与终点站"
        Exit Sub
    End If
    For i = 1 To vertexnum    '遍历顶点
        visited(i) = 0
        path(i) = 0
    Next
    dijkstra (start)
    Text1 = "起讫站：" & ADD(start) & "  -->  " & "终点站：" & ADD(ends) & vbCrLf
    Text1 = Text1 & vbCrLf
    If distance(ends) = max Then
        Text1 = Text1 & "两站点间没有可联接的路线！"
        Exit Sub
    Else
        Text1 = Text1 & "它们之间的距离为： " & distance(ends) * 0.1 & "  Km" & vbCrLf
        Text1 = Text1 & vbCrLf
        Text1 = Text1 & "它们之间的最短路线为：" & vbCrLf
        Text1 = Text1 & vbCrLf
        Text1 = Text1 & ADD(start)
    End If
    k = ends
    j = 1
    Do
        addname(j) = ADD(k)
        k = path(k)
        j = j + 1
    Loop While (k <> 0)
    
    For j = j - 1 To 1 Step -1
        Text1 = Text1 & "--> " & addname(j)
    Next j
End Sub

Private Sub Form_Initialize()
    Dim i, j, k As Long
    Dim filename As String
    Dim buffers As String
    
    On Error Resume Next
    
    filename = App.path + "\" + "Add_Dst" + ".txt"
    Open filename For Input As #1
    If LOF(1) = 0 Then
        MsgBox "The lenth of the file is zero! Please Select it asgain。" & vbCrLf & "The file name is Add_Dst。"
        
        Exit Sub
    End If
    i = 1
    
    Me.Text2.Text = "节点编号     邻节点"
    Me.Text3.Text = "节点编号  与邻接点之间的距离"
    Do While Not EOF(1)
    Line Input #1, buffers
        BH(i) = Val(Mid$(buffers, 1, 3))
        ADD(i) = Mid$(buffers, 4, 4)
            Combo1.AddItem ADD(i)
            Combo2.AddItem ADD(i)
        LJD(i, 1) = Val(Mid$(buffers, 8, 3))    '邻接点的编号
        DST(i, 1) = Val(Mid$(buffers, 11, 2))    '与邻接点之间的距离
        
        If LJD(i, 1) <> 0 And DST(i, 1) <> 0 Then
        
            Me.Text2.Text = Me.Text2.Text & vbCrLf & "   " & i & "           " & LJD(i, 1)
            Me.Text3.Text = Me.Text3.Text & vbCrLf & "   " & i & "           " & DST(i, 1)
        End If
        
        LJD(i, 2) = Val(Mid$(buffers, 13, 3))
        DST(i, 2) = Val(Mid$(buffers, 16, 2))
        
        If LJD(i, 2) <> 0 And DST(i, 2) <> 0 Then
        
            Me.Text2.Text = Me.Text2.Text & vbCrLf & "   " & i & "          " & LJD(i, 2)
            Me.Text3.Text = Me.Text3.Text & vbCrLf & "   " & i & "          " & DST(i, 2)
        End If
        
        LJD(i, 3) = Val(Mid$(buffers, 18, 3))
        DST(i, 3) = Val(Mid$(buffers, 21, 2))
        
        If LJD(i, 3) <> 0 And DST(i, 3) <> 0 Then
        
            Me.Text2.Text = Me.Text2.Text & vbCrLf & "   " & i & "          " & LJD(i, 3)
            Me.Text3.Text = Me.Text3.Text & vbCrLf & "   " & i & "          " & DST(i, 3)
        End If
        
        LJD(i, 4) = Val(Mid$(buffers, 24, 3))
        DST(i, 4) = Val(Mid$(buffers, 27, 2))
        
        If LJD(i, 4) <> 0 And DST(i, 4) <> 0 Then
        
            Me.Text2.Text = Me.Text2.Text & vbCrLf & "   " & i & "          " & LJD(i, 4)
            Me.Text3.Text = Me.Text3.Text & vbCrLf & "   " & i & "          " & DST(i, 4)
        End If
        
        Kill buffers
        i = i + 1
        
        Me.Text2.Text = Me.Text2.Text & vbCrLf
        Me.Text3.Text = Me.Text3.Text & vbCrLf
    Loop
        n = i - 1
'       Debug.Print n
    Close #1
       
    vertexnum = n  '设置图的顶点数
    
    edgenum = 0
   
    For i = 1 To n
        For j = 1 To 4
            If LJD(i, j) = 0 Then Exit For
            edgenum = edgenum + 1    '获得图的边数
            graph(i, LJD(i, j)) = DST(i, j)   '从i点与其邻接点LJD(i,j)的距离
        Next
    Next

    For i = 0 To n
        For j = 0 To n
            If graph(i, j) = 0 Then
                graph(i, j) = max
            End If
        Next
    Next
End Sub
Private Sub Combo1_click()
    start = Combo1.ListIndex + 1      '获得起讫站的编号
End Sub

Private Sub Combo2_click()
    ends = Combo2.ListIndex + 1      '获得终点站的编号
End Sub