www.pudn.com > BeiJingBusSerchSystem.rar > frmAddStation.frm, change:2008-11-27,size:15244b


VERSION 5.00 
Begin VB.Form frmStation  
   Caption         =   "北京市公交查询系统" 
   ClientHeight    =   6150 
   ClientLeft      =   60 
   ClientTop       =   450 
   ClientWidth     =   9300 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   6150 
   ScaleWidth      =   9300 
   StartUpPosition =   2  '屏幕中心 
   Begin VB.CommandButton cmdSave  
      Caption         =   "保存" 
      Height          =   495 
      Left            =   5160 
      TabIndex        =   21 
      Top             =   5400 
      Visible         =   0   'False 
      Width           =   1095 
   End 
   Begin VB.CommandButton cmdCancel  
      Caption         =   "取消" 
      Height          =   495 
      Left            =   3840 
      TabIndex        =   20 
      Top             =   5400 
      Visible         =   0   'False 
      Width           =   1095 
   End 
   Begin VB.ComboBox cmbbus  
      Height          =   300 
      Left            =   240 
      Style           =   2  'Dropdown List 
      TabIndex        =   19 
      Top             =   1080 
      Width           =   2895 
   End 
   Begin VB.Frame frameBus  
      Caption         =   "Frame3" 
      Height          =   3615 
      Left            =   240 
      TabIndex        =   11 
      Top             =   1560 
      Width           =   2895 
      Begin VB.Label labBus7  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   18 
         Top             =   3120 
         Width           =   2340 
      End 
      Begin VB.Label labBus6  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   17 
         Top             =   2680 
         Width           =   2340 
      End 
      Begin VB.Label labBus5  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   16 
         Top             =   2240 
         Width           =   2340 
      End 
      Begin VB.Label labBus4  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   15 
         Top             =   1800 
         Width           =   2340 
      End 
      Begin VB.Label labBus3  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   14 
         Top             =   1360 
         Width           =   2340 
      End 
      Begin VB.Label labBus2  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   13 
         Top             =   920 
         Width           =   2340 
      End 
      Begin VB.Label labBus1  
         Caption         =   "运行区间:" 
         Height          =   180 
         Left            =   240 
         TabIndex        =   12 
         Top             =   480 
         Width           =   2340 
      End 
   End 
   Begin VB.CommandButton cmdExit  
      Cancel          =   -1  'True 
      Caption         =   "退出" 
      Height          =   495 
      Left            =   7680 
      TabIndex        =   8 
      Top             =   5400 
      Width           =   1095 
   End 
   Begin VB.Frame Frame2  
      Caption         =   "站名" 
      Height          =   4215 
      Left            =   3360 
      TabIndex        =   0 
      Top             =   960 
      Width           =   5655 
      Begin VB.CommandButton cmdUp  
         Caption         =   "上移" 
         Enabled         =   0   'False 
         Height          =   495 
         Left            =   3000 
         TabIndex        =   6 
         Top             =   3240 
         Width           =   1095 
      End 
      Begin VB.CommandButton cmdDown  
         Caption         =   "下移" 
         Enabled         =   0   'False 
         Height          =   495 
         Left            =   4200 
         TabIndex        =   7 
         Top             =   3240 
         Width           =   1095 
      End 
      Begin VB.CommandButton cmdDel  
         Caption         =   "删除" 
         Enabled         =   0   'False 
         Height          =   495 
         Left            =   4200 
         TabIndex        =   5 
         Top             =   2400 
         Width           =   1095 
      End 
      Begin VB.ListBox lstStation  
         Height          =   3840 
         Left            =   240 
         TabIndex        =   1 
         Top             =   240 
         Width           =   2535 
      End 
      Begin VB.ComboBox cmbStation  
         Height          =   300 
         Left            =   3000 
         TabIndex        =   2 
         Text            =   "Combo1" 
         Top             =   960 
         Width           =   2175 
      End 
      Begin VB.CommandButton cmdAdd  
         Caption         =   "添加" 
         Height          =   495 
         Left            =   3000 
         TabIndex        =   3 
         Top             =   1560 
         Width           =   2175 
      End 
      Begin VB.CommandButton cmdModify  
         Caption         =   "修改" 
         Enabled         =   0   'False 
         Height          =   495 
         Left            =   3000 
         TabIndex        =   4 
         Top             =   2400 
         Width           =   1095 
      End 
      Begin VB.Label Label3  
         AutoSize        =   -1  'True 
         Caption         =   "站名:" 
         Height          =   180 
         Left            =   3120 
         TabIndex        =   9 
         Top             =   480 
         Width           =   540 
      End 
   End 
   Begin VB.Label Label2  
      AutoSize        =   -1  'True 
      Caption         =   "管理站点" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   14.25 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   285 
      Left            =   3840 
      TabIndex        =   10 
      Top             =   360 
      Width           =   1140 
   End 
