frmmain.frm

本论文以西电基础教学实验中心学生上机管理系统为背景

Dim rsSpeciality As Recordset
Dim rsClass As Recordset
Dim rsShangJiTemp As Recordset
Dim rsShangJiTempCount As Recordset
Dim rsShangJiTempExit As Recordset
Dim rsCardholderTempAllExit As Recordset
Dim rsComputer As Recordset
Dim rsExitComputer As Recordset
Dim rsShangJi As Recordset
Dim rsExitShangJi As Recordset
Dim rsAddCardholderTemp As Recordset
Dim rsExitCardholderTemp As Recordset
Dim rsAddCountCardholderTemp As Recordset
Dim rsListCardholderTemp As Recordset
Dim rsCountCardholderTemp As Recordset
Dim rsloss As Recordset
Dim rsStopUse As Recordset

Dim rsMorning As Recordset
Dim rsAfternoon As Recordset
Dim rsNight As Recordset
Dim rsComputerCount As Recordset
Dim srtid As String
Public StrItem As String
Dim strJudge As String
Dim StrWeek As String

Dim n As Integer
Public ItgSum As Integer
Public ItgUse As Integer
Private Sub CmdAllExit_Click()
Set rsCardholderTempAllExit = New Recordset
rsCardholderTempAllExit.Open "select * from TbCardholderTemp", Modmain.conn, 3, 2
If rsCardholderTempAllExit.RecordCount = 0 Then
    MsgBox "没有上机人员,误操作！", vbOKOnly + vbExclamation, "机房管理"
    Exit Sub
End If
If MsgBox("确实要全部下机吗?", vbYesNo + vbQuestion, "机房管理") = vbYes Then
    While Not rsCardholderTempAllExit.EOF
        If rsCardholderTempAllExit.Fields!Fashion = "教学上机" Then
            NoCountAllExit                     '不收费
        ElseIf rsCardholderTempAllExit.Fields!Fashion = "自由上机" Then
            CountAllExit                         '收费
        End If
    rsCardholderTempAllExit.MoveNext
    Wend
End If
End Sub

Private Sub CmdChangComputer_Click()
Set rsCardholderTempAllExit = New Recordset
rsCardholderTempAllExit.Open "select * from TbCardholderTemp", Modmain.conn, 3, 2
If rsCardholderTempAllExit.RecordCount = 0 Then
    MsgBox "没有上机人员,误操作！", vbOKOnly + vbExclamation, "机房管理"
    Exit Sub
End If
frmCFault.Show 1
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''调整5个按钮及lvwFunction控件的位置,并显示lvwFunction控件的内容  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdContral_Click()
lvwFunction.ListItems.Clear
Set rsMenu = New Recordset
rsMenu.Open "select * from TbMenu where PID=4", Modmain.conn, 3, 2

    While Not rsMenu.EOF              ' 添加相应的 ListItem
      Set lItem = lvwFunction.ListItems.Add
      lItem.Text = rsMenu.Fields("text")
      rsMenu.MoveNext
    Wend

CmdSys.Top = 600 - 200
CmdDate.Top = 1080 - 200
cmddegree.Top = 1560 - 200
cmdContral.Top = 2040 - 200
cmdFind.Top = 5400 - 200
lvwFunction.Top = 2520 - 200
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''调整5个按钮及lvwFunction控件的位置,并显示lvwFunction控件的内容  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdDate_Click()
lvwFunction.ListItems.Clear
Set rsMenu = New Recordset
rsMenu.Open "select * from TbMenu where PID=2", Modmain.conn, 3, 2

    While Not rsMenu.EOF              ' 添加相应的 ListItem
      Set lItem = lvwFunction.ListItems.Add
      lItem.Text = rsMenu.Fields("text")
      rsMenu.MoveNext
    Wend

CmdSys.Top = 600 - 200
cmdFind.Top = 5400 - 200
cmdContral.Top = 4920 - 200
cmddegree.Top = 4440 - 200
CmdDate.Top = 1080 - 200
lvwFunction.Top = 1560 - 200
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''调整5个按钮及lvwFunction控件的位置,并显示lvwFunction控件的内容  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmddegree_Click()
lvwFunction.ListItems.Clear
Set rsMenu = New Recordset
rsMenu.Open "select * from TbMenu where PID=3", Modmain.conn, 3, 2

    While Not rsMenu.EOF              ' 添加相应的 ListItem
      Set lItem = lvwFunction.ListItems.Add
      lItem.Text = rsMenu.Fields("text")
      rsMenu.MoveNext
    Wend

CmdSys.Top = 600 - 200
CmdDate.Top = 1080 - 200
cmddegree.Top = 1560 - 200
cmdContral.Top = 4920 - 200
cmdFind.Top = 5400 - 200
lvwFunction.Top = 2040 - 200
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''调整5个按钮及lvwFunction控件的位置,并显示lvwFunction控件的内容  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdFind_Click()
lvwFunction.ListItems.Clear
Set rsMenu = New Recordset
rsMenu.Open "select * from TbMenu where PID=5", Modmain.conn, 3, 2

    While Not rsMenu.EOF              ' 添加相应的 ListItem
      Set lItem = lvwFunction.ListItems.Add
      lItem.Text = rsMenu.Fields("text")
      rsMenu.MoveNext
    Wend

CmdSys.Top = 600 - 200
CmdDate.Top = 1080 - 200
cmddegree.Top = 1560 - 200
cmdContral.Top = 2040 - 200
cmdFind.Top = 2520 - 200
lvwFunction.Top = 3000 - 200
End Sub

Private Sub cmdList_Click()
frmCardholderList.StrForm = "frmmain"
frmCardholderList.Show 1
txtCH_ID.SetFocus
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''调整5个按钮及lvwFunction控件的位置,并显示lvwFunction控件的内容  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdSys_Click()
Static a As Integer
a = a + 1
lvwFunction.ListItems.Clear
Set rsMenu = New Recordset
rsMenu.Open "select * from TbMenu where PID=1", Modmain.conn, 3, 2

    While Not rsMenu.EOF              ' 添加相应的 ListItem
      Set lItem = lvwFunction.ListItems.Add
      lItem.Text = rsMenu.Fields("text")
      rsMenu.MoveNext
    Wend
    
CmdSys.Top = 600 - 200
cmdFind.Top = 5400 - 200
cmdContral.Top = 4920 - 200
cmddegree.Top = 4440 - 200
CmdDate.Top = 3960 - 200
lvwFunction.Top = 1080 - 200
If a = 1 Then
    lvwFunction.Width = lvwFunction.Width + 80
    CmdSys.Width = lvwFunction.Width
    cmdFind.Width = lvwFunction.Width
    cmdContral.Width = lvwFunction.Width
    cmddegree.Width = lvwFunction.Width
    CmdDate.Width = lvwFunction.Width
    lvwFunction.Width = lvwFunction.Width
End If
End Sub

Private Sub Form_Initialize()
CreateWeek
SbaMain.Panels(4) = "当前日期：" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日," & StrWeek
Set rsComputerCount = New Recordset
rsComputerCount.Open "select * from tbcomputer", Modmain.conn, 3, 2
ItgSum = rsComputerCount.RecordCount

Set rsSJCount = New Recordset
rsSJCount.Open "select * from TbCardholderTemp", Modmain.conn, 3, 2

ItgUse = rsSJCount.RecordCount
SbaMain.Panels(3) = "共" & ItgSum & "台计算机，" & ItgUse & "台使用，" & CStr(ItgSum - ItgUse) & "台空闲"
End Sub

Private Sub Form_Load()
CreateBakFolder            '创建一个放备份数据的文件夹
CreateSonFolder           '创建一个放长期备份数据的文件夹
Bak                           '备份数据

lvwFunction.GridLines = True
lvwFunction.ColumnHeaders.Add , , "", lvwFunction.Width   '配置lvwSpeciality控件
lvwFunction.Sorted = True
lvwFunction.View = lvwReport


lvwPerson.GridLines = True                          '配置lvwPerson控件
lvwPerson.Sorted = True
lvwPerson.View = lvwReport


lvwPerson.ColumnHeaders.Add , , "卡号", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "学号", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "类别", lvwPerson.Width / 9
lvwPerson.ColumnHeaders.Add , , "姓名", lvwPerson.Width / 18
lvwPerson.ColumnHeaders.Add , , "院系", lvwPerson.Width / 9
lvwPerson.ColumnHeaders.Add , , "专业", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "班级", lvwPerson.Width / 15
lvwPerson.ColumnHeaders.Add , , "上机方式", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "上机时间", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "计算机ID", lvwPerson.Width / 12
lvwPerson.ColumnHeaders.Add , , "金额", lvwPerson.Width / 18
lvwPerson.ColumnHeaders.Add , , "持卡人描述", lvwPerson.Width / 12

