form6.frm

交通规划的课程设计

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form6 
   BackColor       =   &H80000013&
   Caption         =   "交通量分配"
   ClientHeight    =   8265
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   11880
   ForeColor       =   &H00000000&
   LinkTopic       =   "Form6"
   ScaleHeight     =   8265
   ScaleWidth      =   11880
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "生成Excel报表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6600
      TabIndex        =   5
      Top             =   7560
      Width           =   1935
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关  闭"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9120
      TabIndex        =   4
      Top             =   7560
      Width           =   1695
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "..\traffic\traffic.mdb"
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   495
      Left            =   960
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "road"
      Top             =   7440
      Visible         =   0   'False
      Width           =   2895
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H80000012&
      Caption         =   "开 始 计 算"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      TabIndex        =   1
      Top             =   7560
      Width           =   1815
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Bindings        =   "Form6.frx":0000
      Height          =   6015
      Left            =   960
      TabIndex        =   0
      Top             =   1320
      Width           =   9855
      _ExtentX        =   17383
      _ExtentY        =   10610
      _Version        =   393216
      Rows            =   370
      Cols            =   10
      ForeColor       =   0
      GridColor       =   8388736
   End
   Begin VB.Label Label2 
      BackColor       =   &H80000013&
      Caption         =   "（本次计算用时稍长，请耐心等待……）"
      Height          =   255
      Left            =   4080
      TabIndex        =   3
      Top             =   960
      Width           =   3375
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000013&
      Caption         =   "容量限制法计算交通量分配"
      BeginProperty Font 
         Name            =   "方正琥珀简体"
         Size            =   24
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004080&
      Height          =   615
      Left            =   2880
      TabIndex        =   2
      Top             =   240
      Width           =   6015
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()

Command1.Enabled = False

Dim Lij(619, 619) '两节点间距离
Dim Vij(619, 619) '两节点间走行速度
Dim Taij(619, 619) '两节点间走行时间
Dim Cij(619, 619) '两节点间容量
Dim tij(619, 619) '小区节点交通分布量
Dim qa(619, 619) '两节点交通量
Dim V(370)
Dim O(370)
Dim D(370)
Dim L(370)
Dim Ca(370)
Dim path(619) '又最短路到某点的前一点
Dim times '总循环次数
Dim dot(23) '小区中心点
Const node = 619 '节点上限数字

'将msflexgrid1中的数据读出赋给变量
With MSFlexGrid1
For i = 1 To 370
    L(i) = .TextMatrix(i, 4)
    O(i) = .TextMatrix(i, 2)
    D(i) = .TextMatrix(i, 3)
    V(i) = .TextMatrix(i, 5)
    Ca(i) = .TextMatrix(i, 7)
Next i

For x = 1 To 619
For y = 1 To 619
    Lij(x, y) = 32767
    Cij(x, y) = 1
    Vij(x, y) = 1
    qa(x, y) = 0
Next y
Next x

For i = 1 To 370
    Lij(O(i), D(i)) = L(i)
    Vij(O(i), D(i)) = V(i)
    Cij(O(i), D(i)) = Ca(i)
Next i
End With

'将路网图上小区中心编号重新排列成序

dot(1) = 2: dot(2) = 201: dot(3) = 213: dot(4) = 208: dot(5) = 311
dot(6) = 304: dot(7) = 424: dot(8) = 501: dot(9) = 134: dot(10) = 97
dot(11) = 100: dot(12) = 28: dot(13) = 55: dot(14) = 619: dot(15) = 70
dot(16) = 65: dot(17) = 104: dot(18) = 63: dot(19) = 135: dot(20) = 136
dot(21) = 137: dot(22) = 138: dot(23) = 139

Dim m, n As Integer
m = 0
n = 0
times = 1

'由全局变量中导入tij的值
For i = 1 To 23
For j = 1 To 23
tij(dot(i), dot(j)) = T(i, j)
Next j
Next i

'以下交通分配量计算开始
Do

For i = 1 To 23 '将23个小区中心点循环作V0

Dim V0
Dim u, vnum, w, min
Dim distance(619) '记录从源点到其他各点当前的最短路径
Dim s(619)
Max = 32767 'max表示如果两点间不相邻，则时间为无穷大

V0 = dot(i)

For w = 1 To node
    path(w) = 0
    distance(w) = Taij(V0, w)
    If Taij(V0, w) < 32767 Then path(w) = V0
    s(w) = 0
    s(V0) = 1
Next w

vnum = 1 '集合中s定点个数为1，即只有一个点v0


Do
'循环终止条件就是最后只剩一个点，那就没有选择余地
min = Max
u = V0
    For w = 1 To node
        If s(w) = 0 And distance(w) < min Then
        u = w
        min = distance(w) '寻找最小的distance(w),找u
        End If
    Next w
    
    s(u) = 1
    
    For w = 1 To node
        If s(w) = 0 And distance(u) + Taij(u, w) < distance(w) Then
        distance(w) = distance(u) + Taij(u, w) '调整非s点集合点的最短路径值
        path(w) = u
        End If
    Next w
        
        vnum = vnum + 1
        
Loop Until vnum = 232

For j = 1 To 23
If dot(i) = dot(j) Then Exit For
n = dot(j)
m = path(n)
 
Do
qa(m, n) = qa(m, n) + tij(dot(i), dot(j)) / 4 '小组号+1
qa(O(i), D(j)) = qa(m, n)
n = path(n)
m = path(n)
Loop Until n = dot(i)
Next j
Next i

For x = 1 To node
For y = 1 To node
Taij(x, y) = 32767
Next y
Next x

For i = 1 To 370
    Lij(O(i), D(i)) = L(i)
    Vij(O(i), D(i)) = V(i)
    Cij(O(i), D(i)) = Ca(i)
    Taij(O(i), D(i)) = Lij(O(i), D(i)) / Vij(O(i), D(i)) * (1 + 2.62 * (qa(O(i), D(j)) / Cij(O(i), D(i)))) 'BPR函数
    Taij(D(i), O(i)) = Taij(O(i), D(i))
    If Cij(O(i), D(i)) <= qa(O(i), D(i)) Then
    Taij(O(i), D(i)) = 32767
    qa(O(i), D(i)) = Cij(O(i), D(i))
    End If
Next i

times = times + 1

Loop Until times > 4

With MSFlexGrid1
For i = 1 To 370
.TextMatrix(i, 9) = Format(qa(O(i), D(i)), ".00")
Next i
End With

MsgBox "恭喜你，交通量分配计算完毕！", , "计算完毕"

Command1.Enabled = False
Command2.Enabled = True
Command3.Enabled = True
End Sub

Private Sub Command2_Click()
Unload Form6
End Sub

Private Sub Command3_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
On Error Resume Next
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

For i = 0 To 370 '网格数
MSFlexGrid1.Row = i
For j = 1 To 9
MSFlexGrid1.Col = j

If IsNull(MSFlexGrid1.Text) = False Then
xlSheet.Cells(i + 1, j) = MSFlexGrid1.Text
End If
Next j
Next i
Exit Sub
End Sub

Private Sub Form_Load()
Command2.Enabled = False
Command3.Enabled = False
 '调整网格的宽度
MSFlexGrid1.ColWidth(0) = 120
MSFlexGrid1.ColWidth(4) = 1200
MSFlexGrid1.ColWidth(7) = 1200
MSFlexGrid1.ColWidth(8) = 1200
MSFlexGrid1.ColWidth(9) = 1200
End Sub