{uses
 crt;}
const
 n=100;
 no='№';
 famil='Фамилия ';
 st='Страна ';
 ba='Балл ';
 no1='№';
 f1='Фамилия';
 st1='Страна';
 ba1='Балл';
type
 u4astnik=record
   fam:string[15];
   strana:string[15];
   ball:real
  end;
 base=array[1..n] of u4astnik;
{0}
procedure mmm (var m:integer);
 begin
  Writeln;
  write(' Введите количество фигуристов: ');
  readln(m);
  if m=0 then
   begin
    writeln(' В турнире нет участников');
    Writeln(' Для выхода нажмите Enter');
    readln;
    exit;
   end;
  if m>n then
   begin
    repeat
     writeln(' Программа не поддерживает такого количества участников введите другое число');
     writeln(' Введите количество фигуристов');
     readln(m);
     if m=0 then
   begin
    writeln(' В турнире нет участников');
    Writeln(' Для выхода нажмите Enter');
    readln;
    exit;
   end;
    until m<=n ;
   end;
    if m<0 then
   begin
    repeat
     writeln(' Программа не поддерживает такого количества участников введите другое число');
     writeln(' Введите количество фигуристов');
     readln(m);
     if m=0 then
   begin
    writeln(' В турнире нет участников');
    Writeln(' Для выхода нажмите Enter');
    readln;
    exit;
   end;
    until m>0 ;
   end;
  end;
{*0}
{1}
procedure vvod (var b:base; var f: file of u4astnik; var m:integer);
 var
  i:integer;
 begin
  {clrscr;}
  mmm(m);
  rewrite(f);
  for i:=1 to m do
   begin
    writeln(no:3,i:3);
    write(famil:10);readln(b[i].fam);
    write(st:10);readln(b[i].strana);
    write(ba:10);readln(b[i].ball);
    write(f,b[i]);
    writeln;
   end;
  close(f);
  writeln(' Ввод базы произведён удачно. Для продолжения нажмите Enter.');
  readln;
  {clrscr;}
