cjb2.bas

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

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


Function OnRecentFilesList(Filename) As Integer  '判断文件是否在文件菜单的自定义函数
    Dim i
    For i = 1 To 4
        If UCase(frmMain.mnuRecentFile(i).Caption) = UCase(Filename) Then
            OnRecentFilesList = True
            Exit Function
        End If
    Next i
        OnRecentFilesList = False
End Function

Sub UpdateFileMenu(Filename)                     '更新注册表，刷新“文件”菜单
    
    If Filename = "" Then Exit Sub
    Dim intRetVal As Integer
    '判断打开的文件名是否已经在“文件”菜单控件数组中
    intRetVal = OnRecentFilesList(Filename)
    If Not intRetVal Then
        '将打开的文件写到注册表，调用写注册表过程
        WriteRecentFiles (Filename)
    End If
    '更新“文件”菜单空间数组中最近打开的文件列表
    GetRecentFiles
    
End Sub


Sub SaveFileAs(Filename)                         '写文件过程
    On Error Resume Next
    '声明存盘文件变量
    Dim i, j, k As Integer
    Dim strC As String
    
    '打开文件
    '显示鼠标沙漏指针
    Screen.MousePointer = 11
    '为 strC 赋值
    With frmMain.ActiveForm
    strC = Filename & vbCrLf
    For i = 1 To 15
        strC = strC & .TextShuxing(i).Text & vbCrLf  '前 15 行为属性文本框的内容
    Next
    strC = strC & .ChengJB.Font.Size & vbCrLf       '表格字号
    strC = strC & .ChengJB.GridLines & vbCrLf       '表格线型
    strC = strC & .ChengJB.GridColor & vbCrLf       '表线颜色
    strC = strC & .ChengJB.Rows & vbCrLf            '表格总行数
    For j = 0 To .ChengJB.Rows - 1
        For k = 0 To 18
            strC = strC & .ChengJB.TextArray(Fgi((j), (k))) & vbCrLf    '表内数据
        Next k
    Next j
    End With
    '将变量内容写到一个保存的文件中
    Open Filename For Output As #1
    Print #1, strC
    Close #1
    '重新设置鼠标指针
    Screen.MousePointer = 0
    '设置窗体标题
    If Err Then
        MsgBox Error, 48, App.Title
    Else
        frmMain.ActiveForm.Caption = UCase(Filename)
        '重新设置 Dirty 标志
        FState(frmMain.ActiveForm.Tag).Dirty = False
    End If
End Sub

Sub FileOpenProc()                          '打开文件的准备
    Dim intRetVal
    On Error Resume Next
    Dim strOpenFilename As String
    frmMain.CMDialog1.Filename = ""
    frmMain.CMDialog1.Filter = "所有文件(*.*)|*.*|" & _
        "学生成绩管理系统文件(*.CJB)|*.CJB"
    frmMain.CMDialog1.FilterIndex = 2
    frmMain.CMDialog1.ShowOpen
    If Err <> 32755 Then
        strOpenFilename = frmMain.CMDialog1.Filename
        OpenFile (strOpenFilename)
        UpdateFileMenu (strOpenFilename)
    End If

End Sub

Function GetFileName(Filename As Variant)        '显示“另存为”对话框并返回文件名
    
    Dim strmsg, strName As String
    On Error Resume Next
    '如果选择“取消”则返回空字符串
    frmMain.CMDialog1.CancelError = True
    frmMain.CMDialog1.Flags = cdlOFNOverwritePrompt
    frmMain.CMDialog1.Filename = Filename
    frmMain.CMDialog1.Filter = "所有文件(*.*)|*.*|" & _
        "学生成绩管理系统文件(*.CJB)|*.CJB"
    frmMain.CMDialog1.FilterIndex = 2
    frmMain.CMDialog1.ShowSave
    If Err <> 32755 Then
        GetFileName = frmMain.CMDialog1.Filename
    Else
        GetFileName = ""
    End If
    UpdateFileMenu (Filename)
End Function


Sub OpenFile(Filename)                  '打开指定文件过程
    
    If Filename = "" Then Exit Sub
    
    Dim fIndex As Integer
    Dim abcd As String
    Dim i, j, k As Integer
    
    '找到下一个可用的索引并显示该子窗体
    fIndex = FindFreeIndex()
    Doc(fIndex).Tag = fIndex
    
    On Error Resume Next
    '打开选定文件
    '将文件内相应的行赋值给相应的变量
    Open Filename For Input As #1
    If Err Then
       MsgBox "不能打开文件：" + Filename
       Unload frmMain.ActiveForm
       Exit Sub
    End If
    '改变鼠标指针类型为沙漏
    Screen.MousePointer = 11
    Line Input #1, abcd
    Doc(fIndex).Caption = Filename
    Doc(fIndex).Show
    
    Doc(fIndex).Timer1.Enabled = False
    Doc(fIndex).Text1.Visible = False
    For i = 1 To 15
        Line Input #1, abcd
        Doc(fIndex).TextShuxing(i).Text = abcd
    Next
    Line Input #1, abcd
    Doc(fIndex).ChengJB.Font.Size = abcd
    Doc(fIndex).ChengJB.Refresh
    Line Input #1, abcd
    Doc(fIndex).ChengJB.GridLines = abcd
    Line Input #1, abcd
    Doc(fIndex).ChengJB.GridColor = abcd
    Line Input #1, abcd
    Doc(fIndex).ChengJB.Rows = abcd
    For j = 0 To Doc(fIndex).ChengJB.Rows - 1
        For k = 0 To 18
            Line Input #1, abcd
            Doc(fIndex).ChengJB.TextArray(Fgi((j), (k))) = abcd
        Next k
    Next j
    Close #1
    Chushi
    Screen.MousePointer = 0
    For i = 2 To 18
        frmMain.ActiveForm.ChengJB.ColAlignment(i) = 0
    Next
    FState(Doc(fIndex).Tag).Dirty = False
End Sub

Sub filePrintJ()            '打印简表
    
    '定义 PrintText 为表格内容
    Dim i, j As Integer
    Dim PrintText As String
    PrintText = ""
    With frmMain.ActiveForm
    For i = 0 To .ChengJB.Rows - 1
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (0))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (1))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (10))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (13))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (16))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (17))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (18))) & vbCrLf
    Next i
    End With
    abcd = frmMain.ActiveForm.TextShuxing(1).Text & " " & _
        frmMain.ActiveForm.TextShuxing(2).Text & _
        " 成绩表"

    Printer.ScaleLeft = -560
    '定义字体并打印
    Printer.FontName = "宋体"
    Printer.FontSize = 18
    Printer.Print " " & vbCrLf
    Printer.Print abcd
    
    Printer.FontName = "楷体_GB2312"
    Printer.FontSize = 12
    Printer.Print " " & vbCrLf
    Printer.Print PrintText
    
    Printer.FontName = "黑体"
    Printer.FontSize = 12
    Printer.Print " " & vbCrLf
    Printer.Print "学生成绩管理系统  报表输出"
    Printer.Print "     丹青阁电脑工作室"
    
    Printer.EndDoc
End Sub

Sub filePrintZ()            '打印总表
    
    '定义 PrintText 为表格内容
    Dim i, j As Integer
    Dim PrintText As String
    PrintText = ""
    With frmMain.ActiveForm
    For i = 0 To .ChengJB.Rows - 1
        For j = 0 To 18
            PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (j)))
            If j <> 18 Then
                PrintText = PrintText + vbTab
            Else
                If i <> .ChengJB.Rows - 1 Then PrintText = PrintText + vbCrLf
            End If
        Next j
    Next i
    End With
    abcd = frmMain.ActiveForm.TextShuxing(1).Text & " " & _
        frmMain.ActiveForm.TextShuxing(2).Text & _
        " 成绩表"

    Printer.ScaleLeft = -560
    '定义字体并打印
    Printer.FontName = "宋体"
    Printer.FontSize = 22
    Printer.Print " " & vbCrLf
    Printer.Print abcd
    
    Printer.FontName = "楷体_GB2312"
    Printer.FontSize = 9
    Printer.Print " " & vbCrLf
    Printer.Print PrintText
    
    Printer.FontName = "黑体"
    Printer.FontSize = 10
    Printer.Print " " & vbCrLf
    Printer.Print "学生成绩管理系统  报表输出"
    Printer.Print "     丹青阁电脑工作室"
    
    Printer.EndDoc
End Sub


Sub filePrintTJ()            '预览简表
    
    '定义 PrintText 为表格内容
    Dim i, j As Integer
    Dim PrintText As String
    PrintText = ""
    With frmMain.ActiveForm
    For i = 0 To .ChengJB.Rows - 1
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (0))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (1))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (10))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (13))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (16))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (17))) & vbTab
        PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (18))) & vbCrLf
    Next i
    End With
    abcd = frmMain.ActiveForm.TextShuxing(1).Text & " " & _
        frmMain.ActiveForm.TextShuxing(2).Text & _
        " 成绩表"

    frmYuLan.Show
    frmYuLan.Caption = "打印预览(简表)  " & abcd
    frmYuLan.ScaleLeft = -560
    '定义字体并显示
    frmYuLan.FontName = "宋体"
    frmYuLan.FontSize = 18
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print abcd
    
    frmYuLan.FontName = "楷体_GB2312"
    frmYuLan.FontSize = 12
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print PrintText
    
    frmYuLan.FontName = "黑体"
    frmYuLan.FontSize = 12
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print "学生成绩管理系统  报表输出"
    frmYuLan.Print "     丹青阁电脑工作室"
    
End Sub


Sub filePrintTZ()            '预览总表
    
    '定义 PrintText 为表格内容
    Dim i, j As Integer
    Dim PrintText As String
    PrintText = ""
    With frmMain.ActiveForm
    For i = 0 To .ChengJB.Rows - 1
        For j = 0 To 18
            PrintText = PrintText & .ChengJB.TextArray(Fgi((i), (j)))
            If j <> 18 Then
                PrintText = PrintText + vbTab
            Else
                If i <> .ChengJB.Rows - 1 Then PrintText = PrintText + vbCrLf
            End If
        Next j
    Next i
    End With
    abcd = frmMain.ActiveForm.TextShuxing(1).Text & " " & _
        frmMain.ActiveForm.TextShuxing(2).Text & _
        " 成绩表"

    frmYuLan.Show
    frmYuLan.Caption = "打印预览(简表)  " & abcd
    frmYuLan.ScaleLeft = -560
    '定义字体并显示
    frmYuLan.FontName = "宋体"
    frmYuLan.FontSize = 22
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print abcd
    
    frmYuLan.FontName = "楷体_GB2312"
    frmYuLan.FontSize = 9
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print PrintText
    
    frmYuLan.FontName = "黑体"
    frmYuLan.FontSize = 10
    frmYuLan.Print " " & vbCrLf
    frmYuLan.Print "学生成绩管理系统  报表输出"
    frmYuLan.Print "     丹青阁电脑工作室"
    
End Sub