rekordy (nNNn)

program rekordy;
uses crt;
type
dziennik=record
nr : byte;
nazwisko : string[20];
ocena_polski : byte;
ocena_matematyka : byte;
ocena_mepr : byte;
srednia : real;
end;
const
n = 50;
ileWklasie = n; {zakres numerow od 1 - ileWklasie}
naStr = 10; {ilosc rekordow na stronie}
var osoba : array [1..n] of dziennik;
kopiaOsobaRos : array [1..n] of dziennik;
kopiaOsobaMal : array [1..n] of dziennik;
schowek : dziennik; {schowek wartosci}
x,wybor,nrOsoby,iloscPrzedmiotow,a,b,ktoreMenu,coSkopiuj,sortowanieOn : byte;
{po to, aby sie ladnie wyswietlalo}
rosCzyMal : byte;
rosMalInformuj,jakieInformuj : string;
procedure menu(ktoreMenu : byte);
begin
case ktoreMenu of
1:begin
writeln('1 - wypelnij danej jednej osoby');
writeln('2 - wyswietl dane jednej osoby');
writeln('3 - wyswietl dane wszystkich osob');
writeln('4 - wyswielt dane osoby o najwiekszej sredniej');
writeln('5 - wyswietl dane osoby o najmniejszej sredniej');
writeln('6 - usun rekord');
writeln('7 - Wyswietl od do...');
writeln('8 - sortuj');
writeln('9 - wyjscie');
write('Twoj wybor: ');read(wybor);end;
2:begin clrscr;
writeln('1 - sortuj wg indeksu');
writeln('2 - sortuj wg numeru');
writeln('3 - sortuj wg oceny z polskiego');
writeln('4 - sortuj wg oceny z matematyki');
writeln('5 - sortuj wg oceny z mepru');
writeln('6 - sortuj wg srednich');
writeln('7 - powrot do menu');end;
3:begin
writeln('1 - sortuj rosnaco');
writeln('2 - sortuj malejaco');end;
end;
end;
procedure wypelnijLosowo;
var y,rNr,jest : byte;
begin randomize;
for x:=1 to n do begin
REPEAT jest:=1;
rNr:=random(ileWklasie)+1;
    for y:=1 to x do begin
        if rNr=osoba[y].nr then begin jest:=0;break;end;
    end;
UNTIL jest=1;
osoba[x].Nr:=rNr;osoba[x].nazwisko:=chr(random(25)+61);
osoba[x].ocena_polski:=random(6)+1;osoba[x].ocena_matematyka:=random(6)+1;
osoba[x].ocena_mepr:=random(6)+1;
osoba[x].srednia:=(osoba[x].ocena_polski+osoba[x].ocena_matematyka+osoba[x].ocena_mepr)/3;
end;
end;
procedure jednaOsobaWpr;
var y,schowek,jest,enda : byte;
begin jest:=0;
      for x:=1 to n do begin
          if osoba[x].nr=0 then begin jest:=1;break;end;end;
          if jest=1 then begin
          write('Podaj numer osoby: ');
          REPEAT readln(schowek);UNTIL (0<schowek)AND(schowek<ileWklasie+1);
          enda:=1;
              for y:=1 to n do begin
                  if osoba[y].nr=schowek then begin
                  write('Uczen o takim numerze juz istnieje (',osoba[y].nazwisko,')');
                  readkey;enda:=0;break;end;
              end;
          if enda = 1 then begin
          osoba[x].nr:=schowek;
          write('Wpisz nazwisko: ');readln(osoba[x].nazwisko);
          write('Wpisz ocene z polskiego: ');readln(osoba[x].ocena_polski);
          write('Wpisz ocene z matematyki: ');readln(osoba[x].ocena_matematyka);
          write('Wpisz ocene z mepr-u: ');readln(osoba[x].ocena_mepr);
          osoba[x].srednia:=(osoba[x].ocena_polski+osoba[x].ocena_matematyka+osoba[x].ocena_mepr)/iloscPrzedmiotow;
          write('Dodano.');delay(1500);end;
          end ELSE begin write('Dziennik zapelniony (maks: ',n,' osob)');readkey;end;
