Программа


USES CRT;  { Подключение модуля CRT }
CONST FileName='SCHOOL';   { Имя файла с данными }
      QuantityMarks=5;     { Количество оценок }
TYPE Pupil=record { Тип "Ученик" для файла и буферных переменных }
             FamilyName:string[10];
             Name:String[10];
             Form:record
                    Year:byte;
                    Letter:char;
                  end;
             Marks:array [1..QuantityMarks] of byte;
           end;
     ListPupil=^PupilType; { Список учеников }
     PupilType=record { Тип "Ученик" }
                 FamilyName:string[10];
                 Name:String[10];
                 Form:record
                        Year:byte;
                        Letter:char;
                      end;
                 Marks:array [1..QuantityMarks] of byte;
                 Next:ListPupil
               end;
    FileOfPupil=file of Pupil; { Файл учеников }
VAR F:FileOfPupil; { Файл учеников }
    School:ListPupil;    { Список учеников }
PROCEDURE ReadFile(var F:FileOfPupil;var School:ListPupil);
                              { Процедура чтения файла и формирования списка }
  Var PupilBuf:Pupil; { Буфер для чтения записи из файла }
      MeterMarks:integer;  { Счетчик оценок }
      MeterChar:integer; { Счетчик символов }
  Begin
    if not EOF(F)
      then
        begin
          Read(F,PupilBuf); { Чтение записи из файла }
          { Выравнивание длин фамилии и имени: }
          with PupilBuf do
            begin
              for MeterChar:=Length(FamilyName)+1 to 10 do
                FamilyName:=FamilyName+' ';
              for MeterChar:=Length(Name)+1 to 10 do Name:=Name+' '
            end;
          { Создание нового элемента списка: }
          New(School);
          School^.FamilyName:=PupilBuf.FamilyName;
          School^.Name:=PupilBuf.Name;
          School^.Form.Year:=PupilBuf.Form.Year;
          School^.Form.Letter:=PupilBuf.Form.Letter;
          for MeterMarks:=1 to QuantityMarks do
            School^.Marks[MeterMarks]:=PupilBuf.Marks[MeterMarks];
          ReadFile(F,School^.Next)
        end
      else School:=nil
  End;
PROCEDURE SortList(var School:ListPupil);   { Процедура сортировки списка }
  Function SecondElementIsMin(First,Second:PupilType):boolean;
                                 { Функция определения минимального элемента }
    begin
      if Second.Form.Year<First.Form.Year
      then SecondElementIsMin:=TRUE
      else if Second.Form.Year>First.Form.Year
           then SecondElementIsMin:=FALSE
           else if Second.Form.Letter<First.Form.Letter
                then SecondElementIsMin:=TRUE
                else if Second.Form.Letter>First.Form.Letter
                     then SecondElementIsMin:=FALSE
                     else if Second.FamilyName<First.FamilyName
                          then SecondElementIsMin:=TRUE
                          else if Second.FamilyName>First.FamilyName
                               then SecondElementIsMin:=FALSE
                               else if Second.Name<First.Name
                                    then SecondElementIsMin:=TRUE
                                    else SecondElementIsMin:=FALSE
    end;
  Var Ref,         { Ссылка }
      RefPred,     { Ссылка на предыдущий элемент }
      RefMin,      { Ссылка на минимальный элемент }
      RefPredMin   { Ссылка на элемент предыдущий минимальному }
      :ListPupil;
  Begin
    { Начальное определение ссылок: }
    RefMin:=School;
    RefPredMin:=nil;
    Ref:=RefMin;
    while Ref^.Next<>nil do { Цикл просмотра очереди }
      begin
        RefPred:=Ref;   { Переопределение ссылки на предыдущий элемент }
        Ref:=Ref^.Next; { Переопределение ссылки на текщий элемент }
        { Сравнивание минимального элемента с текущим: }
        if SecondElementIsMin(RefMin^,Ref^) then begin
  { Переопределение ссылок минимального элемента } RefMin:=Ref;
                                                   RefPredMin:=RefPred
                                                 end
      end;
    if RefPredMin<>nil then begin
   { Если минимальный элемент не первый, то перестановка минимального элемента
     в начало очереди }       RefPredMin^.Next:=RefMin^.Next;
                              RefMin^.Next:=School;
                              School:=RefMin
                            end;
    if School^.Next<>nil then SortList(School^.Next)
                           { Если есть хвост очереди, то - сортировка хвоста }
  End;
PROCEDURE OutList(School:ListPupil);         { Процедура вывода списка }
  Procedure OutPupil(Pupil:ListPupil); { Процедура вывода записей учеников }
    Var MeterMarks:integer;  { Счетчик оценок }
        MediumMark:real;     { Средний балл }
    Begin
      if Pupil<>nil { Если запись существует, }
        then        { то - вывод записи }
          with Pupil^ do
            begin
              Write('║ ',FamilyName,' ',Name,' ║ ', { Вывод фамилии, имени, }
                    Form.Year:2,Form.Letter,' ║ '); { класса }
              MediumMark:=0;  { Сброс среднего балла }
              for MeterMarks:=1 to QuantityMarks do { Набор суммарной оценки }
                MediumMark:=MediumMark+Marks[MeterMarks];
              MediumMark:=MediumMark/QuantityMarks; { Пересчет среднего балла }
              for MeterMarks:=1 to QuantityMarks do { Цикл вывода оценок }
                if Marks[MeterMarks]>0 then Write(Marks[MeterMarks])
                                       else Write('.');
              WriteLn('  ║ ',MediumMark:4:1,'  ║'); { Ввыод среднего балла }
              OutPupil(Pupil^.Next) { Вывод хвоста очереди }
            end;
    End;
  Begin
    ClrScr; { Очистка экрана }
    { Вывод шапки таблицы }
    WriteLn('╔═══════════════════════╦═════╦════════╦═══════╗');
    WriteLn('║  Фамилия    Имя       ║Класс║ Оценки ║Ср.балл║');
    WriteLn('╠═══════════════════════╬═════╬════════╬═══════╣');
    OutPupil(School); { Вывод очереди }
    { Закрытие таблицы: }
    WriteLn('╚═══════════════════════╩═════╩════════╩═══════╝');
  End;
PROCEDURE DisposerTurn(var S:ListPupil); { Процедура уничтожения очереди }
  Begin
    if S<>nil then begin DisposerTurn(S^.NEXT); Dispose(S) end;
    S:=nil
  End;
BEGIN
  Assign(F,FileName); { Связывание файловой переменной с именем файла }
  Reset(F);         { Открытие файла под чтение }
  ReadFile(F,School); { Чтение файла и формирование списка }
  if School<>nil then SortList(School); { Сортировка списка }
  OutList(School);  { Вывод списка }
  Close(F); { Закрытие файла }
  DisposerTurn(School) { Уничтиожение очереди }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию