formulabuildfrm.frm

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

        TemNum = TemNum + TemDataSet.Tables(7).Rows(0).Items(Duan).Value
    Next
    TemNum = TemNum * TemDataSet.Tables(6).RowCount
    ReDim Lcount(TemNum)
    ReDim ViewDataMode(TemNum)
    '根据时限公式总结可用课时。
    TemDataSet.LimitCount Text1.Text, Lcount
    '改变显示状态。
    For TemNum = 1 To Lcount(0)
        '从第一个可用课时开始显示。
        PrintTop = 0
        For Duan = 1 To (Lcount(TemNum) Mod 100) \ 10 - 1 Step 1
            PrintTop = PrintTop + TemDataSet.Tables(7).Rows(0).Items(Duan - 1).Value
        Next
        PrintTop = PrintTop + Lcount(TemNum) Mod 10
        ViewDataMode((Lcount(TemNum) \ 100 - 1) * (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) + PrintTop - 1) = True
    Next
    '显示状态。
    Duan = 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
    For TemNum = 0 To TemDataSet.Tables(6).RowCount - 1
        For ForIndex = 0 To Duan - 1 Step 1
            Select Case ViewDataMode(TemNum * Duan + ForIndex)
            Case True:
                TemStr = "允许"
                Me.Picture1.ForeColor = RGB(0, 0, 255)
            Case Else
                TemStr = "禁止"
                Me.Picture1.ForeColor = RGB(255, 0, 0)
            End Select
            Me.Picture1.CurrentX = (TemNum + 1) * ColWidth + (ColWidth - Me.Picture1.TextWidth(TemStr)) / 2
            Me.Picture1.CurrentY = (ForIndex + 1) * RowHeight + (RowHeight - Me.Picture1.TextHeight(TemStr)) / 2
            Me.Picture1.Print TemStr
        Next
    Next
    Me.Picture1.ForeColor = RGB(0, 0, 0)
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim TableIndex As Long
    Dim RowIndex As Long
    Dim DataIndex As Long
    Dim TemStr As String
    Select Case Index
    Case 0: '关闭。
        Unload Me
    Case 1:
        If TemDataSet.TestLimit(Text1.Text, TemDataSet) = True Then
            MsgBox "时限公式有错！" & Chr(13) & "请重新选择！", vbOKOnly, "公式有错..."
            Exit Sub
        End If
        '应用于当前记录。
        If Me.Option1(0).Value = True Then '
            If Me.Option2(0).Value = True Then '追加。
                TemStr = TemDataSet.Tables(8).Rows(Me.AbsolutePosition).Items(7).Value
                If TemStr <> "" Then TemStr = TemStr & ","
                TemStr = TemStr & Text1.Text
                TemDataSet.Tables(8).Rows(Me.AbsolutePosition).Items(7).Value = TemDataSet.LimitReduce(TemStr)
            Else '替换。
                If Me.Option1(0).Value = True Then TemDataSet.Tables(8).Rows(Me.AbsolutePosition).Items(7).Value = Text1.Text
            End If
        End If
        '应用于所有记录。
        If Me.Option1(1).Value = True Then
            If MsgBox("您选择了应用于<所有记录>！" & Chr(13) & "这将修改所有课程计划数据中的时限公式设置值！" & Chr(13) & "真的要这样做吗？", vbYesNo, "确认修改...") <> vbYes Then Exit Sub
            For RowIndex = 0 To TemDataSet.Tables(8).RowCount - 1
                If Me.Option2(0).Value = True Then '追加。
                    TemStr = TemDataSet.Tables(8).Rows(RowIndex).Items(7).Value
                    If TemStr <> "" Then TemStr = TemStr & ","
                    TemStr = TemStr & Text1.Text
                    TemDataSet.Tables(8).Rows(RowIndex).Items(7).Value = TemDataSet.LimitReduce(TemStr)
                Else '替换。
                    TemDataSet.Tables(8).Rows(RowIndex).Items(7).Value = Text1.Text
                End If
            Next
        End If
        '应用于当前选择。
        If Me.Option1(2).Value = True Then
            If MsgBox("您选择了应用于<当前选择>！" & Chr(13) & "这将修改相应对象课程计划数据的时限公式设置值！" & Chr(13) & "真的要这样做吗？", vbYesNo, "确认修改...") <> vbYes Then Exit Sub
            For TableIndex = 0 To 3
                For RowIndex = 0 To List1(TableIndex).ListCount - 1
                    If List1(TableIndex).Selected(RowIndex) = True Then
                        For DataIndex = 0 To TemDataSet.Tables(8).RowCount - 1
                            If TemDataSet.Tables(8).Rows(DataIndex).Items(TableIndex).Value = RowIndex Then
                                If Me.Option2(0).Value = True Then '追加。
                                    TemStr = TemDataSet.Tables(8).Rows(DataIndex).Items(7).Value
                                    If TemStr <> "" Then TemStr = TemStr & ","
                                    TemStr = TemStr & Text1.Text
                                    TemDataSet.Tables(8).Rows(DataIndex).Items(7).Value = TemDataSet.LimitReduce(TemStr)
                                Else '替换。
                                    TemDataSet.Tables(8).Rows(DataIndex).Items(7).Value = Text1.Text
                                End If
                            End If
                        Next
                    End If
                Next
            Next
        End If
        Unload Me
    End Select
End Sub

Private Sub Command2_Click()
    Me.VScroll1.Value = 0
    Me.HScroll1.Value = 0
End Sub

Private Sub Form_Load()
    Dim TableIndex As Long
    Dim RowIndex As Long
    For TableIndex = 0 To 3
        For RowIndex = 0 To TemDataSet.Tables(TableIndex).RowCount - 1
            Me.List1(TableIndex).AddItem TemDataSet.Tables(TableIndex).Rows(RowIndex).Items(0).Value
        Next
    Next
    Me.WindowState = 2
    RowHeight = Me.TextHeight("正") * 2 '确定行高。
    ColWidth = RowHeight * 3 '确定列宽。
    Me.Picture1.Width = ColWidth * (TemDataSet.Tables(6).RowCount + 1)
    Me.Picture1.Height = RowHeight * (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 + 1)
    Me.Picture1.Top = 0
    Me.Picture1.Left = 0
    Me.VScroll1.Min = 0
    Me.VScroll1.Max = Me.Picture1.Height
    Me.VScroll1.LargeChange = Me.VScroll1.Max / 30
    Me.VScroll1.SmallChange = Me.VScroll1.LargeChange
    Me.HScroll1.Min = 0
    Me.HScroll1.Max = Me.Picture1.Width
    Me.HScroll1.LargeChange = Me.HScroll1.Max / 30
    Me.HScroll1.SmallChange = Me.HScroll1.LargeChange
    Text1.Text = TemDataSet.Tables(8).Rows(Me.AbsolutePosition).Items(7).Value
    ViewRefresh
End Sub

Private Sub Form_Resize()
On Error Resume Next
    Me.Frame1.Left = Me.ScaleWidth - Me.Frame1.Width - 50
    Me.Frame1.Top = Me.ScaleHeight - Me.Frame1.Height - 50
    Me.Frame2.Width = Me.Frame1.Left
    Me.Frame2.Top = Me.ScaleHeight - Me.Frame2.Height - 50
    Me.Text1.Width = Me.Frame2.Width - Me.Text1.Left * 2
    Me.Command2.Width = Me.VScroll1.Width
    Me.Command2.Height = Me.HScroll1.Height
    Me.Command2.Left = Me.Frame1.Left - Me.Command2.Width
    Me.Command2.Top = Me.Frame2.Top - Me.Command2.Height - 50
    Me.HScroll1.Width = Me.Command2.Left
    Me.HScroll1.Left = 0
    Me.HScroll1.Top = Me.Command2.Top
    Me.VScroll1.Height = Me.Command2.Top
    Me.VScroll1.Left = Me.Command2.Left
    Me.VScroll1.Top = 0
    Me.Picture2.Width = Me.Command2.Left
    Me.Picture2.Height = Me.Command2.Top
    Me.Picture2.Left = 0
    Me.Picture2.Top = 0
End Sub

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

Private Sub List1_Click(Index As Integer)
    Me.Option1(2).Value = True
End Sub

Private Sub VScroll1_Change()
    Me.Picture1.Top = -Me.VScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
    VScroll1_Change
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim TemData As Boolean
    Dim TemNum As Long
    Dim ForIndex As Long
    Dim TemStr As String
    Dim Tian As Long
    Dim Duan As Long
    Dim Jie As Long
    If Button = 1 Then
        'If X < ColWidth Or Y < RowHeight Then Exit Sub
        TemNum = (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)
        If X < ColWidth And Y < RowHeight Then '单击左上格单元格。
            ViewDataMode(0) = Not (ViewDataMode(0))
            For ForIndex = 0 To TemDataSet.Tables(6).RowCount * TemNum - 1
                ViewDataMode(ForIndex) = ViewDataMode(0)
            Next
        End If
        If X < ColWidth And X > ColWidth / 2 And Y > RowHeight Then '单击行标题。
            ViewDataMode(TemNum + Y \ RowHeight - 1) = Not (ViewDataMode(TemNum + Y \ RowHeight - 1))
            For ForIndex = 0 To TemDataSet.Tables(6).RowCount - 1
                ViewDataMode(ForIndex * TemNum + Y \ RowHeight - 1) = ViewDataMode(TemNum + Y \ RowHeight - 1)
            Next
            Jie = Y \ RowHeight - 1
            For Duan = 0 To 4
                Jie = Jie - TemDataSet.Tables(7).Rows(0).Items(Duan).Value
                If Jie < 0 Then
                    Jie = Jie + TemDataSet.Tables(7).Rows(0).Items(Duan).Value
                    Exit For
                End If
            Next
        End If
        If X < ColWidth / 2 And Y > RowHeight Then '单击时段。
            '计算时段号。
            Duan = Y \ RowHeight - 1
            Jie = 0
            For ForIndex = 0 To 4
                Duan = Duan - TemDataSet.Tables(7).Rows(0).Items(ForIndex).Value
                If Duan < 0 Then
                    Duan = ForIndex
                    Exit For
                End If
                Jie = Jie + TemDataSet.Tables(7).Rows(0).Items(ForIndex).Value
            Next
            ViewDataMode(Jie) = Not (ViewDataMode(Jie))
            For Tian = 0 To TemDataSet.Tables(6).RowCount - 1
                For ForIndex = 0 To TemDataSet.Tables(7).Rows(0).Items(Duan).Value - 1
                    ViewDataMode(Tian * TemNum + ForIndex + Jie) = ViewDataMode(Jie)
                Next
            Next
        End If
        If X > ColWidth And Y < RowHeight Then '单击列标题(全选某一天)。
            ViewDataMode((X \ ColWidth - 1) * TemNum + 0) = Not (ViewDataMode((X \ ColWidth - 1) * TemNum + 0))
            For ForIndex = 0 To TemNum - 1
                ViewDataMode((X \ ColWidth - 1) * TemNum + ForIndex) = ViewDataMode((X \ ColWidth - 1) * TemNum + 0)
            Next
        End If
        If X > ColWidth And Y > RowHeight Then '单击相应单元格。
            TemNum = (X \ ColWidth - 1) * (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) + Y \ RowHeight - 1
            TemData = ViewDataMode(TemNum)
            ViewDataMode(TemNum) = Not (TemData)
            Jie = Y \ RowHeight - 1
            For Duan = 0 To 4
                Jie = Jie - TemDataSet.Tables(7).Rows(0).Items(Duan).Value
                If Jie < 0 Then
                    Jie = Jie + TemDataSet.Tables(7).Rows(0).Items(Duan).Value
                    Exit For
                End If
            Next
        End If
        '生成公式字符串。
        TemStr = ""
        For ForIndex = 0 To 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) - 1
            TemNum = ForIndex Mod (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)
            For Duan = 0 To 4
                If TemNum >= TemDataSet.Tables(7).Rows(0).Items(Duan).Value Then
                    TemNum = TemNum - TemDataSet.Tables(7).Rows(0).Items(Duan).Value
                Else
                    Exit For
                End If
            Next
            '记入公式字符串。
            If TemStr <> "" Then TemStr = TemStr & ","
            If ViewDataMode(ForIndex) = False Then TemStr = TemStr & "-"
            TemStr = TemStr & ForIndex \ (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) + 1
            TemStr = TemStr & Duan + 1 & TemNum + 1
        Next
        Text1.Text = TemDataSet.LimitReduce(TemStr)
        ViewRefresh
    End If
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        If TemDataSet.TestLimit(Text1.Text, TemDataSet) = True Then
            MsgBox "公式错误！" & Chr(13) & "请修改公式！", vbOKOnly, "错误..."
        Else
            '刷新显示。
            ViewRefresh
        End If
    End If
End Sub