Const max_vertex = 6 '最大顶点数
Const max_arc = 8 '最大边数
Dim P(1 To max_vertex, 1 To max_vertex) As Integer '路径
Dim D(1 To max_vertex, 1 To max_vertex) As Integer '存放距离
Dim arc_pos(1 To max_vertex, 1 To max_vertex) As Integer '边在图中的编号 Sub short_path() '最短路径
Const Infinity = 2767 '无穷大
Dim adjmatrix(1 To max_vertex, 1 To max_vertex) As Integer '邻接矩阵
Dim vex_pos(1 To max_vertex) As Integer '顶点在图中的编号
Dim vexnum As Integer, arcnum As Integer '图的当前顶点数和弧数 vexnum = 6
Dim ii As Integer
For ii = 1 To vexnum
vex_pos(ii) = ii '顶点位置
Next ii
'初始化邻接矩阵
Dim jj As Integer
Dim k As Integer
For jj = 1 To vexnum
For k = 1 To vexnum
If jj = k Then
adjmatrix(jj, k) = 0
Else
adjmatrix(jj, k) = Infinity
End If
Next k
Next jj
'以下为给各边赋权值
arcnum = 8
adjmatrix(1, 2) = 10
adjmatrix(2, 1) = 10
adjmatrix(1, 4) = 10
adjmatrix(4, 1) = 10
adjmatrix(1, 5) = 10
adjmatrix(5, 1) = 10
adjmatrix(1, 6) = 60
adjmatrix(6, 1) = 60
adjmatrix(2, 6) = 45
adjmatrix(6, 2) = 45
adjmatrix(3, 4) = 45
adjmatrix(4, 3) = 45
adjmatrix(4, 5) = 50
adjmatrix(5, 4) = 50
adjmatrix(5, 6) = 15
adjmatrix(6, 5) = 15
'边在图中的编号
Dim l As Integer, h As Integer
For l = 1 To vexnum
For h = 1 To vexnum
arc_pos(l, h) = 0
Next h
Next l
arc_pos(1, 2) = 1
arc_pos(2, 1) = 1
arc_pos(1, 4) = 2
arc_pos(4, 1) = 2
arc_pos(1, 5) = 3
arc_pos(5, 1) = 3
arc_pos(1, 6) = 4
arc_pos(6, 1) = 4
arc_pos(2, 6) = 5
arc_pos(6, 2) = 5
arc_pos(5, 6) = 6
arc_pos(6, 5) = 6
arc_pos(3, 4) = 7
arc_pos(4, 3) = 7
arc_pos(4, 5) = 8
arc_pos(5, 4) = 8
'求最短路径，将最短路径的长度放在数组D(max_vertex, max_vertex)中，路径放在数组P(max_vertex, max_vertex)中
Dim v As Integer
Dim w As Integer
For v = 1 To vexnum
For w = 1 To vexnum
D(v, w) = adjmatrix(v, w)
If v <> w And D(v, w) < Infinity Then
P(v, w) = v
Else
P(v, w) = 0
End If
Next w
Next v
Dim z As Integer, x As Integer, y As Integer
For z = 1 To vexnum
For x = 1 To vexnum
For y = 1 To vexnum
If D(x, z) + D(z, y) < D(x, y) Then
D(x, y) = D(x, z) + D(z, y)
P(x, y) = P(z, y)
End If
Next y
Next x
Next z
End Sub Private Sub Command2_Click()
If Combo1.ListIndex = -1 Or Combo2.ListIndex = -1 Then '若用户没有请选择一个公交站点
MsgBox "请选择一个公交站点！"
Else
Dim m As Integer, n As Integer
m = Me.Combo1.ListIndex + 1
n = Me.Combo2.ListIndex + 1
Text1.Text = D(m, n)
End If
'高亮显示最短路径
Dim fs As Features
Dim lyr As Layer
Set lyr = Map1.Layers("边")
Set fs = lyr.AllFeatures
lyr.Selection.ClearSelection
If m <> n Then '若起点和终点一样（即m=n）,则不要求高亮显示
If P(m, n) = m Then
lyr.Selection.Add fs(arc_pos(m, n)) '即站点m和站点n之间直接相连
Else
Do
lyr.Selection.Add fs(arc_pos(n, P(m, n))) '即站点m和站点n之间要通过站点p(m,n)
n = P(m, n)
Loop While P(m, n) <> m
lyr.Selection.Add fs(arc_pos(n, m)) '将起点m与其第一个通过的站点n相连
End If
End If End Sub |
