rekordyDO

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 = 40;
ileWklasie = n; {zakres numerow od 1 - ileWklasie}
maxNaStr = 20; {ilosc rekordow na stronie}
naStrX = 24; {pozycja (x) info ile jest na stronie}
naStrY = 23; {pozycja (y) -||-}
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,iluJest,licznik10 : integer;
{po to, aby sie ladnie wyswietlalo}
rosCzyMal : byte;
rosMalInformuj,jakieInformuj : string;
procedure menu(ktoreMenu : byte);
begin
case ktoreMenu of
1:begin gotoxy(26,9);TextBackGround(7);textcolor(red);
write('Aktualnie jest ',iluJest,' osob w dzienniku');textcolor(7);TextBackGround(0);gotoxy(1,1);
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 - Wyswietl od do...');
writeln('7 - sortuj');
writeln('8 - 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-10 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 z,zs,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);
          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: ');
          REPEAT readln(osoba[x].ocena_polski);UNTIL (0<osoba[x].ocena_polski)AND(osoba[x].ocena_polski<7);
          write('Wpisz ocene z matematyki: ');
          REPEAT readln(osoba[x].ocena_matematyka);UNTIL (0<osoba[x].ocena_matematyka)AND(osoba[x].ocena_matematyka<7);
          write('Wpisz ocene z mepr-u: ');
          REPEAT readln(osoba[x].ocena_mepr);UNTIL (0<osoba[x].ocena_mepr)AND(osoba[x].ocena_mepr<7);
          osoba[x].srednia:=(osoba[x].ocena_polski+osoba[x].ocena_matematyka+osoba[x].ocena_mepr)/iloscPrzedmiotow;
          write('Dodano.');delay(1500);
              for z:=1 to n do begin
                   if kopiaOsobaRos[z].nr=0 then begin kopiaOsobaRos[z]:=osoba[x];break;end;
              end;zs:=n;
              for z:=1 to n do begin
                   kopiaOsobaMal[z]:=kopiaOsobaRos[zs];
              zs:=zs-1;
              end;

          end;
          end ELSE begin write('Dziennik zapelniony (maks: ',n,' osob)');readkey;end;
end;
procedure naglowek;
begin
gotoxy(10,1);write('Numer');gotoxy(16,1);write('Nazwisko');gotoxy(33,1);write('polski');gotoxy(40,1);write('matematyka');
gotoxy(51,1);write('mepr');gotoxy(56,1);write('srednia');
end;
procedure jednaOsobaZcz;
var jest : byte;
begin jest:=0;
if iluJest <> 0 then begin
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  ELSE write('Pusto...'); end;
{schowek do 3(2), 7(2), 8(1-6)}
procedure bigSchowek(coSkopiuj : byte);
begin
case coSkopiuj of
0: begin
   schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
end; {sortowanie (podmiana wartosci)}
1: begin gotoxy(naStrX,naStrY);write('Liczba rekordow na stronie: ',licznik10); end;
2:begin naglowek;
    if osoba[x].nr <> 0 then begin
       gotoxy(10,licznik10+1);write(osoba[x].nr);
       gotoxy(16,licznik10+1);write(osoba[x].nazwisko);
       gotoxy(33,licznik10+1);write(osoba[x].ocena_polski);
       gotoxy(40,licznik10+1);write(osoba[x].ocena_matematyka);
       gotoxy(51,licznik10+1);writeln(osoba[x].ocena_mepr);
       gotoxy(56,licznik10+1);write(osoba[x].srednia:2:2);writeln;bigSchowek(1);
    end;
end; {wypisywanie}
3:begin naglowek;
    if kopiaOsobaRos[x].nr <> 0 then begin
       gotoxy(10,licznik10+1);write(kopiaOsobaRos[x].nr);
       gotoxy(16,licznik10+1);write(kopiaOsobaRos[x].nazwisko);
       gotoxy(33,licznik10+1);write(kopiaOsobaRos[x].ocena_polski);
       gotoxy(40,licznik10+1);write(kopiaOsobaRos[x].ocena_matematyka);
       gotoxy(51,licznik10+1);writeln(kopiaOsobaRos[x].ocena_mepr);
       gotoxy(56,licznik10+1);write(kopiaOsobaRos[x].srednia:2:2);writeln;bigSchowek(1);
    end;
end; {wypisywanie kopia rosnaco}
4:begin naglowek;
    if kopiaOsobaMal[x].nr <> 0 then begin
       gotoxy(10,licznik10+1);write(kopiaOsobaMal[x].nr);
       gotoxy(16,licznik10+1);write(kopiaOsobaMal[x].nazwisko);
       gotoxy(33,licznik10+1);write(kopiaOsobaMal[x].ocena_polski);
       gotoxy(40,licznik10+1);write(kopiaOsobaMal[x].ocena_matematyka);
       gotoxy(51,licznik10+1);writeln(kopiaOsobaMal[x].ocena_mepr);
       gotoxy(56,licznik10+1);write(kopiaOsobaMal[x].srednia:2:2);writeln;bigSchowek(1);
    end;
end; {wypisywanie kopia malejaco}
end;
end;
procedure wysWszystkich;
begin licznik10:=0;clrscr;
if iluJest <> 0 then begin
    for x:=1 to n do begin
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = MaxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;naglowek;writeln;
        end;coSkopiuj:=2;
        bigSchowek(coSkopiuj);
     end;
end ELSE write('Pusto...');
end;
procedure najwiekszaSr;
var poz,jest2 : byte;
max : real;
begin jest2:=0;max:=1;
for x:=1 to n do begin
    if (osoba[x].srednia>max)AND(osoba[x].srednia<>0)AND(osoba[x].nr<>0) then begin max:=osoba[x].srednia;poz:=x;jest2:=1;end;
end;
if jest2 = 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:=10;
for x:=1 to n do begin
    if (osoba[x].srednia<min)AND(osoba[x].srednia<>0)AND(osoba[x].nr<>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;
procedure wyswietlOdDo(a,b : byte);
var jest : byte;
begin licznik10:=0;jest:=0;
for x:=a to b do begin
    if osoba[x].nr <> 0 then begin jest:=1;
    licznik10:=licznik10+1;
    if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;naglowek;writeln;
        end;coSkopiuj:=2;
        bigSchowek(coSkopiuj);
    end;
end;
if jest = 0 then write('Nie ma nikogo w tym przedziale');
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 ileJestNaLiscie;
begin iluJest:=0;
for x:=1 to n do begin
    if osoba[x].nr <> 0 then iluJest:=iluJest+1;
end;
end;
procedure sortowanie;
var y,jakieSortowanie : byte;
begin
REPEAT clrscr;
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;
case jakieSortowanie of
1:begin jakieInformuj:='indeksu';
     for x:=1 to n do begin
         if rosCzyMal=1 then begin
         coSkopiuj:=3;
         osoba[x]:=kopiaOsobaRos[x];
              if kopiaOsobaRos[x].nr <> 0 then licznik10:=licznik10+1;
         end ELSE begin
                  osoba[x]:=kopiaOsobaMal[x];coSkopiuj:=4;
                       if kopiaOsobaMal[x].nr <> 0 then licznik10:=licznik10+1;
                  end;
              if licznik10 = maxNaStr+1 then begin licznik10:=1;
              gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
              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
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
        end;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
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
        end;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
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
        end;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
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
        end;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;
    for x:=1 to n do begin
        if osoba[x].nr <> 0 then licznik10:=licznik10+1;
        if licznik10 = maxNaStr+1 then begin licznik10:=1;
        gotoxy(75,25);write('>>>');readkey;clrscr;writeln;
        end;coSkopiuj:=2;
         bigSchowek(coSkopiuj);
     end;
end;
end;
readkey;end;
UNTIL jakieSortowanie=7;
end;
procedure all;
begin wypelnijLosowo;kopiaZapasowa;
iloscPrzedmiotow:=3;
REPEAT ileJestNaLiscie;
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
if iluJest<>0 then begin
REPEAT
write('Podaj od ktorego nr indeksu: ');read(a);write('Do ktorego numeru indeksu: ');read(b);clrscr;
UNTIL (0<b)AND(0<a)AND(a<=b)AND(a>0)AND(b<=n);wyswietlOdDo(a,b);readkey;end ELSE
begin write('Pusto...');readkey;end;
end;
7:begin if iluJest <> 0 then begin ktoreMenu:=2;menu(ktoreMenu);sortowanie;end ELSE begin
write('Pusto...');readkey;end;
end;
end;
clrscr;
UNTIL wybor=8;
end;{eng...}
begin clrscr;
all;
end.