setsysfrm.frm

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

FRM
693 行
字号
12
                  Width           =   1335
               End
               Begin VB.Label Label1 
                  Caption         =   "每天节数合计："
                  Height          =   255
                  Index           =   1
                  Left            =   120
                  TabIndex        =   27
                  Top             =   240
                  Width           =   1335
               End
            End
         End
         Begin VB.Frame Frame9 
            Caption         =   "操作提示："
            Height          =   1935
            Left            =   2280
            TabIndex        =   16
            Top             =   2160
            Width           =   3495
            Begin VB.Label Label7 
               Caption         =   $"SetSysFrm.frx":098B
               Height          =   1455
               Left            =   120
               TabIndex        =   17
               Top             =   360
               Width           =   3255
            End
         End
         Begin VB.Frame Frame8 
            Caption         =   "资源命名："
            Height          =   1935
            Left            =   120
            TabIndex        =   13
            Top             =   2160
            Width           =   2055
            Begin VB.ListBox List1 
               Height          =   1140
               Index           =   4
               Left            =   1200
               TabIndex        =   18
               ToolTipText     =   "共享数量"
               Top             =   600
               Width           =   735
            End
            Begin VB.TextBox Text1 
               Height          =   270
               Index           =   3
               Left            =   120
               TabIndex        =   15
               ToolTipText     =   "请在此文本框中输入文本，然后按回车键添加。"
               Top             =   240
               Width           =   1815
            End
            Begin VB.ListBox List1 
               Height          =   1140
               Index           =   3
               Left            =   120
               TabIndex        =   14
               ToolTipText     =   "资源名称；在上面的文本框中输入名称按回车键添加。"
               Top             =   600
               Width           =   1095
            End
         End
         Begin VB.ListBox List1 
            Height          =   960
            Index           =   0
            Left            =   120
            TabIndex        =   9
            ToolTipText     =   "请在上面的文本框中输入文本，然后按回车键添加。"
            Top             =   1140
            Width           =   1815
         End
         Begin VB.TextBox Text1 
            Height          =   270
            Index           =   0
            Left            =   120
            TabIndex        =   8
            ToolTipText     =   "请在此文本框中输入文本，然后按回车键添加。"
            Top             =   780
            Width           =   1815
         End
         Begin VB.ListBox List1 
            Height          =   960
            Index           =   1
            Left            =   2040
            TabIndex        =   7
            ToolTipText     =   "请在上面的文本框中输入文本，然后按回车键添加。"
            Top             =   1140
            Width           =   1815
         End
         Begin VB.ListBox List1 
            Height          =   960
            Index           =   2
            Left            =   3960
            TabIndex        =   6
            ToolTipText     =   "请在上面的文本框中输入文本，然后按回车键添加。"
            Top             =   1140
            Width           =   1815
         End
         Begin VB.TextBox Text1 
            Height          =   270
            Index           =   1
            Left            =   2040
            TabIndex        =   5
            ToolTipText     =   "请在此文本框中输入文本，然后按回车键添加。"
            Top             =   780
            Width           =   1815
         End
         Begin VB.TextBox Text1 
            Height          =   270
            Index           =   2
            Left            =   3960
            TabIndex        =   4
            ToolTipText     =   "请在此文本框中输入文本，然后按回车键添加。"
            Top             =   780
            Width           =   1815
         End
         Begin VB.Label Label4 
            Caption         =   "班级命名："
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   12
            Top             =   480
            Width           =   1335
         End
         Begin VB.Label Label4 
            Caption         =   "教师命名："
            Height          =   255
            Index           =   1
            Left            =   2040
            TabIndex        =   11
            Top             =   480
            Width           =   1335
         End
         Begin VB.Label Label4 
            Caption         =   "科目命名："
            Height          =   255
            Index           =   2
            Left            =   4080
            TabIndex        =   10
            Top             =   480
            Width           =   1335
         End
      End
   End
End
Attribute VB_Name = "SetSys"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim TemDataSet As New MDD_Data
Private Sub Command1_Click(Index As Integer)
    Dim TableIndex As Long
    Dim RowIndex As Long
    Select Case Index
    Case 0: '取消。
        Unload Me
    Case 1: '确定。
        For TableIndex = 0 To 3 '班级名称，教师姓名，科目名称，资源名称。
            TemDataSet.Tables(TableIndex).ClearRows
            For RowIndex = 0 To List1(TableIndex).ListCount - 1
                TemDataSet.Tables(TableIndex).AddRow
                TemDataSet.Tables(TableIndex).Rows(TemDataSet.Tables(TableIndex).RowCount - 1).Items(0).Value = List1(TableIndex).List(RowIndex)
                If TableIndex = 3 Then
                    TemDataSet.Tables(TableIndex).Rows(TemDataSet.Tables(TableIndex).RowCount - 1).Items(1).Value = List1(TableIndex + 1).List(RowIndex)
                End If
            Next
        Next
        TableIndex = 6 '教学日名称。
        TemDataSet.Tables(TableIndex).ClearRows
        For RowIndex = 0 To List1(5).ListCount - 1
            TemDataSet.Tables(TableIndex).AddRow
            TemDataSet.Tables(TableIndex).Rows(TemDataSet.Tables(TableIndex).RowCount - 1).Items(0).Value = List1(5).List(RowIndex)
        Next
        '系统参数。
        If TemDataSet.Tables(7).RowCount <= 0 Then TemDataSet.Tables(7).AddRow
        For RowIndex = 0 To 4
            TemDataSet.Tables(7).Rows(0).Items(RowIndex).Value = Val(Text2(RowIndex).Text)
        Next
        Set MyDataSet = New MDD_Data: Set MyDataSet = TemDataSet
        MyDataSet.Updatable = True '表示数据已经修改。
        Unload Me
    End Select
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
    If KeyCode = 27 Then Unload Me '按ESC键取消.
End Sub

Private Sub Form_Load()
    Dim ForIndex As Long
    Dim TableIndex As Long
    Dim RowIndex As Long
On Error Resume Next
    '将课程安排表进行备份.
    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 '密码文本.
    
    Me.Caption = App.ProductName & "  <课程设置>"
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    For TableIndex = 0 To 3
        List1(TableIndex).Clear
        For RowIndex = 0 To TemDataSet.Tables(TableIndex).RowCount - 1
            List1(TableIndex).AddItem TemDataSet.Tables(TableIndex).Rows(RowIndex).Items(0).Value
            If TableIndex = 3 Then List1(TableIndex + 1).AddItem TemDataSet.Tables(TableIndex).Rows(RowIndex).Items(1).Value
        Next
    Next
    List1(5).Clear
    For RowIndex = 0 To TemDataSet.Tables(6).RowCount - 1
        List1(5).AddItem TemDataSet.Tables(6).Rows(RowIndex).Items(0).Value
    Next
    For ForIndex = 0 To 4
        Text2(ForIndex).Text = TemDataSet.Tables(7).Rows(0).Items(ForIndex).Value
    Next
End Sub

Private Sub List1_Click(Index As Integer)
    On Error Resume Next
    If Index = 3 Then
        List1(Index + 1).ListIndex = List1(Index).ListIndex
        List1(Index + 1).TopIndex = List1(Index).TopIndex
    End If
    If Index = 4 Then
        List1(Index - 1).ListIndex = List1(Index).ListIndex
        List1(Index - 1).TopIndex = List1(Index).TopIndex
    End If
End Sub

Private Sub List1_DblClick(Index As Integer)
    '双击选择项直接进行修改。
On Error Resume Next
    Dim TemStr As String
    Dim ForIndex As Long
    If List1(Index).ListIndex < 0 Then Exit Sub
    TemStr = InputBox("请输入新的数据：", "修改...", List1(Index).List(List1(Index).ListIndex))
    If TemStr = "" Then Exit Sub
    If Index <> 4 Then
        For ForIndex = 0 To List1(Index).ListCount - 1
            If ForIndex <> List1(Index).ListIndex And List1(Index).List(ForIndex) = TemStr Then
                If MsgBox("发现重名！" & Chr(13) & "你仍要使用这个名称吗？", vbYesNo + vbDefaultButton2, "重名...") <> vbYes Then Exit Sub
            End If
        Next
        List1(Index).List(List1(Index).ListIndex) = TemStr
    Else
        If CStr(Val(TemStr)) <> TemStr Then
            MsgBox "输入了非法字符！请输入数字！", vbOKOnly, "错误..."
            Exit Sub
        End If
        List1(Index).List(List1(Index).ListIndex) = Val(TemStr)
    End If
