VB版机房管理系统-上下机

其他 2018-08-06 10:06:29 阅读次数: 0

一、逻辑图

先理清楚上下机的逻辑过程，再去实现代码

①上机模块


②下机模块


二、代码

①上机模块

Private Sub cmdOnLine_Click()
    Dim mrc As ADODB.Recordset
    Dim msgtext As String
    Dim txtSQL As String
    Dim mrcBasicData As ADODB.Recordset
    Dim mrcline As ADODB.Recordset
    Dim mrccash As ADODB.Recordset
    txtDownTime.Text = ""
    txtDownTime.Text = ""
    txtBalance.Text = ""
    txtExpenseTime.Text = ""
    txtExpenseCash.Text = ""
    
    '判断是否为空
    If Not Testtxt(txtCardNo.Text) Then
        MsgBox "请输入上机卡号！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    Else
        If Not IsNumeric(Trim(txtCardNo.Text)) Then
            MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
    End If
    
    '判断卡号是否注册
    txtSQL = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
    If mrc.BOF And mrc.EOF Then
        MsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    Else
        If Trim(mrc.Fields(10)) = "不使用" Then
            MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
    End If
    
    '查BasicData_Info，判断余额是否小于最小金额
    txtSQL = "select*from BasicData_Info"
    Set mrcBasicData = ExecuteSQL(txtSQL, msgtext)
    mrcBasicData.MoveFirst
    If Val(mrc.Fields(7)) < Val(mrcBasicData.Fields(5)) Then
        MsgBox "余额不足，请充值后上机", vbOKOnly + vbExclamation, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
    Else
        '查OnLine_Info,看该卡是否在上机
        txtSQL = "select*from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
        Set mrc = ExecuteSQL(txtSQL, msgtext)
        
        If mrc.EOF = False Then
            MsgBox "该卡正在上机，不能重复上机！"
            txtCardNo.Text = mrc.Fields(0)
            txtType.Text = mrc.Fields(1)
            txtStudentNo.Text = mrc.Fields(2)
            txtName.Text = mrc.Fields(3)
            txtDepartment.Text = mrc.Fields(4)
            txtSex.Text = mrc.Fields(5)
            txtOnDate.Text = mrc.Fields(6)
            txtOnTime.Text = mrc.Fields(7)
            txtSQL = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
            Set mrccash = ExecuteSQL(txtSQL, msgtext)
            txtBalance.Text = mrccash!Cash
        Else
            '正常上机，显示卡号信息
            txtSQL = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
            Set mrc = ExecuteSQL(txtSQL, msgtext)
            If mrc.EOF = False Then
                txtCardNo.Text = Trim(mrc.Fields(0))
                txtStudentNo.Text = Trim(mrc.Fields(1))
                txtName.Text = Trim(mrc.Fields(2))
                txtSex.Text = mrc.Fields(3)
                txtDepartment.Text = mrc.Fields(4)
                txtType.Text = mrc.Fields(14)
                txtOnDate.Text = Date
                txtOnTime.Text = Time
                txtBalance.Text = mrc!Cash
                '更新Line_Info数据
                txtSQL = "select * from Line_Info where cardno='" & Trim(txtCardNo.Text) & "'"
                Set mrcline = ExecuteSQL(txtSQL, msgtext)
                
                mrcline.AddNew
                mrcline.Fields(1) = Trim(txtCardNo.Text)
                mrcline.Fields(2) = Trim(txtStudentNo.Text)
                mrcline.Fields(3) = Trim(txtName.Text)
                mrcline.Fields(4) = Trim(txtDepartment.Text)
                mrcline.Fields(5) = Trim(txtSex.Text)
                mrcline.Fields(6) = Trim(txtOnDate.Text)
                mrcline.Fields(7) = Trim(txtOnTime.Text)
                On Error Resume Next
                mrcline.Fields(12) = Trim(mrc.Fields(7))
                mrcline.Fields(13) = "正常上机"
                mrcline.Fields(14) = Trim(Environ("username"))
                mrcline.Update
                '更新OnLine_Info数据
                txtSQL = "select * from OnLine_Info"
                Set mrc = ExecuteSQL(txtSQL, msgtext)
                mrc.AddNew
                mrc.Fields(0) = Trim(txtCardNo.Text)
                mrc.Fields(1) = Trim(txtType.Text)
                mrc.Fields(2) = Trim(txtStudentNo.Text)
                mrc.Fields(3) = Trim(txtName.Text)
                mrc.Fields(4) = Trim(txtDepartment.Text)
                mrc.Fields(5) = Trim(txtSex.Text)
                mrc.Fields(6) = Date
                mrc.Fields(7) = Time
                mrc.Fields(8) = Trim(Environ("username"))
            
                mrc.Update
                If mrc.EOF = True Then
                  Label18.Caption = 0
                Else
                  Label18.Caption = mrc.RecordCount
                End If
            End If
        End If
    End If
End Sub
②下机模块 

'判断卡号是否为空，判断是否为数字
    If Trim(txtCardNo.Text = "") Then
        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    Else
        If Not IsNumeric(Trim(txtCardNo.Text)) Then
               MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"
               txtCardNo.Text = ""
               txtCardNo.SetFocus
               Exit Sub
          End If
     End If
     
     
    '判断卡号是否注册，否则退卡
    txtSQL = "select*from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
    If mrc.BOF And mrc.EOF Then
           MsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"
           txtCardNo.Text = ""
           txtCardNo.SetFocus
           Exit Sub
     Else
           If Trim(mrc.Fields(10)) = "不使用" Then
                MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"
                txtCardNo.Text = ""
                txtCardNo.SetFocus
                Exit Sub
            End If
    End If
    
    '判断该卡号是否在上机，没有上机不能下机
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
    
    If mrc.EOF = True Then
        MsgBox "该卡没有上机，不能进行下机处理", vbOKOnly + vbExclamation, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        txtStudentNo.Text = ""
        txtDepartment.Text = ""
        txtType.Text = ""
        txtName.Text = ""
        txtSex.Text = ""
        txtOnDate.Text = ""
        txtDownDate.Text = ""
        txtBalance.Text = ""
        txtOnTime.Text = ""
        txtDownTime.Text = ""
        txtExpenseTime.Text = ""
        txtExpenseCash.Text = ""
         Exit Sub
    End If
    
    '计算所消费的时间（实际花费的时间）
    intlinetime = (Date - DateValue(mrc!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc!OnTime))) '时间单位为分钟
       
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
    
    '获得基本表的数据
    txtSQL = "select * from BasicData_Info"
    Set mrcBasicData = ExecuteSQL(txtSQL, msgtext)
    mrcBasicData.MoveFirst
    
    '单位时间的费用 （把固定用户，临时用户单位时间的费用分别赋值给费用）
    fixedunit = Val(mrcBasicData.Fields(0)) '把固定用户的金额赋值给变量
    temunit = Val(mrcBasicData.Fields(1)) '把临时用户的金额赋值给变量
    
    '判断在线时间是否小于准备时间，若小于则 消费金额0元
    If intlinetime <= Val(Trim(mrcBasicData.Fields(4))) Then
        txtExpenseCash.Text = "0"
    Else
  '判断在线时间是否小于最低消费时间，若小于则消费金额为0元
       If intlinetime < Val(Trim(mrcBasicData.Fields(3))) Then
            txtExpenseCash.Text = "0"
       End If
    End If
  
 '在线时间大于单位时间，就按有几个单位时间算，固定用户、临时用户
    If intlinetime >= Val(Trim(mrcBasicData!leastTime)) And intlinetime And Trim(mrc.Fields(14)) = "固定用户" Then
        a = Int(intlinetime / Val(Trim(mrcBasicData!unitTime)))
            If a = intlinetime / Trim(mrcBasicData!unitTime) Then
                curconsume = a
            Else
                curconsume = a + 1
            End If
        txtExpenseCash.Text = Val(curconsume) * Val(fixedunit)
    Else
         If intlinetime >= Val(Trim(mrcBasicData!leastTime)) And intlinetime And Trim(mrc.Fields(14)) = "临时用户" Then
            a = Int(intlinetime / Val(Trim(mrcBasicData!unitTime)))
                If a = intlinetime / Trim(mrcBasicData!unitTime) Then
                     curconsume = a
                Else
                     curconsume = a + 1
                End If
            txtExpenseCash.Text = Val(curconsume) * Val(temunit)
         End If
    End If
   
   
   
    '更新学生表
    txtSQL = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
    remainCash1 = mrc!Cash - Val(txtExpenseCash.Text)
  
    mrc.Fields(7) = remainCash1
    mrc.Update
    mrc.Close
    
    
    '下机显示，更新在线表的信息显示
    txtSQL = "select * from OnLine_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, msgtext)
  
    txtOnDate.Text = Trim(mrc.Fields(6))
    txtOnTime.Text = Trim(mrc.Fields(7))
    txtDownDate.Text = Date
    txtDownTime.Text = Time
    txtType = Trim(mrc.Fields(1))
    txtStudentNo.Text = Trim(mrc.Fields(2))
    txtName.Text = Trim(mrc.Fields(3))
    txtDepartment.Text = Trim(mrc.Fields(4))
    txtSex = Trim(mrc.Fields(5))
    txtExpenseTime.Text = intlinetime
    txtBalance.Text = remainCash1
    
    
    '更新上机记录表
    txtSQL = "select * from Line_Info where ontime= '" & Trim(txtOnTime.Text) & "'"
    Set mrcline = ExecuteSQL(txtSQL, msgtext)
     On Error Resume Next
    mrcline.Fields(8) = Trim(txtDownDate.Text)
    mrcline.Fields(9) = Trim(txtDownTime.Text)
    mrcline.Fields(10) = Trim(txtExpenseTime.Text)
    mrcline.Fields(11) = Trim(txtExpenseCash.Text)
    mrcline.Fields(12) = Trim(txtBalance.Text)
    mrcline.Fields(13) = Trim("正常下机")
    mrcline.Fields(14) = Trim(Environ("username"))
    mrcline.Update
  
    MsgBox "下机成功，欢迎下次再来", vbOKOnly + vbExclamation, "提示"
    
