Option Explicit
Dim p(9) As rcd
Dim Matrix(9, 9) As Integer
Function seekSmall(a() As Integer)
Dim n, k, m, i, j As Integer
n = UBound(a) - 2
i = 1
m = a(0, 1): k = 0
Do While a(i, 1) <> 0
If a(i, 1) < m Then
m = a(i, 1): k = i
End If
i = i + 1
Loop
seekSmall = k
Print
End Function
Private Sub cmdContinue_Click()
MsgBox "请输入要求的路径," 'vbOKCancel
txtStart.Text = ""
txtEnd.Text = "'"
txtStart.SetFocus
txtPath.Text = ""
txtLength.Text = ""
End Sub
Private Sub cmdEnd_Click()
End
End Sub
Private Sub cmdOk_Click()
Dim nS, nE As Integer
Dim h As String
Dim i, j As Integer
Dim n As Integer
Dim x, y, z As Integer
' If txtStart.Text <> And txtEnd.Text <> Then
'nS = Val(txtStart.Text) - 1: nE = Val(txtEnd.Text) - 1 '确定起始点
'If (nS > 8 Or nE > 8) Then
' MsgBox ("没有该点,请重新输入正确的点")
'End If
'Else
'MsgBox ("没有输入")
'End If
p(0).In = nS '记录起始点
n = 0
For j = 0 To 8
If j <> nS Then
p(0).fT(n, 0) = j
p(0).fT(n, 1) = Matrix(nS, j)
n = n + 1
End If
Next j
p(0).jN = seekSmall(p(0).fT())
Print
p(0).judge = True
n = 0
For j = 0 To 8
If (j <> p(0).fT(p(0).jN, 0)) And (j <> nS) Then
p(0).bT(n, 0) = j
p(0).bT(n, 1) = Matrix(nS, j)
n = n + 1
End If
Next j
For i = 1 To 9
p(i).In = p(i - 1).fT(p(i - 1).jN, 0)
For j = 0 To 7 - i
If ((p(i - 1).bT(j, 1) >= (p(i - 1).fT(p(i - 1).jN, 1) + Matrix(p(i).In, p(i - 1).bT(j, 0)))) And ((p(i - 1).fT(p(i - 1).jN, 1)) + Matrix(p(i).In, p(i - 1).bT(j, 0)) < 100)) Then
If p(i - 1).bT(j, 0) = nE Then
If p(i - 1).bT(j, 1) >= (p(i - 1).fT(p(i - 1).jN, 1) + Matrix(p(i).In, p(i - 1).bT(j, 0))) Then
p(i).judge = True
End If
End If
p(i).fT(j, 1) = (p(i - 1).fT(p(i - 1).jN, 1) + Matrix(p(i).In, p(i - 1).bT(j, 0)))
p(i).fT(j, 0) = p(i - 1).bT(j, 0)
Else
p(i).fT(j, 1) = p(i - 1).bT(j, 1)
p(i).fT(j, 0) = p(i - 1).bT(j, 0)
End If
If p(i).fT(j, 0) = nE Then
If p(i).fT(j, 1) > 100 Then
p(i).judge = True
End If
End If
Next j
p(i).jN = seekSmall(p(i).fT())
n = 0
For j = 0 To 9 - i
If p(i).jN <> j Then
p(i).bT(n, 0) = p(i).fT(j, 0)
p(i).bT(n, 1) = p(i).fT(j, 1)
n = n + 1
End If
Next j
Next i
For i = 0 To 9
If p(i).In = nE Then
For j = 0 To i
If p(j).judge = True Then
h = h & (p(j).In + 1)
End If
Next j
txtLength.Text = p(i - 1).fT(nS, 1)
ElseIf i = 9 And p(i).In <> nE Then
For j = 0 To 9
If p(j).judge = True Then
h = h & (p(j).In + 1)
End If
Next j
txtLength.Text = p(7).fT(nS, 1)
End If
Next i
txtPath.Text = h & nE + 1
Open ("d:\1.txt") For Output As #1
For z = 0 To 9
Print #1,
Print #1, "----------------------------------------------------------;"
Print #1,
Print #1, p(z).In
For x = 0 To 9 - z
For y = 0 To 1
Print #1, p(z).fT(x, y);
Next y
Next x
Print #1,
Print #1, p(z).jN
For x = 0 To 8 - z
For y = 0 To 1
Print #1, p(z).bT(x, y);
Next y
Next x
Next z
For x = 0 To 8
Print #1,
Print #1, p(x).judge
Next x
Close
End Sub
Private Sub cmdOpen_Click()
Dim i, j As Integer
With CommonDialog1
CommonDialog1.Filter = "文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"
CommonDialog1.ShowOpen
End With
Open CommonDialog1.FileName For Input As #1
While Not EOF(1)
For i = 0 To 8
For j = 0 To 8
Input #1, Matrix(i, j)
Next j
Next i
Print " 距离矩阵 "
For i = 0 To 8
For j = 0 To 8
Print Spc(3); Matrix(i, j);
Next j
Print
Next i
Wend
Close #1
End Sub
'Dim i, j As Integer
'On Error GoTo a:
'With CommonDialog1
'CommonDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
'CommonDialog1.ShowOpen
'End With
'
'Open CommonDialog1.FileName For Input As #1
'Do While Not EOF(1)
'For i = 0 To 8
'For j = 0 To 8
'Input #1, Matrix(i, j)
'Next j
'Next i
'Loop
'Close
'Open CommonDialog1.FileName For Input As #1
'txtEdit.Text = Input(LOF(1), 1)
'
'Close #1
'a: