cjb1.bas

用VB编写的学生成绩管理系统

Attribute VB_Name = "Module1"
'*****        丹青阁电脑工作室 杨富城 编写代码        *****
'*****                                                *****
'*****            学生成绩管理系统全局模块            *****
'*****                                                *****
'**********************************************************


'存储关于子窗体信息的用户自定义类型

Type formstate
    Deleted As Integer
    Dirty As Integer
    Color As Long
End Type


Public FState() As formstate                    '用户自定义数组
Public Doc() As New frmBG                       '子窗体对象数组
Public Const ThisApp = "管理系统"               '定义 ThisApp 函数
Public Const ThisKey = "Recent Files"           '定义 ThisKey 函数


Sub Main()                                      '启动窗体
    frmSplash.Show
    frmSplash.Refresh
End Sub


Function AnyPadsLeft() As Integer
    '检测是否还有打开的子窗体
    Dim i As Integer
    For i = 1 To UBound(Doc)
        If Not FState(i).Deleted Then
            AnyPadsLeft = True
            Exit Function
        End If
    Next
End Function

Sub FileNew()                                   '新建文件过程
    Dim fIndex As Integer
    
    '找到下一个可用的索引并显示该子窗体
    fIndex = FindFreeIndex()
    Doc(fIndex).Tag = fIndex
    Doc(fIndex).Caption = "新成绩表：" & fIndex
    Doc(fIndex).Show
    
End Sub

Function FindFreeIndex() As Integer             '空文件索引检索过程
    
    Dim i As Integer
    Dim ArrayCount As Integer
    ArrayCount = UBound(Doc)
    For i = 1 To ArrayCount
        If FState(i).Deleted Then
            FindFreeIndex = i
            FState(i).Deleted = False
            Exit Function
        End If
    Next
    
    '如果子窗体对象数组中没有一个元素被删除，
    '文档数组与状态数组均加 1 并返回新元素的索引(Index)。
    ReDim Preserve Doc(ArrayCount + 1)
    ReDim Preserve FState(ArrayCount + 1)
    FindFreeIndex = UBound(Doc)
           
End Function


Sub GetRecentFiles()                            '读注册表数据,更新“文件”菜单
    Dim i, j As Integer
    Dim VarFiles As Variant
    
    '用 Getallsettings 语句从注册表中返回最近使用过的文件
    '常数 ThisApp 和 ThisKey 已在模块中定义
    
    If GetSetting(ThisApp, ThisKey, "Recentfile1") = Empty Then Exit Sub
    
    VarFiles = GetAllSettings(ThisApp, ThisKey)
    
    For i = 0 To UBound(VarFiles, 1)
        frmMain.mnuRecentFile(0).Visible = True
        frmMain.mnuRecentFile(i).Caption = VarFiles(i, 1)
        frmMain.mnuRecentFile(i).Visible = True
            '更新所有子窗体的“文件”菜单
            For j = 1 To UBound(Doc)
                If Not FState(j).Deleted Then
                    Doc(j).mnuRecentFile(0).Visible = True
                    Doc(j).mnuRecentFile(i + 1).Caption = VarFiles(i, 1)
                    Doc(j).mnuRecentFile(i + 1).Visible = True
                End If
            Next j
    Next i
End Sub

Sub WriteRecentFiles(OpenFileName)              '写注册表数据
    
    '本过程使用 SaveSettings 语句将最近使用的文件名写入系统注册表
    
    Dim i, j As Integer
    Dim strFile, Key As String
    
    ' 将文件 RecentFile1 复制给 RecentFile2 等等
    For i = 3 To 1 Step -1
        Key = "RecentFile" & i
        strFile = GetSetting(ThisApp, ThisKey, Key)
        If strFile <> "" Then
            Key = "RecentFile" & (i + 1)
            SaveSetting ThisApp, ThisKey, Key, strFile
        End If
    Next i
    
    '将正在打开的文件写到最近使用的文件列表的第一项
    SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
    
End Sub
Function Fgi(r As Integer, c As Integer) As Integer
    '表格单元值函数
    Fgi = c + frmMain.ActiveForm.ChengJB.Cols * r
End Function

Sub CopyThing(a, b, c, d As Integer)        '复制过程
    Dim i, j As Integer
    Dim CopyText As String
    CopyText = ""
    With frmMain.ActiveForm
    For i = a To b
        For j = c To d
            CopyText = CopyText & .ChengJB.TextArray(Fgi((i), (j)))
            If j <> d Then
                CopyText = CopyText & vbTab
            End If
        Next j
        If i <> b Then
            CopyText = CopyText & vbCrLf
        End If
    Next i
    Clipboard.Clear
    Clipboard.SetText CopyText
    End With
End Sub

Sub FontChang(s As String)                  '字体变化过程
    With frmMain.ActiveForm
    Dim Abc
    Abc = .ChengJB.Font.Size + s
    If Abc > 0 Then .ChengJB.Font.Size = Abc
    For i = 2 To 17
        .ChengJB.ColWidth(i) = .ChengJB.ColWidth(1) * 7 / 8
    Next
    .ChengJB.ColWidth(18) = .ChengJB.ColWidth(1) * 5 / 8
    .txtedit.Font.Size = .ChengJB.Font.Size
    FState(.Tag).Dirty = True
    frmMain.sbStatusBar.Panels(3).Text = "当前表格字号  " & .ChengJB.Font.Size
    End With
End Sub

Sub Chushi()
    '初始化主窗体状态栏
    With frmMain.ActiveForm
    If .TextShuxing(1).Text <> "Text1" Then
        frmMain.sbStatusBar.Panels(1).Text = _
            "班级：" & .TextShuxing(1).Text & " " & .TextShuxing(2).Text
        .ChengJB.ToolTipText = ""
    Else
        frmMain.sbStatusBar.Panels(1).Text = _
            "未知班级  请单击“文件”菜单下的“属性”项，设置属性"
    End If
    End With
End Sub