dataeditfrm.frm

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

                        TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(ColIndex + 1).Value = Me.Combo3(ColIndex).ListIndex
                    Next
                    TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(6).Value = Val(Me.Combo3(5).Text)
                    TemDataSet.Tables(8).Rows(TemDataSet.Tables(8).RowCount - 1).Items(7).Value = Text2.Text
                End If
            Next
            '使当前显示位置为新添加的数据。
            Me.VScroll1.Value = Me.VScroll1.Max
            Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
            RowSelectIndex = Me.VScroll1.Value + 1
            ColSelectIndex = -1
            Me.DataRefresh
            If Me.Combo3(0).ListIndex < 0 Then
                MsgBox "已经添加课程数据，但未对任课教师进行指派！" & Chr(13) & "请记得对相关课程数据进行修改！", vbOKOnly, "提示..."
            Else
                If Me.Combo3(1).ListIndex < 0 Then
                    MsgBox "已经添加课程数据，但未对相关科目进行指派！" & Chr(13) & "请记得对相关课程数据进行修改！", vbOKOnly, "提示..."
                End If
            End If
        End If
    Case 4: '删除.
        TemDataSet.Tables(8).DelRow (RowSelectIndex)
        Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
        Me.DataRefresh
    Case 5: '清空.
        TemDataSet.Tables(8).ClearRows
        Me.VScroll1.Max = TemDataSet.Tables(8).RowCount - 1
        Me.DataRefresh
    Case 6: '取消.
        Me.MousePointer = 0
        Unload Me
        Exit Sub
    Case 7: '公式生成。
        'MsgBox "注册后方可使用该功能！" & Chr(13) & "时限公式：" & TemDataSet.Tables(8).Rows(RowSelectIndex).Items(ColSelectIndex).Value
        Dim TemFrm As New FormulaBuildFrm
        Set TemFrm.TemDataSet = TemDataSet
        TemFrm.AbsolutePosition = RowSelectIndex
        TemFrm.Show 1
        Me.DataRefresh
    Case 8: '确定。
        MyDataSet.Updatable = False
        Call Command1_Click(1)
        If MyDataSet.Updatable = True Then
            Me.MousePointer = 0
            Unload Me
            Exit Sub
        End If
    End Select
    Me.MousePointer = 0
End Sub

Public Sub DataRefresh()
On Error Resume Next
    Dim RowIndex As Long
    Dim FieldIndex As Long
    Dim TemStr As String
    Dim LeftStr As String
    Dim TemIndex As Long
    Me.Picture1.Cls '清显示.
    '画列标题。
    Me.Picture1.ForeColor = Me.TitleColor
    For FieldIndex = Me.HScroll1.Value To 7
        TemStr = Left(TemDataSet.Tables(8).Fields.Items(FieldIndex).Name, Me.ColWidth \ Me.Picture1.TextWidth("正"))
        Me.Picture1.CurrentX = Me.ColWidth * (FieldIndex - Me.HScroll1.Value) + (Me.ColWidth - Me.Picture1.TextWidth(TemStr)) / 2
        Me.Picture1.CurrentY = (Me.RowHeight - Me.Picture1.TextHeight(TemStr)) / 2
        Me.Picture1.Print TemStr
    Next
    Me.Picture1.ForeColor = Me.TextColor
    '画行线。
    For RowIndex = 0 To Me.Picture1.ScaleHeight \ Me.RowHeight
        Me.Picture1.Line (0, RowIndex * Me.RowHeight)-(Me.Picture1.ScaleWidth, RowIndex * Me.RowHeight), Me.LineColor
    Next
    '画列线。
    For FieldIndex = 0 To 7 - Me.HScroll1.Value
        Me.Picture1.Line (FieldIndex * Me.ColWidth, 0)-(FieldIndex * Me.ColWidth, Me.Picture1.ScaleHeight), Me.LineColor
    Next
    '确定时否显示编辑框。
    Me.Combo1.Visible = False: Me.Text1.Visible = False: Me.Command1(7).Visible = False
    If RowSelectIndex >= 0 And RowSelectIndex < TemDataSet.Tables(8).RowCount And ColSelectIndex >= 0 And ColSelectIndex < TemDataSet.Tables(8).Fields.FieldCount Then
        If (ColSelectIndex >= 0 And ColSelectIndex < 8 And RowSelectIndex >= 0 And RowSelectIndex < TemDataSet.Tables(8).RowCount) Then
            If ColSelectIndex - Me.HScroll1.Value >= 0 And RowSelectIndex - Me.VScroll1.Value >= 0 And RowSelectIndex - Me.VScroll1.Value < Me.HScroll1.Top \ Me.RowHeight Then
                If ColSelectIndex < 6 Then
                    Me.Combo1.Clear
                    For RowIndex = 0 To TemDataSet.Tables(ColSelectIndex).RowCount - 1
                        Me.Combo1.AddItem TemDataSet.Tables(ColSelectIndex).Rows(RowIndex).Items(0).Value
                    Next
                    Me.Combo1.ListIndex = TemDataSet.Tables(8).Rows(RowSelectIndex).Items(ColSelectIndex).Value
                    Me.Combo1.Left = (ColSelectIndex - Me.HScroll1.Value) * Me.ColWidth
                    Me.Combo1.Top = (RowSelectIndex - Me.VScroll1.Value + 1) * Me.RowHeight
                    Me.Combo1.Visible = True: Me.Combo1.SetFocus
                Else
                    Me.Text1.Text = TemDataSet.Tables(8).Rows(RowSelectIndex).Items(ColSelectIndex).Value
                    Text1.SelStart = Len(Text1.Text)
                    Me.Text1.Top = (RowSelectIndex - Me.VScroll1.Value + 1) * Me.RowHeight
                    Me.Text1.Left = (ColSelectIndex - Me.HScroll1.Value) * Me.ColWidth
                    If ColSelectIndex = 7 Then
                        'Me.Text1.MaxLength = 250 '公式字符串长度.
                        Me.Text1.Width = Me.Picture1.ScaleWidth - Me.Text1.Left
                    Else
                        'Me.Text1.MaxLength = 5 '排课节数长度.
                        Me.Text1.Width = Me.ColWidth
                    End If
                    Text1.Visible = True
                    If Text1.Width > Me.Command1(7).Width And ColSelectIndex = 7 Then '显示按钮。
                        Text1.Width = Text1.Width - Me.Command1(7).Width
                        Me.Command1(7).Height = Me.RowHeight
                        Me.Command1(7).Left = Me.Text1.Left + Me.Text1.Width
                        Me.Command1(7).Top = (RowSelectIndex - Me.VScroll1.Value + 1) * Me.RowHeight
                        Me.Command1(7).Visible = True
                    End If
                    Text1.SetFocus
               End If
            End If
        End If
    End If
    Me.Picture1.ForeColor = Me.TextColor
    For RowIndex = Me.VScroll1.Value To TemDataSet.Tables(8).RowCount - 1
        If RowIndex = RowSelectIndex Then
            Me.Picture1.ForeColor = Me.SelectColor
        Else
            Me.Picture1.ForeColor = Me.TextColor
        End If
        For FieldIndex = Me.HScroll1.Value To 7
            SelectX = Me.ColWidth * (FieldIndex - Me.HScroll1.Value)
            SelectY = (RowIndex - Me.VScroll1 + 1) * Me.RowHeight
            TemStr = "": LeftStr = ""
            If FieldIndex < 6 Then
                TemStr = TemDataSet.Tables(FieldIndex).Rows(TemDataSet.Tables(8).Rows(RowIndex).Items(FieldIndex).Value).Items(0).Value
            Else
                TemStr = CStr(TemDataSet.Tables(8).Rows(RowIndex).Items(FieldIndex).Value)
            End If
            Me.Picture1.CurrentX = SelectX + Me.Picture1.TextWidth("正") / 3
            Me.Picture1.CurrentY = SelectY + (Me.RowHeight - Me.Picture1.TextHeight(TemStr)) / 2
            If FieldIndex < 7 Then
                For TemIndex = 1 To Len(TemStr)
                    If Me.Picture1.TextWidth(Left(TemStr, TemIndex)) < Me.ColWidth Then LeftStr = Left(TemStr, TemIndex)
                Next
                Me.Picture1.Print LeftStr
            Else
                Me.Picture1.Print TemStr
            End If
        Next
        If Me.Picture1.CurrentY > Me.HScroll1.Top Then Exit For
    Next
    Me.Picture1.Refresh
    If RowSelectIndex >= 0 And RowSelectIndex < TemDataSet.Tables(8).RowCount Then
        Me.Caption = App.ProductName & "<课程计划>——当前记录：" & RowSelectIndex
    Else
        Me.Caption = App.ProductName & "<课程计划>"
    End If
End Sub

Private Sub Form_Resize()
    Dim ForIndex As Long
On Error Resume Next
    If Me.ScaleWidth > Me.Command1(8).Left + Me.Command1(8).Width Then Me.Frame1.Width = Me.ScaleWidth
    Me.Frame1.Top = Me.ScaleHeight - Me.Frame1.Height
    Me.Frame1.Left = 0
    Me.VScroll1.Height = Me.Frame1.Top - Me.HScroll1.Height
    Me.VScroll1.Left = Me.ScaleWidth - Me.VScroll1.Width - Me.Frame2.Width - 50
    Me.VScroll1.Top = 0
    Me.HScroll1.Width = Me.VScroll1.Left
    Me.HScroll1.Left = 0
    Me.HScroll1.Top = Me.VScroll1.Height
    Me.Command1(0).Width = Me.VScroll1.Width
    Me.Command1(0).Height = Me.HScroll1.Height
    Me.Command1(0).Left = Me.VScroll1.Left
    Me.Command1(0).Top = Me.HScroll1.Top
    Me.Picture1.Width = Me.VScroll1.Left
    Me.Picture1.Height = Me.HScroll1.Top
    Me.Picture1.Left = 0
    Me.Picture1.Top = 0
    Me.Frame2.Height = Me.HScroll1.Top + Me.HScroll1.Height
    Me.Frame2.Left = Me.VScroll1.Left + Me.VScroll1.Width + 50
    Me.Frame2.Top = 0
    Me.DataRefresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set TemDataSet = New MDD_Data
    rv = SetWindowLong(Me.hWnd, GWL_WNDPROC, PROROC)  '消息为默认的窗口处理函数.
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim ForIndex As Long
    If (KeyCode = Asc("a") Or KeyCode = Asc("A")) And Shift = 2 Then
       For ForIndex = 0 To List1.ListCount - 1
            List1.Selected(ForIndex) = True
       Next
    End If
End Sub

Private Sub VScroll1_Change()
    Me.DataRefresh
End Sub
Private Sub VScroll1_Scroll()
    VScroll1_Change
End Sub
Private Sub HScroll1_Change()
    VScroll1_Change
End Sub
Private Sub HScroll1_Scroll()
    HScroll1_Change
End Sub

Private Sub Picture1_DblClick()
    If RowSelectIndex - VScroll1.Value < 0 Then '双击列标题。
        If ColSelectIndex < 7 Then
            TemDataSet.Tables(8).IndexUpdate ColSelectIndex
        Else
            TemDataSet.Tables(8).IndexUpdate 7
        End If
    End If
    DataRefresh
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Text1.Visible = False: Me.Combo1.Visible = False
    If Y > Me.RowHeight Then
        RowSelectIndex = Y \ Me.RowHeight - 1 + Me.VScroll1.Value
    Else
        RowSelectIndex = -1
    End If
    If Button = 1 Then
        ColSelectIndex = X \ Me.ColWidth + Me.HScroll1.Value: If ColSelectIndex > 7 Then ColSelectIndex = 7 '字段索引最大为7。
    Else
        ColSelectIndex = -1
    End If
    DataRefresh
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If ColSelectIndex <> 7 Then '如果不是时限公式编辑,则不允许输入非数字字符.
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub
Private Sub Text1_Change()
    Dim TemStr As String
    Dim ForIndex As Long
    Dim FormatUpdata As Boolean
    If ColSelectIndex >= 7 Then '表示时限公式字段.
        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 = Text1.Text
        If TemDataSet.TestLimit(Text1.Text, TemDataSet) = True Then Text1.ToolTipText = "时限公式错误!" Else Text1.ToolTipText = "直接输入数据进行修改."
        Exit Sub
    End If
    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 = Val(Text1.Text)
End Sub