frmstuplace.frm

基于vb的程序管理系统

   Unload frmStuIfm
    Call HeadList
End Sub
'加载列表头
Private Sub HeadList()
On Error GoTo mErr
    Dim mRstA As New ADODB.Recordset
    Dim mRstB As New ADODB.Recordset
    Dim i As Integer
    lsvStuPlace.ListItems.Clear
    With lsvStuPlace.ColumnHeaders
        .Add , , "学生学号", 1200
        .Add , , "学生姓名", 980
        .Add , , "班级", 980
        .Add , , "院系", 980
        mRstA.Open "SELECT DISTINCT 课程ID FROM tblScore", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
        i = 3
        Do Until mRstA.EOF
            mRstB.Open "SELECT 课程名称 FROM tblLesson WHERE 课程ID = " & CLng(mRstA("课程ID")), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
            .Add , , mRstB("课程名称"), 800
            .Item(i).Tag = mRstA("课程ID")
            i = i + 1
            mRstB.Close
            mRstA.MoveNext
        Loop
            .Add , , "总分", 800
            .Add , , "平均分", 800
            .Add , , "名次", 800
    End With
        lsvStuPlace.View = lvwReport
        mRstA.Close
        Set mRstA = Nothing
        Set mRstB = Nothing
    Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub

Private Sub tbrStuPlace_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "查找"
            
            SeltFrom = 3
            frmFindStu.Show 1
        Case "前十名"
          If seltfrom1 = 1 Then
            Call TopTen
          End If
        Case "后十名"
          If seltfrom1 = 1 Then
            Call BottomTen
          End If
        Case "全部显示"
          If seltfrom1 = 1 Then
            Call DispAll
          End If
        Case "排序"
          If seltfrom1 = 1 Then
            Call paixu
          End If
        Case "清空"
            Call ClearAll
        Case "退出"
            Unload Me
    End Select
End Sub
'从两个表中读取数据到列表中
Public Sub DataToList(ByVal mStr As String)
On Error GoTo mErr
    Dim mRstA As New ADODB.Recordset
    Dim mRstB As New ADODB.Recordset
    Dim mLItem As ListItem
    Dim StuP As Long
    Dim i As Long
    mRstA.Open mStr, mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    If mRstA.RecordCount <> 0 Then
        mRstB.Open "SELECT DISTINCT 学生ID FROM tblScore WHERE 学生ID = " & CLng(mRstA("学生ID")), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
        If mRstB.RecordCount <> 0 Then
            mRstB.Close
            Set mRstB = Nothing
            Do Until mRstA.EOF
                Set mLItem = lsvStuPlace.ListItems.Add(, , mRstA("学生学号"))
                With mLItem
                    .SubItems(1) = mRstA("学生姓名")
                    .Tag = mRstA("学生ID")
                    .SubItems(2) = mRstA("班级")
                    .SubItems(3) = mRstA("院系")
                    For i = 4 To lsvStuPlace.ColumnHeaders.Count - 6
                        mRstB.Open "SELECT * FROM tblScore WHERE 学生ID = " & CStr(mRstA("学生ID")) & " AND 课程ID =" & CLng(lsvStuPlace.ColumnHeaders(i + 1 - 2).Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
                        .SubItems(i) = mRstB("成绩")
                        mRstB.Close
                        
                        mRstB.Open "SELECT * FROM tblScore WHERE 学生ID = " & CStr(mRstA("学生ID")) & " AND 课程ID =" & CLng(lsvStuPlace.ColumnHeaders(i + 1).Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
                       .SubItems(i + 2) = mRstB("成绩")
                        mRstB.Close
                    Next i
                    mRstB.Open "SELECT SUM(成绩) AS sumzf FROM tblScore WHERE 学生ID = " & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
                    .SubItems(i + 2) = mRstB("sumzf").Value
                    .SubItems(i + 1 + 2) = Format(mRstB("sumzf").Value / (lsvStuPlace.ColumnHeaders.Count - 5), "##0.0")
                    mRstB.Close
                    StuP = 0
                    Call SortStuPlace(mRstA("学生ID"), StuP)
                    .SubItems(i + 2 + 2) = StuP
                End With
                mRstA.MoveNext
            Loop
            mRstA.Close
            Set mRstA = Nothing
        End If
    End If
    Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub
'分数排序
Private Sub SortStuPlace(SendID As Long, StuPlace As Long)
    Dim mRst As New ADODB.Recordset
    Dim Temp As Long
    Dim RecNum As Long
    Dim CountSame As Long
    mRst.Open "SELECT * FROM (SELECT 学生ID,SUM(成绩) AS 总分 FROM tblScore GROUP BY 学生ID) ORDER BY 总分 DESC", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Temp = -1
    CountSame = 0
    Do
        If mRst("总分") <> Temp Then
            If CountSame <> 0 Then
                StuPlace = StuPlace + CountSame
                CountSame = 0
            End If
            StuPlace = StuPlace + 1
            Temp = mRst("总分")
        Else
            CountSame = CountSame + 1
        End If
        RecNum = mRst("学生ID")
        mRst.MoveNext
    Loop Until RecNum = SendID
    mRst.Close
    Set mRst = Nothing
End Sub
'显示全部学生的成绩以及名次
Private Sub DispAll()
    Dim mRst As New ADODB.Recordset
    lsvStuPlace.ListItems.Clear
    mRst.Open "SELECT 学生ID ,总分 FROM (SELECT 学生ID,SUM(成绩) AS 总分 FROM tblScore GROUP BY 学生ID) ORDER BY 总分 DESC", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        DataToList "SELECT * FROM tblStudent WHERE 学生ID = " & CLng(mRst("学生ID"))
        mRst.MoveNext
    
    Loop
End Sub
'显示前十名学生的成绩以及名次
Private Sub TopTen()
    Dim mRst As New ADODB.Recordset
    lsvStuPlace.ListItems.Clear
    mRst.Open "SELECT TOP 10 学生ID ,总分 FROM (SELECT 学生ID,SUM(成绩) AS 总分 FROM tblScore GROUP BY 学生ID) ORDER BY 总分 DESC", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        DataToList "SELECT * FROM tblStudent WHERE 学生ID = " & CLng(mRst("学生ID"))
        mRst.MoveNext
    Loop
End Sub
'显示后十名学生的成绩以及名次
Private Sub BottomTen()
    Dim mRst As New ADODB.Recordset
    lsvStuPlace.ListItems.Clear
    mRst.Open "SELECT * FROM (SELECT TOP 10 学生ID ,总分 FROM (SELECT 学生ID,SUM(成绩) AS 总分 FROM tblScore GROUP BY 学生ID) ORDER BY 总分 ASC) ORDER BY 总分 DESC", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        DataToList "SELECT * FROM tblStudent WHERE 学生ID = " & CLng(mRst("学生ID"))
        mRst.MoveNext
    Loop
End Sub
Private Sub paixu()
    Dim mRst As New ADODB.Recordset
    lsvStuPlace.ListItems.Clear
    mRst.Open "SELECT TOP 50 学生ID ,总分 FROM (SELECT 学生ID,SUM(成绩) AS 总分 FROM tblScore GROUP BY 学生ID) ORDER BY 总分 DESC", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        DataToList "SELECT * FROM tblStudent WHERE 学生ID = " & CLng(mRst("学生ID"))
        mRst.MoveNext
    Loop
End Sub

Private Sub ClearAll()
    lsvStuPlace.ListItems.Clear
End Sub

Private Sub Form_Resize()
    If frmStuPlace.WindowState <> 1 Then
        lsvStuPlace.Move lsvStuPlace.Left, lsvStuPlace.Top, Me.ScaleWidth - lsvStuPlace.Left - 100, Me.ScaleHeight - lsvStuPlace.Top - 100
    End If
End Sub