frmstat.frm

一个比较适合做毕业设计的程序

Private Sub Command4_Click()
If Combo3.ListIndex > -1 Then
        Call stat3(Combo3.Text)
End If
End Sub

'Private Sub Command5_Click()
   ' If List1.ListIndex > -1 Then
      '  DlgPass.addnewstate = False
      '  DlgPass.Label1.Caption = "旧密码："
       ' Text1.PasswordChar = "*"
       ' DlgPass.Label2.Caption = "新密码："
      '  DlgPass.Label3.Caption = "验证："
      '  DlgPass.Show 1
   'End If
'End Sub

'Private Sub Command6_Click()
  '  DlgPass.addnewstate = True
  'DlgPass.Label1.Caption = "用户名："
  '  Text1.PasswordChar = ""
   ' DlgPass.Label2.Caption = "密码："
   ' DlgPass.Label3.Caption = "验证："
   'DlgPass.Show 1
    'If DlgPass.upok = True Then
          '  Freshlist
   ' End If
'nd Sub

'Private Sub Command7_Click()
'On Error GoTo errh:
    'If List1.ListIndex > -1 Then
        'If MsgBox("", vbOKCancel, "警告") = vbOK Then
            'Dim rs As New ADODB.Recordset
           ' Set rs = cn.Execute("SELECT * FROM 超级用户 WHERE UserName=" & "'" & List1.List(List1.ListIndex) & "'")
            'If rs.EOF Then
              '  rs.Close
              '  Exit Sub
           ' End If
           ' rs.Delete
           ' rs.UpdateBatch
           ' rs.Close
        'End If
   'End If
    'Exit Sub
'    MsgBox Err.Description
' Sub

'Private Sub Form_Load()
  '  MakeCenter Me
   ' If IsAdmin = True Then
       ' Command7.Enabled = True
  '  Else
       ' Command7.Enabled = False
 '   End If
    'SSTab1.Tab = 0
  'GetClass True, Combo1
'End Sub

Private Sub Freshlist()
On Error GoTo errh:
    List1.Clear
    Dim rs As New ADODB.Recordset
    Set rs = cn.Execute("SELECT UserName FROM 超级用户")
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    rs.MoveFirst
    Do
        List1.AddItem rs.Fields("UserName").Value
        rs.MoveNext
    Loop Until rs.EOF
    rs.Close
    Exit Sub
errh:
    rs.Close
    MsgBox Err.Description
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
On Error GoTo errh:
    Select Case SSTab1.Tab
    Case 0
        If Combo1.ListCount < 1 Then
            GetClass True, Combo1
        End If
    Case 1
        If Combo2.ListCount < 1 Then
            GetClass False, Combo2
        End If
    Case 2
        If Combo3.ListCount < 1 Then
        GetClass True, Combo3
        End If
    Case 3
        If List1.ListCount < 1 Then
            Freshlist
        End If
    End Select
    Exit Sub
errh:
    MsgBox Err.Description
End Sub

Private Sub GetClass(flag As Boolean, combo As ComboBox)
On Error GoTo errh:
    Combo1.Clear
    Dim s As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Set rs = cn.Execute("SELECT 学号 FROM 学生 ORDER BY 学号 ASC")
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    rs.MoveFirst
    Dim i As Integer
    If flag Then
        i = 6
    Else
        i = 8
    End If
    combo.AddItem Left$(rs.Fields(0).Value, i)
    Do
        s = Left$(rs.Fields(0).Value, i)
        If s <> combo.List(combo.ListCount - 1) Then
            combo.AddItem s
        End If
        rs.MoveNext
    Loop Until rs.EOF
    combo.Text = "请选择"
    rs.Close
Exit Sub
errh:
    rs.Close
    MsgBox Err.Description
End Sub

Private Sub Stat(classID As String) '统计某班级学生的总分和平均分
On Error GoTo errh
    Text1.Text = Text1.Text & vbCrLf & "***********************"
    Text1.Text = Text1.Text & vbCrLf & Combo1.Text
    Dim q As String
    q = "SELECT [课程].[课程ID], [学生和课程].[成绩], [课程].[课程名称] From 学生, 课程, 学生和课程 WHERE [学生].[学号] Like" & "'" & classID & "##' And [学生].[学生ID]=[学生和课程].[学生ID] And [学生和课程].[课程ID]=[课程].[课程ID] ORDER BY [课程].[课程ID]"
    Dim rs As New ADODB.Recordset
    Set rs = cn.Execute(q)
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    rs.MoveFirst
    Dim sum As Variant
    Dim stdnum As Integer
    Dim cid As Integer
    Dim cname As String
    sum = 0
    classID = -1
    Do While Not rs.EOF
        If cid <> rs.Fields(0).Value Then
            If sum > 0 And stdnum > 0 Then
                Text1.Text = Text1.Text & vbCrLf & cname & vbCrLf & "      总分为：" & Str(sum) & vbCrLf & "       平均分为: " & Str(sum / stdnum)
            End If
            sum = 0
            stdnum = 0
            cid = rs.Fields(0).Value
        End If
        sum = sum + rs.Fields(1).Value
        stdnum = stdnum + 1
        cname = rs.Fields(2)
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
Exit Sub
errh:
    MsgBox Err.Description
End Sub

Private Sub stat2(stdID As String) '统计某个学生的平均分和总分
On Error GoTo errh
    Text2.Text = Text2.Text & vbCrLf & "***********************" & vbCrLf & "学号：" & Combo2.Text
    Text2.Text = Text2.Text & vbCrLf & "课程列表："
    Dim q As String
    q = "SELECT 学生和课程.学生课程ID,课程.课程ID,课程.课程名称,学生和课程.成绩 FROM 学生,学生和课程,课程 WHERE 学生.学号=" & "'" & stdID & "'" & "AND 学生和课程.学生ID=学生.学生ID AND 课程.课程ID=学生和课程.课程ID"
    Dim rs As New ADODB.Recordset
    Set rs = cn.Execute(q)
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    rs.MoveFirst
    Dim sum As Variant
    Dim sn As Integer
    sum = 0
    sn = 0
    Do While Not rs.EOF
        sum = sum + rs.Fields(3).Value
        sn = sn + 1
        Text2.Text = Text2.Text & vbCrLf & rs.Fields(2)
        rs.MoveNext
    Loop
    rs.Close
    If sn > 0 Then
        Text2.Text = Text2.Text & vbCrLf & "该生总分为：" & Str(sum) & vbCrLf & "平均分为: " & Str(sum / sn)
    Else
        Text2.Text = Text2.Text & vbCrLf & "没有成绩"
    End If
    Set rs = Nothing
Exit Sub
errh:
    MsgBox Err.Description
End Sub

Private Sub stat3(classID) '统计某班不及格的学生
On Error GoTo errh
    On Error GoTo errh
    Text3.Text = Text3.Text & vbCrLf & "***********************"
    Text3.Text = Text3.Text & vbCrLf & Combo3.Text
    Dim q As String
    q = "SELECT [课程].[课程ID], [学生和课程].[成绩], [课程].[课程名称],[学生].[名字] From 学生, 课程, 学生和课程 WHERE [学生].[学号] Like" & "'" & classID & "##' And [学生].[学生ID]=[学生和课程].[学生ID] And [学生和课程].[课程ID]=[课程].[课程ID] ORDER BY [课程].[课程ID]"
    Dim rs As New ADODB.Recordset
    Set rs = cn.Execute(q)
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    rs.MoveFirst
        Do While Not rs.EOF
        If rs.Fields(1).Value < 60 Then
            Text3.Text = Text3.Text & vbCrLf & rs.Fields(3).Value & Space(5) & rs.Fields(2) & Space(5) & rs.Fields(1)
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Exit Sub
errh:
    MsgBox Err.Description
End Sub