⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cpath.vb

📁 继续上传经典GIS二次开发书籍系列
💻 VB
📖 第 1 页 / 共 2 页
字号:
'---------------------------------------------------------------------
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 + -