bbb.frm

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

Private Sub mnuFileOpen_Click()
    '调用文件打开准备过程
    FileOpenProc
End Sub

Private Sub mnuFilePinter_Click()
    frmMain.CMDialog1.Flags = cdlPDPrintSetup
    frmMain.CMDialog1.ShowPrinter
End Sub

Private Sub mnuFilePrin_Click()
    CopyThing 0, ChengJB.Rows - 1, 0, 18
End Sub


Private Sub mnuFileSave_Click()
    
    '检察文件是否已有文件名，无则 GET，有则使用
    Dim strFilename As String
    If Left(Me.Caption, 4) = "新成绩表" Then
        strFilename = GetFileName(strFilename)
    Else
        strFilename = Me.Caption
    End If
    If strFilename <> "" Then
        SaveFileAs strFilename
    End If
    
End Sub

Private Sub mnuFileSaveAs_Click()
    
    Dim strSaveFilename As String
    Dim strDefaultName As String
    
    '将窗体标题赋值给变量
    strDefaultName = Me.Caption
    If Left(Me.Caption, 4) = "新成绩表" Then
        strSaveFilename = GetFileName("")
        If strSaveFilename <> "" Then SaveFileAs (strSaveFilename)
        '更新文件菜单
        UpdateFileMenu (strSaveFilename)
    Else
        '窗体标题包含打开的文件名
        strSaveFilename = GetFileName(strSaveFilename)
        If strSaveFilename <> "" Then SaveFileAs (strSaveFilename)
        '更新文件菜单
        UpdateFileMenu (strSaveFilename)
    End If
    
End Sub

Private Sub mnuFileShuxing_Click()
    frmShuxing.Show vbModal, frmMain
End Sub

Private Sub mnuFileZong_Click()
    filePrintTZ
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, frmMain
End Sub

Private Sub mnuhelpmain_Click()
    frmHelp.Show vbModal, frmMain
End Sub

Private Sub mnuPrintJian_Click()
    filePrintJ
End Sub

Private Sub mnuPrintZong_Click()
    filePrintZ
End Sub

Private Sub mnuToolJiang_Click()
    Dim i As Integer
    With ChengJB
        .Sort = 2
        .TextArray(Fgi(0, 18)) = "名次"
        For i = 1 To .Rows - 1
            .TextArray(Fgi((i), 18)) = i
            If Val(.TextArray(Fgi((i), 17))) = 0 Then .TextArray(Fgi((i), 18)) = ""
        Next
    End With
End Sub

Private Sub mnuToolJiangT_Click()
    Dim LsShuju As String
    LsShuju = ChengJB.Col
    ChengJB.Col = 17
    mnuToolJiang_Click
    ChengJB.Col = LsShuju
End Sub

Private Sub mnuToolJin_Click()
    MsgBox "学生成绩管理系统 Ver 1.20 (赠送版)" & _
        vbCrLf & "暂时没有此项功能……" & _
        vbCrLf & "请留意后续版本！", 48, "抱歉……"
End Sub

