cpath.vb

继续上传经典GIS二次开发书籍系列

        Return array
    End Function
    '---------------------------------------------------------------------
    Private Function Search(ByVal pAllRoutines As Routine(), ByVal nSize As Short, _
    ByVal pStations As Station(), ByVal nSCount As Short, _
    ByVal szFrom As String, ByVal szTo As String, ByVal pResPath As ArrayList) As Short
        Dim nCount As Short = 0
        Dim nStationOrder As Short
        Dim nodeCurrent As Node
        Dim queueNodes As New Queue() ' 存储需要访问的节点
        Dim nRoutineCurrent, nStationCurrent, i As Short
        Dim nMinChangeTimes As Short = 1000  ' 第一次找到的换乘次数

        ' 先得到起点站的线路
        For i = 0 To nSize - 1
            nStationOrder = HasStation(pAllRoutines(i), szFrom, 0, 0)
            If nStationOrder >= 0 Then
                nodeCurrent = New Node()
                nodeCurrent.nNodeNumber = 1
                ReDim nodeCurrent.nRoutineOrder(9)
                ReDim nodeCurrent.nStationOrder(10)

                nodeCurrent.nRoutineOrder(0) = i
                nodeCurrent.nStationOrder(0) = nStationOrder
                ' 入队列操作
                queueNodes.Enqueue(nodeCurrent)
            End If
        Next

        While Not 0 = queueNodes.Count
            nodeCurrent = queueNodes.Dequeue()
            If nodeCurrent.nNodeNumber >= TIMELIMIT + 1 Or _
               nodeCurrent.nNodeNumber > nMinChangeTimes - 1 Or _
               queueNodes.Count > 1500000 Then '换乘次数限制
                Return nCount
            End If

            ' 得到队列头
            ' 从队头站点序列的最后一个站开始检索是否能够找到到站
            nRoutineCurrent = nodeCurrent.nRoutineOrder(nodeCurrent.nNodeNumber - 1)
            nStationCurrent = nodeCurrent.nStationOrder(nodeCurrent.nNodeNumber - 1)

            nStationOrder = HasStation(pAllRoutines(nRoutineCurrent), szTo, _
                                  nStationCurrent, pAllRoutines(nRoutineCurrent).nFlag)
            If nStationOrder >= 0 Then ' 表示找到
                nodeCurrent.nRoutineOrder(nodeCurrent.nNodeNumber) = nRoutineCurrent
                nodeCurrent.nStationOrder(nodeCurrent.nNodeNumber) = nStationOrder
                nodeCurrent.nNodeNumber = nodeCurrent.nNodeNumber + 1

                If nodeCurrent.nNodeNumber > nMinChangeTimes Then
                    Return nCount
                End If
                Dim pPathTempNode As New PathNode()
                pPathTempNode.nSegNumber = nodeCurrent.nNodeNumber - 1
                ReDim pPathTempNode.szRoutineName(pPathTempNode.nSegNumber - 1)
                ReDim pPathTempNode.szFromStationName(pPathTempNode.nSegNumber - 1)
                ReDim pPathTempNode.szToStationName(pPathTempNode.nSegNumber - 1)
                For i = 0 To pPathTempNode.nSegNumber - 1
                    pPathTempNode.szRoutineName(i) = String.Copy(pAllRoutines(nodeCurrent.nRoutineOrder(i)).szRoutineName)
                    pPathTempNode.szFromStationName(i) = String.Copy(pAllRoutines(nodeCurrent.nRoutineOrder(i)).szStaionName(nodeCurrent.nStationOrder(i)))
                    pPathTempNode.szToStationName(i) = String.Copy(pAllRoutines(nodeCurrent.nRoutineOrder(i + 1)).szStaionName(nodeCurrent.nStationOrder(i + 1)))
                Next
                pResPath.Add(pPathTempNode)

                If nCount = 0 Then
                    nMinChangeTimes = nodeCurrent.nNodeNumber
                End If
                nCount = nCount + 1
                If nCount > 20 Then
                    Return nCount
                End If
            Else  ' 要将所有可能的路径加入队列
                For i = nStationCurrent + 1 To pAllRoutines(nRoutineCurrent).nStationNumber - 1
                    Dim szTheStation As String
                    szTheStation = String.Copy(pAllRoutines(nRoutineCurrent).szStaionName(i))
                    Dim j As Short = SearchStation(pStations, nSCount, szTheStation)
                    Dim k As Short
                    For k = 0 To pStations(j).nRoutineNumber - 1
                        Dim l As Short
                        For l = 0 To nodeCurrent.nNodeNumber - 1
                            If pStations(j).pnRoutineID(k) = nodeCurrent.nRoutineOrder(l) Then
                                GoTo BreakL
                            End If
                        Next l
