主窗体:
① 主窗体的建立:
用户名和密码登录成功之后,用户登录窗口消失,主窗体出现,主窗体是一个MDI父窗体,父窗体控制上下机、控制对应用户名的功能使用等功能。
主窗口是由一个图片框、两个命令按钮、十三个文本框、二十个标签、一个timer控件、一个菜单栏组成。图片框是放这些轻量级控件(MDI父窗体只能放上的容器控件只有窗体和图片框,这里选择了图片框);两个命令按钮控制上下机、十三个文本框显示学生信息、二十个标签其中有两个标签用来显示当前时间,一个标签显示上下机信息,一个标签显示正在上机的人数;一个timer用来显示当前时间。菜单栏是三个一个菜单栏组成,分别为一般用户、操作员、管理员;它们彼此的功能权限不同,是通过用户名身份进行判断的。
用户到了主窗体,当然先输入卡号,如果是刷卡则直接调用上机按钮的单击事件,即上机,当在次刷卡的时候则调用下机按钮的单击事件,即下机。当学生上机,文本框就会显示“欢迎光临”;用户下机的时候就会显示“欢迎下次再来”;由于上机的同学已经正在上机,所以不能再去单击上机按钮,已经下机的同学不能在点击下机
单击菜单栏显示功能窗体的实现过程,因为图片框在MDI父窗体上,当单击MDi子窗体的时候会被图片框覆盖在下面,所以就在通用的过程中定义了一个API函数:setparent功能就是让所有的子窗体做图片框的子窗体
Dim Isenter As Boolean
Dim b As Boolean
'声明函数,让一个窗体变成另外一个窗体或控件的子窗体
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub AddDeleteUser_Click()
'添加删除用户
FrmAddDeleteUser.Show
Call SetParent(FrmAddDeleteUser.hWnd, Picture1.hWnd)
End Sub
Private Sub BasicdataSet_Click()
'基本设定
FrmBasicSet.Show
Call SetParent(FrmBasicSet.hWnd, Picture1.hWnd)
End Sub
Private Sub Charge_Click()
'显示充值窗口
FrmCharge.Show
Call SetParent(FrmCharge.hWnd, Picture1.hWnd)
End Sub
Private Sub ChargeRecord_Click()
'显示查看充值记录窗口
FrmInqchargeRecord.Show
Call SetParent(FrmInqchargeRecord.hWnd, Picture1.hWnd)
End Sub
Private Sub CmdAway_Click()
Dim intH As Integer
Dim intN As Integer
Dim intS As Integer
Dim TimeOk As Single
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim objrss As ADODB.Recordset
Dim objrsss As ADODB.Recordset
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim mrccc As ADODB.Recordset
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set mrc = ExecuteSQL(strsql, msgtext)
If mrc.EOF Then
'判断卡号是否注册
MsgBox "没有此卡号的信息,请先去注册!", vbOKOnly + vbExclamation, "警告"
Call ClearInfo
strsql = "select * from Computer_Info where ComputerState='正在上机'"
Set mrcc = ExecuteSQL(strsql, msgtext)
'当前没有正在上机的人,则清空卡号
If mrcc.EOF Then
TxtCardID.Text = ""
TxtCardID.SetFocus
Exit Sub
Else
'当前有正在上机的人,则显示一条当前上机的人的信息
mrcc.MoveLast
TxtCardID.Text = mrcc.Fields(0).Value
TxtstudentID.Text = mrcc.Fields(2).Value
TxtSeries.Text = mrcc.Fields(5).Value
TxtStyle.Text = mrcc.Fields(1).Value
TxtName.Text = mrcc.Fields(3).Value
TxtSex.Text = mrcc.Fields(4).Value
TxtEnterDate.Text = mrcc.Fields(6).Value
TxtEnterTime.Text = mrcc.Fields(8).Value
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set mrccc = ExecuteSQL(strsql, msgtext)
TxtBalance.Text = mrccc.Fields(8).Value
mrccc.Close
TxtAwayDate.Text = ""
TxtAwayTime.Text = ""
End If
End If
'判断用户是否正在上机
If Isenter = False Then
Label20.Caption = "该用户没有上机,请先上机!"
Exit Sub
End If
strsql = "select * from Computer_Info where Card_ID='" & Trim(TxtCardID.Text) & "' and ComputerState='正在上机'"
Set objrs = ExecuteSQL(strsql, msgtext)
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set objrss = ExecuteSQL(strsql, msgtext)
'获得当前时间和日期
TxtAwayDate.Text = Date
TxtAwayTime.Text = Time
'计算消费时间和金额
'计算公式:消费时间=(下机时间-上机时间-5)/60
'消费金额:消费金额=消费时间*1或*2
'余额=金额-消费金额
intN = DateDiff("n", TxtEnterTime.Text, TxtAwayTime.Text)
strsql = "select * from Basic_Info"
Set objrsss = ExecuteSQL(strsql, msgtext)
If intN < objrsss.Fields(4) Then
TimeOk = 0
Else
If ((intN - objrsss.Fields(4).Value) / 60 - (intN - objrsss.Fields(4).Value) / 60) < 0.5 Then
TimeOk = (intN - objrsss.Fields(4).Value) / 60 + 0.5
Else
TimeOk = (intN - objrsss.Fields(4).Value) / 60 + 1
End If
End If
objrsss.Close
TxtConsumetime.Text = TimeOk
If Trim(TxtStyle.Text) = "固定用户" Then
TxtConsumemoney.Text = TimeOk * 1
Else
TxtConsumemoney.Text = TimeOk * 2
End If
TxtBalance.Text = Str(objrss.Fields(8).Value - Val(TxtConsumemoney.Text))
'当单击下机的时候出现对应的基本信息
TxtstudentID.Text = objrs.Fields(2).Value
TxtSeries.Text = objrs.Fields(5).Value
TxtStyle.Text = objrs.Fields(1).Value
TxtName.Text = objrs.Fields(3).Value
TxtSex.Text = objrs.Fields(4).Value
TxtEnterDate.Text = objrs.Fields(6).Value
TxtEnterTime.Text = objrs.Fields(8).Value
'删除正在上机的记录
objrs.Delete
'添加一条已经下机的记录
objrs.AddNew
objrs.Fields(0) = Trim(TxtCardID.Text)
objrs.Fields(1) = Trim(TxtStyle.Text)
objrs.Fields(2) = Trim(TxtstudentID.Text)
objrs.Fields(3) = Trim(TxtName.Text)
objrs.Fields(4) = Trim(TxtSex.Text)
objrs.Fields(5) = Trim(TxtSeries.Text)
objrs.Fields(6) = Trim(TxtEnterDate.Text)
objrs.Fields(7) = Trim(TxtAwayDate.Text)
objrs.Fields(8) = Trim(TxtEnterTime.Text)
objrs.Fields(9) = Trim(TxtAwayTime.Text)
objrs.Fields(10) = Trim(TxtConsumetime.Text)
objrs.Fields(11) = Trim(TxtConsumemoney.Text)
objrs.Fields(12) = "已经下机"
objrs.Fields(13) = Trim(TxtBalance.Text)
objrs.Update
objrs.Close
objrss.Fields(8) = Trim(TxtBalance.Text)
objrss.Update
objrss.Close
Label20.Caption = "下机成功!欢迎您下次再来!"
Isenter = False
'显示当前正在上机的人数
strsql = "select * from Computer_Info where ComputerState='正在上机'"
Set objrs = ExecuteSQL(strsql, msgtext)
TxtPeople.Text = objrs.RecordCount
objrs.Close
End Sub
Private Sub CmdEnter_Click()
b = True
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim objrss As ADODB.Recordset
Dim objrsss As ADODB.Recordset
Dim objrssss As ADODB.Recordset
Dim objrsssss As ADODB.Recordset
Dim objrssssss As ADODB.Recordset
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set objrs = ExecuteSQL(strsql, msgtext)
If objrs.EOF Then
'判断卡号是否注册
MsgBox "没有此卡号的信息,请先去注册!", vbOKOnly + vbExclamation, "警告"
Call ClearInfo
strsql = "select * from Computer_Info where ComputerState='正在上机'"
Set objrss = ExecuteSQL(strsql, msgtext)
'当前没有正在上机的人,则清空卡号
If objrss.EOF Then
TxtCardID.Text = ""
TxtCardID.SetFocus
Exit Sub
Else
'当前有正在上机的人,则显示一条当前上机的人的信息
objrss.MoveLast
TxtCardID.Text = objrss.Fields(0).Value
TxtstudentID.Text = objrss.Fields(2).Value
TxtSeries.Text = objrss.Fields(5).Value
TxtStyle.Text = objrss.Fields(1).Value
TxtName.Text = objrss.Fields(3).Value
TxtSex.Text = objrss.Fields(4).Value
TxtEnterDate.Text = objrss.Fields(6).Value
TxtEnterTime.Text = objrss.Fields(8).Value
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set objrsssss = ExecuteSQL(strsql, msgtext)
TxtBalance.Text = objrsssss.Fields(8).Value
objrsssss.Close
TxtAwayDate.Text = ""
TxtAwayTime.Text = ""
End If
Else
'判断注册(状态的不可用)
If Trim(objrs.Fields(7)) = "不可用" Then
MsgBox "您的卡没有注册,请先去注册!", vbOKOnly + vbExclamation, "警告"
Call ClearInfo
strsql = "select * from Computer_Info where ComputerState='正在上机'"
Set objrss = ExecuteSQL(strsql, msgtext)
If objrss.EOF Then
TxtCardID.Text = ""
TxtCardID.SetFocus
Exit Sub
Else
objrss.MoveLast
TxtCardID.Text = objrss.Fields(0).Value
TxtstudentID.Text = objrss.Fields(2).Value
TxtSeries.Text = objrss.Fields(5).Value
TxtStyle.Text = objrss.Fields(1).Value
TxtName.Text = objrss.Fields(3).Value
TxtSex.Text = objrss.Fields(4).Value
TxtEnterDate.Text = objrss.Fields(6).Value
TxtEnterTime.Text = objrss.Fields(8).Value
strsql = "select * from Student_Info where Card_ID='" & Trim(TxtCardID.Text) & "'"
Set objrsssss = ExecuteSQL(strsql, msgtext)
TxtBalance.Text = objrsssss.Fields(8).Value
objrsssss.Close
TxtAwayDate.Text = ""
TxtAwayTime.Text = ""
End If
Else
strsql = "select * from Basic_Info"
Set objrsss = ExecuteSQL(strsql, msgtext)
'判断余额,少于规定值不能上机
If Trim(objrs.Fields(9)) = "固定用户" Then
If objrs.Fields(8).Value < objrsss.Fields(5).Value Then
MsgBox "您是固定用户,余额为" & objrs.Fields(8) & "元,余额不足5元,请去充值!", vbOKOnly + vbExclamation, "警告"
Call ClearInfo
Exit Sub
End If
Else
If objrs.Fields(8).Value < objrsss.Fields(6).Value Then
MsgBox "您是临时用户,余额为" & objrs.Fields(8) & "元,余额不足10元,请去充值!", vbOKOnly + vbExclamation, "警告"
Call ClearInfo
Exit Sub
End If
End If
strsql = "select * from Computer_Info where Card_ID='" & Trim(TxtCardID.Text) & "' and ComputerState='正在上机'"
Set objrssss = ExecuteSQL(strsql, msgtext)
'避免用户正在上机的时候单击上机按钮
If Not objrssss.EOF Then
Label20.Caption = "该用户正处于上机状态!"
Isenter = True
Exit Sub
End If
'显示基本信息(从学生信息表中遍历出来的)
TxtstudentID.Text = objrs.Fields(1).Value
TxtSeries.Text = objrs.Fields(4).Value
TxtStyle.Text = objrs.Fields(9).Value
TxtName.Text = objrs.Fields(2).Value
TxtSex.Text = objrs.Fields(3).Value
TxtBalance.Text = objrs.Fields(8).Value
TxtConsumetime.Text = "0.0"
TxtConsumemoney.Text = "0.0"
TxtEnterDate.Text = Date
TxtEnterTime.Text = Time
'写入正在上机记录表中
strsql = "select * from Computer_Info"
Set objrss = ExecuteSQL(strsql, msgtext)
objrss.AddNew
objrss.Fields(0) = Trim(TxtCardID.Text)
objrss.Fields(1) = Trim(TxtStyle.Text)
objrss.Fields(2) = Trim(TxtstudentID.Text)
objrss.Fields(3) = Trim(TxtName.Text)
objrss.Fields(4) = Trim(TxtSex.Text)
objrss.Fields(5) = Trim(TxtSeries.Text)
objrss.Fields(6) = Trim(TxtEnterDate.Text)
objrss.Fields(8) = Trim(TxtEnterTime.Text)
objrss.Fields(12) = "正在上机"
strsql = "select * from User_Info where User_Name='" & UserName & "'"
Set objrssssss = ExecuteSQL(strsql, msgtext)
objrss.Fields(14) = objrssssss.Fields(4).Value
objrss.Update
objrss.Close
End If
End If
Isenter = True
'显示上机人数
strsql = "select * from Computer_Info where ComputerState='正在上机'"
Set objrss = ExecuteSQL(strsql, msgtext)
TxtPeople.Text = objrss.RecordCount
objrss.Close
TxtAwayDate.Text = ""
TxtAwayTime.Text = ""
Label20.Caption = "上机成功!祝您上机愉快!"
Label20.Visible = True
End Sub
Private Sub DateBill_Click()
'单击把日结记录存到数据库中并且显示日结窗口
Dim objrs As Recordset
Dim strsql As String
Dim msgtext As String
Dim objrss As Recordset
Dim allBalance As Single
Dim objrsss As Recordset
Dim AllCharge As Single
Dim objrssss As Recordset
Dim allRemovemoney As Single
Dim Allconsumemoney As Single
Dim objrsssss As Recordset
Dim ALlmoney As Single
strsql = "select * from Student_Info where EnroDate='" & Trim(Date) & "'"
Set objrss = ExecuteSQL(strsql, msgtext)
If objrss.EOF Then
allBalance = 0
Else
Do While Not objrss.EOF
allBalance = allBalance + objrss.Fields(14).Value
objrss.MoveNext
Loop
objrss.Close
End If
strsql = "select * from Charge_Info where Charge_Date='" & Trim(Date) & "'"
Set objrsss = ExecuteSQL(strsql, msgtext)
If objrsss.EOF Then
AllCharge = 0
Else
Do While Not objrsss.EOF
AllCharge = AllCharge + objrsss.Fields(1).Value
objrsss.MoveNext
Loop
objrsss.Close
End If
strsql = "select * from RemoveCard_Info where Removecar_Date='" & Trim(Date) & "'"
Set objrssss = ExecuteSQL(strsql, msgtext)
If objrssss.EOF Then
allRemovemoney = 0
Else
Do While Not objrssss.EOF
allRemovemoney = allRemovemoney + objrssss.Fields(1).Value
objrssss.MoveNext
Loop
objrssss.Close
End If
strsql = "select * from Computer_Info where Out_Date='" & Trim(Date) & "'"
Set objrsssss = ExecuteSQL(strsql, msgtext)
If objrsssss.EOF Then
Allconsumemoney = 0
Else
Do While Not objrsssss.EOF
Allconsumemoney = Allconsumemoney + objrsssss.Fields(11).Value
objrsssss.MoveNext
Loop
objrsssss.Close
End If
ALlmoney = allBalance + AllCharge - Allconsumemoney - allRemovemoney
strsql = "select * from WeekAccount_Info"
Set objrs = ExecuteSQL(strsql, msgtext)
Dim mrc As ADODB.Recordset
strsql = "select * from WeekAccount_Info where NowDate='" & Trim(Date) & "'"
Set mrc = ExecuteSQL(strsql, msgtext)
If mrc.EOF Then
objrs.AddNew
objrs.Fields(0).Value = Trim(allBalance)
objrs.Fields(1).Value = Trim(AllCharge)
objrs.Fields(2).Value = Trim(Allconsumemoney)
objrs.Fields(3).Value = Trim(allRemovemoney)
objrs.Fields(4).Value = Trim(ALlmoney)
objrs.Fields(5).Value = Trim(Date)
objrs.Update
objrs.Close
Else
mrc.Delete
mrc.AddNew
mrc.Fields(0).Value = Trim(allBalance)
mrc.Fields(1).Value = Trim(AllCharge)
mrc.Fields(2).Value = Trim(Allconsumemoney)
mrc.Fields(3).Value = Trim(allRemovemoney)
mrc.Fields(4).Value = Trim(ALlmoney)
mrc.Fields(5).Value = Trim(Date)
mrc.Update
mrc.Close
End If
FrmDayAccount.Show
End Sub
Private Sub Enrol_Click()
'显示学生注册窗口
FrmStuEnrol.Show
Call SetParent(FrmStuEnrol.hWnd, Picture1.hWnd)
End Sub
Private Sub Exitform_Click()
'关闭程序
End
End Sub
Private Sub Inquirecomputestatinfo_Click()
'显示学生上机统计信息窗口
FrmInqcomInfoRecord.Show
Call SetParent(FrmInqcomInfoRecord.hWnd, Picture1.hWnd)
End Sub
Private Sub InquireHandbackMoney_Click()
'显示退还金额查询窗口
FrmInqRemoveMoney.Show
Call SetParent(FrmInqRemoveMoney.hWnd, Picture1.hWnd)
End Sub
Private Sub InquireMoney_Click()
'显示收取金额查询窗体
FrmInqReceiveMoney.Show
Call SetParent(FrmInqReceiveMoney.hWnd, Picture1.hWnd)
End Sub
Private Sub MDIForm_Load()
Isenter = False
Timer1.Enabled = True
'判断登录者的身份并且给定相应的权限
Dim objrs As ADODB.Recordset
Dim Msgtxt As String
Dim strsql As String
strsql = "select * from User_Info where User_Name='" & UserName & "'"
Set objrs = ExecuteSQL(strsql, Msgtxt)
If Trim(objrs.Fields(2)) = "操作员" Then
Admintor.Visible = False
End If
If Trim(objrs.Fields(2)) = "一般用户" Then
Operators.Visible = False
Admintor.Visible = False
End If
objrs.Close
End Sub
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'询问真的要关闭主窗口吗?
Dim a As Integer
a = MsgBox("您真的要关闭吗?", vbYesNo, "询问")
If a = vbYes Then
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim objrss As ADODB.Recordset
strsql = "select * from Opertor_Info"
Set objrs = ExecuteSQL(strsql, msgtext)
strsql = "select * from OndutyTeacher_Info where Username='" & Trim(UserName) & "'"
Set objrss = ExecuteSQL(strsql, msgtext)
objrs.AddNew
objrs.Fields(1) = Trim(objrss.Fields(1).Value)
objrs.Fields(2) = Trim(objrss.Fields(2).Value)
objrs.Fields(3) = Trim(objrss.Fields(3).Value)
objrs.Fields(4) = Trim(objrss.Fields(4).Value)
objrs.Fields(5) = Trim(objrss.Fields(5).Value)
objrs.Fields(6) = Trim(Date)
objrs.Fields(7) = Trim(Time)
objrs.Fields(8) = Trim(objrss.Fields(6).Value)
objrs.Update
objrs.Close
objrss.Close
Unload Me
Else
Cancel = 1
End If
End Sub
Private Sub ModifyPassword_Click()
'修改密码窗口显示
FrmModifypassword.Show
Call SetParent(FrmModifypassword.hWnd, Picture1.hWnd)
End Sub
Private Sub OndutyTeacher_Click()
'查看值班人员记录
FrmOndutyteaRecord.Show
Call SetParent(FrmOndutyteaRecord.hWnd, Picture1.hWnd)
End Sub
Private Sub OperatorsRecord_Click()
'显示操作人员工作记录查询
FrmOpertorRecord.Show
Call SetParent(FrmOpertorRecord.hWnd, Picture1.hWnd)
End Sub
Private Sub ProtectBasicinfo_Click()
'显示学生基本信息查询
FrmInqStuInfo.Show
Call SetParent(FrmInqStuInfo.hWnd, Picture1.hWnd)
End Sub
Private Sub RemoveCard_Click()
'显示退卡窗口
FrmremoveCard.Show
Call SetParent(FrmremoveCard.hWnd, Picture1.hWnd)
End Sub
Private Sub SeeBalance_Click()
'查看余额窗口显示
FrmInqBalance.Show
Call SetParent(FrmInqBalance.hWnd, Picture1.hWnd)
End Sub
Private Sub SeeComputerrecord_Click()
'查看学生上机记录窗口显示
FrmInqcomrecord.Show
Call SetParent(FrmInqcomrecord.hWnd, Picture1.hWnd)
End Sub
Private Sub SeeComputerstate_Click()
'查看学生上机状态窗口显示
FrmInqstucomState.Show
Call SetParent(FrmInqstucomState.hWnd, Picture1.hWnd)
End Sub
Private Sub SettleAccount_Click()
'显示结账窗口
FrmAccount.Show
Call SetParent(FrmAccount.hWnd, Picture1.hWnd)
End Sub
Private Sub Timer1_Timer()
Label19.Caption = Time
End Sub
Private Sub TxtcardID_KeyPress(KeyAscii As Integer)
Dim objrs As ADODB.Recordset
Dim strsql As String
Dim msgtext As String
Dim objrss As ADODB.Recordset
'单击回车键 则执行相应的上机下机操作
If KeyAscii = 13 Then
strsql = "select * from Computer_Info where Card_ID='" & Trim(TxtCardID.Text) & "' and ComputerState='正在上机'"
Set objrss = ExecuteSQL(strsql, msgtext)
If objrss.EOF Then
Call CmdEnter_Click
Else
TxtstudentID.Text = objrss.Fields(2).Value
TxtSeries.Text = objrss.Fields(5).Value
TxtStyle.Text = objrss.Fields(1).Value
TxtName.Text = objrss.Fields(3).Value
TxtSex.Text = objrss.Fields(4).Value
TxtEnterDate.Text = objrss.Fields(6).Value
TxtEnterTime.Text = objrss.Fields(8).Value
Isenter = True
Call CmdAway_Click
End If
objrss.Close
End If
End Sub
Public Sub ClearInfo()
TxtCardID.Text = ""
TxtName.Text = ""
TxtSeries.Text = ""
TxtStyle.Text = ""
TxtstudentID.Text = ""
TxtSex.Text = ""
TxtEnterDate.Text = ""
TxtEnterTime.Text = ""
TxtBalance.Text = ""
TxtConsumetime.Text = ""
TxtConsumemoney.Text = ""
End Sub
Private Sub WeekBill_Click()
FrmWeekAccount.Show
End Sub