📄 cpath.vb
字号:
'---------------------------------------------------------------------
Public Class PathNode
Public nSegNumber As Short
Public szRoutineName As String()
Public szFromStationName As String()
Public szToStationName As String()
End Class
'---------------------------------------------------------------------
Public Class Routine ' 一条公交线路
Public nFlag As Short ' 0:双向;1:上行;2:下行
Public nStationNumber As Short ' 该公交路线中的站点数目
Public szRoutineName As String ' 公交路线的名称
Public szStaionName As String() ' 包含公交路线中各站点名称的数组
End Class
'---------------------------------------------------------------------
Public Class Node ' 节点集合
Public nNodeNumber As Short ' 节点数目
Public nRoutineOrder As Short() ' 线路索引
Public nStationOrder As Short() ' 站点索引
End Class
'---------------------------------------------------------------------
Public Class Station ' 公交站点
Public szStationName As String ' 站点名称
Public nRoutineNumber As Short ' 通过该公交站点的公交线路的数目
Public pnRoutineID As Short() ' 通过该公交站点的公交线路的标识号数组
Public pnOrder As Short() ' 该站点在公交线路上的索引集
End Class
'---------------------------------------------------------------------
Public Class CPath
Private TIMELIMIT As Integer = 3
Private _pRoutine As Routine() ' 公交路线数组
Private _pStations As Station() ' 公交站点数组
Private _nRCount As Short ' 公交路线数目
Private _nSCount As Short ' 公交站点数目
'---------------------------------------------------------------------
Public Sub New()
ReDim _pRoutine(1000)
ReDim _pStations(5000)
End Sub
'---------------------------------------------------------------------
Public Sub Build(ByVal env As CEnvironment)
_nRCount = BuildRoutine(_pRoutine, env)
_nSCount = BuildStationIndex(_pRoutine, _nRCount, _pStations)
End Sub
'---------------------------------------------------------------------
Private Function BuildRoutine(ByVal pRoutine As Routine(), ByVal env As CEnvironment) As Short
Dim typeTbl As System.Data.DataTable = env.m_dataSet.Tables("公交车站路线")
Dim rowstypes As System.Data.DataRow()
If env.m_szBusFilter <> "" Then
rowstypes = typeTbl.Select(env.m_szBusFilter)
Else
rowstypes = typeTbl.Select()
End If
Dim nCount As Short = 0
Dim nSCount As Short = 0
Dim i As Integer
Dim rName, sName, sTemp1, sTemp2 As String
Dim sNames(350) As String
Dim myRow As System.Data.DataRow
For Each myRow In rowstypes
rName = myRow(0).ToString()
sTemp1 = myRow(1).ToString()
sName = myRow(2).ToString()
sTemp2 = myRow(0).ToString()
If nCount = 0 Then
pRoutine(nCount) = New Routine()
pRoutine(nCount).szRoutineName = String.Copy(rName)
If rName.Length > 4 Then
If rName.Substring(rName.Length - 4, 4) = "上行" Then
pRoutine(nCount).nFlag = 1
ElseIf rName.Substring(rName.Length - 4, 4) = "下行" Then
pRoutine(nCount).nFlag = 2
End If
Else
pRoutine(nCount).nFlag = 0
End If
nCount = nCount + 1
nSCount = 0
sNames(nSCount) = String.Copy(sName)
nSCount = 1
Else
If pRoutine(nCount - 1).szRoutineName = rName Then
sNames(nSCount) = String.Copy(sName)
nSCount = nSCount + 1
Else
' 结束上一站
pRoutine(nCount - 1).nStationNumber = nSCount
ReDim pRoutine(nCount - 1).szStaionName(nSCount - 1)
For i = 0 To nSCount - 1
pRoutine(nCount - 1).szStaionName(i) = String.Copy(sNames(i))
Next
pRoutine(nCount) = New Routine()
If rName.Length > 4 Then
If rName.Substring(rName.Length - 4, 4) = "上行" Then
pRoutine(nCount).nFlag = 1
ElseIf rName.Substring(rName.Length - 4, 4) = "下行" Then
pRoutine(nCount).nFlag = 2
End If
Else
pRoutine(nCount).nFlag = 0
End If
pRoutine(nCount).szRoutineName = String.Copy(rName)
nCount = nCount + 1
nSCount = 0
sNames(nSCount) = String.Copy(sName)
nSCount = 1
End If
End If
Next
pRoutine(nCount - 1).nStationNumber = nSCount
ReDim pRoutine(nCount - 1).szStaionName(nSCount - 1)
For i = 0 To nSCount - 1
pRoutine(nCount - 1).szStaionName(i) = String.Copy(sNames(i))
Next
Return nCount
End Function
'---------------------------------------------------------------------
Private Function BuildStationIndex(ByVal pAllRoutines As Routine(), ByVal nSize As Short, ByVal pStations As Station()) As Short
Dim nCount As Integer = 0
Dim i As Short
For i = 0 To nSize - 1
Dim j As Short
For j = 0 To pAllRoutines(i).nStationNumber - 1
Dim k As Short
For k = 0 To nCount - 1
If pStations(k).szStationName = pAllRoutines(i).szStaionName(j) Then
GoTo breakForK
End If
Next k
breakForK: If k = nCount Then
' 添加一个新站
pStations(k) = New Station()
pStations(k).szStationName = String.Copy(pAllRoutines(i).szStaionName(j))
pStations(k).nRoutineNumber = 1
nCount = nCount + 1
Else
pStations(k).nRoutineNumber = pStations(k).nRoutineNumber + 1
End If
Next j
Next i
' 为各个站的信息分配内存
For i = 0 To nCount - 1
ReDim pStations(i).pnRoutineID(pStations(i).nRoutineNumber - 1)
ReDim pStations(i).pnOrder(pStations(i).nRoutineNumber - 1)
pStations(i).nRoutineNumber = 0 ' 下面重新数
Next
' 重新设置信息
For i = 0 To nSize - 1
Dim j As Short
For j = 0 To pAllRoutines(i).nStationNumber - 1
Dim k As Short
For k = 0 To nCount - 1
If pStations(k).szStationName = pAllRoutines(i).szStaionName(j) Then
GoTo breakSecond
End If
Next k
breakSecond: pStations(k).pnRoutineID(pStations(k).nRoutineNumber) = i
pStations(k).pnOrder(pStations(k).nRoutineNumber) = j
pStations(k).nRoutineNumber = pStations(k).nRoutineNumber + 1
Next j
Next i
Return nCount
End Function
'---------------------------------------------------------------------
Public Function Search(ByVal sz1 As String, ByVal sz2 As String, ByVal array As ArrayList) As ArrayList
Search(_pRoutine, _nRCount, _pStations, _nSCount, sz1, sz2, array)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -