PROGRAM PRIM2;
USES CRT;
TYPE
STR=RECORD
FAM: STRING [30];
B1,B2,B3,B4,B5: 2..5;
SB: REAL
END;
VAR
TBL: ARRAY [1..25] OF STR;
Y:STR;
I,J,K,M:INTEGER;
X,R:REAL;
PR:BYTE;
BEGIN
CLRSCR;
REPEAT
WRITELN ('Введите число студентов');
READLN (M);
FOR I:= 1 TO M DO
WITH TBL[I] DO
BEGIN
WRITELN('Введите фамилию');
READLN (FAM);
WRITELN('Введите пять оценок студента');
READLN (B1,B2,B3,B4,B5);
END;
FOR I:= 1 TO M DO
WITH TBL[I] DO
SB:= (B1+B2+B3+B4+B5)/5;
FOR I:= 1 TO M DO
BEGIN
K:=1;
X:=TBL[I].SB;
FOR J:=I TO M DO
IF TBL[J].SB >=X THEN
BEGIN
K:=J;
X:=TBL[J].SB;
Y:=TBL[K];
TBL[K]:=TBL[I];
TBL[I]:=Y
END;
END;
WRITELN ('Список студентов');
FOR I:=1 TO M DO
WITH TBL[I] DO
WRITELN (FAM, SB:4:2);
WRITELN ('Обработать еще один список? 1-да 0-нет');
READLN(PR);
UNTIL PR=0
END.

type
  TStudent = record
    LastName: string;
    ITIN: string;
    ITINDate: TDate;
    Birthday: TDate;
    EnterDate: integer;
    Cource: integer;
    Group: integer;
    SemesterNumber: integer;
    Marks: array of integer; // оценки за последнюю сессию
    AverageMark: double;
  end; // TSudent


var
  Students: Array of TStudent;

procedure AddMark(M: integer; Number: integer);
var
  tmp: integer;
begin
  if (M in [2..5]) then
    begin
      tmp := Length(Students[Number].Marks);
      SetLength(Students[Number].Marks, tmp + 1);
      Students[Number].Marks[tmp] := M;
    end;
end;

procedure AddStudent(pLastName: string; pITIN: string; pITINDate, pBirthDay: TDate;
                      pEnterDate, pCource, pGroup, pSemesterNumber: integer;
                      M1: integer = 0; M2: integer = 0; M3: integer = 0;
                      M4: integer = 0; M5: integer = 0);
var
  tmp, stmp: integer;
  i: integer;
begin
  tmp := length(Students);
  SetLength(Students, tmp + 1);

  with Students[tmp] do
    begin
      LastName := pLastName;
      ITIN := pITIN;
      ITINDate := pITINDate;
      Birthday := pBirthDay;
      EnterDate := pEnterDate;
      Cource := pCource;
      Group := pGroup;
      SemesterNumber := pSemesterNumber;

      AddMark(M1, tmp);
      AddMark(M2, tmp);
      AddMark(M3, tmp);
      AddMark(M4, tmp);
      AddMark(M5, tmp);

      stmp := length(Marks);
      AverageMark := 0;
      if (stmp <> 0) then
        for i := 0 to stmp - 1 do
          AverageMark := AverageMark + Marks[i]/stmp;
    end;  // with
end;

procedure QSort(Left, Right: integer);
// Left, Right - границы сортируемой области
var
  i, j: integer;
  x: double;
  tmp: TStudent;
begin
  i := Left;
  j := Right;

  // в качестве опорного элемента выбираем медиану сортируемой области
  x := Students[(Left + Right) div 2].AverageMark;
  repeat
    while x > Students[i].AverageMark do
      inc(i);

    while x < Students[j].AverageMark do
      dec(j);

    if i <= j then
      begin
        tmp := Students[i];
        Students[i] := Students[j];
        Students[j] := tmp;
        inc(i);
        dec(j);
      end;
  until i>j;

  if i < Right then QSort(i, Right);
  if j > Left  then QSort(Left, j);
end;

procedure TForm1.ButtonAddClick(Sender: TObject);
begin
  AddStudent(edName.text, edITIN.text, DateTimePickerITIN.Date, DateTimePickerBithday.Date,
              StrToInt(edYear.text), StrToInt(edCource.text), StrToInt(edGroup.text), 
             StrToInt(edSNumber.text), StrToInt(edM1.text), StrToInt(edM2.text), StrToInt(edM3.text), 
             StrToInt(edM4.text), StrToInt(edM5.text));
end;

procedure TForm1.ButtonAddClick(Sender: TObject);
begin
  QSort(0, length(Students)-1);
end;

...
var
  choise: char;
begin
  repeat
    { Ввод всех данных о студенте }
    { фактически содержимое процедуры AddStudent }
    
     запрос на продолжение или прекращение ввода типа "y/n" после i-той операции ввода данных
  
  until choise = 'y';

  { Содержимое процедуры QSort }

  { вывод результата }

end.