📄 frmstuplace.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmStuPlace
Caption = "学生名次"
ClientHeight = 5070
ClientLeft = 1980
ClientTop = 1995
ClientWidth = 7245
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmStuPlace.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 5070
ScaleWidth = 7245
WindowState = 2 'Maximized
Begin MSComctlLib.ImageList imlStuPlace
Left = 8520
Top = 360
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":0442
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":22C4
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":2B9E
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":3478
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":38CA
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmStuPlace.frx":55D4
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar tbrStuPlace
Align = 1 'Align Top
Height = 795
Left = 0
TabIndex = 0
Top = 0
Width = 7245
_ExtentX = 12779
_ExtentY = 1402
ButtonWidth = 1455
ButtonHeight = 1349
Appearance = 1
Style = 1
ImageList = "imlStuPlace"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 6
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查找"
Key = "查找"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "前十名"
Key = "前十名"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "后十名"
Key = "后十名"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "全部显示"
Key = "全部显示"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "清空"
Key = "清空"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "退出"
ImageIndex = 6
EndProperty
EndProperty
BorderStyle = 1
End
Begin MSComctlLib.ListView lsvStuPlace
Height = 4000
Left = 120
TabIndex = 1
Top = 960
Width = 7000
_ExtentX = 12356
_ExtentY = 7064
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
End
Attribute VB_Name = "frmStuPlace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'加载列表头并初始化学生名次
Private Sub Form_Load()
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 "前十名"
Call TopTen
Case "后十名"
Call BottomTen
Case "全部显示"
Call DispAll
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 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -