Advertisement
Guest User

Untitled

a guest
Jun 19th, 2018
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 4.67 KB | None | 0 0
  1. program zadstos;
  2. uses
  3. crt,SysUtils;
  4.  
  5. type
  6.   wskaznik_stosu = ^skladnik_stosu;
  7.   skladnik_stosu = record
  8.     Dane:string;
  9.     imie: string[25];
  10.     nazwisko: string[40];
  11.     wiek: byte;
  12.     PESEL: string[11];
  13.     wskaznik: wskaznik_stosu;
  14.     end;
  15.  
  16.   var
  17.     wierzcholek,punkt:wskaznik_stosu;
  18.     i:integer;
  19.  
  20. function menu:char;
  21. begin
  22.   clrscr;
  23.   writeln('[D] Dodawanie na stos');
  24.   writeln('[W] Wyswietlanie stosu');
  25.   writeln('[X] Kasowanie stosu');
  26.   writeln('[Z] Zapisywanie do pliku');
  27.   writeln('[K] Koniec programu');
  28.   menu:=upcase(readkey);
  29.   end;
  30.  procedure dodawanie;
  31. var
  32.    znak:char;
  33. begin
  34. repeat
  35. if i=0 then
  36. begin
  37.      clrscr;
  38.      i:=1;
  39.      new(wierzcholek);
  40.      write('Dane: ');
  41.      readln(wierzcholek^.dane);
  42.      write('Imie: ');
  43.      readln(wierzcholek^.imie);
  44.      write('Nazwisko: ');
  45.      readln(wierzcholek^.nazwisko);
  46.      write('Wiek: ');
  47.      readln(wierzcholek^.wiek);
  48.      write('PESEL: ');
  49.      readln(wierzcholek^.PESEL);
  50.      wierzcholek^.wskaznik:=nil;
  51.      punkt:=wierzcholek;
  52.      writeln('N - konczy, inny kontynuuje');
  53.      znak:=upcase(readkey);
  54. end
  55. else
  56.  if i<>0 then
  57.  begin
  58.      clrscr;
  59.      new(wierzcholek);
  60.      write('Dane: ');
  61.      readln(wierzcholek^.dane);
  62.      write('Imie: ');
  63.      readln(wierzcholek^.imie);
  64.      write('Nazwisko: ');
  65.      readln(wierzcholek^.nazwisko);
  66.      write('Wiek: ');
  67.      readln(wierzcholek^.wiek);
  68.      write('PESEL: ');
  69.      readln(wierzcholek^.PESEL);
  70.      wierzcholek^.wskaznik:=punkt;
  71.      punkt:=wierzcholek;
  72.      writeln('N - konczy, inny kontynuuje');
  73.      znak:=upcase(readkey);
  74.  end;
  75. until znak='N';
  76. end;
  77.  
  78. procedure wyswietlanie;
  79. begin
  80.   clrscr;
  81.   punkt:=wierzcholek;
  82.   If(length(punkt^.nazwisko)>5) then writeln('wyraz ma wiecej znakow niz 5')
  83.        else writeln('wyraz ma mniej znakow niz 5');
  84.   while punkt<>nil do
  85.      begin
  86.       writeln(punkt^.dane);
  87.       writeln('Imie: ',punkt^.imie);
  88.       writeln('Nazwisko: ',punkt^.nazwisko);
  89.       writeln('Wiek: ',punkt^.wiek);
  90.       writeln('PESEL: ',punkt^.PESEL);
  91.       writeln('---------------------');
  92.       punkt:=punkt^.wskaznik;
  93.       end;
  94.   writeln('Nacisnij ENTER, aby kontynuowac...');
  95.   readln;
  96. end;
  97. procedure kasowanie;
  98. var
  99.    temp:wskaznik_stosu;
  100.    begin
  101.      clrscr;
  102.      punkt:=wierzcholek;
  103.      while punkt <> nil do
  104.            begin
  105.                 dispose(wierzcholek);
  106.                 punkt:=wierzcholek^.wskaznik;
  107.                 wierzcholek:=punkt;
  108.            end;
  109.       writeln('Stos skasowany');
  110.       i:=0;
  111.       readln;
  112. end;
  113.  
  114. Procedure Zapisywanie;
  115. var
  116.   txtFile:textfile;
  117.   numer:integer;
  118.   nazwisko:string;
  119. begin
  120.   if punkt=nil then writeln('Nie mozesz nic zapisac do pliku, poniewaz stos jest pusty!')
  121.   else
  122.   begin
  123.      repeat
  124.         writeln('Wybierz jakie elementy mam umiescic w pliku:');
  125.         writeln('1) Wszystkie elementy stosu');
  126.         writeln('2) Elementy o wybranym nazwisku');
  127.         writeln('3) Osoby pelnoletnie');
  128.         readln(numer);
  129.      until (numer=1) or (numer=2) or (numer=3);
  130.      if(numer=2) then
  131.      begin
  132.        writeln('Podaj nazwisko:');
  133.        readln(nazwisko);
  134.      end;
  135.      assignfile(txtFile, 'stos.txt');
  136.      rewrite(txtFile);
  137.      writeln('Zapisuje...');
  138.      repeat
  139.        begin
  140.          if(numer=1) then
  141.          begin
  142.           writeln(txtFile,'Imie: ',punkt^.imie);
  143.           writeln(txtFile,'Nazwisko: ',punkt^.nazwisko);
  144.           writeln(txtFile,'Wiek: ',punkt^.wiek);
  145.           writeln(txtFile,'PESEL: ',punkt^.PESEL);
  146.           writeln(txtFile,'---------------------');
  147.          end;
  148.          if(numer=2) and (punkt^.nazwisko=nazwisko) then
  149.          begin
  150.           writeln(txtFile,'Imie: ',punkt^.imie);
  151.           writeln(txtFile,'Nazwisko: ',punkt^.nazwisko);
  152.           writeln(txtFile,'Wiek: ',punkt^.wiek);
  153.           writeln(txtFile,'PESEL: ',punkt^.PESEL);
  154.           writeln(txtFile,'---------------------');
  155.          end;
  156.          if(numer=3) and (punkt^.wiek>=18) then
  157.          begin
  158.           writeln(txtFile,'Imie: ',punkt^.imie);
  159.           writeln(txtFile,'Nazwisko: ',punkt^.nazwisko);
  160.           writeln(txtFile,'Wiek: ',punkt^.wiek);
  161.           writeln(txtFile,'PESEL: ',punkt^.PESEL);
  162.           writeln(txtFile,'---------------------');
  163.          end;
  164.          punkt:=punkt^.wskaznik;
  165.        end;
  166.      until punkt=nil;
  167.      writeln('Zapisano!');
  168.     closefile(txtFile);
  169.     end;
  170.     writeln('N - konczy, inny kontynuuje');
  171.     readln;
  172. end;
  173.  
  174.  
  175.  
  176. begin
  177. i:=0;
  178. repeat
  179. clrscr;
  180. case menu of
  181.      'D':dodawanie;
  182.      'X':kasowanie;
  183.      'W':wyswietlanie;
  184.      'Z':Zapisywanie;
  185.      'K':halt;
  186. end;
  187. until false;
  188. readln;
  189. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement