loginmodule.bas

城市公交系统的应用开发

            Next
            rs.Close
            ReDim passsitecount(n)
            For i = 0 To n - 1
                Call connetion
                cmd.CommandText = "select * from SiteName where BusName=? order by BusNameID ASC"
            
                '设置para相关属性
                para.Type = adBSTR
                para.Direction = adParamInput
                para.Value = bussite(i, 0)

                '把para添加到参数集
                cmd.Parameters.Append para
                cmd.Parameters(0) = bussite(i, 0)

                '执行command对象
                Set rs = cmd.Execute
                Do While Not rs.EOF
                    If rs("SiteName").Value = Trim(BusSelect.BusTxt1.Text) Then
                        m = 1
                    ElseIf rs("SiteName").Value = Trim(BusSelect.BusTxt2.Text) Then
                        Exit Do
                    Else
                        m = m + 1
                    End If
                    rs.MoveNext
                Loop
                passsitecount(i) = m
                rs.Close
            Next
            For i = 0 To n - 1
                If passsitecount(i) <> -1 Then
                    min = passsitecount(i)
                    m = i
                End If
            Next
            If m <> -1 Then
                For i = m To n - 1
                    If passsitecount(i) <> -1 And passsitecount(i) < min Then
                        min = passsitecount(i)
                        m = i
                    End If
                Next
            End If
            If min <> -1 Then
                BusSelect.BusList1.AddItem "都经过两个站点的公交车有："
                For i = 0 To n - 1
                    If passsitecount(i) <> -1 Then
                        BusSelect.BusList1.AddItem "第" & bussite(i, 0) & "公交车"
                    End If
                Next
                BusSelect.BusList1.AddItem "最优路线是第" & bussite(m, 0) & "公交车"
            Else
                BusSelect.BusList1.AddItem "没有公交车同时经过这两个站点"
            End If
        Else
            MsgBox "没有" & BusSelect.BusTxt1.Text & "和" & BusSelect.BusTxt2.Text & "站点的相关信息,请您确认是模糊查询还是精确查询", 48, "提示信息"
            BusSelect.BusTxt1.SelStart = 0
            BusSelect.BusTxt1.SelLength = Len(BusSelect.BusTxt1.Text)
            BusSelect.BusTxt1.SetFocus
        End If
    End If
End Sub
Public Sub bussiteside() '站点周边环境
    Dim find As Boolean
    Dim j As Integer
    Dim m As Integer
    BusSelect.BusList1.Clear
    Call connetion
    If BusSelect.BusOption4.Value = True Then
        cmd.CommandText = "select * from SiteName where SiteName like ? order by BusNameID ASC"
        
        '设置para相关属性
        para.Type = adBSTR
        para.Direction = adParamInput
        para.Value = BusSelect.BusTxt1.Text

        '把para添加到参数集
        cmd.Parameters.Append para
        cmd.Parameters(0) = BusSelect.BusTxt1.Text

        '执行command对象
        Set rs = cmd.Execute
        If Not rs.EOF Then
            n = rs.RecordCount
            ReDim siteside(n, 2)
            BusSelect.BusList1.AddItem "请点击列表框项查看相关信息"
            For i = 1 To rs.RecordCount
                'siteside(i, 0) = rs("SiteName").Value
                siteside(i, 0) = rs("SiteX").Value
                siteside(i, 1) = rs("SiteY").Value
                rs.MoveNext
            Next
            rs.Close
            For i = 1 To n
                Call connetion
                cmd.CommandText = "select distinct SiteName,SiteX,SiteY from SiteName"
                Set rs = cmd.Execute
                m = rs.RecordCount
                ReDim bussite(m, 3)
                j = 0
                find = False
                Do While Not rs.EOF
                    If rs("SiteName").Value <> Trim(BusSelect.BusTxt1.Text) And _
                    Sqr(Abs((rs("SiteX").Value - siteside(i, 0)) * (rs("SiteX").Value - siteside(i, 0))) + _
                    Abs((rs("SiteY").Value - siteside(i, 1)) * (rs("SiteY").Value - siteside(i, 1)))) <= area Then
                        find = True
                        bussite(j, 0) = rs("SiteName").Value
                        bussite(j, 1) = rs("SiteX").Value
                        bussite(j, 2) = rs("SiteY").Value
                        j = j + 1
                    End If
                    rs.MoveNext
                Loop
                rs.Close
                If find Then
                    BusSelect.BusList1.AddItem "以下站点符合要求："
                    For k = 0 To j - 1
                        BusSelect.BusList1.AddItem bussite(k, 0)
                    Next
                Else
                    BusSelect.BusList1.AddItem "没有站点符合要求："
                End If
            Next
        Else
            MsgBox "没有" & BusSelect.BusTxt1.Text & "站点周围的相关信息,请您确认是模糊查询还是精确查询", 48, "提示信息"
            BusSelect.BusTxt1.SelStart = 0
            BusSelect.BusTxt1.SelLength = Len(BusSelect.BusTxt1.Text)
            BusSelect.BusTxt1.SetFocus
        End If
    ElseIf BusSelect.BusOption5.Value = True Then
        cmd.CommandText = "select distinct SiteX,SiteY from SiteName where SiteName=?"
        
        '设置para相关属性
        para.Type = adBSTR
        para.Direction = adParamInput
        para.Value = Trim(BusSelect.BusTxt1.Text)

        '把para添加到参数集
        cmd.Parameters.Append para
        cmd.Parameters(0) = Trim(BusSelect.BusTxt1.Text)

        '执行command对象
        Set rs = cmd.Execute
        If Not rs.EOF Then
            n = rs.RecordCount
            ReDim siteside(n, 2)
            BusSelect.BusList1.AddItem "请点击列表框项查看相关信息"
            For i = 1 To rs.RecordCount
                siteside(i, 0) = rs("SiteX").Value
                siteside(i, 1) = rs("SiteY").Value
                rs.MoveNext
            Next
            rs.Close
            For i = 1 To n
                Call connetion
                cmd.CommandText = "select distinct SiteName,SiteX,SiteY from SiteName"
                Set rs = cmd.Execute
                m = rs.RecordCount
                ReDim bussite(m, 3)
                j = 0
                find = False
                Do While Not rs.EOF
                    If rs("SiteName").Value <> Trim(BusSelect.BusTxt1.Text) And _
                    Sqr(Abs((rs("SiteX").Value - siteside(i, 0)) * (rs("SiteX").Value - siteside(i, 0))) + _
                    Abs((rs("SiteY").Value - siteside(i, 1)) * (rs("SiteY").Value - siteside(i, 1)))) <= area Then
                        find = True
                        bussite(j, 0) = rs("SiteName").Value
                        bussite(j, 1) = rs("SiteX").Value
                        bussite(j, 2) = rs("SiteY").Value
                        j = j + 1
                    End If
                    rs.MoveNext
                Loop
                rs.Close
                If find Then
                    BusSelect.BusList1.AddItem "以下站点符合要求："
                    For k = 0 To j - 1
                        BusSelect.BusList1.AddItem bussite(k, 0)
                    Next
                Else
                    BusSelect.BusList1.AddItem "没有站点符合要求："
                End If
            Next
        Else
            MsgBox "没有" & BusSelect.BusTxt1.Text & "站点周围的相关信息,请您确认是模糊查询还是精确查询", 48, "提示信息"
            BusSelect.BusTxt1.SelStart = 0
            BusSelect.BusTxt1.SelLength = Len(BusSelect.BusTxt1.Text)
            BusSelect.BusTxt1.SetFocus
        End If
    End If
