一、前言
完成了机房收费系统后,觉得之前的逻辑图只有大构架,一些细节还是不够清晰,于是回过头来,重新整理了一下上下机逻辑图,顺便晒下代码。
二、内容
1、上机逻辑图
2、上机代码
Private Sub cmdUp_Click() txtDate.Text = "" txtTime.Text = "" txtdistime.Text = "" txtdiscash.Text = "" '是否为空 If Not TxTe(txtCardNo.Text) Then MsgBox "请您输入上机卡号!",vbOKOnly + 48,"提示" txtCardNo.SetFocus txtCardNo.Text = "" Exit Sub End If '是否在线 txtsql = "select*from online_info where cardno='" & txtCardNo.Text & "'" Set mrc = Executesql(txtsql,MsgText) If mrc.EOF = False Then MsgBox "该卡已经上机!","提示" txtCardNo.SetFocus txtCardNo.Text = "" Exit Sub mrc.Close End If '判断有无该卡号 txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'" Set mrc = Executesql(txtsql,MsgText) If mrc.EOF Then MsgBox "无该卡号,请重新输入!","提示" txtCardNo.SetFocus txtCardNo.Text = "" Exit Sub End If '是否使用状态 If mrc.Fields(8) = "未使用" Then If MsgBox("该卡未激活!是否修改学生信息?",vbOKCancel,"提示") = vbOK Then frminformation.Show,Me End If Exit Sub End If '是否有余额 If mrc.Fields(1) <= 0 Then If MsgBox("该卡号余额不足,是否前往充值?","提示") = vbOK Then frmRecharge.Show,Me End If Exit Sub End If mrc.Close '是否设定基础数据 txtsql = "select*from basicdata_info" Set mrc = Executesql(txtsql,MsgText) If mrc.EOF Then If MsgBox("未设定基础数据,无法登陆,是否前往设定?","提示") = vbOK Then frmSetting.Show,Me End If Exit Sub End If mrc.Close '更新上机界面信息 '提取学生表 txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'" Set mrc = Executesql(txtsql,MsgText) txtStudentNo.Text = Trim(mrc.Fields(4)) txtType.Text = Trim(mrc.Fields(9)) txtCash.Text = Trim(mrc.Fields(1)) txtStudentName.Text = Trim(mrc.Fields(2)) txtDepartment.Text = Trim(mrc.Fields(5)) txtSex.Text = Trim(mrc.Fields(3)) txtOnDate.Text = Trim(Date) txtOnTime.Text = Trim(Time) '更新上机表信息 Dim bas As ADODB.Recordset Dim bsql As String,bMsg As String '提取上机表和基础数据表 txtsql = "select*from online_info" Set mrc = Executesql(txtsql,MsgText) bsql = "select*from basicdata_info" Set bas = Executesql(bsql,bMsg) mrc.AddNew mrc.Fields(0) = Trim(txtCardNo.Text) mrc.Fields(1) = Trim(txtType.Text) mrc.Fields(2) = Trim(txtStudentNo.Text) mrc.Fields(3) = Trim(txtStudentName.Text) mrc.Fields(4) = Trim(txtSex.Text) mrc.Fields(5) = Trim(txtDepartment.Text) mrc.Fields(6) = Trim(txtOnDate.Text) mrc.Fields(7) = Trim(txtOnTime.Text) mrc.Fields(8) = Trim(PCName) mrc.Fields(9) = Now mrc.Fields(10) = Trim(txtCash.Text) mrc.Fields(11) = 1 '用户消费方式 If txtType.Text = "固定会员" Then mrc.Fields(12) = Val(Trim(bas.Fields(0))) Else If txtType.Text = "临时用户" Then mrc.Fields(12) = Val(Trim(bas.Fields(1))) Else MsgBox "该卡号未设定用户类型,登陆失败!",vbOKOnly,"提示" Exit Sub End If End If mrc.Update txtCardNo.SetFocus txtCardNo.Text = "" '更新上机人数 txtsql = "select*from online_info" Set mrc = Executesql(txtsql,MsgText) LoginNumber.Caption = "当前上机人数为:" & mrc.RecordCount mrc.Close End Sub
3、扣费
有关扣费请观阅:
机房收费系统之上机扣费
4、下机逻辑图
5、下机代码
Private Sub cmdDown_Click() '是否为空 If Not TxTe(txtCardNo.Text) Then MsgBox "请您输入下机卡号!",MsgText) If mrc.EOF Then MsgBox "用户未上机。","提示" txtCardNo.SetFocus txtCardNo.Text = "" Exit Sub End If '更新界面信息 txtStudentNo.Text = Trim(mrc.Fields(2)) txtType.Text = Trim(mrc.Fields(1)) txtStudentName.Text = Trim(mrc.Fields(3)) txtDepartment.Text = Trim(mrc.Fields(5)) txtSex.Text = Trim(mrc.Fields(4)) txtOnDate.Text = Trim(mrc.Fields(6)) txtOnTime.Text = Trim(mrc.Fields(7)) txtcash.Text = Trim(mrc.Fields(10)) txtdistime.Text = Trim(mrc.Fields(11)) txtDate.Text = Date txtTime.Text = Time '更新Online表数据 mrc.Delete mrc.Close '计算消费金额 txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'" Set mrc = Executesql(txtsql,MsgText) txtdiscash.Text = Val(Trim(mrc.Fields(1))) - Val(Trim(txtcash.Text)) mrc.Close '更新下机信息 Dim STD As ADODB.Recordset Dim tsql As String,mText As String '提取学生表和下线表 tsql = "select*from student_info where cardno='" & txtCardNo.Text & "'" Set STD = Executesql(tsql,mText) txtsql = "select*from line_info order by serial desc" Set mrc = Executesql(txtsql,MsgText) '写入数据 mrc.AddNew mrc.Fields(1) = Trim(txtCardNo.Text) mrc.Fields(2) = Trim(txtStudentNo.Text) mrc.Fields(3) = Trim(txtStudentName.Text) mrc.Fields(4) = Trim(txtDepartment.Text) mrc.Fields(5) = Trim(txtSex.Text) mrc.Fields(6) = Trim(txtOnDate.Text) mrc.Fields(7) = Trim(txtOnTime.Text) mrc.Fields(8) = Trim(txtDate.Text) mrc.Fields(9) = Trim(txtTime.Text) mrc.Fields(10) = Trim(txtdistime.Text) mrc.Fields(11) = Trim(txtdiscash.Text) mrc.Fields(12) = Trim(txtcash.Text) mrc.Fields(14) = Trim(PCName) STD.Fields(1) = Trim(txtcash.Text) '学生卡状态 If Trim(STD.Fields(8)) = "使用" Then mrc.Fields(13) = Trim("使用") Else mrc.Fields(13) = Trim("未使用") End If mrc.Update STD.Update STD.Close mrc.Close '更新上机人数 txtsql = "select*from online_info" Set mrc = Executesql(txtsql,MsgText) LoginNumber.Caption = "当前上机人数为:" & mrc.RecordCount mrc.Close End Sub
三、总结
做项目前,做好产品逻辑构造,可以起到事半功倍的作用,大构架掌控的是方向,而模块逻辑把控的是产品质量,每一次锻炼,都让我在待人待物上得到很大的提升。
原文地址:https://www.jb51.cc/vb/256884.html
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。