end;
{*1}
{2}
procedure vivod (var b:base; var f: file of u4astnik; m:integer);
 var
  i:integer;
 begin
  {clrscr;}
  Writeln('  Таблица участников турнира:');
  writeln;
  write(no1:3);
  write(f1:15);
  write(st1:15);
  writeln(ba1:8);
  reset(f);
  for i:=1 to m do
  read(f,b[i]);
  for i:=1 to m do
   begin
    write(i:3);
    write(b[i].fam:15);
    write(b[i].strana:15);
    write(b[i].ball:8);
    writeln;
   end;
  close(f);
  writeln;
  writeln(' Для продолжения нажмите Enter.');
  readln;
  {clrscr;}
 end;
{*2}
{2.2}
procedure vivod_r (var b:base; m:integer);
 var
  i:integer;
 begin
  {clrscr;}
  Writeln('  Таблица участников турнира:');
  writeln;
  write(no1:3);
  write(f1:15);
  write(st1:15);
  writeln(ba1:8);
  for i:=1 to m do
   begin
    write(i:3);
    write(b[i].fam:15);
    write(b[i].strana:15);
    write(b[i].ball:8);
    writeln;
   end;
  writeln;
 end;
{*2.2}
{3}
procedure vivod_3 (var a:base; m:integer);
 var
  i:integer;
 begin
  {clrscr;}
  writeln('  Места распределены таким образом:');
  writeln;
  write(no1:3);
  write(f1:15);
  write(st1:15);
  writeln(ba1:8);
  for i:=1 to m do
   begin
    write(i:3);
    write(a[i].fam:15);
    write(a[i].strana:15);
    write(a[i].ball:8);
    writeln;
   end;
  writeln;
 end;
{*3}
{4}
procedure poisk (var b:base; m:integer);
 var
  i:integer;
  isk:string;
 begin
   {clrscr;}
   Write(' Введите искомую фамилию: ');
   readln(isk);
   writeln;
   for i:=1 to m do
    begin
     if b[i].fam=isk then
      begin
       write(no1:3);
       write(f1:15);
       write(st1:15);
       writeln(ba1:8);
       write(i:3);
       write(b[i].fam:15);
       write(b[i].strana:15);
       write(b[i].ball:8);
       writeln;
       break;
      end;
     if (i=m) and (b[i].fam<>isk) then
      Writeln(' Данной фамилии не найдено.');
    end;
  writeln;
  writeln(' Для продолжения нажмите Enter.');
  readln;
  {clrscr;}
 end;
{*4}
{5}
 procedure redakt (var b:base; m:integer);
  var
   str:string;
   nom,op:integer;
   str_ball:real;
  begin
   {clrscr;}
   vivod_r(b,m);
   writeln;
   write(' Введите номер фигуриста. № ');
   readln(nom);
   {clrscr;}
   writeln;
   write(no1:3);
   write(f1:15);
   write(st1:15);
   writeln(ba1:8);
   write(nom:3);
   write(b[nom].fam:15);
   write(b[nom].strana:15);
   writeln(b[nom].ball:8);
   writeln;
   writeln(' Что нужно редактировать?');
   writeln;
   writeln('  1-Фамилия.');
   writeln('  2-Страна.');
   writeln('  3-Балл.');
   writeln('  0-Отмена.');
   writeln;
   write(' Пункт меню № ');
   readln(op);
   writeln;
   if op=1 then
    begin
     write(' Введите новое Имя: ');
     readln(str);
     b[nom].fam:=str;
     writeln;
     writeln('Результат корректировки:');
     writeln;
     write(no1:3);
     write(f1:15);
     write(st1:15);
     writeln(ba1:8);
     write(nom:3);
     write(b[nom].fam:15);
     write(b[nom].strana:15);
     write(b[nom].ball:8);
     writeln;
    end
   else
    if op=2 then
     begin
      write(' Введите новую Страну : ');
      readln(str);
      b[nom].strana:=str;
      writeln;
      writeln('Результат корректировки:');
      writeln;
      write(no1:3);
      write(f1:15);
      write(st1:15);
      writeln(ba1:8);
      write(nom:3);
      write(b[nom].fam:15);
      write(b[nom].strana:15);
      write(b[nom].ball:8);
      writeln;
     end
    else
     if op=3 then
      begin
       write(' Введите новый Балл : ');
       readln(str_ball);
       b[nom].ball:=str_ball;
       writeln;
       writeln('Результат корректировки:');
       writeln;
       write(no1:3);
       write(f1:15);
       write(st1:15);
       writeln(ba1:8);
       write(nom:3);
       write(b[nom].fam:15);
       write(b[nom].strana:15);
       write(b[nom].ball:8);
       writeln;
      end
     else;
   writeln;
   writeln(' Для продолжения нажмите Enter.');
   readln;
   {clrscr;}
 end;
{*5}
{6}
procedure mesta (var b:base;  a:base; m:integer);
  var
   i,j:integer;
   z:u4astnik;
  begin
   {clrscr;}
   for i:=1 to m do
   a[i]:=b[i];
   for j:=1 to m do
    begin
     for i:=1 to m-1 do
      begin
       if a[i+1].ball > a[i].ball then
        begin
         z:=a[i];
         a[i]:=a[i+1];
         a[i+1]:=z;
        end;
      end;
    end;
    vivod_3(a,3);
    writeln;
    writeln(' Для продолжения нажмите Enter.');
    readln;
    {clrscr;}
  end;
{*6}
{7}
procedure sred_ball (b:base; m:integer);
 var
  x,y:real;
  i:integer;
 begin
  {clrscr;}
  x:=0;
  for i:=1 to m do
   x:=x+b[i].ball;
  y:=x/m;
  writeln;
  writeln('Средний балл участников =',y:5:2);
  writeln;
  writeln(' Для продолжения нажмите Enter.');
  readln;
  {clrscr;}
 end;
{*7}
var
 f: file of u4astnik;
 b,a:base;
 m:integer;
 menu:integer;
begin
 assign(f,'База фигурного катания.dat');
 while true do
 begin
  writeln;
  writeln('  |-------------------------------------------------------------------------|');
  writeln('  |                  База чемпионата по фигурному катанию.                  |');
  writeln('  |-------------------------------------------------------------------------|');
  writeln('  |Программа хранит базу данных, также возможен её просмотр и редактирование|');
  writeln('  |-------------------------------------------------------------------------|');
  writeln;
  writeln(' Меню:');
  writeln('  1-Создание базы.');
  writeln('  2-Просмотр базы.');
  writeln('  3-Корректировка.');
  writeln('  4-Поиск фигуриста по Фамилии.');
  writeln('  5-Призавые места.');
  writeln('  6-Средний балл Участников.');
  writeln('  7-Выход.');
  write(' Пункт меню № ');
  readln(menu);
  case menu of
   1:vvod(b,f,m);{Процедура Ввода}
   2:vivod(b,f,m);{Процедура вывода}
   3:redakt(b,m);{Процедура редактирования}
   4:poisk(b,m);{Процедура поиска фигуриста}
   5:mesta(b,a,m);{Процедура распределения мест}
   6:sred_ball(b,m);{Процедура определения среднего балла}
   7:exit;
  end;
 {clrscr;}
 end;
end.