Private Sub mnuToolJisuan_Click()
    Dim i, j, k  As Integer
    Dim Abc, dd, ee As Single
        Abc = 0
        For j = 5 To 12
            Zong = Zong + Val(TextShuxing(j).Text)
        Next
        If Zong = 0 Then Exit Sub
    For i = 1 To ChengJB.Rows - 1
        Abc = 0
        For k = 2 To 9
            dd = Val(ChengJB.TextArray(Fgi((i), (k))))
            ee = Val(TextShuxing(k + 3).Text)
            Abc = Val(Abc) + Val(dd) * Val(ee) / Val(Zong)
        Next k
        ChengJB.TextArray(Fgi((i), 10)) = Int(Abc * 1000 + 0.5) / 1000
        If ChengJB.TextArray(Fgi((i), 10)) = 0 Then ChengJB.TextArray(Fgi((i), 10)) = ""
        Abc = Val(ChengJB.TextArray(Fgi((i), 11))) + Val(ChengJB.TextArray(Fgi((i), 12)))
        ChengJB.TextArray(Fgi((i), 13)) = Int(Abc * 1000 + 0.5) / 1000
        If ChengJB.TextArray(Fgi((i), 13)) = 0 Then ChengJB.TextArray(Fgi((i), 13)) = ""
        Abc = Val(ChengJB.TextArray(Fgi((i), 14))) * Val(TextShuxing(3).Text) / 100 + _
            Val(ChengJB.TextArray(Fgi((i), 15))) * Val(TextShuxing(4).Text) / 100
        ChengJB.TextArray(Fgi((i), 16)) = Int(Abc * 1000 + 0.5) / 1000
        If ChengJB.TextArray(Fgi((i), 16)) = 0 Then ChengJB.TextArray(Fgi((i), 16)) = ""
        Abc = Val(ChengJB.TextArray(Fgi((i), 10))) * Val(TextShuxing(14).Text) / 100 + _
              Val(ChengJB.TextArray(Fgi((i), 13))) * Val(TextShuxing(13).Text) / 100 + _
              Val(ChengJB.TextArray(Fgi((i), 16))) * Val(TextShuxing(15).Text) / 100
        ChengJB.TextArray(Fgi((i), 17)) = Int(Abc * 100 + 0.5) / 100
        If ChengJB.TextArray(Fgi((i), 17)) = 0 Then ChengJB.TextArray(Fgi((i), 17)) = ""
    Next i
End Sub

Private Sub mnuToolSheng_Click()
    ChengJB.Sort = 1
End Sub

Private Sub mnuToolShengT_Click()
    ChengJB.Col = 0
    mnuToolSheng_Click
End Sub

Private Sub mnuViewBig_Click()
    FontChang 1
End Sub

Private Sub mnuViewGridAo_Click()
    ChengJB.GridLines = 2
    FState(Me.Tag).Dirty = True
End Sub

Private Sub mnuViewGridColor_Click()
    ChengJB.GridLines = 1
    frmMain.CMDialog1.Color = ChengJB.GridColor
    frmMain.CMDialog1.ShowColor
    ChengJB.GridColor = frmMain.CMDialog1.Color
    FState(Me.Tag).Dirty = True
End Sub

Private Sub mnuViewGridNone_Click()
    ChengJB.GridLines = 0
    FState(Me.Tag).Dirty = True
End Sub

Private Sub mnuViewGridPu_Click()
    ChengJB.GridLines = 1
    FState(Me.Tag).Dirty = True
End Sub

Private Sub mnuViewGridTu_Click()
    ChengJB.GridLines = 3
    FState(Me.Tag).Dirty = True
End Sub

Private Sub mnuViewLittle_Click()
    FontChang -1
End Sub

Private Sub mnuViewSuo_Click()
    mnuViewSuo.Checked = Not mnuViewSuo.Checked
    If mnuViewSuo.Checked Then
        ChengJB.FixedCols = 2
    Else
        ChengJB.FixedCols = 1
    End If
End Sub

Private Sub mnuViewZhuang_Click()
    
    ' 切换 Checked 属性
    mnuViewZhuang.Checked = Not mnuViewZhuang.Checked
    
    ' 基于值切换工具栏
    If mnuViewZhuang.Checked Then
        frmMain.sbStatusBar.Visible = True
    Else
        frmMain.sbStatusBar.Visible = False
    End If

End Sub

Private Sub mnuWindowArrangeIcons_Click()
    frmMain.Arrange vbArrangeIcons
End Sub

Private Sub mnuViewToolbar_Click()
    
    ' 切换 Checked 属性
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    
    ' 基于值切换工具栏
    If mnuViewToolbar.Checked Then
        frmMain.tbToolBar.Visible = True
    Else
        frmMain.tbToolBar.Visible = False
    End If
    
End Sub

Private Sub mnuWindowCascade_Click()
    frmMain.Arrange vbCascade
End Sub

Private Sub mnuWindowTileH_Click()
    frmMain.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowTileZ_Click()
    frmMain.Arrange vbTileVertical
End Sub

Private Sub TextShuxing_Change(Index As Integer)
    FState(Me.Tag).Dirty = True
