机房收费系统——概览

对于机房收费系统，首先了解总共有26个窗体，如果你不够，肯定少了某一个（可能是学生信息维护里面的修改）。里面代码主要涉及到对数据库的增删改查。下面的三步分别讲了建立窗体框架，写登录和模块的代码，首页的代码。Let's begin!

第一步，首先需要建立那26个窗体，把控件整理上去，命名的话也要注意，尽量命名成自己理解的英文。比如：查询按钮Commend，你可以命名成cmdInquire！(其他的控件自行扩展）。这是建立框架的过程，这个过程不需要太长时间。

第二步，建立完窗体，就要开始写代码了，先写那个窗体呢？我先写的是登录窗体和模块的代码。这样就可以顺利实现登录功能了。登录窗体代码如下：

<span style="font-size:18px;">'说明：用户名和密码不能为空，查询用户名，对应的密码，准确无误后进入主界面，引入机器名函数
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long    '该类的公有成员
Public OK As Boolean
Dim miCount As Integer                          '记录登录的次数

Private Sub cmdCancel_Click()                   '点击取消按钮
    OK = False
    Me.Hide
End Sub
                                                '点击确定按钮
Private Sub cmdOK_Click()
    Dim txtSQL As String
    Dim mrc As ADODB.Recordset
    Dim Msgtext As String
    Dim mrcc As ADODB.Recordset
    Dim Msgtext1 As String
    Dim txtSQL1 As String
                                                '检查密码是否正确
    UserName = ""
    If Trim(txtUserName1.Text = "") Then        '用户名不能为空
        MsgBox "请输入用户名！", vbOKOnly + vbExclamation, "提示"
        txtUserName1.SetFocus
    Else                                        '调出数据库中User表的数据
        txtSQL = "select * from User_Info where userID = '" & txtUserName1.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, Msgtext)
        If mrc.EOF Then                         '假如数据库中没有此用户
            MsgBox "没有这个用户，请重新输入用户名！", vbOKOnly + vbExclamation, "提示"
            txtUserName1.Text = ""
            txtPassword.Text = ""
            txtUserName1.SetFocus
            Exit Sub
        Else                                    '判断输入密码是否正确
            If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then
                OK = True
                mrc.Close
                Me.Hide
                UserName = Trim(txtUserName1.Text) '把输入的用户名赋值给UserName
                PD = Trim(txtPassword.Text)        '把输入的密码赋值给PD
            Else
                MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbCritical, "提示"
                txtPassword.SetFocus
                txtPassword.Text = ""
            End If
        End If
    End If
                                                 '提取数据库中对应的信息
    txtSQL = "select * from User_Info where userID = '" & txtUserName1.Text & "'"
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
    
    txtSQL1 = "select * from OnWork_Info "        '调出Onwork数据表
    Set mrcc = ExecuteSQL(txtSQL1, Msgtext1)
    
    mrcc.AddNew
    mrcc.Fields(0) = UserName
    mrcc.Fields(1) = Trim(mrc.Fields(2))
    mrcc.Fields(2) = Date
    mrcc.Fields(3) = Time
    mrcc.Fields(4) = VBA.Environ("computername")  '将当前计算机名写入数据库
    mrcc.Update
    mrcc.Close
    
    miCount = miCount + 1                          '限制它的输入次数
    If miCount = 3 Then
        Me.Hide
        MsgBox "超过登录限制次数！", vbOKOnly + vbExclamation, "提示"
        End If
    Exit Sub
    
End Sub

Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long
    
    
    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)                    '防止存在上一次输入的用户名
                                                        'API中字符串作参数，需要提前确定大小
                                                        
    If lSize > 0 Then
        txtUserName1.Text = ""
        
    Else
        txtUserName1.Text = vbNullString
    End If
    
    OK = False
    miCount = 0
    
End Sub

Private Sub txtUserName1_KeyPress(KeyAscii As Integer)  '文本框只能输入数字

    Select Case KeyAscii
    Case 48 To 57
        Case 8
    Case Else
        MsgBox "只能输数字！", vbOKOnly + vbExclamation, "提示"
        KeyAscii = 0
        txtUserName1.Text = ""
        txtUserName1.SetFocus
    End Select
    
End Sub
</span>

模块窗体代码如下：

<span style="font-size:18px;">Public UserName As String       '它们是类型变量
Public fMainForm As frmMain
Public p As Integer
Public PD As String
Public Sub AutocolWidth(Form As Form, Grid As MSFlexGrid)  '让MSFLexGrid网格自动适应文本大小
                                                           '统一窗体和控件文字大小
    Dim FontSize As Integer
    FontSize = Form.FontSize
    Form.FontSize = Grid.Font.Size
    
    Dim rowNum As Long, colNum As Long, colWidth As Double
    With Grid                           '遍历每一列
        For colNum = 0 To .Cols - 1
            colWidth = 0
                                        '遍历每一行，找到最长文本
            For rowNum = 0 To .Rows - 1
                If Form.TextWidth(.TextMatrix(rowNum, colNum)) > colWidth Then
                    colWidth = Form.TextWidth(.TextMatrix(rowNum, colNum))
                End If
            Next
                                        '在最长文本长度的基础上增加长度150缇
            .colWidth(colNum) = colWidth + 150
        Next
    End With
    Form.FontSize = FontSize
    
End Sub

Public Sub ExportToExcel(FormName As Form, flex As MSFlexGrid)
                                       '导出为Excel表的过程，前者为当前工作的窗体名，后者为控件名
    Dim xlsApp As Object
    Dim xlsBook As Object
    Dim xlsSheet As Object
    
    Screen.MousePointer = vbHourglass
    
    Set xlsApp = New Excel.Application
    Set xlsBook = xlsApp.Workbooks.Add
    Set xlsSheet = xlsBook.Worksheets(1)
    
    On Error GoTo err_proc
    
    Dim i As Integer
    Dim j As Integer
    
    With flex                           '将数据写入到Excel表
        For i = 0 To .Rows - 1
            For j = 0 To .Cols - 1
                xlsSheet.Cells(i + 1, j + 1).Value = "'" & .TextMatrix(i, j)
            Next j
        Next i
    End With
    
    xlsApp.Sheets(1).Columns.EntireColumn.AutoFit  '自动调整列宽
    xlsApp.Visible = True
    Screen.MousePointer = vbDefault
    Exit Sub
    
err_proc:
    Screen.MousePointer = vbDefault
    MsgBox "请确认您的电脑已安装Excel，或是否安装正确！", vbExclamation, "机房收费系统"
End Sub

Sub Main()
    Dim fLogin As New frmLogin
    fLogin.Show vbModal                '显示登录窗体实例
                                       'OK为frmMain类的成员
    If Not fLogin.OK Then              '条件选的好
       End                             '登录失败，所以退出
    End If
    Unload fLogin
    
    Set fMainForm = New frmMain        '显示窗体实例
    fMainForm.Show
End Sub
                                       '以文件DSN标记，访问ODBC数据源
Public Function ConnectString() As String
    ConnectString = "FileDSN=charge_sys.dsn;UID=sa;PWD=123456"
End Function

Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
                                   
    Dim cnn As ADODB.Connection
    Dim RST As ADODB.Recordset
    Dim sTokens() As String
    
    On Error GoTo ExecuteSQL_Error
    
    sTokens = Split(SQL)
    Set cnn = New ADODB.Connection
    cnn.Open ConnectString
    
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then   '非Select语句
        cnn.Execute SQL                                         '数据量不大时，可以在连接上，直接执行SQL语句
        MsgString = sTokens(0) & "query successful "            '虽然MsgString不是返回值但传递方式是ByRef,实参地址和这个地址相同
    Else                                                        'Select语句
        Set RST = New ADODB.Recordset
        RST.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic '得到临时表，游标指向第一条记录
                                                                 'get RecordCount
        Set ExecuteSQL = RST
        MsgString = "查询到" & RST.RecordCount & _
        "条记录"
    End If
    