End Sub

Private Sub List1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error Resume Next
    Dim RowIndex As Long
    If KeyCode = 32 Then List1_DblClick Index '空格键修改。
    If KeyCode = 46 Then 'DEL键删除。
        If List1(Index).ListIndex < 0 Then Exit Sub
        '删除列表。
        If MsgBox("删除列表数据将对课程安排数据有影响！" & Chr(13) & "确定要将其删除吗？", vbOKCancel, "删除...") <> vbOK Then Exit Sub
        If Index = 3 Then List1(Index + 1).RemoveItem (List1(Index).ListIndex)
        If Index = 4 Then List1(Index - 1).RemoveItem (List1(Index).ListIndex)
        If Index <= 3 Then
            For RowIndex = 0 To TemDataSet.Tables(8).RowCount - 1
                '将课程安排表中对该对象的引用置为空.
                If TemDataSet.Tables(8).Rows(RowIndex).Items(Index).Value = List1(Index).ListIndex Then
                    TemDataSet.Tables(8).Rows(RowIndex).Items(Index).Value = -1
                End If
                '将课程安排表中对于其余对象的引用进行索引更正.
                If TemDataSet.Tables(8).Rows(RowIndex).Items(Index).Value > List1(Index).ListIndex Then
                    TemDataSet.Tables(8).Rows(RowIndex).Items(Index).Value = TemDataSet.Tables(8).Rows(RowIndex).Items(Index).Value - 1
                End If
            Next
            TemDataSet.Tables(Index).DelRow List1(Index).ListIndex
        End If
        List1(Index).RemoveItem (List1(Index).ListIndex)
    End If
End Sub

Private Sub List1_Scroll(Index As Integer)
    On Error Resume Next
    If Index = 3 Then
        List1(Index + 1).ListIndex = List1(Index).ListIndex
        List1(Index + 1).TopIndex = List1(Index).TopIndex
    End If
    If Index = 4 Then
        List1(Index - 1).ListIndex = List1(Index).ListIndex
        List1(Index - 1).TopIndex = List1(Index).TopIndex
    End If
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error Resume Next
    Dim ForIndex As Long
    If KeyCode = 13 Then '回车键添加。
        If Text1(Index).Text = "" Then Exit Sub
        For ForIndex = 0 To List1(Index).ListCount - 1
            If List1(Index).List(ForIndex) = Text1(Index).Text Then
                If MsgBox("此名称已经存在！" & Chr(13) & "你仍要将它添加到列表中吗？", vbYesNo + vbDefaultButton2, "重名...") <> vbYes Then Exit Sub
            End If
        Next
        List1(Index).AddItem Text1(Index).Text
        List1(Index).ListIndex = List1(Index).ListCount - 1
        If Index = 3 Then
            List1(Index + 1).AddItem "1"
            List1(Index + 1).ListIndex = List1(Index + 1).ListCount - 1
        End If
        Text1(Index).Text = ""
    End If
End Sub



Private Sub Text1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    If Index = 3 Then
        List1(Index + 1).ListIndex = List1(Index).ListIndex
        List1(Index + 1).TopIndex = List1(Index).TopIndex
    End If
    If Index = 4 Then
        List1(Index - 1).ListIndex = List1(Index).ListIndex
        List1(Index - 1).TopIndex = List1(Index).TopIndex
    End If
End Sub

Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
    '使数字输入框只接收0~9这几个数字.
    If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
    Text2(6).Text = CStr(List1(5).ListCount)
    Text2(5).Text = Abs(Val(Text2(0).Text)) + Abs(Val(Text2(1).Text)) + Abs(Val(Text2(2).Text)) + Abs(Val(Text2(3).Text)) + Abs(Val(Text2(4).Text))
End Sub
12

setsysfrm.frm - 源码说明

本页面展示了「guan yu pai ke xi tong de ruan jian」中的 setsysfrm.frm 源码文件，采用 FRM 编程语言编写，共 693 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与guan相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?