end;
procedure jednaOsobaZcz;
var jest : byte;
begin jest:=0;
write('Podaj nr osoby: ');read(nrOsoby);
for x:=1 to n do begin
    if osoba[x].nr = nrOsoby then begin
    write('Nr ',nrOsoby,' to ',osoba[x].nazwisko);
    write(' ocena z polskiego: ',osoba[x].ocena_polski);
    write(' ocena z matematyki: ',osoba[x].ocena_matematyka);
    writeln(' ocena z mepr-u: ',osoba[x].ocena_mepr);write('srednia: ',osoba[x].srednia:2:2);
    jest:=1;break;
    end;
end;if jest=0 then write('Nie ma ucznia o takim numerze.');
end; {schowek do 3(2), 7(2), 8(1-6)}
procedure bigSchowek(coSkopiuj : byte);
var licznik10 : byte;
begin
case coSkopiuj of
1:begin
    if osoba[x].nr <> 0 then licznik10:=licznik10+1;
         if licznik10 = naStr+1 then begin
         licznik10:=1;gotoxy(75,25);write('>>>');readkey;clrscr;
            if sortowanieOn=1 then begin gotoxy(1,2);
                  if rosCzyMal = 1 then rosMalInformuj:='rosnaco' ELSE rosMalInformuj:='malejaco';
            end;
    end;
end;{manipulacja iloscia wyswietlanych rekordow dom. 10}
2:begin
    if osoba[x].nr <> 0 then begin
       write('Nr ',osoba[x].nr,' to ',osoba[x].nazwisko);
       write(' ocena z polskiego: ',osoba[x].ocena_polski);
       write(' ocena z matematyki: ',osoba[x].ocena_matematyka);
       writeln(' ocena z mepr-u: ',osoba[x].ocena_mepr);write('srednia: ',osoba[x].srednia:2:2);writeln;
    end;
end; {wypisywanie}
3:begin
    if kopiaOsobaRos[x].nr <> 0 then begin
       write('Nr ',kopiaOsobaRos[x].nr,' to ',kopiaOsobaRos[x].nazwisko);
       write(' ocena z polskiego: ',kopiaOsobaRos[x].ocena_polski);
       write(' ocena z matematyki: ',kopiaOsobaRos[x].ocena_matematyka);
       writeln(' ocena z mepr-u: ',kopiaOsobaRos[x].ocena_mepr);write('srednia: ',kopiaOsobaRos[x].srednia:2:2);writeln;
    end;
end; {wypisywanie kopia rosnaco}
4:begin
    if kopiaOsobaMal[x].nr <> 0 then begin
       write('Nr ',kopiaOsobaMal[x].nr,' to ',kopiaOsobaMal[x].nazwisko);
       write(' ocena z polskiego: ',kopiaOsobaMal[x].ocena_polski);
       write(' ocena z matematyki: ',kopiaOsobaMal[x].ocena_matematyka);
       writeln(' ocena z mepr-u: ',kopiaOsobaMal[x].ocena_mepr);write('srednia: ',kopiaOsobaMal[x].srednia:2:2);writeln;
    end;
end; {wypisywanie kopia malejaco}
end;
end;
procedure wysWszystkich;
var jest,licznik10 : byte;
begin jest:=0;licznik10:=0;
for x:=1 to n do begin
    licznik10:=licznik10+1;
    coSkopiuj:=1;bigSchowek(coSkopiuj);
    coSkopiuj:=2;bigSchowek(coSkopiuj);jest:=1;
end;if jest=0 then write('Pusto...');
end;
procedure najwiekszaSr;
var poz,jest : byte;
max : real;
begin jest:=0;max:=0;
for x:=1 to n do begin
    if (osoba[x].srednia>max)AND(osoba[x].srednia<>0) then begin max:=osoba[x].srednia;poz:=x;jest:=1;end;
end;
if jest = 1 then begin write('Najwieksza srednia ma nr ',osoba[poz].nr,'. (',osoba[poz].nazwisko);
write(') i wynosi ona: ',osoba[poz].srednia:2:2);end
ELSE write('Pusto...');
end;
procedure najmniejszaSr;
var poz,jest : byte;
min : real;
begin jest:=0;min:=255;
for x:=1 to n do begin
    if (osoba[x].srednia<min)AND(osoba[x].srednia<>0) then begin min:=osoba[x].srednia;poz:=x;jest:=1;end;
end;
if jest = 1 then begin write('Najmniejsza srednia ma nr ',osoba[poz].nr,'. (',osoba[poz].nazwisko);
write(') i wynosi ona: ',osoba[poz].srednia:2:2);end
ELSE write('Pusto...');
end;
{eks}
procedure przesun(oIle : byte);
var s : byte;
begin
for s:=oIle to n do begin
    osoba[s]:=osoba[s+1];
end;
end;
procedure znajdzZera;
var y : byte;
begin
for y:=1 to n do begin
    for x:=1 to n do begin
        if osoba[x].nr=0 then przesun(x);
    end;
end;
end;
{eks__}
procedure usunRekord;
var jest,schowekNumer : byte;
schowekNazwisko : string[20];
begin jest:=0;write('Podaj nr osoby: ');read(nrOsoby);
for x:=1 to n do begin
    if osoba[x].nr=nrOsoby then begin
       schowekNumer:=osoba[x].nr;osoba[x].nr:=0;schowekNazwisko:=osoba[x].nazwisko;
       osoba[x].nazwisko:='';osoba[x].ocena_polski:=0;
       osoba[x].ocena_matematyka:=0;osoba[x].ocena_mepr:=0;osoba[x].srednia:=0;jest:=1;
       break;
    end;
end;
if jest=0 then write('Nie ma osoby o tym numerze') ELSE begin write('Numer ',schowekNumer);
write('. (',schowekNazwisko,') zostal usuniety z dziennika');end;
znajdzZera;
end;
procedure wyswietlOdDo(a,b : byte);
var licznik10 : byte;
begin licznik10:=0;
for x:=a to b do begin
    coSkopiuj:=1;bigSchowek(coSkopiuj);
    coSkopiuj:=2;bigSchowek(coSkopiuj);
end;
end;
procedure kopiaZapasowa;
var y,yP : byte;
begin
for y:=1 to n do begin
    kopiaOsobaRos[y]:=osoba[y];
end;
yP:=n;
for y:=1 to n do begin
    kopiaOsobaMal[y]:=osoba[yP];
    yP:=yP-1;
end;
end;
procedure sortowanie;
var y,jakieSortowanie,licznik10 : byte;
begin
REPEAT clrscr;sortowanieOn:=1;
ktoreMenu:=2;menu(ktoreMenu);
write('Twoj wybor: ');REPEAT read(wybor); UNTIL (0<wybor)AND(wybor<8);clrscr;
jakieSortowanie:=wybor;
if (0<jakieSortowanie)AND(jakieSortowanie<7) then begin
ktoreMenu:=3;menu(ktoreMenu);write('Twoj wybor: ');REPEAT read(wybor); UNTIL (0<wybor)AND(wybor<3);
rosCzyMal:=wybor;clrscr;gotoxy(1,2);
licznik10:=0;
if jakieSortowanie = 7 then sortowanieOn:=0;
case jakieSortowanie of
1:begin jakieInformuj:='indeksu';
kopiaZapasowa;
     for x:=1 to n do begin
         if rosCzyMal=1 then coSkopiuj:=3 ELSE
         coSkopiuj:=4;
         licznik10:=licznik10+1;
              if licznik10 = 11 then begin licznik10:=1;
              gotoxy(75,25);write('>>>');readkey;clrscr;
              end;

         bigSchowek(coSkopiuj);
     end;
end;
2:begin jakieInformuj:='numeru';
     for y:=1 to n-1 do begin
         for x:=1 to n-1 do begin
             case rosCzyMal of
             1:begin
                  if osoba[x].nr>osoba[x+1].nr then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             2:begin
                  if osoba[x].nr<osoba[x+1].nr then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             end;
         end;
     end;
for x:=1 to n do begin coSkopiuj:=1;bigSchowek(coSkopiuj);coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
3:begin jakieInformuj:='oceny z polskiego';
     for y:=1 to n-1 do begin
         for x:=1 to n-1 do begin
             case rosCzyMal of
             1:begin
                  if osoba[x].ocena_polski>osoba[x+1].ocena_polski then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             2:begin
                  if osoba[x].ocena_polski<osoba[x+1].ocena_polski then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             end;
         end;
     end;
for x:=1 to n do begin coSkopiuj:=1;bigSchowek(coSkopiuj);coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
4:begin jakieInformuj:='oceny z matematyki';
     for y:=1 to n-1 do begin
         for x:=1 to n-1 do begin
             case rosCzyMal of
             1:begin
                  if osoba[x].ocena_matematyka>osoba[x+1].ocena_matematyka then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             2:begin
                  if osoba[x].ocena_matematyka<osoba[x+1].ocena_matematyka then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             end;
         end;
     end;
for x:=1 to n do begin coSkopiuj:=1;bigSchowek(coSkopiuj);coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
5:begin jakieInformuj:='oceny z mepru';
     for y:=1 to n-1 do begin
         for x:=1 to n-1 do begin
             case rosCzyMal of
             1:begin
                  if osoba[x].ocena_mepr>osoba[x+1].ocena_mepr then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             2:begin
                  if osoba[x].ocena_mepr<osoba[x+1].ocena_mepr then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             end;
         end;
     end;
for x:=1 to n do begin coSkopiuj:=1;bigSchowek(coSkopiuj);coSkopiuj:=2;bigSchowek(coskopiuj);end;end;
6:begin jakieInformuj:='sredniej';
     for y:=1 to n-1 do begin
         for x:=1 to n-1 do begin
             case rosCzyMal of
             1:begin
                  if osoba[x].srednia>osoba[x+1].srednia then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             2:begin
                  if osoba[x].srednia<osoba[x+1].srednia then begin
                     schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
                  end;
             end;
             end;
         end;
     end;
     if jakieSortowanie <> 1 then begin
        for x:=1 to n do begin
            coSkopiuj:=1;bigSchowek(coSkopiuj);coSkopiuj:=2;bigSchowek(coSkopiuj);
        end;
     end;
end;
end;
readkey;end;
UNTIL jakieSortowanie=7;
end;
procedure all;
begin wypelnijLosowo;
iloscPrzedmiotow:=3;
REPEAT
ktoreMenu:=1;menu(ktoreMenu);
case wybor of
1:begin jednaOsobaWpr;end;
2:begin jednaOsobaZcz;readkey;end;
3:begin wysWszystkich;readkey;end;
4:begin najwiekszaSr;readkey;end;
5:begin najmniejszaSr;readkey;end;
6:begin usunRekord;readkey;end;
7:begin
REPEAT
write('Podaj od ktorego nr indeksu: ');read(a);write('Do ktorego numeru indeksu: ');read(b);clrscr;
UNTIL (0<a)AND(a<=b)AND(a>0)AND(b<=n);wyswietlOdDo(a,b);readkey;end;
8:begin ktoreMenu:=2;menu(ktoreMenu);sortowanie;end;
end;
clrscr;
UNTIL wybor=9;
end;{eng...}
begin clrscr;
all;
end.