ExecuteSQL_Exit:
    Set RST = Nothing
    Set cnn = Nothing
    Exit Function
    
ExecuteSQL_Error:
    MsgString = "查询错误：" & _
        Err.Description
    Resume ExecuteSQL_Exit
End Function
Public Function Testtxt(txt As String) As Boolean                 '利用Testtxt判定不为空
    If Trim(txt) = "" Then
        Testtxt = False
    Else
        Testtxt = True
    End If
End Function
</span>

好了，这样就可以实现顺利登录到首界面了。

第三步，登录到首界面以后，就需要写首窗体的代码了，如下：

<span style="font-size:18px;">Private Sub cmdOnLine_Click()    '点击上机按钮

    Dim txtSQLdat As String
    Dim txtSQL As String
    Dim strSQL As String
    Dim strSQL2 As String
    Dim strSQL3 As String
    Dim Msgtextdat As String
    Dim Msgtext As String
    Dim strMsgText As String
    Dim strMsgText2 As String
    Dim strMsgText3 As String
    Dim mrcdat As ADODB.Recordset
    Dim mrc As ADODB.Recordset
    Dim objRst As ADODB.Recordset
    Dim objRst2 As ADODB.Recordset
    Dim objRst3 As ADODB.Recordset
                                '让下机日期、下机时间、消费时间、消费金额为空
    txtOutDate.Text = ""
    txtOutTime.Text = ""
    txtPayTime.Text = ""
    txtPayMoney.Text = ""
    
    If txtCardNo.Text = "" Then '判断卡号是否为空
        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
            txtStudentNo.Text = ""
            txtDepartment.Text = ""
            txtType.Text = ""
            txtStudentName.Text = ""
            txtSex.Text = ""
            txtOnDate.Text = ""
            txtOutDate.Text = ""
            txtAllCash.Text = ""
            txtOnTime.Text = ""
            txtOutTime.Text = ""
            txtPayTime.Text = ""
            txtPayMoney.Text = ""
            txtCardNo.SetFocus
        Exit Sub
    Else
                                          '查询数据库里学生基本信息表
        Set objRst = New ADODB.Recordset
        strSQL = "select * from student_Info where cardNo = '" & Trim(txtCardNo.Text) & "' and status ='使用'"
        Set objRst = ExecuteSQL(strSQL, strMsgText)
        If objRst.BOF And objRst.EOF Then '判断卡号是否存在
            MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "提示"
            txtCardNo.Text = ""
            txtStudentNo.Text = ""
            txtDepartment.Text = ""
            txtType.Text = ""
            txtStudentName.Text = ""
            txtSex.Text = ""
            txtOnDate.Text = ""
            txtOutDate.Text = ""
            txtAllCash.Text = ""
            txtOnTime.Text = ""
            txtOutTime.Text = ""
            txtPayTime.Text = ""
            txtPayMoney.Text = ""
            txtCardNo.SetFocus
        Else
            If objRst.Fields(7) < 1 Then            '判断余额是否充足
                MsgBox "余额只有" & objRst.Fields(7) & "元, 少于最少金额，请先充值！", vbOKOnly, "提示"
                txtCardNo.Text = ""
                txtStudentNo.Text = ""
                txtDepartment.Text = ""
                txtType.Text = ""
                txtStudentName.Text = ""
                txtSex.Text = ""
                txtOnDate.Text = ""
                txtOutDate.Text = ""
                txtAllCash.Text = ""
                txtOnTime.Text = ""
                txtOutTime.Text = ""
                txtPayTime.Text = ""
                txtPayMoney.Text = ""
                txtCardNo.SetFocus
                Exit Sub
            Else                                     '判断该卡号是否正在上机
                Set objRst3 = New ADODB.Recordset
                strSQL3 = "select * from OnLine_Info where cardno = '" & Trim(txtCardNo.Text) & "' "
                Set objRst3 = ExecuteSQL(strSQL3, strMsgText3)
                If Not (objRst3.BOF And objRst3.EOF) Then
                    MsgBox "该卡正在上机！", vbOKOnly + vbExclamation, "提示"
                    txtStudentNo.Text = ""
                    txtDepartment.Text = ""
                    txtType.Text = ""
                    txtStudentName.Text = ""
                    txtSex.Text = ""
                    txtOnDate.Text = ""
                    txtOutDate.Text = ""
                    txtAllCash.Text = ""
                    txtOnTime.Text = ""
                    txtOutTime.Text = ""
                    txtPayTime.Text = ""
                    txtPayMoney.Text = ""
                    txtCardNo.SetFocus
                    txtCardNo = ""
                    Exit Sub
                Else
                    txtSQLdat = "select getdate()"
                    Set mrcdat = ExecuteSQL(txtSQLdat, Msgtextdat)
                                           '显示该卡号的一些基本信息
                    txtStudentNo.Text = Trim(objRst.Fields(1))
                    txtDepartment.Text = Trim(objRst.Fields(4))
                    txtType.Text = Trim(objRst.Fields(14))
                    txtStudentName.Text = Trim(objRst.Fields(2))
                    txtSex.Text = Trim(objRst.Fields(3))
                    txtOnDate.Text = Format(mrcdat.Fields(0), "yyyy-mm-dd")
                    txtOnTime.Text = Format(mrcdat.Fields(0), "hh:mm:ss")
                    txtAllCash.Text = Trim(objRst.Fields(7))
                                            '将上机前的余额提出来，用于下机时计算余额
                    curAllCash = Trim(objRst.Fields(7))
                    Label1.Caption = "欢迎光临！"
                                            '将该卡上机的信息填入到online_Info表里
                    Set objRst2 = New ADODB.Recordset
                    strSQL2 = "select * from OnLine_Info"
                    Set objRst2 = ExecuteSQL(strSQL2, strMsgText2)
                 
                    objRst2.AddNew
                    objRst2.Fields(0) = txtCardNo.Text
                    objRst2.Fields(3) = txtStudentName.Text
                    objRst2.Fields(6) = txtOnDate.Text
                    objRst2.Fields(7) = txtOnTime.Text
                    objRst2.Fields(1) = txtType.Text
                    objRst2.Fields(2) = txtStudentNo.Text
                    objRst2.Fields(4) = txtDepartment.Text
                    objRst2.Fields(5) = txtSex.Text
                    objRst2.Fields(8) = VBA.Environ("computername") '显示计算机名字
                    objRst2.Fields(9) = mrcdat.Fields(0)
                    objRst2.Update
                    objRst2.Close
                    objRst.Close
                    
                End If
            End If
        End If
    End If
                    
