机房收费系统--系统用户管理模块和主窗体的建立（二）

主窗体：

① 主窗体的建立：

用户名和密码登录成功之后，用户登录窗口消失，主窗体出现，主窗体是一个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