dispfrm.frm

guan yu pai ke xi tong de ruan jian

    Dim ForIndex As Long
    Dim TemNum As Long
    '将课程安排表进行备份.
    Me.Caption = App.ProductName & "  <课程处理>"
    Me.WindowState = 2 '自动最大化.
    Set TemDataSet = New MDD_Data
    For ForIndex = 0 To MyDataSet.TableCount - 1
        TemDataSet.AddTable MyDataSet.Tables(ForIndex)
    Next
    TemDataSet.DatabaseName = MyDataSet.DatabaseName '数据库存名称.
    TemDataSet.DataFileName = MyDataSet.DataFileName '文件名.
    TemDataSet.PassStr = MyDataSet.PassStr '密码文本.
    '确定表格大小.
    ColWidth = 1200
    RowHeight = 400
    TemNum = RowHeight
    For ForIndex = 0 To 4
        TemNum = TemNum + RowHeight * TemDataSet.Tables(7).Rows(0).Items(ForIndex).Value
    Next
    
    
    
    Me.DispPage.Height = TemNum + 10
    Me.DispPage.Width = ColWidth * (TemDataSet.Tables(6).RowCount + 1) + 10
    '填充班级列表和教师列表.
    For ForIndex = 0 To 1
        Me.Combo1(ForIndex).Clear
        For TemNum = 0 To TemDataSet.Tables(ForIndex).RowCount - 1
            Me.Combo1(ForIndex).AddItem TemDataSet.Tables(ForIndex).Rows(TemNum).Items(0).Value
        Next
        If Me.Combo1(ForIndex).ListCount > 0 Then Me.Combo1(ForIndex).ListIndex = 0
    Next
    '填充科目列表.
    Me.List1.Clear
    For ForIndex = 0 To TemDataSet.Tables(2).RowCount - 1
        Me.List1.AddItem TemDataSet.Tables(2).Rows(ForIndex).Items(0).Value
    Next
    '显示表格.
    PageRefresh
End Sub

Private Sub Form_Resize()
On Error Resume Next
    If Me.ScaleHeight > Me.Command1(3).Top + Me.Command1(3).Height Then Me.Frame1.Height = Me.ScaleHeight
    Me.Frame1.Left = Me.ScaleWidth - Me.Frame1.Width
    Me.Frame1.Top = 0
    Me.VScroll1.Height = Me.ScaleHeight - Me.HScroll1.Height
    Me.VScroll1.Left = Me.Frame1.Left - Me.VScroll1.Width
    Me.VScroll1.Top = 0
    Me.HScroll1.Width = Me.Frame1.Left - Me.VScroll1.Width
    Me.HScroll1.Left = 0
    Me.HScroll1.Top = Me.ScaleHeight - Me.HScroll1.Height
    Me.WinPage.Width = Me.VScroll1.Left
    Me.WinPage.Height = Me.HScroll1.Top
    Me.WinPage.Left = 0
    Me.WinPage.Top = 0
    Me.Command2.Width = Me.VScroll1.Width
    Me.Command2.Height = Me.HScroll1.Height
    Me.Command2.Left = Me.VScroll1.Left
    Me.Command2.Top = Me.HScroll1.Top
    Me.HScroll1.Min = -Me.WinPage.Width
    Me.HScroll1.Max = Me.DispPage.Width
    Me.HScroll1.LargeChange = ColWidth
    Me.HScroll1.SmallChange = Me.HScroll1.LargeChange
    Me.VScroll1.Min = -Me.WinPage.Height
    Me.VScroll1.Max = Me.DispPage.Height
    Me.VScroll1.LargeChange = RowHeight
    Me.VScroll1.SmallChange = Me.VScroll1.LargeChange
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '如果自动处理还没有结束,则结束.
    Dim TemNum As Long
    If TemDataSet.DispState >= 0 Then
        TemNum = MsgBox("自动处理进行中,不能关闭此窗口!" & Chr(13) & "现在就要停止自动处理并退出吗?", vbYesNo, "错误...")
        If TemNum = vbYes Then
            TemDataSet.DispStop
        Else
            Cancel = 1
        End If
    End If
End Sub

Private Sub HScroll1_Change()
    Me.DispPage.Left = -HScroll1.Value
End Sub
Private Sub HScroll1_Scroll()
    Me.DispPage.Left = -HScroll1.Value
End Sub

Private Sub kemu_Click(Index As Integer)
    '根据选定的科目进行排课处理。
    Me.List1.ListIndex = Index
End Sub

Private Sub List1_Click()
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim DispNum As Long
    Dim TemNum As Long
    Dim SelectIndex As Long
    Dim TeachOrClassIndex As Long
    '找到所选科目的代号.
    For SelectIndex = 0 To TemDataSet.Tables(2).RowCount - 1
        If TemDataSet.Tables(2).Rows(SelectIndex).Items(0).Value = Me.List1.List(Me.List1.ListIndex) Then Exit For
    Next
    If SelectIndex >= TemDataSet.Tables(2).RowCount Then Exit Sub '表示未找到相应科目(实际上不可能找不到)。
    '检查是否已经被占用。
    For RowIndex = 0 To TemDataSet.Tables(8).RowCount - 1
        '判断是否是该班或者该教师的该科目的课。
        If TemDataSet.Tables(8).Rows(RowIndex).Items(1 - Abs(Me.Option1(0).Value)).Value = Me.Combo1(1 - Abs(Me.Option1(0).Value)).ListIndex And TemDataSet.Tables(8).Rows(RowIndex).Items(2).Value = SelectIndex Then
            '检查该记录的课是否已经排满。
            DispNum = 0
            For ColIndex = 8 To 27
                If TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value > 0 Then DispNum = DispNum + 1
            Next
            If DispNum < TemDataSet.Tables(8).Rows(RowIndex).Items(6).Value Then
                '检查该班该科目的任课教师的此节是否为空。或者该教师该科目的相应班级在此位置是否为空。
                TeachOrClassIndex = TemDataSet.Tables(8).Rows(RowIndex).Items(Abs(Me.Option1(0).Value)).Value
                DispNum = SelectUp.X * 100 + SelectUp.Y * 10 + SelectUp.Z
                '从第一条记录开始搜索。
                For TemNum = 0 To TemDataSet.Tables(8).RowCount - 1
                    If TemDataSet.Tables(8).Rows(TemNum).Items(Abs(Me.Option1(0).Value)).Value = TeachOrClassIndex Then
                        For ColIndex = 8 To 27
                            If TemDataSet.Tables(8).Rows(TemNum).Items(ColIndex).Value = DispNum Then Exit For
                        Next
                        If ColIndex <= 27 Then Exit For
                    End If
                Next
                If TemNum >= TemDataSet.Tables(8).RowCount Then '说明未被占用,处理后退出。
                    '此处要添加对资源是否已满的判断。
                    If TemDataSet.Tables(8).Rows(RowIndex).Items(3).Value >= 0 Then '如果有资源要求。
                        If TemDataSet.SumLocation(-1, -1, -1, TemDataSet.Tables(8).Rows(RowIndex).Items(3).Value, DispNum) >= TemDataSet.Tables(3).Rows(TemDataSet.Tables(8).Rows(RowIndex).Items(3).Value).Items(1).Value Then
                            MsgBox "记录：" & RowIndex & Chr(13) & "资源：[" & TemDataSet.Tables(3).Rows(TemDataSet.Tables(8).Rows(RowIndex).Items(3).Value).Items(0).Value & "]己满！" & Chr(13) & "请另选一处试试！", vbOKOnly, "资源冲突..."
                            ColIndex = 8 '设置一个小于27的数，表示结束处理。
                        Else
                            For ColIndex = 8 To 27
                                If TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value <= 0 Then
                                    TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value = DispNum
                                    Exit For
                                End If
                            Next
                        End If
                    Else
                        For ColIndex = 8 To 27
                            If TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value <= 0 Then
                                TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value = DispNum
                                Exit For
                            End If
                        Next
                    End If
                    If ColIndex <= 27 Then Exit For
                End If
            End If
        End If
    Next
    If RowIndex >= TemDataSet.Tables(8).RowCount Then
        MsgBox "冲突:" & Chr(13) & "该位置已被占用!请另选一处试试.", vbOKOnly, "错误..."
    End If
    List1.Visible = False
    Me.PageRefresh
End Sub

Private Sub Option1_Click(Index As Integer)
    Me.Combo1(Index).SetFocus
End Sub

Private Sub PopMenus_Click(Index As Integer)
    Select Case Index
    Case 3:
        DispPage_KeyUp 46, 0
    Case 4:
        If MsgBox("真的要清空当前课表吗？", vbOKCancel + vbDefaultButton2, "清空...") <> vbOK Then Exit Sub
        DispPage_KeyUp 46, 2
    Case 5:
        If MsgBox("真的要清空所有课表吗？", vbOKCancel + vbDefaultButton2, "清空...") <> vbOK Then Exit Sub
        DispPage_KeyUp 46, 1
    End Select
End Sub


Private Sub teachers_Click(Index As Integer)
    '根据选中的教师，及当前课表中选中的节号，修改课程安排数据及排课标志。
    Dim TeaIndex As Long '教师索引号。
    Dim RowIndex As Long '记录索引号。
    Dim ColIndex As Long '字段索引号。
    Dim ForIndex As Long '循环变量。
    Dim TemNumber As Long '临时变量。
    '找到教师索引号。
    For TeaIndex = 0 To TemDataSet.Tables(1).RowCount - 1 Step 1
        If TemDataSet.Tables(1).Rows(TeaIndex).Items(0).Value = teachers(Index).Caption Then Exit For
    Next
    '找到记录索引号。
    For RowIndex = 0 To TemDataSet.Tables(8).RowCount - 1 Step 1
         If TemDataSet.Tables(8).Rows(RowIndex).Items(1 - Abs(Me.Option1(0).Value)).Value = Me.Combo1(1 - Abs(Me.Option1(0).Value)).ListIndex Then
            For ColIndex = 8 To 27
                If TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value = SelectUp.X * 100 + SelectUp.Y * 10 + SelectUp.Z Then
                    If TemDataSet.Tables(8).Rows(RowIndex).Items(6).Value > 1 Then
                        '当前记录课时数大于1节。则分一节到一新的记录。
                        TemNumber = MsgBox("该科目的课不只1节，是否全部由该教师代课？", vbYesNoCancel, "代课提示...")
                        If TemNumber = vbCancel Then Exit Sub '用户选择取消。
                        If TemNumber = vbNo Then '用户选择No，表示只代这一节。
                            TemDataSet.Tables(8).Rows(RowIndex).Items(6).Value = TemDataSet.Tables(8).Rows(RowIndex).Items(6).Value - 1 '课时数减1。
                            TemDataSet.Tables(8).Rows(RowIndex).Items(ColIndex).Value = 0 '清除当前处理标志。
                            TemDataSet.Tables(8).AddRow '添加新记录。
                            For ForIndex = 0 To 7
                                TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(ForIndex).Value = TemDataSet.Tables(8).Rows(RowIndex).Items(ForIndex).Value
                            Next
                            TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(6).Value = 1 '表示排1节。
                            TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(1).Value = TeaIndex
                            TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(8).Value = SelectUp.X * 100 + SelectUp.Y * 10 + SelectUp.Z
                        Else '用户选择是，表示全部由该教师代课。
                            '检测是否所有代课时数皆不冲突。
                            For TemNumber = 8 To 27
                                If TemDataSet.Tables(8).Rows(RowIndex).Items(TemNumber).Value > 0 And TemDataSet.SumLocation(-1, TeaIndex, -1, -1, TemDataSet.Tables(8).Rows(RowIndex).Items(TemNumber).Value) > 0 Then
                                    MsgBox "发现教师<" & TemDataSet.Tables(1).Rows(TeaIndex).Items(0).Value & ">的第<" & TemDataSet.Tables(8).Rows(RowIndex).Items(TemNumber).Value \ 100 & ">天的第<" & (TemDataSet.Tables(8).Rows(RowIndex).Items(TemNumber).Value Mod 100) \ 10 & ">时段的第<" & TemDataSet.Tables(8).Rows(RowIndex).Items(TemNumber).Value Mod 10 & ">节已经排了课！" & Chr(13) & "代课无法继续！请重新选择！", vbOKOnly, "代课冲突..."
                                    Exit Sub
                                End If
                            Next
                            TemDataSet.Tables(8).Rows(RowIndex).Items(1).Value = TeaIndex
                        End If
                    Else
                        '当前记录课时数等于1节。则直接将教师姓名修改即可。
                        TemDataSet.Tables(8).Rows(RowIndex).Items(1).Value = TeaIndex
                    End If
                    Exit For
                End If
            Next
            If ColIndex <= 27 Then Exit For
         End If
    Next
    If RowIndex >= TemDataSet.Tables(8).RowCount Then Exit Sub '表示当前选择位置没有排课，则不进行处理。
    TemDataSet.RowAddRow '合并相同记录。
    'MsgBox TemDataSet.Tables(1 - Abs(Me.Option1(0).Value)).Rows(TemDataSet.Tables(8).Rows(RowIndex).Items(1 - Abs(Me.Option1(0).Value)).Value).Items(0).Value & ":" & SelectUp.X * 100 + SelectUp.Y * 10 + SelectUp.Z
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
    Dim MsgStr As String
    If TemDataSet.DispState < 0 Then
        Me.Caption = App.ProductName & "  <课程处理>"
        Exit Sub
    End If
    MsgStr = "处理记录:" & TemDataSet.DispState & "/" & TemDataSet.Tables(8).RowCount
    MsgStr = MsgStr & "————" & "正在处理：<" & TemDataSet.Tables(0).Rows(TemDataSet.Tables(8).Rows(TemDataSet.DispState).Items(0).Value).Items(0).Value & ">的<" & TemDataSet.Tables(2).Rows(TemDataSet.Tables(8).Rows(TemDataSet.DispState).Items(2).Value).Items(0).Value & ">课..."
    Me.Caption = MsgStr
    Me.Option1(0).Value = True
    Me.Combo1(0).ListIndex = TemDataSet.Tables(8).Rows(TemDataSet.DispState).Items(0).Value
    Me.PageRefresh
End Sub

Private Sub VScroll1_Change()
    Me.DispPage.Top = -VScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
    Me.DispPage.Top = -VScroll1.Value
End Sub
Private Sub Command2_Click()
    Me.DispPage.Left = 0: Me.DispPage.Top = 0
    Me.HScroll1.Value = 0: Me.VScroll1.Value = 0
End Sub
Public Sub PageRefresh()
    Dim TemNum As Long
    Dim ForIndex As Long
    Me.DispPage.Cls
    Me.DispPage.DrawWidth = 1
    
    '显示表格数据。
    TemDataSet.PrintTableOne Me.DispPage, 0, 0, ColWidth, RowHeight, Abs(Me.Option1(0).Value = False), Me.Combo1(Abs(Me.Option1(0).Value = False)).ListIndex
    '显示选中状态。
    '判断是否在有效数据区。
    If SelectUp.X > 0 And SelectUp.Y > 0 And SelectUp.Z > 0 Then
        If SelectUp.X <= TemDataSet.Tables(6).RowCount Then
            If SelectUp.Y <= 5 Then
                If SelectUp.Z <= TemDataSet.Tables(7).Rows(0).Items(SelectUp.Y - 1).Value Then
                    TemNum = 0
                    For ForIndex = 2 To SelectUp.Y Step 1
                        TemNum = TemNum + TemDataSet.Tables(7).Rows(0).Items(ForIndex - 2).Value
                    Next
                    TemNum = TemNum + SelectUp.Z
                    Me.DispPage.DrawWidth = 3
                    Me.DispPage.Line ((SelectUp.X + 0) * ColWidth, (TemNum + 0) * RowHeight)-((SelectUp.X + 1) * ColWidth, (TemNum + 0) * RowHeight), RGB(0, 255, 0)
                    Me.DispPage.Line ((SelectUp.X + 0) * ColWidth, (TemNum + 0) * RowHeight)-((SelectUp.X + 0) * ColWidth, (TemNum + 1) * RowHeight), RGB(0, 255, 0)
                    Me.DispPage.Line ((SelectUp.X + 1) * ColWidth, (TemNum + 1) * RowHeight)-((SelectUp.X + 1) * ColWidth, (TemNum + 0) * RowHeight), RGB(0, 255, 0)
                    Me.DispPage.Line ((SelectUp.X + 1) * ColWidth, (TemNum + 1) * RowHeight)-((SelectUp.X + 0) * ColWidth, (TemNum + 1) * RowHeight), RGB(0, 255, 0)
                    Me.DispPage.DrawWidth = 1
                End If
            End If
        End If
    End If
End Sub