End Sub

Private Sub cmdOffLine_Click()   '点击下机按钮
    Dim rstOnLine As ADODB.Recordset
    Dim rststudent As ADODB.Recordset
    Dim rstLine As ADODB.Recordset
    Dim strOff As String
    Dim strMsg As String
    Dim rstBasicData As ADODB.Recordset
    Dim intLineTime As Integer
    Dim intConsumeTime As Integer
    Dim curConsume As Currency
    Dim curBalance As Currency
    Static Serical As Integer
    Dim mrc As ADODB.Recordset
    Dim Msgtext As String
    Dim txtSQL As String
    
    txtSQL = "select getdate()" '读取服务器时间
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
    
                                '判断卡号输入框是否为空
    If txtCardNo.Text = "" Then
        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    End If
    
                                '判断卡号输入框是否输入的位数字
    If Not IsNumeric(txtCardNo.Text) Then
        MsgBox "请输入数字！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
    
                                '判断卡是否在线
    strOff = "select * from OnLine_Info where cardno = '" & txtCardNo.Text & "'"
    Set rstOnLine = ExecuteSQL(strOff, strMsg)
    
    If rstOnLine.EOF Then
        MsgBox "该卡还没有上机！", vbOKOnly + vbExclamation, "提示"
            txtCardNo.Text = ""
            txtStudentNo.Text = ""
            txtDepartment.Text = ""
            txtType.Text = ""
            txtStudentName.Text = ""
            txtSex.Text = ""
            txtOnDate.Text = ""
            txtOutDate.Text = ""
            txtAllCash.Text = ""
            txtOnTime.Text = ""
            txtOutTime.Text = ""
            txtPayTime.Text = ""
            txtPayMoney.Text = ""
            txtCardNo.SetFocus
        Exit Sub
    End If
    
                                '查询基本数据表，获得设定的基本数据
    strOff = "select * from BasicData_Info"
    Set rstBasicData = ExecuteSQL(strOff, strMsg)
                                '计算消费时间，{实际上线时间=上机时间-下机时间，
                                '消费时间=取整（（实际在线时间-准备时间）/递增单位时间）* 递增单位时间 ，
                                '在此的时间单位均为分钟，取整必须用round函数四舍五入，不可用int或Fix函数}
        intLineTime = DateDiff("n", rstOnLine.Fields(9), Format(mrc.Fields(0), "yyyy-mm-dd hh:mm:ss"))
                                '判断实际在线时间是否小于准备时间
    If intLineTime <= rstBasicData!PrepareTime Then
        intLineTime = 0         '在线时间为零
    Else                        '判断实际在线时间是否小于最低消费时间
        If intLineTime < rstBasicData!leasttime Then
            intLineTime = rstBasicData!leasttime
        End If
    End If
                                '查询学生信息表
        strOff = "select * from student_Info where cardno= '" & txtCardNo.Text & "' and status ='使用'"
        Set rststudent = ExecuteSQL(strOff, strMsg)
        
        If Trim(rststudent.Fields(14)) = Trim("固定用户") Then
                                '计算消费金额 【消费金额=消费时间/60分钟 * 1小时费率】
            curConsume = Round(Round(intLineTime / 60, 4) * rstBasicData!Rate, 2)
        Else
            curConsume = Round(Round(intLineTime / 60, 4) * rstBasicData!tmpRate, 2)
        End If
                                '判断消费金额是否小于最低消费金额
        If curConsume > 0 And curConsume < rstBasicData!Limitcash Then
            curConsume = rstBasicData!Limitcash
        End If
                                '计算余额 【账户余额 = 原账户余额 - 消费金额】
        curBalance = Val(rststudent!cash) - curConsume
                                '下机信息显示
        txtCardNo.Text = rstOnLine!cardno
        txtType.Text = rstOnLine!cardtype
        txtStudentNo.Text = rstOnLine!studentno
        txtStudentName.Text = rstOnLine!studentName
        txtSex.Text = rstOnLine!sex
        txtDepartment.Text = rstOnLine!department
        txtOnDate.Text = rstOnLine!Ondate
        txtOnTime.Text = rstOnLine!OnTime
        txtOutDate.Text = Format(mrc.Fields(0), "yyyy-mm-dd")
        txtOutTime.Text = Format(mrc.Fields(0), "hh:mm:ss")
        Label1.Caption = "欢迎下次再来！"
        txtPayTime.Text = intLineTime
        txtPayMoney.Text = curConsume
        txtAllCash.Text = curBalance
                                '更新学生信息表的余额
        rststudent!cash = curBalance
        rststudent.Update
        rststudent.Close
                                '更新上机记录表
        strOff = "select * from Line_Info "
        Set rstLine = ExecuteSQL(strOff, strMsg)
        
        rstLine.AddNew          '增加新行，在临时列表中
            rstLine.Fields(1) = Trim(txtCardNo.Text)
            rstLine.Fields(3) = Trim(txtStudentName.Text)
            rstLine.Fields(2) = Trim(txtStudentNo.Text)
            rstLine.Fields(4) = Trim(txtDepartment.Text)
            rstLine.Fields(5) = Trim(txtSex.Text)
            rstLine.Fields(6) = Trim(txtOnDate.Text)
            rstLine.Fields(7) = Trim(txtOnTime.Text)
            rstLine.Fields(8) = Trim(txtOutDate.Text)
            rstLine.Fields(9) = Trim(txtOutTime.Text)
            rstLine.Fields(10) = Trim(txtPayTime.Text)
            rstLine.Fields(11) = Trim(txtPayMoney.Text)
            rstLine.Fields(12) = Trim(txtAllCash.Text)
            rstLine.Fields(13) = "正常下机"
            rstLine.Fields(14) = VBA.Environ("computername")
            rstLine.Update      '更新数据库
            rstLine.Close
                                '删除相应的在线卡状态表记录
            rstOnLine.Delete
     
End Sub

Private Sub Form_Load()
                                
    Dim mrc As ADODB.Recordset
    Dim txtSQL, Msgtext As String

    txtSQL = "select * from User_Info where Level= '" & "操作员" & "'"
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
    
    Do While Not mrc.EOF
        If UserName = Trim(mrc.Fields(0)) Then
            mnuManager.Visible = False     '如果登录名是操作员则管理员界面不可见
        End If
        mrc.MoveNext
    Loop
    
    txtSQL = "select * from User_Info where Level ='" & "一般用户" & "'"
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
    Do While Not mrc.EOF                   '如果登录名是一般用户，管理员和操作员界面不可见
        If UserName = Trim(mrc.Fields(0)) Then
        mnuManager.Visible = False
        mnuOprator.Visible = False
        End If
        mrc.MoveNext
    Loop
    
End Sub

Private Sub Form_Unload(Cancel As Integer) '关闭主窗体提示
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim Msgtext As String
    Dim Msgtext1 As String
    Dim txtSQL1 As String
    Dim mrcc As ADODB.Recordset
    Dim x As String
    Dim mrcdat As ADODB.Recordset
    Dim txtSQLdat As String
    Dim Msgtextdat As String
    
    txtSQLdat = "select getdate()"
    Set mrcdat = ExecuteSQL(txtSQLdat, Msgtextdat)
                                        '窗口关闭提示
    x = MsgBox("你确定要退出系统吗？", vbYesNo, "提示")
    If x = vbYes Then
        
        
        txtSQL = "select * from User_Info where userID='" & UserName & "'"
        Set mrc = ExecuteSQL(txtSQL, Msgtext)
        
        a = Trim(mrc.Fields(2))
        txtSQL = "select * from Onwork_Info "
        Set mrc = ExecuteSQL(txtSQL, Msgtext)
        
        b = Trim(mrc.Fields(2))
        c = Trim(mrc.Fields(3))
        
                                       '工作记录表中的信息更新
        txtSQL = "select * from worklog_Info where UserID = '" & UserName & "' And  status = '" & "true" & "'"
        Set mrcc = ExecuteSQL(txtSQL, Msgtext)
        
        mrcc.AddNew
        mrcc.Fields(1) = UserName
        mrcc.Fields(2) = a
        mrcc.Fields(3) = b
        mrcc.Fields(4) = c
        mrcc.Fields(5) = Format(mrcdat.Fields(0), "yyyy-mm-dd")
        mrcc.Fields(6) = Format(mrcdat.Fields(0), "hh:mm:ss")
        mrcc.Fields(7) = VBA.Environ("computername")
        mrcc.Fields(8) = "False"
        mrcc.Update
        mrcc.Close
                                        '删除正在上机信息
        txtSQL1 = "delete from OnWork_Info "
        Set mrc = ExecuteSQL(txtSQL1, Msgtext1)
        End                            '结束工程
    Else
        frmMain.Show
    End If
End Sub

Private Sub mnuAbout_Click()              '关于窗体显示
    frmAbout.Show   
End Sub

Private Sub mnuBasicDataSetting_Click()   '基本数据设定窗体
    frmBasicDataSetting.Show
End Sub

Private Sub mnuCancel_Click()             '退卡窗体
    frmCancel.Show     
End Sub

Private Sub mnuCloseAccounts_Click()      '结账窗体显示
    frmCloseAccounts.Show
End Sub
Private Sub mnuDayBill_Click()            '日结账单显示
    frmDayBill.Show
End Sub

Private Sub mnuDeleOrAddUser_Click()      '增加或者删除用户窗体显示 
    frmDeleOrAddUser.Show     
End Sub

Private Sub mnuDutyTeacher_Click()        '值班老师窗体显示 
    frmDutyTeacher.Show 
End Sub

Private Sub mnuExit_Click()               '退出工程
    Unload Me
End Sub

Private Sub mnuLookRecord_Click()        '查看学生上机记录窗体
    frmLookSJRecord.Show    
End Sub

Private Sub mnuExplain_Click()           '说明窗体
    frmExplain.Show
End Sub

Private Sub mnuGatherSum_Click()        '收取金额查询窗体
    frmGatherSum.Show  
End Sub

Private Sub mnuInfoUphold_Click()       '学生基本信息维护窗体
    frmInfoUphold.Show
