机房收费系统之功能实现
一.查询功能
1.基本信息查询功能
本文以学生查看上机记录为例子，进行展示：
如图，卡号为1的全部都排列在表里。
代码展示：
Private Sub Form_Load()
With myflexgrid '初始化flexgrid空间的行标题
.CellAlignment = 4
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "上机日期"
.TextMatrix(0, 3) = "上机时间"
.TextMatrix(0, 4) = "下机日期"
.TextMatrix(0, 5) = "下机时间"
.TextMatrix(0, 6) = "消费金额"
.TextMatrix(0, 7) = "余额"
.TextMatrix(0, 8) = "备注"
End With
End Sub
很多人要问为什么要在form_Load事件里添加这些代码呢？这是为了在加载窗体的同时，将表格的表头内容填写完整，不会出现空空的一个表在那的感觉，当然这些都是细节。接下来是加载的数据。
Private Sub Command1_Click()
Dim txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
txtSQL = "select * from Line_Info where cardno= '" & Trim(Text1.Text) & "'" '打开数据库并查询卡号所有的数据
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Text1.Text = "" Then '对输入的数据进行判断，防止运行时报错
MsgBox "请输入查询卡号！", vbOKOnly + vbExclamation, "警告"
End If
If mrc.EOF Then '查询数据库中最后一行之前的所有数据
MsgBox "用户不存在！", vbOKOnly + vbExclamation, "警告"
Text1.Text = ""
Text1.SetFocus
Else
With myflexgrid '加载表头
.Rows = 1
.CellAlignment = 4
Do While Not mrc.EOF '将数据库中的内容加载到表中
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = mrc.Fields(1)
.TextMatrix(.Rows - 1, 1) = mrc.Fields(3)
.TextMatrix(.Rows - 1, 2) = Format(mrc.Fields(6), "yyyy-mm-dd")
.TextMatrix(.Rows - 1, 3) = Format(mrc.Fields(7), "hh:mm")
.TextMatrix(.Rows - 1, 4) = Format(mrc.Fields(8), "yyyy-mm-dd")
.TextMatrix(.Rows - 1, 5) = Format(mrc.Fields(9), "hh:mm")
.TextMatrix(.Rows - 1, 6) = mrc.Fields(11)
.TextMatrix(.Rows - 1, 7) = mrc.Fields(12)
.TextMatrix(.Rows - 1, 8) = mrc.Fields(13)
mrc.MoveNext
Loop
AdjustColWidth frmInquiremb, myflexgrid '定义的函数，用来调整表的间距
End With
mrc.Close '关闭数据库，释放内存
End If
End Sub
2.联合查询
联合查询困扰了我很长的时间，不知道如何进行条件的筛选，对多条件的联合查询，在经过查阅资料和博客，终于完成了。
代码展示：
If Trim(Combo1.Text) = "" Or Trim(Combo2.Text) = "" Or Trim(Text1.Text) = "" Then
MsgBox "请输入完整的查询条件！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
txtSQL = "select * from Line_Info where "
txtSQL = txtSQL & field(Combo1.Text) & Trim(Combo2.Text) & "'" & Trim(Text1.Text) & "'"
If Trim(Combo7.Text) <> "" Then
If Trim(Combo3.Text) = "" Or Trim(Combo4.Text) = "" Or Trim(Text2.Text) = "" Then
MsgBox "您选择了第一个组合关系，请输入第二行条件后查询！", vbOKOnly + vbExclamation, "提示"
Combo3.SetFocus
Exit Sub
Else
txtSQL = txtSQL & field(Combo7.Text) & " " & field(Combo3.Text) & Combo4.Text & "'" & Trim(Text2.Text) & "'"
End If
End If
If Trim(Combo8.Text) <> "" Then
If Trim(Combo5.Text) = "" Or Trim(Combo6.Text) = "" Or Trim(Text3.Text) = "" Then
MsgBox "您选择了第二个组合关系，请输入第三行条件后查询！", vbOKOnly + vbExclamation, "提示"
Combo5.SetFocus
Exit Sub
Else
txtSQL = txtSQL & field(Combo8.Text) & " " & field(Combo5.Text) & Combo6.Text & "'" & Trim(Text3.Text) & "'"
End If
End If
其实当想明白后很简单，就是txtSQL所查询内容的传递，不断的添加查询条件而已。有的时候只是我们把问题想的困难了，其实多换些角度看问题，也许就能找到不一样的方法。
二.导出为Excel
导出为Excel是我们才接触的一个新的功能，在数据库中查询的条件让我们在窗体的表中看到的同时，还可以导出为Excel，形成文档统计。由此也可见VB的强大之处。
首先要在同目录文件夹下新建Excel，并修改名称为所需要的。
代码展示：
Private Sub Command2_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim i As Integer
Dim j As Integer
myflexgrid.Redraw = False '关闭表格重画，加快运行速度
Set xlApp = CreateObject("Excel.Application") '创建Excel对象
Set xlBook = xlApp.Workbooks.Open(App.Path & "\收取金额查询.xlsx") '打开已经存在的Excel工作薄文件
xlApp.Visible = True '设置Excel对象课件
Set xlSheet = xlBook.Worksheets("Sheet1") '设置活动工作表
xlSheet.Activate '激活工作表
'在Excel中写入数据
For i = 0 To myflexgrid.Rows - 1
For j = 0 To myflexgrid.Cols - 1
xlSheet.Cells(i + 1, j + 1) = myflexgrid.TextMatrix(i, j)
Next j
Next i
myflexgrid.Redraw = True
Set xlApp = Nothing '释放xlapp对象
我们发现，在好几个的查询功能窗体都有导出为Excel功能，既然这样，本着简化代码的原则，我们将该功能加载到标准模块中，以简化窗体的代码。具体如下：
Public Sub Export(frmName As Form, FlexGridName As String)
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Set xlApp = CreateObject("Excel.Application") '创建Excel对象
Set xlBook = xlApp.Workbooks.Add '添加新表
xlApp.Visible = True '设置Excel对象课件
Set xlSheet = xlBook.Worksheets("Sheet1") '设置活动工作表
xlSheet.Activate '激活工作表
'在Excel中写入数据
With frmName.Controls(FlexGridName)
For i = 0 To .Rows - 1
For j = 0 To .Cols - 1
xlSheet.Cells(i + 1, j + 1) = .TextMatrix(i, j)
Next j
Next i
End With
Set xlApp = Nothing '释放xlapp对象
End Sub这次改进还有一点值得一提的就是，代码Set xlBook=xlApp.workbooks.Add，使得每次导出为Excel不用在根目录新建不同类型的Excel了。直接自己新建Excel表A。
三.报表
所谓的日结账单，就是供管理员来查看这一天的收入支出情况。而周结账单的意义大同小异，不过是查看最近一周的收入支出
情况而已。账单上标明的查看项目有上期充值卡余额、当日充值金额、当日消费金额、当日退款金额、本期充值卡余额还有日期。
很明显的能够查询到近期或者当天的资金流向，简单且一目了然。现在以周结账单为例，看下报表的制作和代码实现。
很多大神早已将这一功能介绍的十分详细，我就在此推荐一下：
机房收费系统问题集---报表（日结，周结账单）
Private Sub Form_Load()
Dim txtSQL As String
Dim a, b As String
a = DTP1.Value '日期控件
b = DTP2.Value
Set report = New grproLibCtl.GridppReport '实例化报表对象
report.LoadFromFile App.Path & "\周结账单.grf" '加载报表模板
report.ParameterByName("BeginTime").AsString = DTP1.Value
report.ParameterByName("EndTime").AsString = DTP2.Value
report.ParameterByName("X").AsString = userName
report.DetailGrid.Recordset.ConnectionString = connectstring '连接到数据库
txtSQL = "select * from checkWeek_Info where date>='" & a & "'and date<='" & b & "'"
report.DetailGrid.Recordset.QuerySQL = txtSQL '通过select查询创建记录集
GRDisplayViewer1.report = report '设置报表查询显示器控件的关联报表对象
GRDisplayViewer1.Start '启动报表运行
End Sub
当然，报表的设计步骤和方法不同，代码也有些不同，但核心的内容是不会更改太多的，只提供参考。
四，选中行下机
这个功能之所以困扰我们很长时间的主要原因就是我们对于MSHFlexGrid控件的掌握不够，不了解该控件的属性和事件。我们先来看看效果图。
If myflexgrid.RowSel = 0 Then
MsgBox "请选中要下机的行！", vbOKOnly + vbExclamation, "警告"
Else
aa = Trim(myflexgrid.TextMatrix(myflexgrid.RowSel, 0)) '返回选中行的字段对应的值
txtSQL = "select * from OnLine_Info where cardno= '" & aa & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
Private Sub myflexgrid_Click() myflexgrid.HighLight = flexHighlightWithFocus End Sub
根据代码我们可以分析出来，要想让选中行下机，我们就得知道选中的行学号是多少，因为知道学号才能让其下机，所以现在的问题是如何再选中行的时候，将学号传递出来，进入SQL中进行查询。所以，这里我用到的是将控件选中行的学号传递给aa,然后进行查询。后面的代码是为了让选中的行高亮。便于查看。
五。结账
1.结账无非就是算钱呗，管理员想看看最近的收入和操作员的工作记录，就通过这个结账功能来查看
首先我们来分析一下算钱的思路：应收金额=总注册金额+总充值金额-退卡金额
有了这一条件，我们所有的工作就是围绕着这一条件来进行提取数据和运算。
我以总充值金额的代码来进行展示，其他均类似：
txtSQL = "select * from ReCharge_Info where userID= '" & Trim(Combo1.Text) & "' and status='未结账'" '查询未结账并符合操作员的内容
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
With myflexgrid2 '初始化flexgrid空间的行标题
.Rows = 1
.CellAlignment = 4
Do While Not mrc2.EOF
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = mrc2!studentNo
.TextMatrix(.Rows - 1, 1) = mrc2!cardno
.TextMatrix(.Rows - 1, 2) = mrc2!addmoney
.TextMatrix(.Rows - 1, 3) = mrc2!Date
.TextMatrix(.Rows - 1, 4) = mrc2!Time
mrc2.MoveNext
Loop
txtSQL = "select Sum(addmoney) as Sum from Recharge_Info where status='未结账 ' and UserID ='" & Trim(Combo1.Text) & " '"
Set mrc6 = ExecuteSQL(txtSQL, MsgText) '将Recharge表中的所有未结账且是该操作员的充值金额相加
If IsNull(Trim(mrc6.Fields(0))) Then '判断查询的内容是否为空，为空则输出0，否则输出总金额
Text1(3).Text = 0
Else
Text1(3).Text = Trim(mrc6.Fields(0))
End If
mrc2.Close
mrc6.Close '释放内存
End With2.操作员用户名和操作员真实姓名的同步
两个combo控件内容的同步也就让我有点纠结的小问题，下面我们借助代码来分析下同步过程。
（1）首先需要做的就是让combo1中的操作员显示在combo1的列表中，那么如何加载呢？首先想到的就是利用循环语句，不断从User表中查询操作员的数据记录。代码如下：
txtSQL = "select * from user_Info where Level= '操作员'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
For i = 0 To mrc.RecordCount - 1 '循环的调取每一个记录，加载后，MoveNext下一条记录，直到最后一条记录
Combo1.AddItem mrc.Fields(0)
mrc.MoveNext
Next i
mrc.Close（
2）同步的过程就是当combo1改变操作员时，combo2也同时改变
txtSQL = "select * from user_Info where userID= '" & Trim(Combo1.Text) & "'" Set mrcc = ExecuteSQL(txtSQL, MsgText) Combo2.Text = mrcc.Fields(3) mrcc.Close
是不是很简单的代码，就是在user表中查询combo1的操作员ID。值得一提的是该事件要放在combo1的Click的单机事件里，这样才能同步。
总结：其实大体上说下来，机房收费系统也就是这些东西，其他的内容都是将这个例子进行不断的改变而已，就是换汤不换药的工作。抓住中心，理清思路。然后进行分支补充，这样才能将机房收费系统高效的完成。所以说，树立一个很好的全局观是很有必要的。