机房-下机

雨点打透心脏的1/2处 2022-06-03 05:24 153阅读 0赞

# 开篇： #

下机这一过程在机房中具体体现为3处，一处是主窗体上的下机；还有就是选中学生下线和所有学生下线了，这可以说是一个难点，但是别急，我这个小鸟也可以带你们飞啊，如果方向错了，欢迎提醒哈！![大笑][laugh.gif]

# 逻辑过程： #

##    一、下机 ##

###    1.必要的判断不可少 ###

卡号是否为空，是否输入数字，是否还在使用（student\_Info），是否正在上机（Online\_Info）。由于这些判断经常用，这里不再进行代码展示。

###    2.查询下机需要填写的内容 ###

下机日期和时间，这个很简单，直接是Date,Time即可。

之后是消费时间的计算：

labConsumetime.Caption = (Date - DateValue(mrconline!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrconline!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrconline!OnTime))) '单位时间为分钟    '计算消费时间

很长的代码，但是很好理解，就是下机时间和上机时间中间走过的分钟数。

然后是消费金额的计算，这是一个重点：首先从BasicData\_Info表中获取基础数据；然后根据消费时间来判断应该收取多少钱，中间有准备上机时间和最少上机时间，如果没有超过两者之和，都是不收取费用的！超过两者之和的话，应判断是临时用户还是固定用户，不同类型的用户其费率不一样；最后，下机成功，删除Online\_Info表里的相应记录，并在当前上机人数地方-1。

Dim w1 As Currency                                                      '固定用户费率
            Dim w2 As Currency                                                      '临时用户费率
            Dim money As Double                                                     '消费金额
            
            Dim a1 As Long                                                          '最少上机时间
            Dim a2 As Long                                                          '准备上机时间
            Dim x As Long                                                           '单位递增时间
            Dim w As Currency                                                       '最少金额
            
            '连接BasicData表
            txtSQL = "select *from BasicData_Info"
            Set mrcbas = ExecuteSQL(txtSQL, Msgtext)
            
            '为各变量赋值
            With mrcbas
                
                w1 = Trim(.Fields(0))
                w2 = Trim(.Fields(1))
                x = Trim(.Fields(2))
                a1 = Trim(.Fields(3))
                a2 = Trim(.Fields(4))
                w = Trim(.Fields(5))
                
            End With
            
            
            '计算消费时间和金额
            '固定用户一小时费用为 w1，临时用户一小时费用为w2，至少上机时间为t1，准备时间为t2，最少金额为w，
            '上机时间为time1，下机时间为time2，输出的钱为money，x为递增单位时间
            '准备时间不收钱，没有达到最少上机时间，收取金额为最少金额，达到最少上机时间后，按时间计算
            
            
            '没有达到准备上机时间
            If Val(labConsumetime.Caption) < a2 Then
                
                MsgBox "没有达到上机准备时间，不收取费用！", 48, "提示"
                
                '删除上机信息
                txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
                Set mrconline = ExecuteSQL(txtSQL, Msgtext)
                
                money = 0
                labConsume.Caption = Val(money)
                
                '查询学生表中的信息
                txtSQL = "select * from student_info"
                Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                
                mrcstu.Fields(7) = Val(labCash.Caption) - Val(money)
                labCash.Caption = mrcstu.Fields(7)
                mrcstu.Update
                mrcstu.Close
                
                labCount.Caption = Str(Int(labCount.Caption - 1))
            End If
            
            
            '没有达到最少上机时间
            If Val(labConsumetime.Caption) > a1 + a2 Then
                
                If Val(labConsumetime.Caption) <= a1 + a2 Then
                    
                    MsgBox "未达到最少上机时间，给亲优惠不收费哦！", vbOKOnly + vbInformation, "提示"
                    money = 0
                    labConsume.Caption = Val(money)
                    
                    '删除上机信息
                    txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
                    Set mrconline = ExecuteSQL(txtSQL, Msgtext)
                    
                    txtSQL = "select * from student_info"
                    Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                    
                    mrcstu.Fields(7) = Val(labCash.Caption) - Val(money)
                    labCash.Caption = mrcstu.Fields(7)
                    mrcstu.Update
                    mrcstu.Close
                    
                    labCount.Caption = Str(Int(labCount.Caption - 1))
                End If
                
                '达到最少上机时间了
                '这里又分为固定用户和临时用户
                If Val(labConsumetime.Caption) > a1 + a2 Then
                    
                    Select Case Trim(labCardtype.Caption)
                    Case "固定用户"
                        txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & " 'and status= '使用'"
                        Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                        money = Round(Val(labConsumetime.Caption) / x * w1, 2)
                        
                        
                        If money > 1# Then       '处理消费金额小于1的时候0不显示的问题
    
                            labConsume.Caption = Str(money)
    
                        Else
    
                            labConsume.Caption = "0" & Str(money)
    
                        End If
                         
                        mrcstu.Fields(7) = labCash.Caption - money
                        labCash.Caption = mrcstu.Fields(7)
                        mrcstu.Update
                        mrcstu.Close
                        
                        '删除上机信息
                        txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
                        Set mrconline = ExecuteSQL(txtSQL, Msgtext)
                        
                        txtSQL = "select * from student_info"
                        Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                        
                      
                    Case "临时用户"
                        txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & " 'and status= '使用'"
                        Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                        money = Round(Val(labConsumetime.Caption) / x * w2, 2)
                        
                        If money > 1# Then       '处理消费金额小于1的时候0不显示的问题
                         
                            labConsume.Caption = Str(money)
                        
                        Else
                         
                            labConsume.Caption = "0" & Str(money)
                        
                        End If
                        
                        mrcstu.Fields(7) = labCash.Caption - money
                        
                        labCash.Caption = mrcstu.Fields(7)
                        mrcstu.Update
                        mrcstu.Close
                        
                        '删除上机信息
                        txtSQL = "delete from online_info where cardno= '" & txtCardno.Text & "'"
                        Set mrconline = ExecuteSQL(txtSQL, Msgtext)
                        
                        txtSQL = "select * from student_info"
                        Set mrcstu = ExecuteSQL(txtSQL, Msgtext)
                       
                    End Select
                    
                    MsgBox "下机成功，欢迎下次再来!", vbOKOnly + vbInformation, "提示"
                    
                    labCount.Caption = Str(Int(labCount.Caption - 1))
                End If
            End If
        End If

这样下机就可以完成了。

###       3.主窗体上有一个“当前上机人数为”，这个很简单。 ###

只需查询Online\_Info表，显示表中有几条记录即可。

txtSQL = "select * from OnLine_Info"
         Set mrconline = ExecuteSQL(txtSQL, Msgtext)
         labCount.Caption = mrconline.RecordCount

##     二、所有学生下线 ##

Dim mrc As ADODB.Recordset
        Dim Msgtext As String
        Dim txtSQL As String
        Dim i As Integer
        Dim m As Integer
       
        txtSQL = "select * from OnLine_Info "
        Set mrc = ExecuteSQL(txtSQL, Msgtext)
       
        If mrc.EOF = True Then
            MsgBox "没有学生上机!", vbOKOnly + vbExclamation, "提示"
        Else
      
           Do While Not mrc.EOF
               i = mrc.Fields(0)
               frmMain.Show
               frmMain.txtCardno = i     '将卡号赋给frmMain窗体中的卡号文本框
               frmMain.cmdOutline = True     '执行下机操作
             mrc.MoveNext
           Loop
         
           MSHFlexGrid1.Rows = 1     '删除MSFlexGrid中的数据
             MsgBox "所有学生成功下机！", vbOKOnly + vbExclamation, "提示"
             
             frmMain.labCount = "0"
            
             
         End If

##     三、选中学生下线 ##

Dim mrc As Recordset
        Dim Msgtext As String
        Dim txtSQL As String
        Dim i As Integer
        
       If Val(MSHFlexGrid1.RowSel) = 0 Then
          MsgBox "请选择学生下线！", vbOKOnly + vbExclamation, "提示"
         Exit Sub
       End If
       
       If MSHFlexGrid1.RowSel = MSHFlexGrid1.Row = 0 Then
          MsgBox "首行不能删除！", vbOKOnly + vbExclamation, "提示"
         Exit Sub
       End If
      
       txtSQL = "select * from student_Info where cardno= '" & Trim(MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, 0)) & "'"
       Set mrc = ExecuteSQL(txtSQL, Msgtext)
       
       i = mrc.Fields(0)    '卡号
       frmMain.Show
       frmMain.txtCardno = i    '将卡号赋给frmMain窗体中的卡号文本框
       frmMain.cmdOutline = True    '执行下机操作
      
       MSHFlexGrid1.RemoveItem MSHFlexGrid1.RowSel  '删除Msflexgrid表中选中的一行
             选中学生下线和所有学生下线，这两个都用到了下机的代码，把选中的卡号赋给主窗体的卡号框，激发主窗体上的下机操作，走下机的代码，这样就可以省很多的代码了！

# 小结： #

这是关乎下机的一系列过程，最重要的是可以把钱理清楚，计算消费金额的那一块，当时我也是一篇混乱，现在看来还可以哦！

[laugh.gif]: /images/20220603/8fcc37499ecd47c88c78747cfca1c300.png