End Sub

Private Sub mnuInquirySJInfo_Click()    '查询学生上机信息窗体
    frmInquirySJInfo.Show
End Sub

Private Sub mnuLookRemain_Click()       '查看余额窗体
    frmLookRemain.Show
End Sub

Private Sub mnuLookSJRecord_Click()     '查看上机记录窗体
    frmLookSJRecord.Show
End Sub

Private Sub mnuLookSJState_Click()      '查看学生上机状态
    frmLookSJState.Show
End Sub

Private Sub mnuModifyPassword_Click()    '修改密码窗体显示
    frmModifyPassword.Show
End Sub

Private Sub mnuOperateWkRecord_Click()   '操作员工作记录窗体显示 
    frmOperateWkRecord.Show
End Sub

Private Sub mnuRecharge_Click()         '充值窗体显示
    frmRecharge.Show
End Sub

Private Sub mnuRechargeRecord_Click()   '充值记录窗体显示
    frmRechargeRecord.Show
End Sub

Private Sub mnuRegister_Click()        '注册窗体显示  
    frmRegister.Show  
End Sub

Private Sub mnuSumBack_Click()        '金额返还信息查询
    frmSumBack.Show
End Sub

Private Sub mnuWeekBill_Click() '周结账单窗体显示
    frmWeekBill.Show
End Sub

Private Sub Timer1_Timer()      '在窗口添加动态时间

    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim Msgtext As String
    
    txtSQL = "select getdate() "
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
    
    Label18.Caption = Format(mrc.Fields(0), "yyyy-mm-dd hh:mm:ss")
End Sub

Private Sub Timer2_Timer()      '利用Timer事件来实时统计当前上机人数

Dim Msgtext As String
Dim mrc As ADODB.Recordset
Dim txtSQL As String
Dim SJ As String

    SJ = 0
    txtSQL = "select * from OnLine_Info "
    Set mrc = ExecuteSQL(txtSQL, Msgtext)
                Do While Not mrc.EOF
                    SJ = SJ + 1
                    mrc.MoveNext
                Loop
            mrc.Close
    Label24.Caption = Val(SJ)
    
End Sub
                                                         '卡号窗体只能输入数字
Private Sub txtCardNo_KeyPress(KeyAscii As Integer)

    Select Case KeyAscii
        Case 48 To 57
        Case 8
    Case Else
        MsgBox "只能输数字！", vbOKOnly + vbExclamation, "提示"
        KeyAscii = 0
        txtCardNo.Text = ""
        txtCardNo.SetFocus
    End Select

End Sub
</span>

好的，做完这三步，就可以开始写各个窗体的代码了，其中涉及到对数据库的增删改查，下一篇博客我会再仔细分析这26个窗体各涉及到什么操作！希望这篇博客对大家有帮助！