frmaddcurrschedule.frm

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

    If rsClassAfternoon.RecordCount = 0 Then
        MsgBox "该班级不存在，请确认！", vbOKOnly + vbCritical, "机房管理"
        txtAfternoon.Text = ""
    End If
End If
End Sub

Private Sub txtMorning_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    SendKeys "{tab}"
End If
Dim L As Boolean
    L = Chr(KeyAscii) Like "[0-9]" Or KeyAscii = 8
    If L = False Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtMorning_Validate(Cancel As Boolean)
If txtMorning.Text <> "" Then
    Set rsClassMorning = New Recordset
    rsClassMorning.Open "select * from tbClass where C_ID= '" & txtMorning.Text & "'", Modmain.conn, 3, 2
    If rsClassMorning.RecordCount = 0 Then
        MsgBox "该班级不存在，请确认！", vbOKOnly + vbCritical, "机房管理"
        txtMorning.Text = ""
    End If
End If
End Sub
Private Sub txtNight_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    SendKeys "{tab}"
End If
Dim L As Boolean
    L = Chr(KeyAscii) Like "[0-9]" Or KeyAscii = 8
    If L = False Then
        KeyAscii = 0
    End If
End Sub
Private Sub cmdSave_Click()
If Judge = True Then
    If MsgBox("确实要保存吗?", vbYesNo + vbQuestion, "机房管理") = vbYes Then
        SaveInfo
        If frmCurrSchedule.typeAdd = True Then
            DTPDate.Value = ""
            lblWeekList.Caption = ""
            txtMorning.Text = ""
            txtAfternoon.Text = ""
            txtNight.Text = ""
            DTPDate.SetFocus
            AddItem
        Else
            frmCurrSchedule.lvwCurrSchedule.ListItems.Remove (frmCurrSchedule.Index)
            AddItem
            Unload Me
        End If
    End If
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''判断是添加课表信息，还是修改课表信息，并设置其RECORDSET对象     ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
DTPDate.Value = Null
If frmCurrSchedule.typeAdd = True Then
    Set rsAddCurrSchedule = New Recordset
    rsAddCurrSchedule.Open "select * from tbCurrSchedule", Modmain.conn, 3, 2
ElseIf frmCurrSchedule.typeAdd = False Then
    Set rsEditCurrSchedule = New Recordset
    rsEditCurrSchedule.Open "select * from tbCurrSchedule where date like '" & frmCurrSchedule.StrItem & "'", Modmain.conn, 3, 2
    
    DTPDate.Value = rsEditCurrSchedule.Fields!Date
    lblWeekList.Caption = rsEditCurrSchedule.Fields!Week
    If rsEditCurrSchedule.Fields!Morning <> "" Then
        txtMorning = rsEditCurrSchedule.Fields!Morning
    End If
    If rsEditCurrSchedule.Fields!Afternoon <> "" Then
        txtAfternoon = rsEditCurrSchedule.Fields!Afternoon
    End If
    If rsEditCurrSchedule.Fields!Night <> "" Then
        txtNight = rsEditCurrSchedule.Fields!Night
    End If
    DTPDate.Enabled = False
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''验证输入的日期是否已经存在，若存在则清空重新编写                ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub DTPDate_LostFocus()
Set rsDate = New Recordset
rsDate.Open "select * from tbCurrSchedule where date like '" & DTPDate.Value & "'", Modmain.conn, 3, 2
If rsDate.RecordCount <> 0 Then
    MsgBox "该日期已存在，请重新编写！", vbOKOnly + vbCritical, "机房管理"
    DTPDate.Value = ""
    DTPDate.SetFocus
End If
rsDate.Close
Set rsDate = Nothing
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''保存新添加的课表信息                                            ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub SaveInfo()
If frmCurrSchedule.typeAdd = True Then
    rsAddCurrSchedule.AddNew
    rsAddCurrSchedule.Fields("Date") = DTPDate.Value
    rsAddCurrSchedule.Fields("Week") = lblWeekList.Caption
    If Trim(txtNight.Text) <> "" Then
        rsAddCurrSchedule.Fields("Night") = Trim(txtNight.Text)
    Else
        rsAddCurrSchedule.Fields("Night") = ""
    End If

    If Trim(txtMorning.Text) <> "" Then
        rsAddCurrSchedule.Fields("Morning") = Trim(txtMorning.Text)
    Else
        rsAddCurrSchedule.Fields("Morning") = ""
    End If

    If Trim(txtAfternoon.Text) <> "" Then
        rsAddCurrSchedule.Fields("Afternoon") = Trim(txtAfternoon.Text)
    Else
        rsAddCurrSchedule.Fields("Afternoon") = ""
    End If
    rsAddCurrSchedule.Update
    AddLog ("L05")
    MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
