第一次机房收费系统优化总结

这次的机房持续了很长一段时间，也正是由于时间间隔较长，系统上的一些问题也显露了出来，因此优化也用了挺长的一段时间。但总体上没遇上什么大麻烦。以下是对这次机房系统的一个优化的总结，其实之前的总结中也包含了一些，但不太完整，以下是我在此次机房中的一些优化的内容：

一.限制字符类型(在KeyPress事件中编辑)

1.只输入数字和删除键

If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) Then
     KeyAscii = 0
     end if

2.只输入数字和小数和删除键

If KeyAscii <> Asc(".") And (KeyAscii <> 8) And (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) Then
    KeyAscii = 0
    End If

3.限制文本框输入内容的数值范围

If Val(txtClassno.Text) > 2147483647 Or Val(txtClassno.Text) < 1Then
            MsgBox "输入数值在1到2147483647范围内"
            txtClassno.SetFocus
            Exit Sub```

4.文本框内只能输入文字及删除键

 If KeyAscii >= -20319 And KeyAscii <= -3652 Or KeyAscii = 8 Then
    Else
        KeyAscii = 0
    End If

5.输入数字和英文字母

If ((KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122)) = False Then
 KeyAscii = 0
End If

6.只能输入数字和文字

If ((KeyAscii <= 57 And KeyAscii >= 48) Or (KeyAscii <= -3652 And KeyAscii >= -20319) Or KeyAscii = 8) = False Then
     KeyAscii = 0
End If

7.只能输入文字，英文和空格

If ((KeyAscii <= -3652 And KeyAscii >= -20319) Or (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Or KeyAscii = 32 Or KeyAscii = 8) = False Then
        KeyAscii = 0
 End If

二、不可输入且不可粘贴

不可粘贴是在右击鼠标时粘贴板上的内容自动清空

Private Sub txtStudentName_KeyPress(KeyAscii As Integer)
    KeyAscii = 0 '不可输入值
End Sub

Private Sub txtStudentName_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '不可粘贴
    If Button = 2 Then
        Clipboard.Clear
    End If
End Sub

三、实现背景图随窗体自定义变化

Dim H As Single '定义窗体高的变量
Dim W As Single '定义窗体高的变量
Private Sub Form_Load()
    H = Me.Height
    W = Me.Width
End Sub
Private Sub Form_Resize()
    Me.Height = H
    Me.Width = W
    Me.PaintPicture Me.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight '实现背景图随窗体变大而改变
End Sub

四、选择日期必须小于等于当前日期

Private Sub DTPicker2_Change()
    cmdInquery.Enabled = True
    '当选择的日期大于当前日期时报错
    If DTPicker2.Value > Date Then
        MsgBox "日期错误，终止日期应小于等于当前日期！", vbOKOnly + vbCritical, "错误"
        DTPicker2.Value = Date
        DTPicker2.SetFocus
        Exit Sub
    End If
End Sub

五、动态查询，强制下机

Private Sub Timer2_Timer()
    Dim i As Integer '用于计算数组号
    Dim datevalue As Integer '用于日期的差值
    Dim timevalue As Integer '用于时间的差值
    Dim sumTime As Integer '用于计算上机时间
    Dim cardno As String '用于承载卡号
    Dim pay As Long '用于计算单价
    Dim Consume As Long '用于总花费金额
    '对Online_info表的操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息
    '对student_info表操作
    Dim mrcstudent As ADODB.Recordset '用于存放记录集
    Dim studentSQL As String '用于存放SQL语句
    Dim studentMsgText As String '用于存放返回信息
    '对basic_info表操作
    Dim mrcbasic As ADODB.Recordset '用于存放记录集
    Dim basicSQL As String '用于存放SQL语句
    Dim basicMsgText As String '用于存放返回信息
    '对Line_info表操作
    Dim mrcline As ADODB.Recordset '用于存放记录集
    Dim lineSQL As String '用于存放SQL语句
    Dim lineMsgText As String '用于存放返回信息
    
    onlineSQL = "select * from OnLine_Info "
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    If mrconline.EOF = False Then
        mrconline.MoveFirst
    Else
        Timer2.Enabled = False
        Exit Sub
    End If
    '定义一个未知长度的数组
    ReDim a(mrconline.RecordCount) As String
    '动态的查询余额情况，一旦不足就下机
    For i = 0 To mrconline.RecordCount - 1
        a(i) = Trim(mrconline.Fields(0))
        cardno = a(i)
        
        studentSQL = "select * from student_info where cardno='" & Trim(cardno) & "'"
        Set mrcstudent = ExecuteSQL(studentSQL, studentMsgText)
        
        lineSQL = "select * from Line_Info where cardno='" & Trim(cardno) & "' and ondate='" & Trim(mrconline.Fields(6)) & "' and ontime='" & Trim(mrconline.Fields(7)) & "'"
        Set mrcline = ExecuteSQL(lineSQL, lineMsgText)
        
        basicSQL = "select * from basicdata_info "
        Set mrcbasic = ExecuteSQL(basicSQL, basicMsgText)
        
        datevalue = DateDiff("n", Trim(mrconline(6)), Date)
        timevalue = DateDiff("n", Trim(mrconline(7)), Time)
        'abs()函数时绝对值函数；datediff（"单位",日期1,日期2）计算时间差
        sumTime = Abs(datevalue + timevalue)
        
        '用户不同，收费不同
        If Trim(mrconline.Fields(1)) = "固定用户" Then
            'round（）四舍五入保留两位小数；
            pay = Round(mrcbasic.Fields(0) / 60)
        Else
            pay = Round(mrcbasic.Fields(1) / 60)
        End If
        If sumTime < Val(mrcbasic.Fields(4)) Then
            Consume = 0
        Else
            If sumTime < Val(mrcbasic.Fields(3)) Then
                Consume = 1
            Else
                Consume = pay * sumTime
            End If
        End If
        
        '更新Student表
        mrcstudent.Fields(7) = mrcstudent.Fields(7) - Consume
        mrcstudent.Update
        
        If Val(mrcstudent.Fields(7)) > 0 And Val(mrcstudent.Fields(7)) <= Val(mrcbasic.Fields(5)) Then
            MsgBox a(i) & "您卡内余额已不足" & Val(mrcbasic.Fields(5)) & "元，请及时充值！", vbOKOnly + vbInformation, "提示"
        End If
        
        '判断余额是否小于零
        If Val(mrcstudent.Fields(7)) <= 0 Then
            mrcstudent.Fields(7) = 0
            mrcstudent.Update
            mrconline.Delete
            mrconline.Update
            MsgBox "卡号：" & a(i) & "余额不足，即将下机！", vbOKOnly + vbInformation, "提示"
        End If
        
        '更新line表
        mrcline.Fields(8) = Date
        mrcline.Fields(9) = Time
        mrcline.Fields(10) = sumTime
        mrcline.Fields(11) = Consume
        mrcline.Fields(12) = Trim(mrcstudent.Fields(7))
        mrconline.MoveNext
    Next i
    mrcstudent.Close
    mrcbasic.Close
    mrconline.Close
End Sub

六、添加Enter快捷键

Private Sub txtPassWord_KeyPress(KeyAscii As Integer)
    '添加Enter快捷键
    If KeyAscii = 13 Then
        cmdOK.SetFocus
    End If
End Sub

七、无边框窗体随意拖动（对登录窗体）

Dim mx As Long '用于随意拖动窗体中宽的计算
Dim my As Long '用于随意拖动窗体中高的计算
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And vbLeftButton Then '按下鼠标左按钮
        mx = X
        my = Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     '随意拖动无边框窗体
    If Button And vbLeftButton Then
        Me.Move Me.Left - mx + X, Me.Top - my + Y
    End If
End Sub

八、超过登录次数强制退出系统

适用于登录窗体

Public ok As Boolean '记录确定次数
Dim miCount As Integer '定义密码的次数
Private Sub cmdOK_Click()
    '限制登录次数，超过次数强制退出系统
    miCount = miCount + 1
    If miCount = 5 Then
        MsgBox "超出限定次数，系统将被强制退出！", vbOKOnly + vbExclamation, "警告"
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    ok = False
    '初次为0
    miCount = 0
End Sub

九、Locked属性和keyASCII=0的区别

对于文本框而言两者没有差距，都表示不可输入，但对于combox而言差距很大，keyASCII=0表示不可输入值，但可以选择；而locked=true代表着控件已锁定，无法进行任何操作。

十、显示实时时间

Private Sub Timer1_Timer()
    lblTime.Caption = Format(Now, "hh:mm:ss")
End Sub

十一、显示上机人数

Private Sub MDIForm_Load()
    '对online_info表操作
    Dim mrconline As ADODB.Recordset '用于存放记录集
    Dim onlineSQL As String '用于存放SQL语句
    Dim onlineMsgText As String '用于存放返回信息

    '显示上机人数
    
    onlineSQL = "select * from OnLine_info"
    Set mrconline = ExecuteSQL(onlineSQL, onlineMsgText)
    
    If mrconline.EOF Then
        lblNOWPeople.Caption = 0
    Else
        lblNOWPeople.Caption = mrconline.RecordCount '计算上机总人数
    End If
End Sub

十二、每次仅显示一个窗体

第一种方法是将所有窗体设置成为MDI窗体的子窗体；
第二方法就是通过代码进行实现，例子如下：

Private Sub About_Click()
    frmAbout.Show
    Unload frmADDUser
    Unload frmADUser
    Unload frmBalance
    Unload frmCancelCard
    Unload frmCollectionCharge
    Unload frmControlRecord
    Unload frmDailyBill
    Unload frmDutyTeacher
    Unload frmExplain
    Unload frmInquery
    Unload frmInqueryONRecord
    Unload frmInqueryReChargeRecord
    Unload frmInqueryStatus
    Unload frmModifyData
    Unload frmModifyPassword
    Unload frmModifyStudentInformation
    Unload frmReCharge
    Unload frmRegister
    Unload frmReturnCharge
    Unload frmSettleAccount
    Unload frmStudentInformation
    Unload frmWeeklyBill
    Unload frmWriter
End Sub

十三、限制字符长度

第一种方法是直接在控件的属性栏里找到“MaxLength”属性设置位数即可；
第二种方法是在代码中实现，例子如下：

Private Sub txtInquery3_Change()
    If comboFieldName3.Text = "卡号" Then
        txtInquery3.MaxLength = 10
    End If
    If comboFieldName3.Text = "姓名" Then
        txtInquery3.MaxLength = 8
    End If
    If comboFieldName3.Text = "消费金额" Then
        txtInquery3.MaxLength = 6
    End If
    If comboFieldName3.Text = "余额" Then
        txtInquery3.MaxLength = 6
    End If
    If comboFieldName3.Text = "备注" Then
        txtInquery3.MaxLength = 25
    End If
End Sub