'    txtCardNo.Text = ""
'    txtStudentNo.Text = ""
'    txtDepartment.Text = ""
'    txtType.Text = ""
'    txtName.Text = ""
'    txtSex.Text = ""
'    txtOnDate.Text = ""
'    txtDownDate.Text = ""
'    txtBalance.Text = ""
'    txtOnTime.Text = ""
'    txtDownTime.Text = ""
'    txtExpenseTime.Text = ""
'    txtExpenseCash.Text = ""
    '删除在线表的信息
    mrc.Delete
    mrc.Update
    Label18.Caption = Str(Int(Label18.Caption) - 1)
End Sub



猜你喜欢

转载自blog.csdn.net/lifuchao784533/article/details/79057086
今日推荐
周排行
成为C++高手之宏与枚举
在CAD二次开发中使用进度条
Js插件ECharts，HighCharts学习网址整理
Celery提交任务出错(on windows.)
cephfs内核客户端性能追踪
thinkphp中PHPExcel用法
EntityFramework动态组合多排序字段
汇编语言（八）实验9 根据材料编程
安装ubuntu后必须做的事情（对我而言）
JS函数式编程
每日归档
更多
2024-10-22(0)
2024-10-21(0)
2024-10-20(0)
2024-10-19(0)
2024-10-18(0)
2024-10-17(0)
2024-10-16(0)
2024-10-15(0)
2024-10-14(0)
2024-10-13(0)

代码天地 © 2018 codetd.com

境外服务器   最新电视剧2022