frmstat.frm

来自「管理信息系统my sql++ visual bassic」· FRM 代码 · 共 528 行 · 第 1/2 页

    Unload Me
End Sub

Private Sub Command2_Click()
    If Combo1.ListIndex > -1 Then
        Call Stat(Combo1.Text)
    End If
End Sub

Private Sub Command3_Click()
If Combo2.ListIndex > -1 Then
        Call stat2(Combo2.Text)
End If
End Sub

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
End 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
            Freshlist
        End If
    End If
    Exit Sub
errh:
    MsgBox Err.Description
End 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