ListlvwPerson                                          '给lvwPerson控件添加信息
CmdSys_Click
strJudge = "Start"

DeleteLoss    '挂失一个月后不撤消挂失的信息自动全部删除
EditStopUse         '修改撤消停用日期是今天的信息
End Sub

Private Sub Form_Unload(Cancel As Integer)
Bak
End Sub

Private Sub lblMore_Click()
    MsgBox "没有上机人员,误操作！", vbOKOnly + vbExclamation, "机房管理"
End Sub

Private Sub lblMore_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If strJudge = "Start" Then
     lblMore.ForeColor = vbRed
     strJudge = "End"
Else
     lblMore.ForeColor = vbbalck
     strJudge = "Start"
End If
End Sub

Private Sub lvwFunction_ItemClick(ByVal Item As MSComctlLib.ListItem)
If Item = "操作员维护" Then
    MnuOperator_Click
End If
If Item = "注销" Then
    MnuStart_Click
End If
If Item = "院系、专业、班级信息维护" Then
    MnuInstitute_Click
End If
If Item = "持卡人信息维护" Then
    MnuCardholder_Click
End If
If Item = "计算机信息维护" Then
    MnuComputer_Click
End If
If Item = "课表信息维护" Then
    MnuCurrSchedule_Click
End If
If Item = "卡停用及挂失" Then
    MnuStopUse_Click
End If
If Item = "集体充值" Then
    MnuPrepay_Click
End If
If Item = "个人充值" Then
    MnuSaving_Click
End If
If Item = "退卡" Then
    MnuExitCard_Click
End If
If Item = "机房状态监控（列表）" Then
    MnuTable_Click
End If
If Item = "机房状态监控（图示）" Then
    MnuGraph_Click
End If
If Item = "充值统计" Then
    MnuSaveStatistic_Click
End If
If Item = "教学上机统计" Then
    MnuEductionStatistic_Click
End If
If Item = "上机情况统计" Then
    MnuShangjiStatistic_Click
End If
If Item = "打印机设置" Then
    MnuPrinter_Click
End If
If Item = "更改登录密码" Then
    MnuReworkPsd_Click
End If
If Item = "数据库备份与恢复" Then
    MnuDatabase_Click
End If
If Item = "系统操作日志" Then
    MnuOperateLog_Click
End If
End Sub
Private Sub lvwPerson_ItemClick(ByVal Item As MSComctlLib.ListItem)
StrItem = Item
End Sub
Private Sub lvwPerson_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
    PopupMenu MnuLook, vbPopupMenuRightButton
End If
End Sub
Private Sub MnuAbout_Click()
frmAbout.Show 1
End Sub
Private Sub MnuCardholder_Click()
If frmLoad.BlCardholder = True Then
    frmCardholder.Show 1
End If
End Sub
Private Sub MnuComputer_Click()
If frmLoad.BlComputer = True Then
    frmComputer.Show 1
End If
End Sub
Private Sub MnuCurrSchedule_Click()
If frmLoad.BlCurrSchedule = True Then
    frmCurrSchedule.Show 1
End If
End Sub
Private Sub MnuDatabase_Click()
If frmLoad.BlDatabase = True Then
    frmCopyData.Show 1
End If
End Sub
Private Sub MnuEductionStatistic_Click()
If frmLoad.BlEductionStatistic = True Then
    frmHourStatistic.Show 1
End If
End Sub
Private Sub MnuExit_Click()
Unload Me
End Sub
Private Sub MnuExitCard_Click()
If frmLoad.BlExitCard = True Then
    frmExitCard.Show 1
End If
End Sub
Private Sub MnuExitSystem_Click()
Unload Me
End Sub
Private Sub MnuGraph_Click()
If frmLoad.BlGraph = True Then
    FrmTableLook.Show 1
End If
End Sub

Private Sub MnuHelpFrom_Click()
    Shell "hh " & App.Path & "\Help\help.chm"
End Sub

Private Sub MnuInstitute_Click()