Создать файл,содержащий сведения о том,какие из пяти предлагаемых дисциплин по выбору желает слушать студент

program Project1;
 
 
uses
  SysUtils, Windows, Math;
 
{$APPTYPE CONSOLE}
type
  Discipline = Record
               Name : String[15];
               Vybor : Boolean;
               End;
  Student = record
            fam : string[20];
            Group : integer;
            Sr_Ball : Real;
            Disciplins : Array[1..5] Of Discipline;
            end;
Const
  DiscList : Array[1..5] Of String[15] = ('Алгебра','Биология','Физика','Химия','Информатика');
var
  Students        : array of Student;
  factfile        : file of Student;
  Students_Count  : integer;
  filename        : string = 'Students.db';
  ansver          : Integer;
 
procedure MakeFile;
var
  i,j : integer;
  new_one : Student;
  ch : Char;
  Flag : Boolean;
begin
  Writeln('Создаю файл');
 
  Repeat
    Write('Количество студентов : ');
  Try
    Flag:=True;
    Readln(Students_Count);
  Except
    //Ошибка ввода
    WriteLn;
    WriteLn('Произошла ошибка ввода. Попробуйте ещё.');
    ReadLn;
    Flag:=False;
  End;
  Until Flag;
 
  AssignFile(factfile, filename);
  Rewrite(factfile);
 
  for i := 1 to Students_Count do
  Repeat
    Try
     Flag:=True;
     WriteLn(i:3);
     Write('Фамилия: '); Readln(new_one.fam);
     Write('Группа: '); Readln(new_one.Group);
     Write('Средний балл: ');
     Readln(new_one.Sr_Ball);
     WriteLn('Выбор дисциплин: 1 - выбор, пробел - нет');
     For j:=1 To 5 Do
     Begin
       Write('   '+DiscList[j]+': '); Readln(ch);
       new_one.Disciplins[j].Name:=DiscList[j];
       new_one.Disciplins[j].Vybor:=(ch='1');
     End;
     Write(factfile, new_one);
    Except
      //Ошибка ввода
      WriteLn;
      WriteLn('Произошла ошибка ввода. Попробуйте ещё.');
      ReadLn;
      Flag:=False;
    End;
  Until Flag;
  CloseFile(factfile);
end;
 
procedure AddRecords;
var
  i,j     : integer;
  new_one : Student;
  ch : Char;
  Flag : Boolean;
begin
  Repeat
    Write('Добавить записей : ');
  Try
    Flag:=True;
    Readln(Students_Count);
  Except
    //Ошибка ввода
    WriteLn;
    WriteLn('Произошла ошибка ввода. Попробуйте ещё.');
    ReadLn;
    Flag:=False;
  End;
  Until Flag;
 
  AssignFile(factfile, filename);
  Reset(factfile);
  Seek(factfile, FileSize(factfile));
  for i := 1 to Students_Count do
  Repeat
    Try
     Flag:=True;
     WriteLn(i:3);
     Write('Фамилия: '); Readln(new_one.fam);
     Write('Группа: '); Readln(new_one.Group);
     Write('Средний балл: '); Readln(new_one.Sr_Ball);
     WriteLn('Выбор дисциплин: 1 - выбор, пробел - нет');
     For j:=1 To 5 Do
     Begin
       Write('   '+DiscList[j]+': '); Readln(ch);
       new_one.Disciplins[j].Name:=DiscList[j];
       new_one.Disciplins[j].Vybor:=(ch='1');
     End;
     Write(factfile, new_one);
    Except
      //Ошибка ввода
      WriteLn;
      WriteLn('Произошла ошибка ввода. Попробуйте ещё.');
      ReadLn;
      Flag:=False;
    End;
  Until Flag;
  CloseFile(factfile);
end;
 
procedure FindStudents;
Var
  i,j : Integer;
  next_worker   : Student;
  Discipl : String;
  Flag : Boolean;
Begin
  Repeat
    Write('Задайте дисциплину для поиска: ');
    ReadLn(Discipl);
    Flag:=False;
    For i:=1 to 5 Do
    If DiscList[i]=Discipl Then
    Begin
      Flag:=True;
      Break;
    End;
    If Not Flag Then
    Begin
      Write('Такой дисциплины нет. Попробуйте ещё.');
      ReadLn;
    End;
  Until Flag;
  //Перенос данных файла в массив
  AssignFile(factfile, filename);
  Reset(factfile);
  SetLength(Students, FileSize(factfile));
 
  Students_Count:=0;
  While not EOF(factfile) do
  Begin
    Read(factfile,next_worker);
    //Будем переносить только желающих прослушать дисциплину
    Flag:=False;
    For i:=1 To 5 Do
    With next_worker.Disciplins[i] Do
    If Name=Discipl Then
    Begin
      Flag:=Vybor;
      Break;
    End;
 
    If Flag Then
    Begin
      Students[Students_Count]:=next_worker;
      Inc(Students_Count);
    End;
  End;
  CloseFile(factfile);
  If Students_Count>8 Then
  //Будем отбирать с наибольшим средним баллом
  //Нужно сортировать
  For i:=0 To 7 Do
  For j:=i+1 To Students_Count-1 Do
  If Students[i].Sr_Ball<Students[j].Sr_Ball Then
  Begin
    next_worker:=Students[i];
    Students[i]:=Students[j];
    Students[j]:=next_worker;
  End;
  //Выдадим на экран первых 8 отобранных
  For i:=0 To Min(Students_Count-1,7) Do
  With Students[i] Do
  WriteLn(fam:20,Group:5,Sr_Ball:10:2);
 
  Finalize(Students);
End;
 
//Выдача файла на экран
procedure PrintFile;
var
  j : Integer;
  next_worker   : Student;
  ch : Char;
begin
  Writeln('Выдача файла на экран');
  AssignFile(factfile, filename);
  Reset(factfile);
  while not EOF(factfile) do
  begin
    Read(factfile, next_worker);
    WriteLn('Фамилия: ',next_worker.fam);
    WriteLn('Группа: ',next_worker.Group);
    WriteLn('Средний балл: ',next_worker.Sr_Ball:10:2);
    For j:=1 To 5 Do
    Begin
      Write('   '+next_worker.Disciplins[j].Name:15);
      ch:=' ';
      If next_worker.Disciplins[j].Vybor Then ch:='1';
      WriteLn('   ',ch);
    End;
  end;
  CloseFile(factfile);
end;
 
begin
  //Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  //Если после переключения русские буквы показываются неверно,
  //следует открыть системное меню консольного окна - щелчком мыши в левом
  //верхнем углу окна консоли и выбрать:
  //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
  SetConsoleOutputCp(1251);
  SetConsoleCP(1251);
  repeat
    Writeln(' Меню:');
    Writeln('1) Создание файла');
    Writeln('2) Добавить записи');
    Writeln('3) Выдача файла на экран');
    Writeln('4) Поиск желающих прослушать дисциплину');
    Writeln('5) Выход');
 
    Writeln; Writeln; Write('Ваш выбор: ');
    Readln(ansver);
    case ansver of
      1 : MakeFile;
      2 : AddRecords;
      3 : PrintFile;
      4 : FindStudents;
      5 : Break;
      else
        Writeln('Такого пункта нет! Попробуйте еше')
    end;
    Readln;
    Writeln; Writeln;
  until false;
  Writeln('всё');
  readln;
end.