dataeditfrm.frm

来自「guan yu pai ke xi tong de ruan jian」· FRM 代码 · 共 746 行 · 第 1/3 页

      Left            =   0
      TabIndex        =   1
      Top             =   4320
      Width           =   7095
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   4335
      Left            =   7080
      TabIndex        =   0
      Top             =   0
      Width           =   255
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   4335
      Left            =   0
      ScaleHeight     =   4275
      ScaleWidth      =   7035
      TabIndex        =   3
      ToolTipText     =   "单击选择数据；Del键删除数据；Ctrl+Del删除当前记录;Shift+Del删除所有记录；双击列标题分类排序。"
      Top             =   0
      Width           =   7095
      Begin VB.CommandButton Command1 
         Caption         =   "..."
         Height          =   375
         Index           =   7
         Left            =   5400
         TabIndex        =   12
         ToolTipText     =   "编辑公式"
         Top             =   1200
         Width           =   495
      End
      Begin VB.TextBox Text1 
         Height          =   735
         Left            =   1080
         TabIndex        =   5
         Text            =   "Text1"
         Top             =   720
         Visible         =   0   'False
         Width           =   2295
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   1080
         Style           =   2  'Dropdown List
         TabIndex        =   4
         ToolTipText     =   "单击选择,DEL清除！"
         Top             =   240
         Visible         =   0   'False
         Width           =   2535
      End
   End
End
Attribute VB_Name = "DataEditFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const HTCAPTION = 2
Private ColSelectIndex As Long
Private RowSelectIndex As Long
Public LineColor As Long
Public TitleColor As Long
Public TextColor As Long
Public SelectColor As Long
Public ColWidth As Long
Public RowHeight As Long
Private TemDataSet As MDD_Data

Private Sub Combo3_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 46 Then Combo3(Index).ListIndex = -1
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 46 Then '清空单元格。
        If RowSelectIndex >= 0 And RowSelectIndex < TemDataSet.Tables(8).RowCount And ColSelectIndex >= 0 And ColSelectIndex < 6 Then
            TemDataSet.Tables(8).Rows(RowSelectIndex).Items(ColSelectIndex).Value = -1
        End If
        If Shift = 2 Then 'Ctrl+Del表示删除本条记录。
            Call Command1_Click(4)
        End If
        If Shift = 1 Then 'Shift+Del表示删除所有记录。
            Call Command1_Click(5)
        End If
    End If
    Me.DataRefresh
End Sub

Private Sub Form_Load()
    Dim TemNum As Long
    Dim TableIndex As Long
    Dim RowIndex As Long
    Set TemDataSet = New MDD_Data
    For TemNum = 0 To MyDataSet.TableCount - 1
        TemDataSet.AddTable MyDataSet.Tables(TemNum)
    Next
    For RowIndex = 0 To TemDataSet.Tables(0).RowCount - 1
        Me.List1.AddItem TemDataSet.Tables(0).Rows(RowIndex).Items(0).Value
    Next
    For TableIndex = 1 To 5
        Me.Combo3(TableIndex - 1).Clear
        For RowIndex = 0 To TemDataSet.Tables(TableIndex).RowCount - 1
            Me.Combo3(TableIndex - 1).AddItem TemDataSet.Tables(TableIndex).Rows(RowIndex).Items(0).Value
        Next
    Next
    Me.Combo3(5).Clear
    For RowIndex = 1 To 30
        Me.Combo3(5).AddItem CStr(RowIndex)
    Next
    Me.Caption = App.ProductName & "<课程计划>"
    Me.LineColor = RGB(200, 200, 200) '表格线颜色.
    Me.Picture1.BackColor = RGB(255, 255, 255) '背景色.
    Me.TitleColor = RGB(150, 0, 0) '列标题颜色.
    Me.TextColor = RGB(100, 100, 100) '数据颜色.
    Me.SelectColor = RGB(0, 0, 255) '选中颜色.
    Me.WindowState = 2 '自动最大化.
    
    Me.ColWidth = Me.Picture1.TextWidth("正") * 6 '列宽为六个汉字字符宽.
    Me.Combo1.Width = Me.ColWidth '列表框宽度与列宽一致.
    Me.RowHeight = Me.Combo1.Height '表格行高与列表框高度一致.
    Me.Text1.Width = Me.Combo1.Width '文本框与列表框大小一致.
    Me.Text1.Height = Me.Combo1.Height
        
    Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
    Me.VScroll1.Min = 0
    Me.VScroll1.LargeChange = 1
    Me.VScroll1.SmallChange = 1
    Me.HScroll1.Max = 7 ' TemDataSet.Tables(8).Fields.FieldCount
    Me.HScroll1.Min = 0
    Me.HScroll1.LargeChange = 1
    Me.HScroll1.SmallChange = 1
    RowSelectIndex = -1 '表示未选择.
    DataRefresh
    '处理鼠标滚轮.
    PROROC = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)  '将消息转到自定义函数WindowProc.
End Sub
Private Sub Combo1_Click()
    If RowSelectIndex >= 0 And RowSelectIndex < TemDataSet.Tables(8).RowCount And ColSelectIndex >= 0 And ColSelectIndex < TemDataSet.Tables(8).Fields.FieldCount Then
        TemDataSet.Tables(8).Rows(RowSelectIndex).Items(ColSelectIndex).Value = Me.Combo1.ListIndex
    End If
End Sub
Private Sub Command1_Click(Index As Integer)
    Dim ForIndex As Long
    Dim ColIndex As Long
    Dim TemNum() As Long
On Error Resume Next
    Me.MousePointer = 11
    Select Case Index
    Case 0: '归零.
        VScroll1.Value = 0
        HScroll1.Value = 0
    Case 1: '更新.
        For ForIndex = 0 To TemDataSet.Tables(8).RowCount - 1
         '检测时限公式是否正确.
            If TemDataSet.TestLimit(TemDataSet.Tables(8).Rows(ForIndex).Items(7).Value, TemDataSet) = True Then
                RowSelectIndex = ForIndex: ColSelectIndex = 7
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox("发现时限公式错误!" & Chr(13) & "时限公式：用公式字符串对该课程安排数据记录进行限定。" & Chr(13) & "时间限制公式为一个字符串：它应由多个用“，”号分隔的子项组成(也可以只有一个子项或为空)。每一个子项由一个符号位及若干位数字组成。符号位可为“+”或“-”，为“+”时可将符号省略；其中“+”表示允许，“-”表示禁止。 其中数字部分的个位表示第几节，如果为“0”，表示没有限制；十位表示时段代码（1-早上；2-上午；3-中午；4-下午；5-晚上;0-没有限制），其余位表示第几天，0表示没有限制。整个公式中如果有一个项表示允许，则默认除允许外所有节号均禁止；如果所有子项都为禁止，则默认除禁止外所有节号均允许；如果允许项与禁止项相冲突，则以禁止项为准。 " & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
            '班级引用错误。
            If TemDataSet.Tables(8).Rows(ForIndex).Items(0).Value < 0 Then
                RowSelectIndex = ForIndex: ColSelectIndex = 0
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox("发现未选择班级!" & Chr(13) & "请修改后再更新,否则会出错! " & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
            '教师引用错误。
            If TemDataSet.Tables(8).Rows(ForIndex).Items(1).Value < 0 Then
                RowSelectIndex = ForIndex: ColSelectIndex = 1
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox("发现未选择教师!" & Chr(13) & "请修改后再更新,否则会出错! " & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
            '科目引用错误。
            If TemDataSet.Tables(8).Rows(ForIndex).Items(2).Value < 0 Then
                RowSelectIndex = ForIndex: ColSelectIndex = 2
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox("发现未选择科目!" & Chr(13) & "请修改后再更新,否则会出错! " & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
            '排课节数出现负值.
            If TemDataSet.Tables(8).Rows(ForIndex).Items(6).Value <= 0 Then
                RowSelectIndex = ForIndex: ColSelectIndex = 6
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox("发现排课节数错误!" & Chr(13) & "请修改后再更新,否则会出错! " & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
            ReDim TemNum(TemDataSet.Tables(6).RowCount * (TemDataSet.Tables(7).Rows(0).Items(0).Value + TemDataSet.Tables(7).Rows(0).Items(1).Value + TemDataSet.Tables(7).Rows(0).Items(2).Value + TemDataSet.Tables(7).Rows(0).Items(3).Value + TemDataSet.Tables(7).Rows(0).Items(4).Value)) As Long '用于保存可用的课时代号。及其数量（保存在LCount(0)中）。
            If TemDataSet.LimitCount(TemDataSet.Tables(8).Rows(ForIndex).Items(7).Value, TemNum(), TemDataSet.Tables(8).Rows(ForIndex).Items(4).Value) < TemDataSet.Tables(8).Rows(ForIndex).Items(6).Value Then
                RowSelectIndex = ForIndex: ColSelectIndex = 6
                Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
                Me.VScroll1.Value = RowSelectIndex
                Me.MousePointer = 0
                Me.DataRefresh
                If MsgBox(TemNum(0) & Chr(13) & "根据<时限公式>及<排课时段>限制条件计算,可用的节数不够!" & Chr(13) & "仍要更新排课数据吗?", vbYesNo + vbDefaultButton2, "错误...") <> vbYes Then Exit Sub
                Exit For
            End If
        Next
        For ForIndex = 0 To MyDataSet.TableCount - 1
            MyDataSet.DelTable 0
        Next
        For ForIndex = 0 To TemDataSet.TableCount - 1
            MyDataSet.AddTable TemDataSet.Tables(ForIndex)
        Next
        TemDataSet.RowAddRow '合并相同数据记录。
        MyDataSet.Updatable = True '表示数据已经修改。
        Me.DataRefresh
    Case 2: '刷新.
        For ForIndex = 0 To TemDataSet.TableCount - 1
            TemDataSet.DelTable 0
        Next
        For ForIndex = 0 To MyDataSet.TableCount - 1
            TemDataSet.AddTable MyDataSet.Tables(ForIndex)
        Next
        Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
        Me.DataRefresh
    Case 3 '添加.
        If TemDataSet.TestLimit(Text2.Text, TemDataSet) = True Then
            MsgBox "对不起，时间公式错误！" & Chr(13) & "关于时限公式请查看帮助文件。", vbOKOnly, "错误..."
        Else
            For ForIndex = 0 To Me.List1.ListCount - 1
                If List1.Selected(ForIndex) = True Then Exit For
            Next
            If ForIndex >= Me.List1.ListCount Or Val(Me.Combo3(5).Text) <= 0 Then
                MsgBox "对不起，不能添加！" & Chr(13) & "至少应选择一个班级。" & Chr(13) & "并且排课节数不得少于一节。", vbOKOnly, "未选择..."
                Me.MousePointer = 0
                Exit Sub
            End If
            For ForIndex = 0 To Me.List1.ListCount - 1
                If Me.List1.Selected(ForIndex) = True Then '说明该班被选中。
                    TemDataSet.Tables(8).AddRow
                    TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(0).Value = ForIndex
                    For ColIndex = 0 To 4