Файл: Отображать номера групп в порядке убывания средней успеваемости их студентов - VB

Private Type Student    ' 72 байта
    FIO As String * 32
    Group As String * 8
    Faculty As String * 16
    Year As Long
    Score1 As Long
    Score2 As Long
    Score3 As Long
End Type
Private Type GroupReport
    Group As String
    Score As Double
    Total As Long
End Type
Dim Students() As Student, Init As Boolean
 
Private Function LoadData() As Boolean
    Dim fNum As Integer, I As Long
    On Error GoTo ErrorLoading
    fNum = FreeFile
    Open App.Path & "\Data.rdm" For Random As fNum Len = 72
    I = LOF(fNum) \ 72
    If I = 0 Then Close fNum: Exit Function
    ReDim Students(I - 1): Init = True
    I = 0
    For I = 0 To UBound(Students)
        Get fNum, , Students(I)
    Next
    Close fNum
    LoadData = True
    Exit Function
ErrorLoading:
    MsgBox "Ошибка", vbCritical
End Function
Private Sub StoreData()
    Dim fNum As Integer, I As Long
    On Error GoTo ErrorStore
    fNum = FreeFile
    If Not Dir$(App.Path & "\Data.rdm") = vbNullString Then Kill (App.Path & "\Data.rdm")
    If Not Init Then Exit Sub
    Open App.Path & "\Data.rdm" For Random As fNum Len = 72
    I = 0
    Do Until I > UBound(Students)
        Put fNum, , Students(I)
        I = I + 1
    Loop
    Close fNum
    Exit Sub
ErrorStore:
    MsgBox "Ошибка", vbCritical
End Sub
Private Sub RefreshList()
    Dim I As Long
    If Not Init Then Exit Sub
    lvwList.ListItems.Clear
    For I = 0 To UBound(Students)
        With lvwList.ListItems.Add(, , I + 1)
            .SubItems(1) = RTrim(Students(I).FIO)
            .SubItems(2) = RTrim(Students(I).Group)
            .SubItems(3) = RTrim(Students(I).Faculty)
        End With
    Next
End Sub
Private Sub cmdAdd_Click()
    Dim Index As Long
    If Not Init Then Index = 0: Init = True Else Index = UBound(Students) + 1
    ReDim Preserve Students(Index)
    Students(Index).FIO = txtFIO
    Students(Index).Group = txtGroup
    Students(Index).Faculty = txtFaculty
    Students(Index).Year = txtYear
    Students(Index).Score1 = txtScore(0)
    Students(Index).Score2 = txtScore(1)
    Students(Index).Score3 = txtScore(2)
    StoreData
    RefreshList
End Sub
 
Private Sub cmdBests_Click()
    Dim G As String, I As Long, R As String, T As Long
    If Not Init Then Exit Sub
    G = InputBox("Введите группу")
    If Len(G) = 0 Then Exit Sub
    For I = 0 To UBound(Students)
        If StrComp(Trim$(Students(I).Group), G, vbTextCompare) = 0 And _
           Students(I).Score1 >= 5 And Students(I).Score2 >= 5 And _
           Students(I).Score3 >= 5 Then
            R = R & RTrim$(Students(I).FIO) & " (" & RTrim$(Students(I).Faculty) & ")" & vbNewLine
            T = T + 1
        End If
    Next
    MsgBox "Отличники в группе " & G & " " & T & " человек" & vbNewLine & R
End Sub
 
Private Sub cmdGroup_Click()
    Dim Rep() As GroupReport, rInit As Boolean
    Dim I As Long
    If Not Init Then Exit Sub
    For I = 0 To UBound(Students)
        AddToGroup Rep, Students(I), rInit
    Next
    For I = 0 To UBound(Rep)
        Rep(I).Score = Rep(I).Score / Rep(I).Total / 3
    Next
    qSort Rep, 0, UBound(Rep)
    Load dlgReport
    For I = 0 To UBound(Rep)
        With dlgReport.lvlReport.ListItems.Add(, , I + 1)
            .SubItems(1) = Rep(I).Group
            .SubItems(2) = Round(Rep(I).Score, 3)
        End With
    Next
    dlgReport.Show 1
End Sub
Private Sub AddToGroup(Rep() As GroupReport, Value As Student, Optional ByRef rInit As Boolean)
    Dim I As Long, Z As Long
    If rInit Then
        I = GetGroup(Rep, Value.Group)
        If I = -1 Then
            I = UBound(Rep) + 1
            ReDim Preserve Rep(I)
            Rep(I).Group = Value.Group
        End If
        Rep(I).Total = Rep(I).Total + 1
        Rep(I).Score = Rep(I).Score + Value.Score1 + Value.Score2 + Value.Score3
    Else
        ReDim Rep(0)
        Rep(0).Group = Value.Group
        Rep(0).Score = Value.Score1 + Value.Score2 + Value.Score3
        Rep(0).Total = 1
        rInit = True
    End If
End Sub
Private Function GetGroup(Rep() As GroupReport, Name As String) As Long
    Dim I As Long
    GetGroup = -1
    For I = 0 To UBound(Rep)
        If StrComp(RTrim(Name), RTrim(Rep(I).Group), vbTextCompare) = 0 Then GetGroup = I
    Next
End Function
Private Sub qSort(Ar() As GroupReport, ByVal low As Long, ByVal high As Long)
    Dim I As Long, j As Long, m As Single, wsp As GroupReport
    I = low: j = high: m = Ar(CInt((I + j) / 2)).Score
    Do Until I > j: Do While Ar(I).Score > m: I = I + 1: Loop: Do While Ar(j).Score < m: j = j - 1: Loop
        If (I <= j) Then wsp = Ar(I): Ar(I) = Ar(j): Ar(j) = wsp: I = I + 1: j = j - 1
    Loop
    If low < j Then qSort Ar, low, j
    If I < high Then qSort Ar, I, high
End Sub
Private Sub Form_Load()
    LoadData
    RefreshList
End Sub
Private Sub lvwList_Click()
    If lvwList.SelectedItem Is Nothing Then Exit Sub
    txtFIO = RTrim$(Students(lvwList.SelectedItem.Index - 1).FIO)
    txtGroup = RTrim$(Students(lvwList.SelectedItem.Index - 1).Group)
    txtFaculty = RTrim$(Students(lvwList.SelectedItem.Index - 1).Faculty)
    txtYear = Students(lvwList.SelectedItem.Index - 1).Year
    txtScore(0) = Students(lvwList.SelectedItem.Index - 1).Score1
    txtScore(1) = Students(lvwList.SelectedItem.Index - 1).Score2
    txtScore(2) = Students(lvwList.SelectedItem.Index - 1).Score3
End Sub