frmarrange.frm

一个vb编的计算机机房管理系统

        If objArrange.AddArrange(strTeacher, strRoom, dtStartTime, dtEndTime) Then
            MsgBox "数据添加成功！"
            Call resetMe
            Call initForm
    
            Exit Sub
        Else
            MsgBox "数据添加失败！"
            Exit Sub
        End If
    Else
        MsgBox "机房使用时间有冲突，请重新设定使用时间！"
        Exit Sub
    End If
    
    
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdModi_Click()
    Dim strID As String
    Dim dtStartTime As Date
    Dim dtEndTime As Date
    Dim strStartTime As String
    Dim strEndTime As String
    Dim strTeacher As String
    Dim strRoom As String
    Dim blFlag As Boolean
    Dim rsTmp As ADODB.Recordset
    
    strID = Trim(Me.txtID.Text)
    If Not (IsNumeric(strID) And InStr(1, strID, ".", vbTextCompare) <= 0) Then
        MsgBox "请从列表选择您要修改的数据！"
        Exit Sub
    End If
    strStartTime = Me.txtStartDate & " " & Me.cmbStartHour.Text & ":" & Me.cmbStartMinute & ":" & "00"
    strEndTime = Me.txtEndDate & " " & Me.cmbEndHour.Text & ":" & Me.cmbEndMinute & ":" & "00"
    If Not IsDate(strStartTime) Then
        MsgBox "开始日期不正确，请检查！"
        Exit Sub
    End If
    If Not IsDate(strEndTime) Then
        MsgBox "结束日期不正确，请检查！"
        Exit Sub
    End If
    dtStartTime = CDate(strStartTime)
    dtEndTime = CDate(strEndTime)
    strTeacher = Me.txtTeacher.Text
    strRoom = Me.cmbRoom.Text
    
    If dtStartTime >= dtEndTime Then
        MsgBox "开始时间必须早于结束时间!"
        Exit Sub
    End If
    If strRoom = "" Then
        MsgBox "请选择要使用的机房!"
        Exit Sub
    End If
    
    '合法性检查
    If Not objDBOpt.IsRecordExist("Arrange", "ID=" & strID) Then
        MsgBox "该上机安排不存在！"
        Exit Sub
    End If
    
    objArrange.ModiArrange strID, strRoom, strTeacher, dtStartTime, dtEndTime
    
    Call resetMe
    Call initForm
    
End Sub

Private Sub cmdSearch_Click()
'根据用户填写的内容查询，结果显示在列表中
    Dim strTeacher As String
    Dim strRoom As String
    Dim strStartTime As String
    Dim strEndTime As String
    
    Dim strSql As String
    Dim strCondition As String
    Dim rsq As ADODB.Recordset
    
    strCondition = ""
    strStartTime = Me.txtStartDate & " " & Me.cmbStartHour.Text & ":" & Me.cmbStartMinute & ":" & "00"
    strEndTime = Me.txtEndDate & " " & Me.cmbEndHour.Text & ":" & Me.cmbEndMinute & ":" & "00"
    strTeacher = Me.txtTeacher.Text
    strRoom = Me.cmbRoom.Text
    strSql = "select * from arrange "
    If Trim(strRoom) <> "" Then
        strCondition = strCondition & " and Room='" + strRoom + "'"
    End If
    If Trim(strTeacher) <> "" Then
        strCondition = strCondition & " and Teacher='" + strTeacher + "'"
    End If
    If IsDate(strStartTime) Then
        strCondition = strCondition & " and StartTime=convert(datetime,'" + strStartTime + "')"
    End If
    If IsDate(strEndTime) Then
        strCondition = strCondition & " and EndTime=convert(datetime,'" + strEndTime + "')"
    End If
    '去掉多余的" and"
    If Trim(strCondition) <> "" Then
        strCondition = " where " & Mid(strCondition, 5)
    End If
    
    Me.grdArrangeList.Rows = 1
    
    strSql = strSql & strCondition
    
    Set rsq = objDBOpt.getRecords(strSql)
    If rsq Is Nothing Then
        MsgBox "数据查询失败!"
        Exit Sub
    End If
    If rsq.EOF And rsq.BOF Then
        MsgBox "没有找到符合条件的数据!"
         Exit Sub
    End If
    
    i = 1
    
    While Not rsq.EOF
        Me.grdArrangeList.AddItem i & Chr(9) & setNotNull(rsq.Fields("ID").Value) _
            & Chr(9) & setNotNull(rsq.Fields("Teacher").Value) _
            & Chr(9) & setNotNull(rsq.Fields("Room").Value) _
            & Chr(9) & setNotNull(rsq.Fields("StartTime").Value) _
            & Chr(9) & setNotNull(rsq.Fields("EndTime").Value)
        i = i + 1
        rsq.MoveNext
    Wend
    
    
End Sub


Private Sub Form_Load()
    Call initForm
End Sub
Private Function resetMe()
    Dim i As Integer
    Dim j As Integer
    Dim obj As VB.Control
    
    For Each obj In Me.Controls
        If TypeName(obj) = "TextBox" Then
            If obj.Enabled Then
                obj.Text = ""
            End If
        End If
        If TypeName(obj) = "ComboBox" Then
            For i = 0 To obj.ListCount - 1
                obj.RemoveItem 0
            Next
        End If
    Next
End Function
Private Function initForm()
    Dim dtTmpDate As Date
    Dim rsRoom As ADODB.Recordset
    Dim strSql As String
    Dim i As Integer
    
    
'获取机房名称列表
    Me.cmbRoom.AddItem ""
    strSql = "select distinct [name] from CROOM"
    Set rsRoom = objDBOpt.getRecords(strSql)
    While Not rsRoom.EOF
        Me.cmbRoom.AddItem rsRoom.Fields("name").Value
        rsRoom.MoveNext
    Wend
    rsRoom.Close
    Me.cmbRoom.ListIndex = 0
'初始化时分列表
    
    Me.cmbStartHour.AddItem ""
    Me.cmbEndHour.AddItem ""
    For i = 0 To 23
        Me.cmbStartHour.AddItem CStr(i)
        Me.cmbEndHour.AddItem CStr(i)
    Next
    
    Me.cmbStartMinute.AddItem ""
    Me.cmbEndMinute.AddItem ""
    For i = 0 To 59
        Me.cmbStartMinute.AddItem CStr(i)
        Me.cmbEndMinute.AddItem CStr(i)
    Next
    
    
    Me.cmbEndHour.ListIndex = 0
    Me.cmbEndMinute.ListIndex = 0
    
    Me.cmbStartHour.ListIndex = 0
    Me.cmbStartMinute.ListIndex = 0
    
    '初始化查询列表
    '初始化图书列表－－设定标题栏
    grdArrangeList.Cols = 6
    grdArrangeList.Rows = 1
    
    grdArrangeList.Refresh
    
    grdArrangeList.Row = 0
    
    grdArrangeList.Col = 0
    grdArrangeList.Text = "序号"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    
    grdArrangeList.Col = 1
    grdArrangeList.Text = "编号"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    
    grdArrangeList.Col = 2
    grdArrangeList.Text = "上机老师"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    
    grdArrangeList.Col = 3
    grdArrangeList.Text = "机房"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    
    grdArrangeList.Col = 4
    grdArrangeList.Text = "开始时间"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    
    grdArrangeList.Col = 5
    grdArrangeList.Text = "结束时间"
    grdArrangeList.CellAlignment = flexAlignCenterCenter
    Set rsRoom = Nothing
    '把数据库中的项目输出到列表中
    Set rsRoom = objDBOpt.getRecord("Arrange", "*")
    If rsRoom Is Nothing Then
        Exit Function
    End If
    i = 1
    While Not rsRoom.EOF
        Me.grdArrangeList.AddItem i & Chr(9) & setNotNull(rsRoom.Fields("ID").Value) _
            & Chr(9) & setNotNull(rsRoom.Fields("Teacher").Value) _
            & Chr(9) & setNotNull(rsRoom.Fields("Room").Value) _
            & Chr(9) & setNotNull(rsRoom.Fields("StartTime").Value) _
            & Chr(9) & setNotNull(rsRoom.Fields("EndTime").Value)
        i = i + 1
        rsRoom.MoveNext
    Wend
    
End Function

Private Sub grdArrangeList_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim i As Integer
    Dim j As Integer
    If Me.grdArrangeList.Rows < 2 Then
        Exit Sub
    End If
    For i = 1 To Me.grdArrangeList.Rows - 1
        Me.grdArrangeList.Row = i
        For j = 0 To Me.grdArrangeList.Cols - 1
            Me.grdArrangeList.Col = j
            Me.grdArrangeList.CellBackColor = &HFFFFFF
        Next
    Next
    
    Me.grdArrangeList.Row = Me.grdArrangeList.MouseRow
    intCurIndex = Me.grdArrangeList.MouseRow
    If intCurIndex < 1 Then Exit Sub
    For i = 0 To Me.grdArrangeList.Cols - 1
        Me.grdArrangeList.Col = i
        Me.grdArrangeList.CellBackColor = &HC0C0FF
    Next
    If Button = 2 Then
        PopupMenu mnuArrangeOpt
    End If
End Sub

Private Function getDate()
'调用frmseldate，选择日期
    Load frmSelDate
    frmSelDate.Show 1
    getDate = frmSelDate.lblSelDate.Caption
    Unload frmSelDate
End Function

Private Sub mnuDelArrange_Click()
'删除记录
    Dim strID
    If MsgBox("确认删除该数据吗？", vbOKCancel) = vbCancel Then
        Exit Sub
    End If
    Me.grdArrangeList.Row = intCurIndex
    Me.grdArrangeList.Col = 1
    strID = Me.grdArrangeList.Text
    If objArrange.DelArrange(strID) Then
        MsgBox "数据删除成功！"
        Call resetMe
        Call initForm
    
    Else
        MsgBox "数据删除失败！"
    End If
    
End Sub

Private Sub mnuModiArrange_Click()
'把当前的项目的内容送到编辑域，便于进行修改
    Dim i As Integer
    Dim dtTmp As Date
    Me.grdArrangeList.Row = intCurIndex
    
    Me.grdArrangeList.Col = 1
    Me.txtID.Text = Me.grdArrangeList.Text
    
    Me.grdArrangeList.Col = 2
    Me.txtTeacher.Text = Me.grdArrangeList.Text
    
    Me.grdArrangeList.Col = 3
    For i = 0 To Me.cmbRoom.ListCount - 1
        If Me.cmbRoom.List(i) = Me.grdArrangeList.Text Then
            Me.cmbRoom.ListIndex = i
            Exit For
        End If
    Next
    
    Me.grdArrangeList.Col = 4
    '分解开始时间
    dtTmp = Me.grdArrangeList.Text
    Me.txtStartDate.Text = Year(dtTmp) & "-" & Month(dtTmp) & "-" & Day(dtTmp)
    For i = 0 To Me.cmbStartHour.ListCount - 1
        If Me.cmbStartHour.List(i) = Hour(dtTmp) Then
            Me.cmbStartHour.ListIndex = i
            Exit For
        End If
    Next
    For i = 0 To Me.cmbStartMinute.ListCount - 1
        If Me.cmbStartMinute.List(i) = Minute(dtTmp) Then
            Me.cmbStartMinute.ListIndex = i
            Exit For
        End If
    Next
    
    Me.grdArrangeList.Col = 5
    
    dtTmp = Me.grdArrangeList.Text
    Me.txtEndDate.Text = Year(dtTmp) & "-" & Month(dtTmp) & "-" & Day(dtTmp)
    For i = 0 To Me.cmbEndHour.ListCount - 1
        If Me.cmbEndHour.List(i) = Hour(dtTmp) Then
            Me.cmbEndHour.ListIndex = i
            Exit For
        End If
    Next
    For i = 0 To Me.cmbEndMinute.ListCount - 1
        If Me.cmbEndMinute.List(i) = Minute(dtTmp) Then
            Me.cmbEndMinute.ListIndex = i
            Exit For
        End If
    Next
    
    
    
End Sub

Private Sub txtEndDate_click()
    Me.txtEndDate.Text = getDate()

End Sub

Private Sub txtStartDate_click()
    Me.txtStartDate.Text = getDate()
End Sub