End Sub

Public Sub buschang() '公交线路换乘
    Dim BusfirstName() As Variant
    Dim BuslastName() As Variant
    Dim m, t As Integer
    Dim through As Boolean       '判断是否直接到达
    Dim exist As Boolean         '判断是否可以公交线路换乘
    BusSelect.BusList1.Clear
    Call connetion
    If BusSelect.BusOption4.Value = True Then
    
        '先确定有哪些公交车经过站点
        '=========================================================================================================
        cmd.CommandText = "select * from SiteName where SiteName like ? order by BusNameID ASC"
        
        '设置para相关属性
        para.Type = adBSTR
        para.Direction = adParamInput
        para.Value = BusSelect.BusTxt1.Text

        '把para添加到参数集
        cmd.Parameters.Append para
        cmd.Parameters(0) = BusSelect.BusTxt1.Text

        '执行command对象
        Set rs = cmd.Execute
        If Not rs.EOF Then
            n = rs.RecordCount
            ReDim BusfirstName(n)
            For i = 0 To n - 1
                BusfirstName(i) = rs("BusName").Value
                rs.MoveNext
            Next
            rs.Close
        '=========================================================================================================

        '然后对每一俩公交车进行排除
        '=========================================================================================================
            For i = 0 To n - 1
                Call connetion
                cmd.CommandText = "select * from SiteName where BusName=? order by BusNameID ASC"
        
                '设置para相关属性
                para.Type = adBSTR
                para.Direction = adParamInput
                para.Value = BusfirstName(i)

                '把para添加到参数集
                cmd.Parameters.Append para
                cmd.Parameters(0) = BusfirstName(i)

                '执行command对象
                Set rs = cmd.Execute
                through = True
                Do While Not rs.EOF
                    If rs("SiteName").Value = Trim(BusSelect.BusTxt2.Text) Then       '直接到达
                        BusSelect.BusList1.AddItem "您可以直接乘坐第" & BusfirstName(i) & "公交车"
                        Exit Sub
                    Else                                                              '无直接到达
                        through = False
                    End If
                    rs.MoveNext
                Loop
                rs.Close
        '======================================================================================================

        '无直接到达
        '======================================================================================================
                If through = False Then
                    '=============================================================================================
                    Call connetion
                    cmd.CommandText = "select * from SiteName where BusName=? order by BusNameID ASC"
                    '设置para相关属性
                    para.Type = adBSTR
                    para.Direction = adParamInput
                    para.Value = BusfirstName(i)

                    '把para添加到参数集
                    cmd.Parameters.Append para
                    cmd.Parameters(0) = BusfirstName(i)

                    '执行command对象
                    Set rs = cmd.Execute
                    If Not rs.EOF Then
                        t = rs.RecordCount
                        ReDim bussite(t)
                        For p = 0 To t - 1
                            bussite(p) = rs("SiteName").Value
                            rs.MoveNext
                        Next
                        rs.Close
                    End If
                    For l = 0 To t
                        Call connetion
                        cmd.CommandText = "select * from SiteName where SiteName=? order by BusNameID ASC"
                        '设置para相关属性
                        para.Type = adBSTR
                        para.Direction = adParamInput
                        para.Value = Trim(BusSelect.BusTxt2.Text)

                        '把para添加到参数集
                        cmd.Parameters.Append para
                        cmd.Parameters(0) = Trim(BusSelect.BusTxt2.Text)

                        '执行command对象
                        Set rs = cmd.Execute
                        If Not rs.EOF Then
                            m = rs.RecordCount
                            ReDim BuslastName(m)
                            For j = 0 To m - 1
                                BuslastName(j) = rs("BusName").Value
                                rs.MoveNext
                            Next
                            rs.Close
                            For k = 0 To m - 1