End 
Attribute VB_Name = "frmStation" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Dim gID As Long '定义模块变量,保存线路的ID号 
 
 
Private Sub cmdAdd_Click()  '添加站点信息到列表框 
    Dim str1 As String, i As Long   '定义临时变量 
    str1 = Trim(cmbStation.Text)    '获取组合框中的文本 
    If str1 = "" Then   '若输入或选择的站名为空 
        MsgBox "请选择或输入站名!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
        cmbStation.SetFocus '将输入焦点设置到cmbStation组合框 
        Exit Sub    '退出当前过程 
    End If 
    For i = 0 To lstStation.ListCount - 1   '循环查询列表框中每一项 
        If str1 = lstStation.List(i) Then   '若与输入的内容相同 
            MsgBox "该线路中已有【" & str1 & "】!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
            Exit Sub    '退出当前过程 
        End If 
    Next 
    lstStation.AddItem str1 '将输入的内容添加到列表框 
    cmdCancel.Visible = True    '显示“取消”按钮 
    cmdSave.Visible = True  '显示“保存”按钮 
    cmbStation.SetFocus '设置焦点到组合框 
End Sub 
 
Private Sub cmdCancel_Click()   '“取消”按钮事件代码 
    cmdCancel.Visible = False   '隐藏“取消”按钮 
    cmdSave.Visible = False '隐藏“保存”按钮 
    ShowStation '重新从数据库中读出数据 
End Sub 
 
Private Sub cmdDel_Click()  '“删除”按钮事件代码 
    Dim ret As Long '定义临时变量保存用户选择 
    If lstStation.ListIndex < 0 Then    '若没有选择列表框中的内容 
        MsgBox "请首先选择列表框中的站名!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
        Exit Sub    '退出当前过程 
    End If 
        '删除前的提示 
    ret = MsgBox("真的要删除【" & lstStation.Text & "】?", vbQuestion + vbYesNo, "确认") 
    If ret = vbYes Then '若用户选择“是”按钮 
        lstStation.RemoveItem lstStation.ListIndex  '删除列表框中的选中项 
        cmdCancel.Visible = True    '显示“取消”按钮 
        cmdSave.Visible = True  '显示“保存”按钮 
    End If 
End Sub 
 
Private Sub cmdDown_Click() '“下移”按钮事件代码 
    MoveList 1  '调用过程向下移动选中项 
    cmdCancel.Visible = True    '显示“取消”按钮 
    cmdSave.Visible = True  '显示“隐藏”按钮 
End Sub 
 
Private Sub cmdExit_Click() '“退出”按钮事件代码 
    Unload Me   '卸载当前窗体 
End Sub 
 
Private Sub cmdModify_Click()   '“修改”按钮事件代码 
    Dim str1 As String, i As Long   '定义临时变量 
    If lstStation.ListIndex < 0 Then    '若未选中列表框中的项 
        MsgBox "请首先选择列表框中的站名!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
        Exit Sub    '退出当前过程 
    End If 
     
    str1 = Trim(cmbStation.Text)    '获取组合框中输入或选择的文本 
    If str1 = "" Then   '若输入或选择的文本为空 
        MsgBox "请选择或输入站名!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
        cmbStation.SetFocus '设置输入焦点到组合框 
        Exit Sub    '退出当前过程 
    End If 
     
    For i = 0 To lstStation.ListCount - 1   '循环比较列表框中的已有项 
        If str1 = lstStation.List(i) Then   '若与输入内容相同 
            MsgBox "该线路中已有【" & str1 & "】!", vbCritical + vbOKOnly, "提示"  '显示提示信息 
            Exit Sub    '退出当前过程 
        End If 
    Next 
    lstStation.List(lstStation.ListIndex) = str1    '将输入内容更新到指定项 
    cmdCancel.Visible = True    '显示“取消”按钮 
    cmdSave.Visible = True  '显示“保存”按钮 
    cmbStation.SetFocus '设置输入焦点到组合框 
End Sub 
 
Private Sub cmdSave_Click() '“保存”按钮事件代码 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
    Dim i As Long, str1 As String 
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
 
    cnn.Execute "DELETE FROM [station] WHERE [busid]=" & gID    '删除该线路原有数据 
     
    For i = 0 To lstStation.ListCount - 1   '循环保存列表框中的每项 
        str1 = "INSERT INTO [station]([busid],[station],[order]) VALUES("   '定义SQL语句保存数据 
        str1 = str1 & gID & ",'"    '线路ID 
        str1 = str1 & lstStation.List(i) & "'," '站名 
        str1 = str1 & i + 1 & ")"   '序号 
        cnn.Execute str1    '执行SQL语句 
    Next 
    cnn.Close   '关闭数据库连接 
     
    cmdCancel.Visible = False   '隐藏“取消”按钮 
    cmdSave.Visible = False '隐藏“保存”按钮 
End Sub 
 
Private Sub cmdUp_Click()   '“上移”按钮事件代码 
    MoveList -1 
    cmdCancel.Visible = True 
    cmdSave.Visible = True 
End Sub 
 