BreakL:                 If l < nodeCurrent.nNodeNumber Then ' 说明已经处理过该线路
                            GoTo ContinueK
                        End If

                        Dim nodeTemp As New Node()
                        nodeTemp.nNodeNumber = nodeCurrent.nNodeNumber + 1
                        ReDim nodeTemp.nRoutineOrder(10)
                        ReDim nodeTemp.nStationOrder(10)
                        For l = 0 To nodeCurrent.nNodeNumber - 1
                            nodeTemp.nRoutineOrder(l) = nodeCurrent.nRoutineOrder(l)
                            nodeTemp.nStationOrder(l) = nodeCurrent.nStationOrder(l)
                        Next l
                        nodeTemp.nRoutineOrder(nodeCurrent.nNodeNumber) = pStations(j).pnRoutineID(k)
                        nodeTemp.nStationOrder(nodeCurrent.nNodeNumber) = pStations(j).pnOrder(k)
                        queueNodes.Enqueue(nodeTemp)
ContinueK:          Next k
                Next i

                If pAllRoutines(nRoutineCurrent).nFlag = 0 Then ' 双向线路需要两个方向查询
                    For i = nStationCurrent - 1 To 0 Step -1
                        Dim szTheStation As String
                        szTheStation = String.Copy(pAllRoutines(nRoutineCurrent).szStaionName(i))

                        Dim j As Short = SearchStation(pStations, nSCount, szTheStation)
                        Dim k As Short
                        For k = 0 To pStations(j).nRoutineNumber - 1
                            Dim l As Short
                            For l = 0 To nodeCurrent.nNodeNumber - 1
                                If pStations(j).pnRoutineID(k) = nodeCurrent.nRoutineOrder(l) Then
                                    GoTo SecondBreakL
                                End If
                            Next l
SecondBreakL:               If l < nodeCurrent.nNodeNumber Then ' 说明已经处理过该线路
                                GoTo SecondContinueK
                            End If
                            Dim nodeTemp As New Node()
                            nodeTemp.nNodeNumber = nodeCurrent.nNodeNumber + 1
                            ReDim nodeTemp.nRoutineOrder(10)
                            ReDim nodeTemp.nStationOrder(10)
                            For l = 0 To nodeCurrent.nNodeNumber - 1
                                nodeTemp.nRoutineOrder(l) = nodeCurrent.nRoutineOrder(l)
                                nodeTemp.nStationOrder(l) = nodeCurrent.nStationOrder(l)
                            Next l
                            nodeTemp.nRoutineOrder(nodeCurrent.nNodeNumber) = pStations(j).pnRoutineID(k)
                            nodeTemp.nStationOrder(nodeCurrent.nNodeNumber) = pStations(j).pnOrder(k)
                            queueNodes.Enqueue(nodeTemp)
SecondContinueK:        Next k
                    Next i
                End If
            End If
        End While

        Return nCount
    End Function
    '---------------------------------------------------------------------
    ' 根据站名得到它是一条公交线路上第几站,基0,-1表示没有
    ' nSearchFrom为开始搜寻的站序号
    ' nFlag标记向那个方向搜索,0表示双方向,1表示单向
    Private Function HasStation(ByVal theRoutine As Routine, ByVal szStation As String, ByVal nSearchFrom As Short, ByVal nFlag As Short) As Short
        If nFlag <> 0 Then
            Dim i As Integer
            For i = nSearchFrom To theRoutine.nStationNumber - 1
                If theRoutine.szStaionName(i) = szStation Then
                    Return i
                End If
            Next i
        ElseIf nFlag = 0 Then
            Dim i As Integer
            For i = nSearchFrom To theRoutine.nStationNumber - 1 ' 正向搜索
                If theRoutine.szStaionName(i) = szStation Then
                    Return i
                End If
            Next i
            For i = nSearchFrom To 0 Step -1 ' 反向搜索
                If theRoutine.szStaionName(i) = szStation Then
                    Return i
                End If
            Next i
        End If

        Return -1
    End Function
    '---------------------------------------------------------------------
    Private Function SearchStation(ByVal pStations As Station(), ByVal nSCount As Short, ByVal theName As String) As Short
        Dim j As Short
        ' 用于统计时间
        For j = 0 To nSCount - 1
            If pStations(j).szStationName = theName Then
                Return j
            End If
        Next

        Return j
    End Function
    '---------------------------------------------------------------------
End Class