Else
    rsEditCurrSchedule.Fields("Date") = DTPDate.Value
    rsEditCurrSchedule.Fields("Week") = lblWeekList.Caption
    If Trim(txtNight.Text) <> "" Then
        rsEditCurrSchedule.Fields("Night") = Trim(txtNight.Text)
    Else
        rsEditCurrSchedule.Fields("Night") = ""
    End If

    If Trim(txtMorning.Text) <> "" Then
        rsEditCurrSchedule.Fields("Morning") = Trim(txtMorning.Text)
    Else
        rsEditCurrSchedule.Fields("Morning") = ""
    End If

    If Trim(txtAfternoon.Text) <> "" Then
        rsEditCurrSchedule.Fields("Afternoon") = Trim(txtAfternoon.Text)
    Else
        rsEditCurrSchedule.Fields("Afternoon") = ""
    End If

    rsEditCurrSchedule.Update
    AddLog ("L06")
    MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''验证输入的日期、星期是否为空，若为空则重新添加                  ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function Judge() As Boolean
If IsNull(DTPDate.Value) Then
    MsgBox "日期不能为空", vbOKOnly + vbExclamation, "机房管理"
    DTPDate.SetFocus
    ElseIf lblWeekList.Caption = "" Then
        MsgBox "请重新选择日期！", vbOKOnly + vbExclamation, "机房管理"
        DTPDate.SetFocus
    Else
       Judge = True
End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''修改、添加课表信息后，在表格中显示出来                          ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub AddItem()
If frmCurrSchedule.typeAdd = True Then
      Set lItem = frmCurrSchedule.lvwCurrSchedule.ListItems.Add
      lItem.Text = rsAddCurrSchedule.Fields("Date")
      lItem.SubItems(1) = rsAddCurrSchedule.Fields("Week")
      If rsAddCurrSchedule.Fields("Morning") <> "" Then
        lItem.SubItems(2) = rsAddCurrSchedule.Fields("Morning")
      End If
      If rsAddCurrSchedule.Fields("Afternoon") <> "" Then
        lItem.SubItems(3) = rsAddCurrSchedule.Fields("Afternoon")
      End If
      If rsAddCurrSchedule.Fields("Night") <> "" Then
        lItem.SubItems(4) = rsAddCurrSchedule.Fields("Night")
      End If
Else
      Set lItem = frmCurrSchedule.lvwCurrSchedule.ListItems.Add
      lItem.Text = rsEditCurrSchedule.Fields("Date")
      lItem.SubItems(1) = rsEditCurrSchedule.Fields("Week")
      If rsEditCurrSchedule.Fields("Morning") <> "" Then
        lItem.SubItems(2) = rsEditCurrSchedule.Fields("Morning")
      End If
      If rsEditCurrSchedule.Fields("Afternoon") <> "" Then
        lItem.SubItems(3) = rsEditCurrSchedule.Fields("Afternoon")
      End If
      If rsEditCurrSchedule.Fields("Night") <> "" Then
        lItem.SubItems(4) = rsEditCurrSchedule.Fields("Night")
      End If
End If
End Sub

Private Sub txtNight_Validate(Cancel As Boolean)
If txtNight.Text <> "" Then
    Set rsClassNight = New Recordset
    rsClassNight.Open "select * from tbClass where C_ID= '" & txtNight.Text & "'", Modmain.conn, 3, 2
    If rsClassNight.RecordCount = 0 Then
        MsgBox "该班级不存在，请确认！", vbOKOnly + vbCritical, "机房管理"
        txtNight.Text = ""
    End If
End If
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''将用户添加班级的信息记入操作日志                                ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub AddLog(aa As String)
Dim strEvents As String
Dim strTemp As String
Dim strDate As String
strTemp = "'"
strDate = Year(DTPDate.Value) & "年" & Month(DTPDate.Value) & "日" & Day(DTPDate.Value) & "日"
Set rsOperateLog = New Recordset
rsOperateLog.Open "select * from tbOperateLog", Modmain.conn, 3, 2
Set rsLog = New Recordset
rsLog.Open "select * from tblog where L_ID='" & aa & "'", Modmain.conn, 3, 2
strEvents = rsLog.Fields!Events

rsOperateLog.AddNew
    rsOperateLog.Fields!U_ID = frmLoad.StrU_ID
    rsOperateLog.Fields!Time = Time
    rsOperateLog.Fields!Date = Date
    rsOperateLog.Fields!Events = strEvents
    rsOperateLog.Fields!Description = Left(strEvents, 2) & strDate & Right(strEvents, 2)
rsOperateLog.Update
End Sub