机房收费系统Number two

机房收费系统敲了很长一段时间了，困难很多，但是只要相信自己，就可以完成。

记得刚开始敲机房收费系统的时候一点头绪都没有，自己写代码，脑袋里简直就是一片空白。

都说参照学生管理系统敲就行了，所以自己也照葫芦画瓢开始了，窗体设计好就开始写模块的代码，再写好登陆窗体和修改密码的窗体，设计好数据库，配置好数据源，算是一个良好的开端，接下来就是其他窗体了。

我先设计好添加和删除用户信息窗体。

添加用户代码：

Private Sub CmdCancle_Click()    Unload Me  '取消End SubPrivate Sub CmdOK_Click()    Dim mrc As ADODB.Recordset '存放返回记录集    Dim txtSQL As String       '存放SQL语句    Dim msgtext As String      '存放返回信息'*********************************************************************************'用户名不能为空，并且不能有重名，否则重新输入！    If Trim(Txtuser.Text = "") Then        MsgBox "请输入用户姓名！", vbOKOnly + vbExclamation, "警告"        Exit Sub        Txtuser.SetFocus    Else        txtSQL = "select * from User_info "        Set mrc = ExecuteSQL(txtSQL, msgtext)        While (mrc.EOF = False)            If Trim(mrc.Fields(0) = Trim(Txtuser)) Then                MsgBox "用户已经存在，请重新输入！", vbOKOnly + vbExclamation, "警告"                Txtuser.SetFocus                Txtuser.Text = ""                TxtPWD.Text = ""                TextaPWD.Text = ""                Exit Sub            Else                mrc.MoveNext                End If        Wend    End If        '********************************************************************************* '两次密码不一样的情况     If Trim(TxtPWD.Text <> TxtaPWD.Text) Then        MsgBox "您输入的两次密码不一致，请重新输入！", vbOKOnly + vbExclamation, "警告"        Exit Sub        TxtPWD.SetFocus        TxtPWD.Text = ""        TxtaPWD.Text = ""        Exit Sub    Else        If Trim(TxtPWD.Text = "") Then            MsgBox "密码不能为空！", vbOKOnly + vbExclamation, "警告"            TxtPWD.SetFocus            TxtPWD.Text = ""            TxtaPWD.Text = ""        Else            mrc.AddNew        '条件都满足，就可以成功添加新用户                        mrc.Fields(0) = Txtuser.Text           '把用户名赋给数据库对应的位置            mrc.Fields(1) = TxtPWD.Text           '把密码赋给对应的数据库位置            mrc.Fields(2) = Txtlevel.Text          '把用户级别连接到数据库            mrc.Fields(3) = Txtname.Text           '把姓名连接到数据库中            mrc.Fields(4) = "admin"                                    mrc.Update           '用于更新数据库            mrc.Close            Me.Hide                        MsgBox "添加用户成功！", vbOKCancel + vbExclamation, "警告"        End If    End If                   End SubPrivate Sub Form_Load()    '确定添加窗口的用户级别    Txtlevel.Text = frmadd_deluser.Combolevel.Text'*******************************************************************************'使得进入时没有记录，避免删除再添加的麻烦    End Sub

添加和删除用户信息代码：

Private Sub Cmdadd_Click()    frmadd_user.Show   '添加用户窗口显示    frmadd_user.Txtuser.Text = ""    frmadd_user.Txtname.Text = ""    frmadd_user.TxtPWD.Text = ""    frmadd_user.TxtaPWD.Text = ""End SubPrivate Sub Cmddel_Click()'********************删除数据    Dim msgtext As String    Dim txtSQL As String    Dim mrc As ADODB.Recordset                   '****************************************调数据库，删除自己选定的数据空中的数据！        txtSQL = "select * from User_Info where UserID = '" & Trim(myFlexGrid.TextMatrix(myFlexGrid.Row, 0)) & "'"                Set mrc = ExecuteSQL(txtSQL, msgtext)                mrc.Delete         '删除        mrc.MoveNext        mrc.Close          '关闭数据库                myFlexGrid.RemoveItem myFlexGrid.Row       '删除控件显示的数据，选择的行进行删除'**************************************************************************************'如果没有记录就没有办法再进行删除了，所以要弹出窗口必须添加用户信息    If myFlexGrid.Rows = 1 Then        msgtext = MsgBox("以无该级别的信息，是否添加该级别的用户信息？", vbOKOnly)        If msgtext = vbOK Then            frmadd_user.Show        Else            Exit Sub        End If    End If        End SubPrivate Sub CmdExit_Click()    Unload Me         '退出键End SubPrivate Sub Combolevel_Click()    Dim mrc As ADODB.Recordset    Dim msgtext As String    Dim txtSQL As String'        txtSQL = "select * from User_info "'        Set mrc = ExecuteSQL(txtSQL, MsgText)        txtSQL = "select * from User_Info where Level = '" & Combolevel.Text & "'"        Set mrc = ExecuteSQL(txtSQL, msgtext)                'Debug.Print txtSQL                With myFlexGrid        .Rows = 1      ' 返回或设置在一个 myflexgrid 中的总行数为2        .CellAlignment = 4 '单元格的内容居中、居中对齐。        .TextMatrix(0, 0) = "用户名"        .TextMatrix(0, 1) = "姓名"        .TextMatrix(0, 2) = "开户人"                      Do While Not mrc.EOF      '把添加的数据保存到数据库中                    .Rows = .Rows + 1            .CellAlignment = 4            .TextMatrix(.Rows - 1, 0) = mrc.Fields(0)            .TextMatrix(.Rows - 1, 1) = mrc.Fields(3)            .TextMatrix(.Rows - 1, 2) = mrc.Fields(4)                        mrc.MoveNext        Loop            End With    End SubPrivate Sub Combolevel_KeyPress(KeyAscii As Integer)    KeyAscii = 0        '只能选，不能人工输入！End SubPrivate Sub Form_Load()'************************************************************************************'用户级别的选择        Combolevel.AddItem "管理员"        Combolevel.AddItem "操作员"        Combolevel.AddItem "一般用户"End Sub

写完这两个窗体的代码，思路清晰了很多，其他的代码也是差不多，继续写了注册窗体

代码：

Private Sub CmdExit_Click()    Unload MeEnd SubPrivate Sub Cmdselect_Click()    frmCash.Show '显示学生查看余额窗体End SubPrivate Sub Combosex_KeyPress(KeyAscii As Integer)    KeyAscii = 0        '只能选，不能人工输入！End Sub'**********************************************************'清空所有数据Private Sub CmdEmpty_Click()    TxtCard_NO.Text = ""    TxtStuID.Text = ""    Txtname.Text = ""    TxtDepart.Text = ""    TxtClass.Text = ""    TxtGrade.Text = ""    TxtPayShow.Text = ""    ComboSex.Text = ""    ComboStatus.Text = ""    TxtExplain.Text = ""End SubPrivate Sub Cmdsave_Click()    Dim mrc As ADODB.Recordset   '用来存放返回记录集对象    Dim txtSQL As String    Dim msgtext As String    '判断是否已经注册        txtSQL = "select * from student_Info where "    Set mrc = ExecuteSQL(txtSQL, msgtext)        If Trim(TxtCard_NO.Text = "") Then        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"        TxtCard_NO.SetFocus        Exit Sub    End If        If Not IsNumeric(TxtCard_NO.Text) Then        MsgBox "卡号必须是数字！", vbOKOnly + vbExclamation, "警告"        TxtCard_NO.SetFocus        Exit Sub    End If     If Trim(TxtStuID.Text = "") Then        MsgBox "请输入学号！", vbOKOnly + vbExclamation, "警告"        TxtStuID.SetFocus        Exit Sub    End If        If Not IsNumeric(TxtStuID.Text) Then        MsgBox "学号必须是数字！", vbOKOnly + vbExclamation, "警告"        TxtStuID.SetFocus        Exit Sub    End If        If Trim(Txtname.Text = "") Then        MsgBox "请输入姓名！", vbOKOnly + vbExclamation, "警告"        Txtname.SetFocus        Exit Sub    End If        If Trim(TxtDepart.Text = "") Then        MsgBox "请选择系别！", vbOKOnly + vbExclamation, "警告"        TxtDepart.SetFocus        Exit Sub    End If        If Trim(TxtGrade.Text = "") Then        MsgBox "请输入年级！", vbOKOnly + vbExclamation, "警告"        TxtGrade.SetFocus        Exit Sub    End If        If Trim(TxtClass.Text = "") Then        MsgBox "请输入班级！", vbOKOnly + vbExclamation, "警告"        TxtClass.SetFocus        Exit Sub    End If        If Trim(TxtPayShow.Text = "") Then        MsgBox "请输入金额！", vbOKOnly + vbExclamation, "警告"        TxtPayShow.SetFocus        Exit Sub    End If        If Val(TxtPayShow.Text) < 5 Then        MsgBox "新用户注册至少充值5元！", vbOKOnly + vbExclamation, "警告"        TxtPayShow.SetFocus        Exit Sub    End If    '连接数据库，学生基本信息表    txtSQL = "select * from student_Info where cardno='" & Trim(TxtCard_NO.Text) & "'"    Set mrc = ExecuteSQL(txtSQL, msgtext)        If mrc.EOF = False Then        MsgBox "卡号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"        TxtCard_NO.SetFocus        Exit Sub    End If        txtSQL = "select * from student_info where studentno='" & Trim(TxtStuID.Text) & "'"    Set mrc = ExecuteSQL(txtSQL, msgtext)        If mrc.EOF = False Then0        MsgBox "该学号已经被注册，请重新输入！", vbOKOnly + vbExclamation, "警告"        TxtStuID.SetFocus        Exit Sub    End If        txtSQL = "select * from student_info "    Set mrc = ExecuteSQL(txtSQL, msgtext)                    mrc.AddNew        mrc.Fields(0) = Trim(TxtCard_NO.Text)        mrc.Fields(1) = Trim(TxtStuID.Text)        mrc.Fields(2) = Trim(Txtname.Text)        mrc.Fields(3) = Trim(ComboSex.Text)        mrc.Fields(4) = Trim(TxtDepart.Text)        mrc.Fields(5) = Trim(TxtGrade.Text)        mrc.Fields(6) = Trim(TxtClass.Text)        mrc.Fields(7) = Trim(TxtPayShow.Text)        mrc.Fields(8) = Trim(TxtExplain.Text)        mrc.Fields(9) = frmLogin.txtUserName        mrc.Fields(10) = Trim(ComboStatus.Text)        mrc.Fields(11) = "未结帐"        mrc.Fields("Date") = Format(Date, "yyyy-mm-dd")        mrc.Fields(13) = Time                mrc.Update        mrc.Close        MsgBox "注册成功！"                '注册新号的同时，还需要对该用户进行充值        txtSQL = "select * from Recharge_Info "        Set mrc = ExecuteSQL(txtSQL, msgtext)                mrc.AddNew'        mrc.Fields(0) = Trim(TxtCard_NO.Text)        mrc.Fields(1) = Trim(TxtStuID.Text)        mrc.Fields(2) = Trim(TxtCard_NO.Text)        mrc.Fields(3) = Trim(TxtPayShow.Text)        mrc.Fields(4) = Format(Date, "yyyy/mm/dd")        mrc.Fields(5) = Time        mrc.Fields(6) = frmLogin.txtUserName        mrc.Fields(7) = "未结账"        mrc.Update        mrc.Close                     '把金额附加到充值金额里面去    TxtMoney.Text = TxtPayShow.Text        End SubPrivate Sub ComboStatus_KeyPress(KeyAscii As Integer)    KeyAscii = 0End SubPrivate Sub Form_Load()                        ComboSex.AddItem "男"                '性别        ComboSex.AddItem "女"        ComboStatus.AddItem "使用"        ComboStatus.AddItem "不使"End SubPrivate Sub TxtMoney_KeyPress(KeyAscii As Integer)    KeyAscii = 0End Sub

待续！