modmain.bas

教务处成绩统计系统

Attribute VB_Name = "modMain"
Option Explicit

Public ArrSubLines1(10) As Integer, ArrSubLines2(10) As Integer, ArrSubLines3(10) As Integer
Public ArrClassPops(20) As Integer
Public ArrClassSubUp1(20, 10) As Long, ArrClassSubUp2(20, 10) As Long, ArrClassSubUp3(20, 10) As Long '从0开始存放数据
Public strSQL As String

Public db As Database
Public td As TableDef
Public rs As DAO.Recordset   'Pay attention here

'以上为变量声明内容================================================================================

Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'以上为modMove内容================================================================================

Public Sub CreateReportDB()
Dim ifields As Integer, iSubjects As Integer, iClasses As Integer, iSub As Integer
Dim fl As Object

'Var Define------------------------------------------------------------------
Set db = CreateDatabase(App.Path & "\Report.tmp", dbLangChineseSimplified, dbVersion40)
Set td = db.CreateTableDef("成绩统计结果")
'Create Database and tables--------------------------------------------------

Set fl = td.CreateField("班级", dbText)
    td.Fields.Append fl
Set fl = td.CreateField("总人数", dbInteger)
    td.Fields.Append fl
'----------------------画字段-------------------------------------
With main_frm.Combo
    For iSubjects = 1 To .ListCount
        Set fl = td.CreateField(.List(iSubjects - 1) & "重高", dbInteger)
            td.Fields.Append fl
        Set fl = td.CreateField(.List(iSubjects - 1) & "联招", dbInteger)
            td.Fields.Append fl
        Set fl = td.CreateField(.List(iSubjects - 1) & "普高", dbInteger)
            td.Fields.Append fl
    Next iSubjects
End With

db.TableDefs.Append td
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
With Input_frm
    .CmdCancel.Visible = False
    .CmdOK.Visible = False
    
    .TextLine(1).Visible = False
    .TextLine(2).Visible = False
    .TextLine(3).Visible = False
    
    .LabSub(1).Visible = False
    .LabSub(3).Visible = False
    
    .PBar.Visible = True
    .PBar.Max = 3 * main_frm.LVClass.ListItems.Count
    .LabSub(2).Caption = "正在统计成绩……"
End With

With main_frm.Adodc1
    .RecordSource = "select * from 1"
    .Refresh
    ArrClassPops(0) = .Recordset.RecordCount
    
    Input_frm.PBar.Value = 2
    
    For iClasses = 1 To main_frm.LVClass.ListItems.Count - 1                    'Count the total populars
        
        .RecordSource = "select * from 1 where 班级=" & CStr(iClasses)  'for each class and the grade
        .Refresh
        
        ArrClassPops(iClasses) = .Recordset.RecordCount
        For iSub = 0 To main_frm.Combo.ListCount - 1
            '------------------------重高-----------------------------------------
            .RecordSource = "select * from 1 where 班级=" & CStr(iClasses) & " and " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines1(iSub))
            .Refresh   '各班
            ArrClassSubUp1(iClasses, iSub) = .Recordset.RecordCount
            
            .RecordSource = "select * from 1 where " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines1(iSub))
            .Refresh   '全年级
            ArrClassSubUp1(0, iSub) = .Recordset.RecordCount
            '------------------------联招-----------------------------------------
            .RecordSource = "select * from 1 where 班级=" & CStr(iClasses) & " and " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines2(iSub))
            .Refresh   '各班
            ArrClassSubUp2(iClasses, iSub) = .Recordset.RecordCount
            
            .RecordSource = "select * from 1 where " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines2(iSub))
            .Refresh   '全年级
            ArrClassSubUp2(0, iSub) = .Recordset.RecordCount
            '------------------------普高-----------------------------------------
            .RecordSource = "select * from 1 where 班级=" & CStr(iClasses) & " and " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines3(iSub))
            .Refresh   '各班
            ArrClassSubUp3(iClasses, iSub) = .Recordset.RecordCount
            
            .RecordSource = "select * from 1 where " & main_frm.Combo.List(iSub) & ">=" & CStr(ArrSubLines3(iSub))
            .Refresh   '全年级
            ArrClassSubUp3(0, iSub) = .Recordset.RecordCount
        Next iSub
        
        Input_frm.PBar.Value = 2 * iClasses + 2
    Next iClasses
    
End With
'----------------------------------------------

Set rs = db.OpenRecordset("成绩统计结果", dbOpenTable)

With main_frm
For iClasses = 1 To .LVClass.ListItems.Count    'Fill the first field--"范围"
    rs.AddNew
    rs("班级") = .LVClass.ListItems.Item(iClasses).Text
    rs("总人数") = ArrClassPops(iClasses - 1)
    For iSub = 0 To .Combo.ListCount - 1
        rs(.Combo.List(iSub) & "重高") = ArrClassSubUp1(iClasses - 1, iSub)
        rs(.Combo.List(iSub) & "联招") = ArrClassSubUp2(iClasses - 1, iSub)
        rs(.Combo.List(iSub) & "普高") = ArrClassSubUp3(iClasses - 1, iSub)
    Next iSub
    rs.Update
    
    Input_frm.PBar.Value = 2 * .LVClass.ListItems.Count + iClasses
Next iClasses

.Adodc1.RecordSource = strSQL
.Adodc1.Refresh
End With

Exit Sub
Set fl = Nothing
'Fill the records---------------------------------------------------------------
End Sub

Public Sub CloseReportDB()
db.Close
Set db = Nothing

End Sub

Public Sub DeleteReportDB()
Kill (App.Path & "\Report.tmp")
End Sub

'以上为modMain内容================================================================================