机房收费系统——概览

     对于机房收费系统，首先了解总共有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 BooleanDim miCount As Integer                          '记录登录的次数Private Sub cmdCancel_Click()                   '点击取消按钮    OK = False    Me.HideEnd 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 SubPrivate 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 SubPrivate 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 frmMainPublic p As IntegerPublic PD As StringPublic 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 SubPublic 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 SubSub 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.ShowEnd Sub                                       '以文件DSN标记，访问ODBC数据源Public Function ConnectString() As String    ConnectString = "FileDSN=charge_sys.dsn;UID=sa;PWD=123456"End FunctionPublic 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_ExitEnd FunctionPublic Function Testtxt(txt As String) As Boolean                 '利用Testtxt判定不为空    If Trim(txt) = "" Then        Testtxt = False    Else        Testtxt = True    End IfEnd 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 IfEnd SubPrivate Sub mnuAbout_Click()              '关于窗体显示    frmAbout.Show   End SubPrivate Sub mnuBasicDataSetting_Click()   '基本数据设定窗体    frmBasicDataSetting.ShowEnd SubPrivate Sub mnuCancel_Click()             '退卡窗体    frmCancel.Show     End SubPrivate Sub mnuCloseAccounts_Click()      '结账窗体显示    frmCloseAccounts.ShowEnd SubPrivate Sub mnuDayBill_Click()            '日结账单显示    frmDayBill.ShowEnd SubPrivate Sub mnuDeleOrAddUser_Click()      '增加或者删除用户窗体显示     frmDeleOrAddUser.Show     End SubPrivate Sub mnuDutyTeacher_Click()        '值班老师窗体显示     frmDutyTeacher.Show End SubPrivate Sub mnuExit_Click()               '退出工程    Unload MeEnd SubPrivate Sub mnuLookRecord_Click()        '查看学生上机记录窗体    frmLookSJRecord.Show    End SubPrivate Sub mnuExplain_Click()           '说明窗体    frmExplain.ShowEnd SubPrivate Sub mnuGatherSum_Click()        '收取金额查询窗体    frmGatherSum.Show  End SubPrivate Sub mnuInfoUphold_Click()       '学生基本信息维护窗体    frmInfoUphold.ShowEnd SubPrivate Sub mnuInquirySJInfo_Click()    '查询学生上机信息窗体    frmInquirySJInfo.ShowEnd SubPrivate Sub mnuLookRemain_Click()       '查看余额窗体    frmLookRemain.ShowEnd SubPrivate Sub mnuLookSJRecord_Click()     '查看上机记录窗体    frmLookSJRecord.ShowEnd SubPrivate Sub mnuLookSJState_Click()      '查看学生上机状态    frmLookSJState.ShowEnd SubPrivate Sub mnuModifyPassword_Click()    '修改密码窗体显示    frmModifyPassword.ShowEnd SubPrivate Sub mnuOperateWkRecord_Click()   '操作员工作记录窗体显示     frmOperateWkRecord.ShowEnd SubPrivate Sub mnuRecharge_Click()         '充值窗体显示    frmRecharge.ShowEnd SubPrivate Sub mnuRechargeRecord_Click()   '充值记录窗体显示    frmRechargeRecord.ShowEnd SubPrivate Sub mnuRegister_Click()        '注册窗体显示      frmRegister.Show  End SubPrivate Sub mnuSumBack_Click()        '金额返还信息查询    frmSumBack.ShowEnd SubPrivate Sub mnuWeekBill_Click() '周结账单窗体显示    frmWeekBill.ShowEnd SubPrivate 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 SubPrivate Sub Timer2_Timer()      '利用Timer事件来实时统计当前上机人数Dim Msgtext As StringDim mrc As ADODB.RecordsetDim txtSQL As StringDim 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 SelectEnd Sub</span>

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