上下机窗体 机房收费系统
首先对这个窗体进行下分析，可分为三个部分
1.加载：加载窗体时，显示当前系统时间和上机人数（下图红色内容）
2.上机：通过输入的卡号调去基本信息，显示在窗体上（下图绿色内容）
3下机：显示消费时间，金钱和余额（重点在消费金额的计算）（下图蓝色内容）
3.1.消耗金钱的计算方法：以递增时间为收费时间标准。
基本数据表中有（半小时上机费用，递增时间，准备时间，至少上机时间）
（1）半小时的费用/30 * 递增时间 = 等于一个递增时间段金钱
（2）上机的时间- 准备时间） = 总的时间
（3）总时间/递增时间 得到递增时间段
（4）递增时间段* 递增时间段的金额 等于总的消费金额
实例；半小时的费用为3元 ，递增时间为10分钟， 准备时间为2分钟，至少上机时间为5分钟
上机上机munite <=2 不收钱
总时间munite = 上机时间 - 2
(munite>0 and munite<=5) or munite < =10 收1元 按一个递增时间段收费
munite>10 and minute < = 20 收费 2元 按两个递增时间段
............................
代码如下：
1.先声明全局变量
Option Explicit Dim Timebegin As Date '开始上机时间 Dim Timeend As Date '上机结束时间 Dim onflag As Integer '上机人数
2.加载窗体：
Private Sub Timer1_Timer() '使用Timer控件显示当前时间
Nowtime.Caption = Time
End Sub
Private Sub MDIForm_Load() ’从online表中获取当前上机的人数
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim txtsql As String
txtsql = "select * from OnLine_Info "
Set mrc = ExecuteSQL(txtsql, msgtext)
onflag = mrc.RecordCount
Show2.Caption = onflag ’显示当前上机人数
End Sub3.上机事件：
Private Sub cmdOn_Click()
Dim txtsql As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim status As String '卡的使用状态
'检查卡号是否能正常使用
txtsql = "select * from student_Info where cardno='" & Trim(txtcardNo.Text) & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF Then
MsgBox "此卡尚未注册！", vbOKOnly + vbExclamation, "警告"
txtcardNo.Text = ""
txtcardNo.SetFocus
mrc.Close
Exit Sub
Else
status = Trim(mrc.Fields(10))
If mrc.EOF = False And "未使用" = status Then
MsgBox "该卡没有注册！", vbOKOnly + vbExclamation, "警告！"
txtcardNo.Text = ""
txtcardNo.SetFocus
mrc.Close
Exit Sub
End If
End If
'检查该卡号是否已经登录
txtsql = "select * from OnLine_Info where cardno='" & Trim(txtcardNo.Text) & "'"
Set mrcc = ExecuteSQL(txtsql, msgtext)
'该卡号正在上机，
If mrcc.EOF = False Then
MsgBox "该卡号正在上机！", vbOKOnly + vbInformation, "提示"
mrcc.Close
mrc.Close
Exit Sub
End If
mrcc.Close
'如果卡号能用且没有上机，检查余额
If Not mrc.Fields(7) > 2 Then '2为basicdata表中的最少金额
MsgBox "余额不足，请充值！", vbOKOnly + vbExclamation, "警告"
mrc.Close
Exit Sub
End If
'余额充足，窗体显示上机信息
txtstudentNo.Text = mrc.Fields(1)
txtStudentName.Text = mrc.Fields(2)
txtType.Text = "固定用户"
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(3)
txtRecash.Text = mrc.Fields(7)
txtOndate.Text = Format(Date, "yyyy-mm-dd") '定义时间的格式
txtOntime.Text = Format(Time, "hh:mm")
Timebegin = Trim(txtOntime.Text)
show1.Caption = "欢迎光临！"
'显示登录人数
onflag = onflag + 1
Show2.Caption = onflag
'断开数据库连接
mrc.Close
'将数据信息存入表onLine中
txtsql = "select * from OnLine_Info"
Set mrcc = ExecuteSQL(txtsql, msgtext)
mrcc.AddNew
mrcc.Fields(0) = Trim(txtcardNo.Text)
mrcc.Fields(1) = Trim(txtType.Text)
mrcc.Fields(2) = Trim(txtstudentNo.Text)
mrcc.Fields(3) = Trim(txtStudentName.Text)
mrcc.Fields(4) = Trim(txtDepartment.Text)
mrcc.Fields(5) = Trim(txtSex.Text)
mrcc.Fields(6) = Format(Date, "yyyy-mm-dd")
mrcc.Fields(7) = Format(Time, "hh:mm")
mrcc.Fields(8) = "LL-PC"
mrcc.Update
mrcc.Close
txtOutdate.Text = "" txtOuttime.Text = "" txtExpensetime.Text = "" txtExpensecash.Text = "" End Sub4：下机事件
Private Sub cmdOut_Click()
Dim txtsql As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
'定义这么多的变量用于消耗金钱的计算过程
Dim Usetime As Single '上机消耗的时间
Dim Usecash As Single '上机所消耗的金钱
Dim Unittime As Single '递增时间
Dim Unitcash As Single '递增金钱
Dim UnitNumber As Integer '递增时间段
Dim pretime As Integer '准备时间
Dim Leasttime As Integer '至少上机时间
Dim Halfcash As Single '半小时的费用。
Dim Totalcash As Single '最后余额
'判断卡号是否在上机
txtsql = "select * from OnLine_Info where cardno='" & Trim(txtcardNo.Text) & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = True Then
show1.Caption = "该卡号还没上机！"
mrc.Close
Exit Sub
Else
'卡号在上机，加载基本信息
txtType.Text = mrc.Fields(1)
txtstudentNo.Text = mrc.Fields(2)
txtStudentName.Text = mrc.Fields(3)
txtDepartment.Text = mrc.Fields(4)
txtSex.Text = mrc.Fields(5)
txtOndate.Text = mrc.Fields(6)
txtOntime.Text = mrc.Fields(7)
Timebegin = Trim(txtOntime.Text)
mrc.Close
End If
'计算上机消耗的时间
txtOutdate.Text = Format(Date, "yyyy-mm-dd")
txtOuttime.Text = Format(Time, "hh:mm")
Timeend = Trim(txtOuttime.Text)
Usetime = Abs(DateDiff("n", Timeend, Timebegin)) ’暂不支持过夜功能
txtExpensetime.Text = Usetime
'连接基本数据表，取得基本信息
txtsql = "select * from BasicData_info"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.MoveLast
Halfcash = mrc.Fields(0) '固定用户半小时的费用
Unittime = mrc.Fields(2) '递增时间
Leasttime = mrc.Fields(3) '最少上机时间
pretime = mrc.Fields(4) '准备时间
mrc.Close
'计算消费的金额
'第一种情况消费时间小于准备时间，消费金额为0
If Usetime = <= pretime Then
Usecash = 0
txtExpensecash.Text = Usecash
Else
'一个递增时间段消费的金钱，以半小时的费用为计算基础
Unitcash = Format((Halfcash / 30) * Unittime, "0.0")
'第二种情况 消费时间小于最小上机时间 按一个递增时间段收费
If Usetime <=Leasttime Then
Usecash = Unitcash
txtExpensecash.Text = Unitcash
Else
'第三种情况 最后求出的UnitNumber为递增时间段的个数
Usetime = Usetime - pretime
UnitNumber = Usetime Mod Unittime
If UnitNumber = 0 Then
UnitNumber = Int(Usetime / Unittime)
Else
UnitNumber = Int(Usetime / Unittime) + 1
End If
Usecash = Format(UnitNumber * Unitcash, "0.0")
txtExpensecash.Text = Usecash
End If
End If
'计算最新余额
txtsql = "select * from student_Info where cardno='" & txtcardNo & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
'获得原来的余额
Totalcash = mrc.Fields(7)
'计算消费后的余额
Totalcash = Totalcash - Val(Trim(txtExpensecash.Text))
'更新余额
mrc.Fields(7).Value = Totalcash
mrc.Update
mrc.Close
txtRecash.Text = Totalcash
'更新表
txtsql = "select * from OnLine_Info where cardno='" & Trim(txtcardNo.Text) & "'"
Set mrcc = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from Line_Info"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.AddNew
mrc.Fields(1) = mrcc.Fields(0)
mrc.Fields(2) = mrcc.Fields(2)
mrc.Fields(3) = mrcc.Fields(3)
mrc.Fields(4) = mrcc.Fields(4)
mrc.Fields(5) = mrcc.Fields(5)
mrc.Fields(6) = mrcc.Fields(6)
mrc.Fields(7) = mrcc.Fields(7)
mrc.Fields(8) = Trim(txtOutdate.Text)
mrc.Fields(9) = Trim(txtOuttime.Text)
mrc.Fields(10) = Trim(txtExpensetime.Text)
mrc.Fields(11) = Trim(txtExpensecash.Text)
mrc.Fields(12) = Trim(txtRecash.Text)
mrc.Fields(13) = "正常下机"
mrc.Fields(14) = "LL-PC" '得到计算机的名字
mrc.Update
mrc.Close
mrcc.Delete
mrcc.Update
mrcc.Close
'登录用户减1
onflag = onflag - 1
Show2.Caption = onflag
'显示下线
show1.Caption = "欢迎下次再来！"
End Sub