Private Sub Form_Load() 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
     
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
     
    Set rst.ActiveConnection = cnn  '设置记录集的数据库连接 
    rst.Open "SELECT [bus] FROM [bus]"  '打开记录集,得到线路名数据 
     
    cmbbus.Clear    '清除列表框中原有内容 
    Do While Not rst.EOF    '循环处理记录集中的数据 
        cmbbus.AddItem rst(0).Value    '将线路名添加到组合框中 
        rst.MoveNext    '处理下一记录 
    Loop 
     
    If cmbbus.ListCount > 0 Then    '列表框中有数据 
        cmbbus.ListIndex = 0    '选中第1个数据 
    End If 
     
    rst.Close   '关闭记录集 
     
    rst.Open "SELECT DISTINCT([station]) FROM [station] ORDER BY [station]" 
    cmbStation.Clear 
    Do While Not rst.EOF    '循环处理记录集中的数据 
        cmbStation.AddItem rst(0).Value    '将站名添加到组合框中 
        rst.MoveNext    '处理下一记录 
    Loop 
       
    rst.Close 
    cnn.Close   '关闭数据库连接 
End Sub 
 
Private Sub cmbbus_Click() 
    Dim cnn As New ADODB.Connection '定义数据库连接 
    Dim rst As New ADODB.Recordset  '定义记录集 
    Dim str1 As String, str2 As String  '临时字符串变量 
     
    str1 = cmbbus.List(cmbbus.ListIndex)    '获取组合框中的选中项(可介绍一下列表框) 
     
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
     
    Set rst.ActiveConnection = cnn  '设置记录集的数据库连接 
    str2 = "SELECT * FROM [BUS] WHERE BUS='" & Trim(str1) & "'"   '定义查询字符串 
    rst.Open str2   '打开记录集 
     
    If Not rst.EOF Then '若记录集不为空,显示内容 
        gID = rst("id") '记录关键字 
        frameBus.Caption = rst("bus") '线路名 
        labBus1.Caption = rst("beginend") '运行区间 
        labBus2.Caption = rst("ticktype")  '售票类型 
        labBus3.Caption = rst("price")    '票价 
        If rst("ic") = True Then    '支持IC卡 
            labBus4.Caption = "支持IC卡" 
        Else    '不支持IC卡 
            labBus4.Caption = "不支持IC卡" 
        End If 
        labBus5.Caption = rst("runtime")   '运行时间 
        labBus6.Caption = rst("company")    '公交公司 
        If Not IsNull(rst("memo")) Then '若备注不为空 
            labBus7.Caption = rst("memo")  '显示备注 
        End If 
        ShowStation '调用过程显示指定线路的站名 
    Else    '若记录集为空,清空显示内容 
        lstStation.Clear 
        labBus1.Caption = "" 
        labBus2.Caption = "" 
        labBus3.Caption = "" 
        labBus4.Caption = "" 
        labBus5.Caption = "" 
        labBus6.Caption = "" 
        labBus7.Caption = "" 
    End If 
 
    rst.Close   '关闭记录集 
    cnn.Close   '关闭数据库连接 
End Sub 
 
Sub ShowStation() 
    Dim cnn As New ADODB.Connection '定义数据库连接 
    Dim rst As New ADODB.Recordset  '定义记录集 
    Dim str1 As String  '临时字符串变量 
     
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
     
    str1 = "SELECT * FROM [station] WHERE [busid]=" & gID & " ORDER BY [order]" 
    Set rst = cnn.Execute(str1) 
     
    lstStation.Clear    '表除列表框中的内容 
    Do While Not rst.EOF    '循环处理记录集中的数据 
        lstStation.AddItem rst("station").Value    '将站点名添加到列表框中 
        rst.MoveNext    '处理下一记录 
    Loop 
 
End Sub 
 
Private Sub lstStation_Click()  '列表框单击事件代码 
    If lstStation.ListIndex >= 0 Then   '若选中列表框中的某项 
        cmbStation.Text = lstStation.List(lstStation.ListIndex) '将选中项内容显示到组合框中 
        cmdModify.Enabled = True    '允许使用“修改”按钮 
        cmdDel.Enabled = True   '允许使用“删除”按钮 
        cmdUp.Enabled = True   '允许使用“上移”按钮 
        cmdDown.Enabled = True   '允许使用“下移”按钮 
    End If 
End Sub 
 
Private Function MoveList(ByVal Index As Long)  '移动列表框中的项目顺序 
    Dim str1 As String, x As Long   '定义临时变量 
     
    With lstStation 
        x = .ListIndex  '获取选中项在列表框中的序号 
        If x < 0 Or x + Index < 0 Or x + Index > .ListCount - 1 Then Exit Function '如果未选中则不进行移动 
        str1 = .Text    '获取选中的文本 
        .RemoveItem x   '删除选中项 
        .AddItem str1, x + Index    '将选中文本添加到指定位置 
        .ListIndex = x + Index  '设置选中序号 
    End With 
End Function