__________

 Sysło(iv)

_________

PROGRAM Euklides;
USES CRT;
VAR a,b:INTEGER;
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
FUNCTION nwd(a,b:INTEGER):INTEGER;
BEGIN
WHILE (a>0) AND (b>0) DO
IF a>b THEN a:=a MOD b ELSE b:=b MOD a;
nwd:=a+b
END; {nwd}
FUNCTION JuzKoniec:BOOLEAN;
VAR Odp:CHAR;
BEGIN
WRITELN; WRITELN;
WRITE('Czy chcesz kontynuowac prace z programem? (t/n)');
READLN(Odp);
IF (Odp='t') OR (Odp='T') THEN JuzKoniec:=FALSE
ELSE JuzKoniec:=TRUE
END; {JuzKoniec}
BEGIN
REPEAT
Start('******* NAJWIEKSZY WSPOLNY DZIELNIK *******');
WRITELN('-------------Czytanie danych-------------');
WRITELN('Podaj dwie niezerowe liczby naturalne: ');
WRITE('a= '); READLN(a);
WRITE('b= '); READLN(b);
IF NOT ((a>0) AND (b>0)) THEN WRITELN('ZLE DANE')
ELSE BEGIN
WRITELN;
WRITELN('-----------------Wyniki------------------');
WRITELN('Najwiekszym wspolnym dzielnikiem liczb ');
WRITELN(a,' i ',b,' jest liczba ',nwd(a,b),'.')
END {ELSE}
UNTIL JuzKoniec
END. {Euklides}
PROGRAM ListaUczniow;
USES CRT;
TYPE DziennikLekcyjny=^Uczen;
Uczen =RECORD
Imie,Nazw:STRING[15];
Wsk :DziennikLekcyjny
END;
VAR Dziennik:DziennikLekcyjny;
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
PROCEDURE CzytajImNazw(VAR dz:DziennikLekcyjny);
{Dla kazdego z uczniow procedura czyta z klawiatury jego imie
i nazwisko i wypelnia pola odpowiadajacego mu rekordu.}
VAR i :INTEGER;
n :STRING[15];
Nowy,Biezacy:DziennikLekcyjny;
BEGIN
WRITELN('Podawaj kolejno informacje o uczniach:');
WRITE('(jesli koniec danych, nacisnij ENTER zamiast');
WRITELN(' podawac imie )');
dz:=NIL; {na poczatku lista uczniow jest pusta}
i:=1; {licznik uczniow, o ktorych wprowadzamy informacje}
REPEAT
WRITELN;
WRITE(i:2,'imie: ':10);
READLN(n);
IF n<>'' THEN BEGIN
NEW(Nowy); {rezerwacja obszaru pamieci dla nowego rekordu}
Nowy^.Imie:=n; {wypelnianie pol nowego rekordu}
WRITE('nazwisko: ':12);
READLN(Nowy^.Nazw);
Nowy^.Wsk:=NIL;
IF dz=NIL THEN BEGIN
dz:=Nowy; {tworzenie pierwszego elementu listy}
Biezacy:=dz
END
ELSE BEGIN
Biezacy^.Wsk:=Nowy; {dolaczanie kolejnego elementu
do listy}
Biezacy:=Biezacy^.Wsk
END;
i:=i+1
END {koniec wprowadzania danych o uczniu}
UNTIL n='' {koniec wczytywania danych}
END; {CzytajImNazw}
PROCEDURE DrukujListe(dz:DziennikLekcyjny);
VAR i:INTEGER;
BEGIN
i:=1;
WRITELN; WRITELN;
WRITELN('LISTA UCZNIOW':20); WRITELN;
WHILE dz<>NIL DO BEGIN
WITH dz^ DO
WRITELN(i:2,Imie:15,Nazw:15);
dz:=dz^.Wsk; i:=i+1
END {WHILE}
END; {DrukujListe}
BEGIN
Start('TWORZENIE I DRUKOWANIE LISTY UCZNIOW');
CzytajImNazw(Dziennik);
DrukujListe(Dziennik);
Koniec
END. {ListaUczniow}
PROGRAM Najlepsi;
USES CRT;
CONST MaxLiczbaUczniow=40;
TYPE Uczen =RECORD
Imie,Nazw:STRING[15];
Sr :REAL
END;
DziennikLekcyjny=ARRAY[1..MaxLiczbaUczniow] OF Uczen;
Pomocniczy =ARRAY[1..MaxLiczbaUczniow] OF INTEGER;
VAR Dziennik :DziennikLekcyjny;
LiczbaUczniow,LiczbaDobrych:INTEGER;
TabPom :Pomocniczy;
PROCEDURE DrukujNajlepszych(dz:DziennikLekcyjny;
Tpom:Pomocniczy;Ilu:INTEGER);
VAR i:INTEGER;
BEGIN
WRITELN('NAJLEPSI:');
WRITELN;
WRITELN('imie i nazwisko':30,'srednia ocen':21);
FOR i:=1 TO Ilu DO
WITH dz[Tpom[i]] DO
WRITELN(i:2,Imie:15,Nazw:15,Sr:15:1)
END; {DrukujNajlepszych}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
PROCEDURE CzytajLiczbe(VAR l:INTEGER;p,k:INTEGER;
Tekst:STRING);
BEGIN
WRITE(Tekst); READLN(l); WRITELN;
IF (l<p) OR (l>k) THEN BEGIN
WRITELN('Zle dane: podaj liczbe z przedzialu [',p,',',k,']');
WRITELN;
CzytajLiczbe(l,p,k,Tekst)
END {IF}
END; {CzytajLiczbe}
PROCEDURE CzytajSrednie(VAR dz:DziennikLekcyjny;
IluUczniow:INTEGER);
{Dla kazdego z uczniow procedura czyta z klawiatury imie
i nazwisko oraz srednia ocen wypelniajac pola rekordu
odpowiadajacego temu uczniowi.}
VAR i:INTEGER;
PROCEDURE Czytaj(VAR l:REAL;p,k:INTEGER;
Tekst:STRING);
BEGIN
WRITE(Tekst); READLN(l); WRITELN;
IF (l<p) OR (l>k) THEN BEGIN
WRITELN('Zle dane: podaj liczbe z przedzialu [',p,',',k,']');
WRITELN;
Czytaj(l,p,k,Tekst)
END {IF}
END; {Czytaj}
BEGIN
WRITELN('Podawaj kolejno informacje o uczniach:');
FOR i:=1 TO IluUczniow DO BEGIN
WRITELN;
WRITE(i:2,'imie: ':12);
READLN(dz[i].Imie);
WRITE('nazwisko: ':14);
READLN(dz[i].Nazw);
Czytaj(dz[i].Sr,1,6,'srednia ocen: ')
END {FOR}
END; {CzytajSrednie}
PROCEDURE SzukajNajlepszych(dz:DziennikLekcyjny;
IluUczniow:INTEGER;
VAR Tpom:Pomocniczy;
VAR Ilu:INTEGER);
VAR i:INTEGER;
BEGIN
Ilu:=0;
FOR i:=1 TO IluUczniow DO
IF dz[i].Sr >4.5 THEN BEGIN
Ilu:=Ilu+1;
Tpom[Ilu]:=i
END {IF}
END; {SzukajNajlepszych}
BEGIN
Start('UCZNIOWIE O NAJLEPSZEJ SREDNIEJ OCEN');
WRITE('Podaj liczbe uczniow w klasie (max. ',
MaxLiczbaUczniow,'): ');
CzytajLiczbe(LiczbaUczniow,0,MaxLiczbaUczniow,'');
IF LiczbaUczniow>0 THEN BEGIN
CzytajSrednie(Dziennik,LiczbaUczniow);
SzukajNajlepszych(Dziennik,LiczbaUczniow,TabPom,
LiczbaDobrych);
IF LiczbaDobrych>0 THEN
DrukujNajlepszych(Dziennik,TabPom,LiczbaDobrych)
ELSE
WRITELN('Nie ma uczniow o sredniej ocen powyzej 4.5.')
END; {IF}
Koniec
END. {Najlepsi}
FUNCTION nwdRek(a,b:INTEGER):INTEGER;
BEGIN
IF a<b THEN
nwdRek:=nwdRek(b,a)
ELSE IF b=0 THEN
nwdRek:=a
ELSE
nwdRek:=nwdRek(b,a MOD b)
END; {nwdRek}
PROGRAM SredniaOcen;
USES CRT;
TYPE Przedmioty=(polski,angielski,matematyka,fizyka,chemia,
biologia,geografia,wf);
Oceny =ARRAY[Przedmioty] OF INTEGER;
VAR Swiad:Oceny;
FUNCTION JuzKoniec:BOOLEAN;
VAR Odp:CHAR;
BEGIN
WRITELN; WRITELN;
WRITE('Czy chcesz kontynuowac prace z programem? (t/n)');
READLN(Odp);
IF (Odp='t') OR (Odp='T') THEN JuzKoniec:=FALSE
ELSE JuzKoniec:=TRUE
END; {JuzKoniec}
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
FUNCTION Srednia(Tab:Oceny):REAL;
VAR Suma:REAL;
i :INTEGER;
p :Przedmioty;
BEGIN
Suma:=0; i:=0;
FOR p:=polski TO wf DO BEGIN
Suma:=Suma+Tab[p];
i:=i+1
END;
Srednia:=Suma/i
END; {Srednia}
PROCEDURE CzytajLiczbe(VAR l:INTEGER;p,k:INTEGER;
Tekst:STRING);
BEGIN
WRITE(Tekst); READLN(l); WRITELN;
IF (l<p) OR (l>k) THEN BEGIN
WRITELN('Zle dane: podaj liczbe z przedzialu [',p,',',k,']');
WRITELN;
CzytajLiczbe(l,p,k,Tekst)
END {IF}
END; {CzytajLiczbe}
FUNCTION Nazwa(p:Przedmioty):STRING;
BEGIN
CASE p OF
polski :Nazwa:='polski ';
angielski :Nazwa:='angielski ';
matematyka:Nazwa:='matematyka ';
fizyka :Nazwa:='fizyka ';
chemia :Nazwa:='chemia ';
biologia :Nazwa:='biologia ';
geografia :Nazwa:='geografia ';
wf :Nazwa:='wf '
END {CASE}
END; {Nazwa}
PROCEDURE CzytajOceny(VAR Tab:Oceny);
VAR p:Przedmioty;
BEGIN
WRITE('Podawaj kolejno oceny w postaci liczb ');
WRITELN('z przedzialu <1,6>:');
FOR p:=polski TO wf DO
CzytajLiczbe(Tab[p],1,6,Nazwa(p))
END; {CzytajOceny}
BEGIN
REPEAT
Start('SREDNIA OCEN UCZNIA');
CzytajOceny(Swiad);
WRITELN; WRITELN;
WRITELN('Twoja srednia ocen wynosi:',Srednia(Swiad):11:3)
UNTIL JuzKoniec
END. {SredniaOcen}
PROCEDURE Oferta;
VAR Odp:INTEGER;
BEGIN
CLRSCR; {wyswietlanie oferty na oczyszczonym ekranie}
WRITELN('1. Drukowanie nazwisk i srednich ocen uczniow.');
WRITELN('2. Drukowanie swiadectwa wybranego ucznia.');
WRITE('3. Drukowanie zestawienia ocen z poszczegolnych ');
WRITELN('przedmiotow.');
WRITELN('4. Zakonczenie pracy.');
WRITELN; WRITE('Wybierz numer opcji: ');
READLN(Odp);
CASE Odp OF
1:DrukujSrednie;
2:DrukujSwiadectwo;
3:ObliczZestawienie;
4:;
ELSE Oferta
END; {CASE}
Koniec;
IF Odp<>4 THEN Oferta
END; {Oferta}
PROGRAM SkracanieUlamka;
USES CRT;
VAR Licznik,Mianownik:INTEGER;
FUNCTION nwd(a,b:INTEGER):INTEGER;
BEGIN
WHILE (a>0) AND (b>0) DO
IF a>b THEN a:=a MOD b ELSE b:=b MOD a;
nwd:=a+b
END; {nwd}
PROCEDURE Skracaj(VAR l,m:INTEGER);
VAR Dzielnik:INTEGER;
BEGIN
Dzielnik:=nwd(l,m);
l:=l DIV Dzielnik;
m:=m DIV Dzielnik
END; {Skracaj}
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE CzytajUlamek(VAR l,m:INTEGER);
BEGIN
WRITELN('--------------Czytanie danych--------------');
WRITE('Podaj licznik i mianownik ulamka jako dodatnie');
WRITELN(' liczby naturalne: ');
WRITE('licznik = '); READLN(l);
WRITE('mianownik = '); READLN(m);
IF NOT ((l>0) AND (m>0)) THEN BEGIN
WRITELN('ZLE DANE'); WRITELN;
CzytajUlamek(l,m)
END {IF}
END; {CzytajUlamek}
PROCEDURE DrukujUlamek(l,m:INTEGER);
BEGIN
WRITELN;
WRITELN('-------------------Wyniki-------------------');
WRITELN(' ',l);
WRITELN(' --------');
WRITELN(' ',m)
END; {DrukujUlamek}
BEGIN {Program glowny}
Start('************* SKRACANIE ULAMKA *************');
CzytajUlamek(Licznik,Mianownik);
Skracaj(Licznik,Mianownik);
DrukujUlamek(Licznik,Mianownik);
Koniec
END. {SkracanieUlamka}
PROGRAM ObliczanieSredniej;
USES CRT;
CONST MaxIloscLiczb=100;
TYPE CiagLiczb=ARRAY [1..MaxIloscLiczb] OF REAL;
VAR Dane,Odchylenia:CiagLiczb;
SrAryt :REAL;
IloscLiczb :INTEGER;
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE Start(Tytul:STRING);
BEGIN
CLRSCR;
WRITELN(Tytul);
WRITELN; WRITELN
END; {Start}
PROCEDURE CzytajLiczbe(VAR l:INTEGER;p,k:INTEGER);
BEGIN
WRITE('l='); READLN(l); WRITELN;
IF (l<p) OR (l>k) THEN BEGIN
WRITELN('Zle dane: podaj liczbe z przedzialu [',p,',',k,']');
WRITELN;
CzytajLiczbe(l,p,k)
END {IF}
END; {CzytajLiczbe}
PROCEDURE CzytajDane(VAR Tab:CiagLiczb;Dlugosc:INTEGER);
VAR i:INTEGER;
BEGIN
WRITELN;
WRITELN('--------------Czytanie danych--------------');
WRITE('Podawaj liczby naciskajac klawisz ENTER po ');
WRITELN('kazdej z nich.');
FOR i:=1 TO Dlugosc DO BEGIN
WRITE(i,' ');
READLN(Tab[i])
END {FOR}
END; {CzytajDane}
FUNCTION ObliczSrednia(Tab:CiagLiczb;
Dlugosc:INTEGER):REAL;
VAR Suma:REAL;
i :INTEGER;
BEGIN
Suma:=0;
FOR i:=1 TO Dlugosc DO Suma:=Suma+Tab[i];
ObliczSrednia:=Suma/Dlugosc
END; {ObliczSrednia}
PROCEDURE ObliczRoznice(Tab:CiagLiczb;Srednia:REAL;
Dlugosc:INTEGER;VAR Roznice:CiagLiczb);
VAR i:INTEGER;
BEGIN
FOR i:=1 TO Dlugosc DO
Roznice[i]:=ABS(Tab[i]-Srednia)
END; {ObliczRoznice}
PROCEDURE DrukujWyniki(Tab,Roznice:CiagLiczb;
Dlugosc:INTEGER;Srednia:REAL);
VAR i:INTEGER;
BEGIN
WRITELN;
WRITELN('-------------------Wyniki-------------------');
WRITELN;
WRITELN('Srednia arytmetyczna = ',Srednia:11:3);
WRITELN;
WRITELN('Ciag liczb Ciag odchylen');
FOR i:=1 TO Dlugosc DO
WRITELN(Tab[i]:11:3,' ',Roznice[i]:11:3)
END; {DrukujWyniki}
BEGIN {Program glowny}
Start('SREDNIA ARYTMETYCZNA CIAGU LICZB');
WRITE('Obliczanie sredniej arytmetycznej maksymalnie ');
WRITELN(MaxIloscLiczb,' liczb podanych przez Ciebie');
WRITE('oraz ich odchylen od obliczonej ');
WRITELN ('wartosci sredniej.');
WRITELN;
WRITELN('Podaj ilosc liczb w ciagu:');
CzytajLiczbe(IloscLiczb,0,MaxIloscLiczb);
IF IloscLiczb>0 THEN BEGIN
CzytajDane(Dane,IloscLiczb);
SrAryt:=ObliczSrednia(Dane,IloscLiczb);
ObliczRoznice(Dane,SrAryt,IloscLiczb,Odchylenia);
DrukujWyniki(Dane,Odchylenia,IloscLiczb,SrAryt);
END; {IF}
Koniec
END. {ObliczanieSredniej}
PROGRAM Wizytowka;
BEGIN
WRITELN('*******************************');
WRITELN('* Jan Kowalski *');
WRITELN('* ul. Piwna 31 m 5 *');
WRITELN('* 48-300 NYSA *');
WRITELN('*******************************')
END. {Wizytowka}

PROGRAM Wizytowka1;
USES CRT;
PROCEDURE Start;
BEGIN
CLRSCR;
WRITELN('Drukowanie wizytowki.');
WRITELN; WRITELN
END; {Start}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE DrukujWizytowke1;
BEGIN
WRITELN('*******************************');
WRITELN('* Jan Kowalski *');
WRITELN('* ul. Piwna 31 m 5 *');
WRITELN('* 48-300 NYSA *');
WRITELN('*******************************')
END; {DrukujWizytowke1}
BEGIN
Start; {wywolanie procedury odbywa sie tak, jak w Logo}
DrukujWizytowke1;
Koniec
END. {Wizytowka1}

PROGRAM Wizytowka2;
USES CRT;
VAR Numer:INTEGER;
PROCEDURE Start;
BEGIN
CLRSCR;
WRITELN('Drukowanie wizytowki.');
WRITELN; WRITELN
END; {Start}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE DrukujWizytowke1;
BEGIN
WRITELN('*******************************');
WRITELN('* Jan Kowalski *');
WRITELN('* ul. Piwna 31 m 5 *');
WRITELN('* 48-300 NYSA *');
WRITELN('*******************************')
END; {DrukujWizytowke1}
PROCEDURE DrukujWizytowke2;
BEGIN
WRITELN('*********************************');
WRITELN('* Jan Kowalski *');
WRITELN('* Biuro Turystyczne ODRA *');
WRITELN('* ul. Wojska Polskiego 13 *');
WRITELN('* 45-752 OPOLE *');
WRITELN('* tel.345-64 w.23 *');
WRITELN('*********************************')
END; {DrukujWizytowke2}
BEGIN
Start;
WRITE('Podaj z klawiatury numer wizytowki, ktora ');
WRITELN('chcesz drukowac (1 lub 2).');
READLN(Numer);
IF Numer=1 THEN DrukujWizytowke1
ELSE IF Numer=2 THEN DrukujWizytowke2;
Koniec
END. {Wizytowka2}
PROGRAM Wizytowka3;
USES CRT,PRINTER;
VAR Ile,Licznik:INTEGER;
PROCEDURE Start;
BEGIN
CLRSCR;
WRITELN('Drukowanie wizytowki.');
WRITELN; WRITELN
END; {Start}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE DrukujWizytowke1;
{Jest to zmieniona wersja procedury z przykladu 4.4,
umozliwiajaca wyprowadzenie wizytowek na drukarke.}
BEGIN
WRITELN(LST,'*******************************');
WRITELN(LST,'* Jan Kowalski *');
WRITELN(LST,'* ul. Piwna 31 m 5 *');
WRITELN(LST,'* 48-300 NYSA *');
WRITELN(LST,'*******************************')
END; {DrukujWizytowke1}
BEGIN
Start;
WRITELN('Podaj liczbe potrzebnych Ci wizytowek.');
READLN(Ile);
IF Ile>0 THEN BEGIN
WRITELN('Wlacz drukarke i nacisnij ENTER.');
READLN
END;
Licznik:=1;
WHILE Licznik<=Ile DO BEGIN
DrukujWizytowke1;
Licznik:=Licznik+1
END; {WHILE}
Koniec
END. {Wizytowka3}
PROGRAM Wizytowka4;
USES CRT,PRINTER;
VAR Licznik,Numer,Ile:INTEGER;
PROCEDURE Start;
BEGIN
CLRSCR;
WRITELN('Drukowanie wizytowki.');
WRITELN; WRITELN
END; {Start}
PROCEDURE Koniec;
BEGIN
WRITELN; WRITELN;
WRITELN('Nacisnij klawisz ENTER.');
READLN
END; {Koniec}
PROCEDURE DrukujWizytowke1;
{Jest to zmieniona wersja procedury z przykladu 4.4,
umozliwiajaca wyprowadzenie wizytowek na drukarke.}
BEGIN
WRITELN(LST,'*******************************');
WRITELN(LST,'* Jan Kowalski *');
WRITELN(LST,'* ul. Piwna 31 m 5 *');
WRITELN(LST,'* 48-300 NYSA *');
WRITELN(LST,'*******************************')
END; {DrukujWizytowke1}
PROCEDURE DrukujWizytowke2;
{Jest to zmieniona wersja procedury z programu
Wizytowka2 umozliwiajaca wyprowadzenie wizytowek
na drukarke.}
BEGIN
WRITELN(LST,'*********************************');
WRITELN(LST,'* Jan Kowalski *');
WRITELN(LST,'* Biuro Turystyczne ODRA *');
WRITELN(LST,'* ul. Wojska Polskiego 13 *');
WRITELN(LST,'* 45-752 OPOLE *');
WRITELN(LST,'* tel.345-64 w.23 *');
WRITELN(LST,'*********************************')
END; {DrukujWizytowke2}
BEGIN
Start;
WRITE('Podaj numer wizytowki, ktora chcesz ');
WRITELN('wydrukowac (1 lub 2).');
READLN(Numer);
WRITELN('Podaj liczbe potrzebnych Ci wizytowek.');
READLN(Ile);
IF Ile>0 THEN BEGIN
WRITELN('Wlacz drukarke i nacisnij ENTER.');
READLN
END;
IF Numer=1 THEN
FOR Licznik:=1 TO Ile DO DrukujWizytowke1
ELSE IF Numer=2 THEN
FOR Licznik:=Ile DOWNTO 1 DO DrukujWizytowke2;
Koniec
END. {Wizytowka4}
PROGRAM Wizytowka5;
USES CRT,PRINTER;
VAR Licznik,Numer,Ile:INTEGER;
PROCEDURE Start;
BEGIN
CLRSCR;
WRITELN('Drukowanie wizytowki.');
WRITELN; WRITELN
END; {Start}
PROCEDURE DrukujWizytowke1;
{Jest to zmieniona wersja procedury z przykladu 4.4,
umozliwiajaca wyprowadzenie wizytowek na drukarke.}
BEGIN
WRITELN(LST,'*******************************');
WRITELN(LST,'* Jan Kowalski *');
WRITELN(LST,'* ul. Piwna 31 m 5 *');
WRITELN(LST,'* 48-300 NYSA *');
WRITELN(LST,'*******************************')
END; {DrukujWizytowke1}
PROCEDURE DrukujWizytowke2;
{Jest to zmieniona wersja procedury z programu
Wizytowka2 umozliwiajaca wyprowadzenie wizytowek
na drukarke.}
BEGIN
WRITELN(LST,'*********************************');
WRITELN(LST,'* Jan Kowalski *');
WRITELN(LST,'* Biuro Turystyczne ODRA *');
WRITELN(LST,'* ul. Wojska Polskiego 13 *');
WRITELN(LST,'* 45-752 OPOLE *');
WRITELN(LST,'* tel.345-64 w.23 *');
WRITELN(LST,'*********************************')
END; {DrukujWizytowke2}
FUNCTION JuzKoniec:BOOLEAN;
VAR Odp:CHAR;
BEGIN
WRITELN; WRITELN;
WRITE('Czy chcesz kontynuowac prace z programem? (t/n)');
READLN(Odp);
IF (Odp='t') OR (Odp='T') THEN JuzKoniec:=FALSE
ELSE JuzKoniec:=TRUE
END; {JuzKoniec}
BEGIN
REPEAT
Start;
WRITE('Podaj numer wizytowki, ktora chcesz ');
WRITELN('wydrukowac (1 lub 2).');
READLN(Numer);
WRITELN('Podaj liczbe potrzebnych Ci wizytowek.');
READLN(Ile);
IF Ile>0 THEN BEGIN
WRITELN('Wlacz drukarke i nacisnij ENTER.');
READLN
END;
IF Numer=1 THEN
FOR Licznik:=1 TO Ile DO DrukujWizytowke1
ELSE IF Numer=2 THEN
FOR Licznik:=Ile DOWNTO 1 DO DrukujWizytowke2;
UNTIL JuzKoniec
END. {Wizytowka5}

Uwaga! Brak wcięć i odstępów jest zamierzony:)