optimumpath4.frm

本程序是一个用prim算法寻找最小生成树的小程序。

VERSION 5.00
Begin VB.Form Form4 
   Caption         =   "Form4"
   ClientHeight    =   7815
   ClientLeft      =   1425
   ClientTop       =   570
   ClientWidth     =   9375
   LinkTopic       =   "Form4"
   ScaleHeight     =   7815
   ScaleWidth      =   9375
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   375
      Left            =   4080
      TabIndex        =   4
      Top             =   7200
      Width           =   2655
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   375
      Left            =   2400
      TabIndex        =   2
      Top             =   7200
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   7200
      Width           =   1935
   End
   Begin VB.PictureBox Picture1 
      Height          =   6855
      Left            =   0
      ScaleHeight     =   119.856
      ScaleMode       =   6  'Millimeter
      ScaleWidth      =   164.306
      TabIndex        =   0
      Top             =   0
      Width           =   9375
      Begin VB.Line Line2 
         Index           =   0
         Visible         =   0   'False
         X1              =   122.767
         X2              =   131.233
         Y1              =   55.033
         Y2              =   63.5
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "Label2"
         Height          =   255
         Index           =   0
         Left            =   7200
         TabIndex        =   5
         Top             =   2280
         Visible         =   0   'False
         Width           =   255
      End
      Begin VB.Shape Shape2 
         Height          =   375
         Index           =   0
         Left            =   7320
         Shape           =   3  'Circle
         Top             =   1560
         Visible         =   0   'False
         Width           =   375
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "Label1"
         Height          =   255
         Index           =   0
         Left            =   3240
         TabIndex        =   3
         Top             =   840
         Visible         =   0   'False
         Width           =   255
      End
      Begin VB.Line Line1 
         BorderColor     =   &H0000FFFF&
         DrawMode        =   1  'Blackness
         Index           =   0
         Visible         =   0   'False
         X1              =   38.1
         X2              =   63.5
         Y1              =   16.933
         Y2              =   33.867
      End
      Begin VB.Shape Shape1 
         BackColor       =   &H0000C000&
         BackStyle       =   1  'Opaque
         FillColor       =   &H00FF8080&
         Height          =   375
         Index           =   0
         Left            =   1080
         Shape           =   3  'Circle
         Top             =   1080
         Visible         =   0   'False
         Width           =   495
      End
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim aop() As arctype
Dim vop() As vertextype
Dim vert() As Integer
Dim nofopa As Integer
Dim sqlsid As String
Dim opti As kruscal
Dim ksindex As Integer
Dim psindex As Integer
Dim klindex As Integer
Dim plindex As Integer
Private Sub Command1_Click()
If Not traverse Then MsgBox "图不连通", vbOKOnly, "提示": Exit Sub
otree
nofopa = loada(aop(), "optpath")
dispotree
End Sub

Private Sub Command2_Click()
Unload Form4
End Sub

Private Sub Command3_Click()
If Not traverse Then MsgBox "图不连通", vbOKOnly, "提示": Exit Sub
Set opti = New kruscal
opti.initkruscal
opti.findopt
dispotree1
End Sub

Private Sub Form_Load()
Form4.Caption = "最小生成树"
Command1.Caption = "生成树(prim)"
Command2.Caption = "退出"
Command3.Caption = "最小生成树(kruscal)"
ksindex = 0: klindex = 0: psindex = 0: plindex = 0
ReDim vert(nv)
End Sub
Public Sub otree()
Dim count As Integer, total As Integer
Dim arc As arctype
count = 0
rs2.Open "select * from arc where ilink=(select min(ilink) from arc)", cn, adOpenKeyset, adLockPessimistic
cn.Execute "delete from optpath"
cn.Execute "insert into optpath values ('" & rs2("id").Value & "','" & rs2("sid").Value & "','" & rs2("eid").Value & "','" & rs2("ilink").Value & "')"
sqlsid = "id <>'" & rs2("id").Value & "' "
rs2.Close
rs2.Open "select * from vertex ", cn, adOpenKeyset, adLockPessimistic
total = rslen(rs2)
rs2.Close
rs1.Open "select * from optpath", cn, adOpenKeyset, adLockPessimistic
If rslen(rs1) < 1 Then rs1.Close: Exit Sub
rs1.MoveLast
rs1.Close
For i = 1 To total - 1
   rs1.Open "select * from optpath", cn, adOpenKeyset, adLockPessimistic
   rs1.MoveLast
   st = rs1("eid").Value
   st1 = rs1("sid").Value
   rs2.Open "select * from arc where ilink=(select min(ilink) from arc where ((sid='" & st & "' or eid ='" & st & "' or sid='" & st1 & "' or eid ='" & st1 & "'))and " & sqlsid & ")and " & sqlsid, cn, adOpenKeyset, adLockPessimistic    '"' or sid='" & st1 & "' or eid ='" & st1 &
If rslen(rs2) > 0 Then
 sqlsid = sqlsid & "and " & "id<> '" & rs2("id").Value & "'"
If isexist(rs2("eid").Value, rs1) Or isexist(rs2("sid").Value, rs1) Then
  cn.Execute "insert into optpath values('" & rs2("id").Value & "','" & rs2("sid").Value & "','" & rs2("eid").Value & "','" & rs2("ilink").Value & "')"
  
  Debug.Print rs2("id").Value, rs2("sid").Value, rs2("eid").Value, rs2("ilink").Value
 End If
 Else
  rs1.MoveFirst
  st = ""
 For j = 1 To rslen(rs1)
  st = st & "sid='" & rs1("sid").Value & " 'or sid='" & rs1("eid").Value & "'" & "or eid='" & rs1("sid").Value & " 'or eid='" & rs1("eid").Value & "'"
  If j < rslen(rs1) Then st = st & "or " Else Exit For
  rs1.MoveNext
 Next j
 rs2.Close
   rs2.Open "select * from arc where ilink = (select min(ilink) from arc  where  ((" & st & ")) and " & sqlsid & ") and " & sqlsid & " ", cn, adOpenKeyset, adLockPessimistic
 If rslen(rs2) > 0 Then
 For n = 1 To rslen(rs2)
 If isexist(rs2("eid").Value, rs1) Or isexist(rs2("sid").Value, rs1) Then
   cn.Execute "insert into optpath values('" & rs2("id").Value & "','" & rs2("sid").Value & "','" & rs2("eid").Value & "','" & rs2("ilink").Value & "')"
   sqlsid = sqlsid & "and " & "id<> '" & rs2("id").Value & "'"
  Debug.Print rs2("id").Value, rs2("sid").Value, rs2("eid").Value, rs2("ilink").Value
  Else
   sqlsid = sqlsid & "and " & "id<> '" & rs2("id").Value & "'"
  End If
  rs2.MoveNext
  Next n
 End If
 End If
  rs1.Close
  rs2.Close
Next i
End Sub
Private Function isexist(ByVal iendnode As String, ByVal rs2 As ADODB.Recordset) As Boolean
Dim i1, i As Integer
i1 = 0
If rs2.EOF And rs2.BOF Then isexist = False: Exit Function
rs2.MoveFirst
For i = 1 To rslen(rs2)
  If iendnode = rs2("eid").Value Or iendnode = rs2("sid").Value Then i1 = i1 + 1
  rs2.MoveNext
Next i
If i1 < 1 Then isexist = True Else isexist = False
End Function
Sub dispotree()
Dim i As Integer
For i = 1 To psindex
Unload Shape1(i)
Next i
For i = 1 To plindex
Unload Line1(i)
Unload Label1(i)
Next i
For i = 1 To nv
Load Shape1(i)
With Shape1(i)
.Top = ver(i).py - 3
.Left = ver(i).px - 3
.Visible = True
End With
Next i

psindex = nv

For i = 1 To nofopa
Load Line1(i)
With Line1(i)
.X1 = ver(aop(i).sid).px
.Y1 = ver(aop(i).sid).py
.X2 = ver(aop(i).eid).px
.Y2 = ver(aop(i).eid).py
.Visible = True
End With
Load Label1(i)
With Label1(i)
.Left = (Line1(i).X1 + Line1(i).X2) / 2
.Top = (Line1(i).Y1 + Line1(i).Y2) / 2
.Visible = True
.Caption = aop(i).ilink
End With
Next i
plindex = nofopa
End Sub
Sub dispotree1()
Dim i As Integer
For i = 1 To ksindex
Unload Shape2(i)
Next i
For i = 1 To klindex
Unload Line2(i)
Unload Label2(i)
Next i
For i = 1 To nv
Load Shape2(i)
With Shape2(i)
.Top = ver(i).py - 3
.Left = ver(i).px - 3 + 80
.Visible = True
End With
Next i
ksindex = nv
For i = 1 To opti.nofpa
Load Line2(i)
With Line2(i)
.X1 = ver(koparc(i).sid).px + 80
.Y1 = ver(koparc(i).sid).py
.X2 = ver(koparc(i).eid).px + 80
.Y2 = ver(koparc(i).eid).py
.Visible = True
End With
klindex = opti.nofpa
Load Label2(i)
With Label2(i)
.Left = (Line2(i).X1 + Line2(i).X2) / 2
.Top = (Line2(i).Y1 + Line2(i).Y2) / 2
.Visible = True
.Caption = koparc(i).ilink
End With
Next i
End Sub
Function traverse() As Boolean  '广度优先算法

Dim i, j As Integer
traverse = True
vert(1) = arc(1).id
For i = 2 To nv
vert(i) = 0
  For j = 1 To na
  If arc(j).eid <> vert(i) And arc(j).sid = vert(i - 1) And Not exist(arc(j).eid) Then vert(i) = arc(j).eid
  If arc(j).sid <> vert(i) And arc(j).eid = vert(i - 1) And Not exist(arc(j).sid) Then vert(i) = arc(j).sid
   Next j
Next i
For i = 1 To nv
If vert(i) = 0 Then traverse = False
Next i
End Function
Function exist(ByVal n As Integer) As Boolean
Dim i As Integer
exist = False
For i = 1 To nv
If vert(i) = n Then exist = True: Exit Function
Next i
End Function