frmedit.frm

大型商业学分统计系统原代码说明 1.如果在向导设置班级数为8时,此数值为班级总数

Dim GYXEOV As Integer '取出总班级数
Private Sub Combo1_Click()
    On Error Resume Next
    Data1.DatabaseName = MAIN.Cmd1.filename
    Data1.RecordSource = XS & " WHERE 班级=" & Combo1.Text & "" & " ORDER BY " & "" & Combo2.Text & ""
    Data1.Refresh
    Dim III As Long
    For III = 1 To NUM
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next
End Sub
Private Sub Combo2_Click()
    On Error Resume Next
    Data1.DatabaseName = MAIN.Cmd1.filename
    Data1.RecordSource = XS & " WHERE 班级=" & Combo1.Text & "" & " ORDER BY " & "" & Combo2.Text & ""
    Data1.Refresh
    Dim III As Long
    For III = 1 To NUM
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next
End Sub
Private Sub Command1_Click()
    On Error Resume Next
    Data1.DatabaseName = MAIN.Cmd1.filename
    Data1.RecordSource = XS & " ORDER BY " & "" & Combo2.Text & ""
    Data1.Refresh
    Dim III As Long
    For III = 1 To NUM
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next
    Call Command4_Click
End Sub
Private Sub Command2_Click()
    On Error Resume Next
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    STR = "INSERT INTO 学生 (ID) VALUES ('" & 1 & "')"
    db.Execute STR
    db.Close               '自动生成十行空数据
    Data1.DatabaseName = MAIN.Cmd1.filename
    Data1.RecordSource = XS
    Data1.Refresh
    '############################################################################
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("学生")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext                     '得到数据库中的总数目
    Loop
    '############################################################################
    Dim III As Long
    For III = 1 To NUM + 10
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next                          '在表格左列显示数据总数目
    '############################################################################
End Sub
Private Sub Command3_Click()
    On Error Resume Next
    Dim 科目  As String
    Dim a
    科目 = InputBox("请输入学生姓名：", "数据搜索")
    If 科目 = "" Then
        Exit Sub
    Else
        Data1.DatabaseName = MAIN.Cmd1.filename
        Data1.RecordSource = XS & " WHERE 姓名='" & 科目 & "'"
        Data1.Refresh
    End If
End Sub
Private Sub Command4_Click()
    On Error Resume Next
    Dim QQ As Long
    For QQ = 0 To VSFlexGrid1.Cols
        VSFlexGrid1.ColAlignment(QQ) = flexAlignCenterCenter
        ' VSFlexGrid1.CellAlignment = flexAlignCenterCenter
    Next QQ
End Sub
Private Sub Command5_Click()
    On Error GoTo deldata
    MsgBox "请您删除记录前，选对要删除的对象，否则数据库可能被您意处删除其它数据！！！", vbOKOnly, "警告！"
    Select Case MsgBox("是否真的删除记录吗？", vbOKCancel, "警告！")
        Case vbOK
            Data1.Recordset.Delete
            Data1.Recordset.MoveNext
            If Data1.Recordset.EOF = True Then
                Data1.Recordset.MovePrevious
            End If
            Data1.Refresh
        Case Else
            Cancel = True
    End Select
deldata:
    Select Case Err.Number
        Case 3021
            MsgBox "没有找到要删除的对象！", 32, "提示"
    End Select
End Sub
Private Sub Command6_Click()
    On Error Resume Next
    Select Case MsgBox("是否真的退出程序吗？", vbOKCancel, "提示！")
        Case vbOK
            Set db = OpenDatabase(MAIN.Cmd1.filename)
            STR = "DELETE * from 学生 where 班级=0"
            db.Execute STR
            db.Close
            MsgBox "如果数据被修改,请在报表输出前重新载入一次此数据", 32, "警告!!!"
            Unload Me
        Case Else
            Cancel = True
    End Select
End Sub
Private Sub Form_Activate()
    On Error GoTo 32755
    MAIN.Enabled = False
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='输入显示'")
    XS = rs![代码]
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("SELECT * FROM 年级")
    GYXEOV = rs![班级数]
    '以下代码将取出COM中的输入显示中的代码信息,供下表格输入
    Data1.DatabaseName = MAIN.Cmd1.filename
    Data1.RecordSource = XS
    Data1.Refresh
    Combo1.Clear
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("班级")
    rs.MoveLast
    intRecCount = rs.RecordCount
    rs.MoveFirst
    For intCounter = 1 To intRecCount
        Combo1.AddItem rs![班级]
        rs.MoveNext
    Next intCounter
    Combo1.ListIndex = 0
    '载入班级数目
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("科目")
    rs.MoveLast
    intRecCount = rs.RecordCount
    rs.MoveFirst
    For intCounter = 1 To intRecCount
        Combo2.AddItem rs![科目]
        rs.MoveNext
    Next intCounter
    Combo2.ListIndex = 1
    Set db = OpenDatabase(MAIN.Cmd1.filename)
    Set rs = db.OpenRecordset("学生")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext                     '得到数据库中的总数目
    Loop
    Call Command1_Click
32755:
    Select Case Err.Number
        Case 3343
            MsgBox "无法识别的NHB数据文件,或者该文件已损坏", 64, "无法载入"
            Unload Me
        Case 3061
            MsgBox "此数据被破坏,请使用数据恢复来修复此数据库", 32, "无法载入"
            Unload Me
        Case 3078
            MsgBox "此数据格式不对或被破坏", 32, "无法载入"
            Unload Me
    End Select
End Sub
Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    Skin1.LoadSkin App.Path & "\SKIN\3.sk"
    Skin1.ApplySkin Me.hwnd
    Me.Caption = MAIN.Cmd1.filename
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Resize()
    On Error Resume Next
    VSFlexGrid1.Height = Me.Height - Toolbar1.Height - 740
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    
     Select Case MsgBox("是否真的退出程序吗？", vbOKCancel, "提示！")
        Case vbOK
            Set db = OpenDatabase(MAIN.Cmd1.filename)
            STR = "DELETE * from 学生 where 班级=0"
            db.Execute STR
            db.Close
            MsgBox "如果数据被修改,请在报表输出前重新载入一次此数据", 32, "警告!!!"
            Unload Me
        Case Else
            Cancel = True
    End Select
    
    
    MAIN.Enabled = True
    Dim ws As Workspace
'    Dim db As Database
    Dim rs As Recordset
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
End Sub
Private Sub VSFlexGrid1_BeforeRowColChange(ByVal OldRow As Long, ByVal OldCol As Long, ByVal NewRow As Long, ByVal NewCol As Long, Cancel As Boolean)
    On Error Resume Next
    If VSFlexGrid1.Col = 2 Then '固定检查第三列数据
        If Val(VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 2)) > GYXEOV Then
            MsgBox "输入班级数不能大于 " & GYXEOV & "", 32, "无法保存"
'            VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 2) = ""

        End If
    End If             '班级输入限制
    '##########################################################3
    If VSFlexGrid1.Col > 4 Then
        If Val(VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), VSFlexGrid1.Col)) > iawv Then
            MsgBox " " & Text1.Text & " 输入分数不能大于 " & iawv & " ", 32, "无法保存"
'            VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), VSFlexGrid1.Col) = ""
        End If
    End If                '对科目输入分数检测是否合法
    '##########################################################3
End Sub
Private Sub VSFlexGrid1_Click()
    On Error Resume Next
    Data1.Recordset.AbsolutePosition = VSFlexGrid1.Row - 1
    '点击表格时，同时将DATA1的数据同步显示，确保准确删除数据
End Sub
Private Sub VSFlexGrid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
    On Error Resume Next
    If VSFlexGrid1.Col = 2 Or VSFlexGrid1.Col > 4 Then
        Select Case KeyAscii
            Case 48 To 57, 8
            Case 46
                If InStr(VSFlexGrid1.TextMatrix(VSFlexGrid1.Row, VSFlexGrid1.Col), ".") <> 0 Then
                    KeyAscii = 0
                End If
            Case Else
                KeyAscii = 0
        End Select
    End If
End Sub
Private Sub VSFlexGrid1_RowColChange()
    On Error Resume Next
    If VSFlexGrid1.Col > 4 Then
        Text1.Text = VSFlexGrid1.TextMatrix(0, VSFlexGrid1.Col)
        Set db = OpenDatabase(App.Path & "\SET.PAS")
        Set rs = db.OpenRecordset("SELECT * FROM 科目 WHERE 科目='" & Text1.Text & "'")
        iawv = rs![卷面满分]
        Text2.Text = iawv
    Else
        Text1.Text = ""
        Text2.Text = ""
    End If
End Sub