module1.bas

一个动态调度的软件

Attribute VB_Name = "min_dis"
'Public Declare Sub ShowDlg Lib "xds.dll" (ByRef a As Long)




'求最短路径
Public Function min_dis(ByRef Adjoin As Variant, ByVal start As Integer _
, ByVal endd As Integer _
, ByRef Min_Length As Integer, ByRef Min_Row() As Integer) As Boolean    '节点认为是字符型


  u1 = UBound(Adjoin, 1)   '取出邻接矩阵的第一维最大下标
  u2 = UBound(Adjoin, 2)   '取出邻接矩阵的第二维最大下标
  
  Dim L() As Integer       '存放临时节点
  Dim prev() As Integer    '存放前导点的数组
  Dim d() As Integer       '存放最短路径长度,d(i)表示从起点到i点的最短路径长度
  
  '初始化临时节点表，把跟起始点相连的点都存放进去
  ReDim L(0 To u2)
  Dim k As Integer
  k = 0
  For j = 0 To u2
    L(j) = -1
    If Adjoin(start, j) > 0 Then
       L(j) = j
    End If
  Next
  

  '初始化d()数组，跟起始点没有直线连通的点，暂时不知道最短路径长度，设为无穷大，用-1表示
  ReDim d(0 To u2)
  k = 0
  For m = 0 To u2
    If Adjoin(start, m) > 0 Then
       d(m) = Adjoin(start, m)
    Else
       d(m) = -1
    End If

  Next
  
  '初始prev()数组，跟起始点有直线相连的点的前导点都是起始点
  ReDim prev(0 To u2)
  For p = 0 To u2
     If Adjoin(start, p) > 0 Then
        prev(p) = start
     Else
        prev(p) = -1
     End If
  Next
  
  
  '开始循环求最短路径
  Dim min_d, n As Integer
  
  Do While Not isVoid(L)
     min_d = get_min_d(L, d)
     
'     MsgBox min_d                      '用来逐次打印最短路径上的点
  
  Debug.Print "%%%%%%%%%%"
     Dim ss As String
     ss = ""
     For y = 0 To u2
      ss = ss + " " + CStr(L(y))
     Next
      Debug.Print ss
       Debug.Print "%%%%%%%%%%"
       L(min_d) = -1
       
       
     For n = 0 To u2
       If Adjoin(min_d, n) > 0 Then
          If n <> prev(min_d) And (prev(n) = -1 Or compare(d(n), d(min_d) + Adjoin(min_d, n)) = 1) Then
              d(n) = d(min_d) + Adjoin(min_d, n)
          
          
             If prev(n) = -1 Then
                If Not Add_to_L(L, n) Then
                   MsgBox "将新网络点" & CStr(n) & "加入L数组出错!"
                   Exit Function
                End If
             End If
             
             prev(n) = min_d
          End If
          
       End If
     Next
     
  Loop
  
  '循环结束
  Min_Length = d(endd)
  
  Dim min_row_tmp() As Integer
  ReDim min_row_tmp(0 To u2)
  min_row_tmp(0) = endd

  k = 1
  endd_tmp = endd
  Do While prev(endd_tmp) <> start
      min_row_tmp(k) = prev(endd_tmp)
      endd_tmp = prev(endd_tmp)
      k = k + 1
  Loop
  
  min_row_tmp(k) = start
  ReDim Min_Row(0 To k)
  
  For q = 0 To k
       Min_Row(q) = min_row_tmp(k - q)         '将倒序的路径改为顺序的
  Next

  
  
End Function

'判断一个整数数组是否"为空"
Public Function isVoid(a() As Integer) As Boolean

   u = UBound(a, 1)
   
   For i = 0 To u
     If a(i) > 0 Then
        isVoid = False    '不为空
        Exit Function
     End If
   Next
   
   isVoid = True '为空
   
   
End Function


'从数组L中获取d(i)最小的点i
Public Function get_min_d(a() As Integer, d() As Integer) As Integer
  u = UBound(a, 1)
  
  Dim min, j As Integer
  j = -1
  min = d(0)
  
  Dim ss As String
  
  For i = 0 To u
      ss = ss + " " + CStr(d(i))
     If a(i) >= 0 Then
        If 1 = compare(min, d(a(i))) Then
           min = d(a(i))
           j = a(i)
        End If
     End If
  Next

 Debug.Print "ss====;" + ss
  get_min_d = j

  
End Function

'比较两个路径之间的大小，由于“-1"表示无穷大，所以”-1”比任何非无穷数都大
'a>b 返回 1，a =b 返回 0，a<b 返回-1
Public Function compare(ByVal a As Integer, ByVal b As Integer) As Integer
   If a = -1 Then
      If b <> -1 Then
         compare = 1
      Else
         compare = 0
      End If
   Else
      If b = -1 Then
         compare = -1
      Else
         If a > b Then
            compare = 1
         ElseIf a = b Then
            compare = 0
         Else
            compare = -1
         End If
      End If
   End If
   
      
End Function

'把一个新的点加入到L数组
Public Function Add_to_L(ByRef a() As Integer, ByVal b As Integer) As Boolean
  a(b) = b
  Add_to_L = True
End Function