End Sub

Private Sub Timer1_Timer()
    Text1.Visible = Not Text1.Visible
End Sub

Sub txtEdit_KeyPress(keyascii As Integer)
    '删除回车符，以消除嘟嘟声。
    If keyascii = vbKeyReturn Then
        keyascii = 0
        With ChengJB
        If frmMain.ActiveForm.mnuEditKemu.Checked Then     '按列输入
            If .Row <> .Rows - 1 Then     '这一列没有输入完
                .Row = .Row + 1           '转到此列的下一行
            Else                        '如果这一列已经输入完
                .Row = 1                 '回到第一行
                Select Case .Col
                    Case 9
                        .Col = .Col + 2   '跳过 ∑智育
                    Case 12
                        .Col = .Col + 2   '跳过 ∑德育
                    Case 15
                        .Col = 1
                        .Row = 1
                        Exit Sub        '全部输入完，退出过程
                    Case Else
                        .Col = .Col + 1   '到下一列
                End Select
            End If
        End If
        If frmMain.ActiveForm.mnuEditCheng.Checked Then   '按行输入
            If .Col <> 15 Then           '这一行没有输入完
                Select Case .Col
                    Case 9
                        .Col = .Col + 2   '跳过 ∑智育
                    Case 12
                        .Col = .Col + 2   '跳过 ∑德育
                    Case Else
                        .Col = .Col + 1   '到下一列
                End Select
            Else
                .Col = 2
                If .Row <> .Rows - 1 Then '如果没有到达最后一行
                    .Row = .Row + 1       '将行号加 1
                Else                    '如果到达了最后一行
                    .Col = 1
                    .Row = 1
                    Exit Sub            '退出过程
                End If
            End If
        End If
        End With
    End If

End Sub

Sub txtEdit_KeyDown(KeyCode As Integer, _
Shift As Integer)
    EditKeyCode ChengJB, txtedit, KeyCode, Shift
End Sub

Sub EditKeyCode(MSFlexGrid As Control, Edt As _
Control, KeyCode As Integer, Shift As Integer)

    '标准编辑控件处理。
    Select Case KeyCode

    Case 27 'ESC:隐藏焦点并将其返回 MSFlexGrid。
        Edt.Visible = False
        MSFlexGrid.SetFocus

    Case 13 'ENTER 将焦点返回 MSFlexGrid。
        MSFlexGrid.SetFocus

    Case 38     '向上。
        MSFlexGrid.SetFocus
        DoEvents
        If MSFlexGrid.Row > MSFlexGrid.FixedRows Then
            MSFlexGrid.Row = MSFlexGrid.Row - 1
        End If

    Case 40     '向下。
        MSFlexGrid.SetFocus
        DoEvents
        If MSFlexGrid.Row < MSFlexGrid.Rows - 1 Then
            MSFlexGrid.Row = MSFlexGrid.Row + 1
        End If
    End Select
End Sub
    
Sub ChengJB_GotFocus()
    Dim lsShu As Integer
    If mnuEditAuto.Checked Then
        mnuToolJisuan.Enabled = True
        mnuToolJisuan_Click
        mnuToolJisuan.Enabled = False
    End If
    If mnuEditAutoP.Checked Then
        mnuToolJiangT.Enabled = True
        mnuToolJiangT_Click
        mnuToolJiangT.Enabled = False
        lsShu = ChengJB.Col
        ChengJB.Col = 0
        ChengJB.Sort = 1
        ChengJB.Col = lsShu
    End If
    If txtedit.Visible = False Then Exit Sub
    ChengJB = txtedit
    txtedit.Visible = False
End Sub

Sub ChengJB_LeaveCell()
    If txtedit.Visible = False Then Exit Sub
    ChengJB = txtedit
    txtedit.Visible = False
End Sub
Private Sub mnuRecentFile_click(Index As Integer)
    '调用文件打开过程，传递一个对该窗体实例的引用
    OpenFile (mnuRecentFile(Index).Caption)
    '更新文件菜单
    GetRecentFiles
End Sub