机房收费系统Number two

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

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

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

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

添加用户代码：

Private Sub CmdCancle_Click()
    Unload Me  '取消
End Sub

Private 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 Sub


Private 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 Sub

Private 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 Sub

Private Sub CmdExit_Click()
    Unload Me         '退出键
End Sub

Private 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 Sub
Private Sub Combolevel_KeyPress(KeyAscii As Integer)
    KeyAscii = 0        '只能选，不能人工输入！
End Sub

Private Sub Form_Load()
'************************************************************************************
'用户级别的选择
        Combolevel.AddItem "管理员"
        Combolevel.AddItem "操作员"
        Combolevel.AddItem "一般用户"

End Sub

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

代码：

Private Sub CmdExit_Click()
    Unload Me
End Sub

Private Sub Cmdselect_Click()
    frmCash.Show '显示学生查看余额窗体
End Sub

Private 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 Sub

Private 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 Then
0        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 Sub


Private Sub ComboStatus_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Form_Load()
                
        ComboSex.AddItem "男"                '性别
        ComboSex.AddItem "女"
        ComboStatus.AddItem "使用"
        ComboStatus.AddItem "不使"
End Sub

Private Sub TxtMoney_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

待续！