API tools faq
paste
asmodeus94

rekordy (nN)

asmodeus94
Mar 8th, 2012
59
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 11.21 KB | None | 0 0
raw download clone embed print report
  1. program rekordy;
  2. uses crt;
  3. type
  4. dziennik=record
  5. nr : byte;
  6. nazwisko : string[20];
  7. ocena_polski : byte;
  8. ocena_matematyka : byte;
  9. ocena_mepr : byte;
  10. srednia : real;
  11. end;
  12. const
  13. n = 10;
  14. ileWklasie = 40; {zakres numerow od 1 - ileWklasie}
  15. var osoba : array [1..n] of dziennik;
  16. kopiaOsobaMal : array [1..n] of dziennik;
  17. schowek : dziennik;
  18. x,wybor,nrOsoby,iloscPrzedmiotow,a,b,ktoreMenu,coSkopiuj : byte;
  19. procedure menu(ktoreMenu : byte);
  20. begin
  21. case ktoreMenu of
  22. 1:begin
  23. writeln('1 - wypelnij danej jednej osoby');
  24. writeln('2 - wyswietl dane jednej osoby');
  25. writeln('3 - wyswietl dane wszystkich osob');
  26. writeln('4 - wyswielt dane osoby o najwiekszej sredniej');
  27. writeln('5 - wyswietl dane osoby o najmniejszej sredniej');
  28. writeln('6 - usun rekord');
  29. writeln('7 - Wyswietl od do...');
  30. writeln('8 - sortuj');
  31. writeln('9 - wyjscie');
  32. write('Twoj wybor: ');read(wybor);end;
  33. 2:begin clrscr;
  34. writeln('1 - sortuj wg indeksu');
  35. writeln('2 - sortuj wg numeru');
  36. writeln('3 - sortuj wg oceny z polskiego');
  37. writeln('4 - sortuj wg oceny z matematyki');
  38. writeln('5 - sortuj wg oceny z mepru');
  39. writeln('6 - sortuj wg srednich');end;
  40. 3:begin
  41. writeln('1 - sortuj rosnaco');
  42. writeln('2 - sortuj malejaco');end;
  43. end;
  44. end;
  45. procedure wypelnijLosowo;
  46. var y,rNr,jest : byte;
  47. begin randomize;
  48. for x:=1 to n do begin
  49. REPEAT jest:=1;
  50. rNr:=random(ileWklasie)+1;
  51.     for y:=1 to x do begin
  52.         if rNr=osoba[y].nr then begin jest:=0;break;end;
  53.     end;
  54. UNTIL jest=1;
  55. osoba[x].Nr:=rNr;osoba[x].nazwisko:=chr(random(25)+61);
  56. osoba[x].ocena_polski:=random(6)+1;osoba[x].ocena_matematyka:=random(6)+1;
  57. osoba[x].ocena_mepr:=random(6)+1;
  58. osoba[x].srednia:=(osoba[x].ocena_polski+osoba[x].ocena_matematyka+osoba[x].ocena_mepr)/3;
  59. end;
  60. end;
  61. procedure jednaOsobaWpr;
  62. var y,schowek,jest,enda : byte;
  63. begin jest:=0;
  64.       for x:=1 to n do begin
  65.           if osoba[x].nr=0 then begin jest:=1;break;end;end;
  66.           if jest=1 then begin
  67.           write('Podaj numer osoby: ');
  68.           REPEAT readln(schowek);UNTIL (0<schowek)AND(schowek<ileWklasie+1);
  69.           enda:=1;
  70.               for y:=1 to n do begin
  71.                   if osoba[y].nr=schowek then begin
  72.                   write('Uczen o takim numerze juz istnieje (',osoba[y].nazwisko,')');
  73.                   readkey;enda:=0;break;end;
  74.               end;
  75.           if enda = 1 then begin
  76.           osoba[x].nr:=schowek;
  77.           write('Wpisz nazwisko: ');readln(osoba[x].nazwisko);
  78.           write('Wpisz ocene z polskiego: ');readln(osoba[x].ocena_polski);
  79.           write('Wpisz ocene z matematyki: ');readln(osoba[x].ocena_matematyka);
  80.           write('Wpisz ocene z mepr-u: ');readln(osoba[x].ocena_mepr);
  81.           osoba[x].srednia:=(osoba[x].ocena_polski+osoba[x].ocena_matematyka+osoba[x].ocena_mepr)/iloscPrzedmiotow;
  82.           write('Dodano.');delay(1500);end;
  83.           end ELSE begin write('Dziennik zapelniony (maks: ',n,' osob)');readkey;end;
  84. end;
  85. procedure jednaOsobaZcz;
  86. var jest : byte;
  87. begin jest:=0;
  88. write('Podaj nr osoby: ');read(nrOsoby);
  89. for x:=1 to n do begin
  90.     if osoba[x].nr = nrOsoby then begin
  91.     write('Nr ',nrOsoby,' to ',osoba[x].nazwisko);
  92.     write(' ocena z polskiego: ',osoba[x].ocena_polski);
  93.     write(' ocena z matematyki: ',osoba[x].ocena_matematyka);
  94.     writeln(' ocena z mepr-u: ',osoba[x].ocena_mepr);write('srednia: ',osoba[x].srednia:2:2);
  95.     jest:=1;break;
  96.     end;
  97. end;if jest=0 then write('Nie ma ucznia o takim numerze.');
  98. end; {schowek do 3(2), 7(2), 8(1)}
  99. procedure bigSchowek(coSkopiuj : byte);
  100. begin
  101. case coSkopiuj of
  102. 1:begin
  103. end;
  104. 2:begin
  105.     if osoba[x].nr <> 0 then begin
  106.     write('Nr ',osoba[x].nr,' to ',osoba[x].nazwisko);
  107.     write(' ocena z polskiego: ',osoba[x].ocena_polski);
  108.     write(' ocena z matematyki: ',osoba[x].ocena_matematyka);
  109.     writeln(' ocena z mepr-u: ',osoba[x].ocena_mepr);write('srednia: ',osoba[x].srednia:2:2);writeln;
  110.     end;
  111. end; {wypisywanie}
  112. 3:begin
  113.     if kopiaOsobaMal[x].nr <> 0 then begin
  114.     write('Nr ',kopiaOsobaMal[x].nr,' to ',kopiaOsobaMal[x].nazwisko);
  115.     write(' ocena z polskiego: ',kopiaOsobaMal[x].ocena_polski);
  116.     write(' ocena z matematyki: ',kopiaOsobaMal[x].ocena_matematyka);
  117.     writeln(' ocena z mepr-u: ',kopiaOsobaMal[x].ocena_mepr);write('srednia: ',kopiaOsobaMal[x].srednia:2:2);writeln;
  118.     end;
  119. end; {wypisywanie kopia malejaco}
  120. end;
  121. end;
  122. procedure wysWszystkich;
  123. var jest : byte;
  124. begin jest:=0;
  125. for x:=1 to n do begin
  126.     coSkopiuj:=2;bigSchowek(coSkopiuj);jest:=1;
  127. end;if jest=0 then write('Pusto...');
  128. end;
  129. procedure najwiekszaSr;
  130. var poz,jest : byte;
  131. max : real;
  132. begin jest:=0;max:=0;
  133. for x:=1 to n do begin
  134.     if (osoba[x].srednia>max)AND(osoba[x].srednia<>0) then begin max:=osoba[x].srednia;poz:=x;jest:=1;end;
  135. end;
  136. if jest = 1 then begin write('Najwieksza srednia ma nr ',osoba[poz].nr,'. (',osoba[poz].nazwisko);
  137. write(') i wynosi ona: ',osoba[poz].srednia:2:2);end
  138. ELSE write('Pusto...');
  139. end;
  140. procedure najmniejszaSr;
  141. var poz,jest : byte;
  142. min : real;
  143. begin jest:=0;min:=255;
  144. for x:=1 to n do begin
  145.     if (osoba[x].srednia<min)AND(osoba[x].srednia<>0) then begin min:=osoba[x].srednia;poz:=x;jest:=1;end;
  146. end;
  147. if jest = 1 then begin write('Najmniejsza srednia ma nr ',osoba[poz].nr,'. (',osoba[poz].nazwisko);
  148. write(') i wynosi ona: ',osoba[poz].srednia:2:2);end
  149. ELSE write('Pusto...');
  150. end;
  151. {eks}
  152. procedure przesun(oIle : byte);
  153. var s : byte;
  154. begin
  155. for s:=oIle to n do begin
  156.     osoba[s]:=osoba[s+1];
  157. end;
  158. end;
  159. procedure znajdzZera;
  160. var y : byte;
  161. begin
  162. for y:=1 to n do begin
  163.     for x:=1 to n do begin
  164.         if osoba[x].nr=0 then przesun(x);
  165.     end;    
  166. end;
  167. end;
  168. {eks__}
  169. procedure usunRekord;
  170. var jest,schowekNumer : byte;
  171. schowekNazwisko : string[20];
  172. begin jest:=0;write('Podaj nr osoby: ');read(nrOsoby);
  173. for x:=1 to n do begin
  174.     if osoba[x].nr=nrOsoby then begin
  175.        schowekNumer:=osoba[x].nr;osoba[x].nr:=0;schowekNazwisko:=osoba[x].nazwisko;
  176.        osoba[x].nazwisko:='';osoba[x].ocena_polski:=0;
  177.        osoba[x].ocena_matematyka:=0;osoba[x].ocena_mepr:=0;osoba[x].srednia:=0;jest:=1;
  178.        break;
  179.     end;
  180. end;
  181. if jest=0 then write('Nie ma osoby o tym numerze') ELSE begin write('Numer ',schowekNumer);
  182. write('. (',schowekNazwisko,') zostal usuniety z dziennika');end;
  183. znajdzZera;
  184. end;
  185. procedure wyswietlOdDo(a,b : byte);
  186. begin
  187. for x:=a to b do begin
  188.     coSkopiuj:=2;bigSchowek(coSkopiuj);
  189. end;
  190. end;
  191. procedure kopiaZapasowa;
  192. var y,yP : byte;
  193. begin
  194.      yP:=n;
  195.      for y:=1 to n do begin
  196.          kopiaOsobaMal[y]:=osoba[yP];
  197.          yP:=yP-1;
  198.      end;
  199. end;
  200. procedure sortowanie;
  201. var y,jakieSortowanie,rosCzyMal : byte;
  202. jakieInformuj,rosMalInformuj : string;
  203. begin
  204. write('Twoj wybor: ');REPEAT read(wybor); UNTIL (0<wybor)AND(wybor<7);clrscr;
  205. jakieSortowanie:=wybor;
  206. ktoreMenu:=3;menu(ktoreMenu);write('Twoj wybor: ');REPEAT read(wybor); UNTIL (0<wybor)AND(wybor<3);
  207. rosCzyMal:=wybor;clrscr;
  208. gotoxy(1,2);
  209. case jakieSortowanie of
  210. 1:begin jakieInformuj:='indeksu';
  211. kopiaZapasowa;
  212.      for x:=1 to n do begin
  213.          if rosCzyMal=1 then coSkopiuj:=2 ELSE coSkopiuj:=3; bigSchowek(coSkopiuj);
  214.      end;
  215. end;
  216. 2:begin jakieInformuj:='numeru';
  217.      for y:=1 to n-1 do begin
  218.          for x:=1 to n-1 do begin
  219.              case rosCzyMal of
  220.              1:begin
  221.                   if osoba[x].nr>osoba[x+1].nr then begin
  222.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  223.                   end;
  224.              end;
  225.              2:begin
  226.                   if osoba[x].nr<osoba[x+1].nr then begin
  227.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  228.                   end;
  229.              end;
  230.              end;
  231.          end;
  232.      end;
  233. for x:=1 to n do begin coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
  234. 3:begin jakieInformuj:='oceny z polskiego';
  235.      for y:=1 to n-1 do begin
  236.          for x:=1 to n-1 do begin
  237.              case rosCzyMal of
  238.              1:begin
  239.                   if osoba[x].ocena_polski>osoba[x+1].ocena_polski then begin
  240.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  241.                   end;
  242.              end;
  243.              2:begin
  244.                   if osoba[x].ocena_polski<osoba[x+1].ocena_polski then begin
  245.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  246.                   end;
  247.              end;
  248.              end;
  249.          end;
  250.      end;
  251. for x:=1 to n do begin coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
  252. 4:begin jakieInformuj:='oceny z matematyki';
  253.      for y:=1 to n-1 do begin
  254.          for x:=1 to n-1 do begin
  255.              case rosCzyMal of
  256.              1:begin
  257.                   if osoba[x].ocena_matematyka>osoba[x+1].ocena_matematyka then begin
  258.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  259.                   end;
  260.              end;
  261.              2:begin
  262.                   if osoba[x].ocena_matematyka<osoba[x+1].ocena_matematyka then begin
  263.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  264.                   end;
  265.              end;
  266.              end;
  267.          end;
  268.      end;
  269. for x:=1 to n do begin coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
  270. 5:begin jakieInformuj:='oceny z mepru';
  271.      for y:=1 to n-1 do begin
  272.          for x:=1 to n-1 do begin
  273.              case rosCzyMal of
  274.              1:begin
  275.                   if osoba[x].ocena_mepr>osoba[x+1].ocena_mepr then begin
  276.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  277.                   end;
  278.              end;
  279.              2:begin
  280.                   if osoba[x].ocena_mepr<osoba[x+1].ocena_mepr then begin
  281.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  282.                   end;
  283.              end;
  284.              end;
  285.          end;
  286.      end;
  287. for x:=1 to n do begin coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
  288. 6:begin jakieInformuj:='sredniej';
  289.      for y:=1 to n-1 do begin
  290.          for x:=1 to n-1 do begin
  291.              case rosCzyMal of
  292.              1:begin
  293.                   if osoba[x].srednia>osoba[x+1].srednia then begin
  294.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  295.                   end;
  296.              end;
  297.              2:begin
  298.                   if osoba[x].srednia<osoba[x+1].srednia then begin
  299.                      schowek:=osoba[x];osoba[x]:=osoba[x+1];osoba[x+1]:=schowek;
  300.                   end;
  301.              end;
  302.              end;
  303.          end;
  304.      end;
  305. for x:=1 to n do begin coSkopiuj:=2;bigSchowek(coSkopiuj);end;end;
  306. end;
  307. if rosCzyMal = 1 then rosMalInformuj:='rosnaco' ELSE rosMalInformuj:='malejaco';
  308. gotoxy(24,1);write('Sortowanie wzledem ',jakieInformuj,' (',rosMalInformuj,')');
  309. end;
  310. procedure all;
  311. begin wypelnijLosowo;
  312. iloscPrzedmiotow:=3;
  313. REPEAT
  314. ktoreMenu:=1;menu(ktoreMenu);
  315. case wybor of
  316. 1:begin jednaOsobaWpr;end;
  317. 2:begin jednaOsobaZcz;readkey;end;
  318. 3:begin wysWszystkich;readkey;end;
  319. 4:begin najwiekszaSr;readkey;end;
  320. 5:begin najmniejszaSr;readkey;end;
  321. 6:begin usunRekord;readkey;end;
  322. 7:begin
  323. REPEAT
  324. write('Podaj od ktorego nr indeksu: ');read(a);write('Do ktorego numeru indeksu: ');read(b);clrscr;wyswietlOdDo(a,b);
  325. UNTIL (a<=b)AND(a>0)AND(b<=n);readkey;end;
  326. 8:begin ktoreMenu:=2;menu(ktoreMenu);sortowanie;readkey;end;
  327. end;
  328. clrscr;
  329. UNTIL wybor=9;
  330. end;{eng...}
  331. begin clrscr;
  332. all;
  333. end.
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!