机房收费系统敲了很长一段时间了,困难很多,但是只要相信自己,就可以完成。
记得刚开始敲机房收费系统的时候一点头绪都没有,自己写代码,脑袋里简直就是一片空白。
都说参照学生管理系统敲就行了,所以自己也照葫芦画瓢开始了,窗体设计好就开始写模块的代码,再写好登陆窗体和修改密码的窗体,设计好数据库,配置好数据源,算是一个良好的开端,接下来就是其他窗体了。
我先设计好添加和删除用户信息窗体。
添加用户代码:
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
待续!