______________________

     arci1

______________________

_______________________________1
PROGRAM Funkcja_minimum;
USES
Crt;
VAR
a,b, min, mniej : LONGINT;
Tak_Nie : CHAR;
(*************************************)

FUNCTION Mniejsza:LONGINT;
BEGIN
REPEAT
ClrScr;
Writeln (' Wyznaczenie liczby mniejszej ');
Writeln (' Podaj dwie niezerowe rozne liczby naturalne:');
Writeln;
Write (' Podaj liczbe naturalna a= ');
Readln (a);
Write (' Podaj liczbe naturalna b= ');
Readln (b);
Writeln;
UNTIL a<>b;
IF a>b THEN min:=b
Else min:=a;
Mniejsza:=min; (* Nadanie funkcji wartosci min *)
END;
(*************************************)

BEGIN
REPEAT
ClrScr;
Writeln;
mniej:=Mniejsza; (*Przypisanie wyniku funkcji zmiennej *)
Writeln(' Z liczb ',a ,' i ',b ,' liczba mniejsza to ',mniej);
Writeln;
Writeln (' Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________2
PROGRAM Ciag_Fibonacciego_1;
USES
Crt;
VAR
n,licznik,pierwsza,druga,z_p: LONGINT;
BEGIN
ClrScr;
Write ('Podaj ilosc tworzonych liczb ciagu Fibonacciego n>=2, n = ');
Readln (n);
pierwsza:=0;
druga:=1;
Writeln;
Writeln ('Liczby ciagu Fibonacciego: ');
Writeln;
Write (pierwsza:10,druga:10);
FOR licznik:= 1 TO n-2 DO

BEGIN
z_p:=pierwsza+druga;
pierwsza:=druga;
druga:=z_p;
Write (druga:10);
END;
END.
____________________________________3
PROGRAM Pole_figury;(*Program do wyznaczania pol figur*)
USES
Crt;
VAR
figura:INTEGER;
a,b,P:REAL;
BEGIN
ClrScr;
Writeln ('Wyznaczenie pola figury');
Writeln ('1 - prostokat, 2 - kolo, 3 - trojkat');
Writeln;
Write ('Podaj typ figury geometrycznej : ');
Readln(figura);
CASE figura OF

1:BEGIN(*prostokat*)
Writeln;
Writeln ('* Prostokat *');
Write ('Podaj bok a w cm, a= ');
Readln (a);
Write ('Podaj bok b w cm, b= ');
Read (b);
P:=a*b;
Writeln('Boki prostokata a = ',a:5:2,' cm oraz b = ',b:5:2 ,' cm');
Writeln('Pole prostokata P= ',P:6:2,' cm kw.');
END;

2:BEGIN(*kolo*)
Writeln;
Writeln ('* Kolo *');
Write ('Podaj promien kola a w cm, a= ');
Readln(a);
P:=PI*a*a;
Writeln ('Kolo o promieniu a = ',a:5:2,' cm');
Writeln ('Pole kola wynosi P= ',P:6:2,' cm kw.');
END;

3:BEGIN(*trojkat*)
Writeln;
Writeln ('* Trojkat *');
Write ('Podaj podstawe trojkata a w cm, a= ');
Readln(a);
Write ('Podaj wysokosc trojkata b w cm, b= ');
Readln(b);
P:=a*b/2;
Writeln ('Podstawa trojkata a =',a:5:2,' cm i wysokosc b =',b:5:2,' cm');
Write ('Pole trojkata wynosi P=',P:6:2,' cm kw.');
END;
ELSE
Writeln ('Blad w danych ')
END;
END.
____________________________________4
PROGRAM Funkcja_szescian_4;
USES
Crt;
VAR
x, y : LONGINT;
z : LONGINT;
Tak_Nie : CHAR;
(****************************************************************)

FUNCTION Szescian(VAR a,b:LONGINT):LONGINT;
BEGIN
Writeln;
a:=a*a*a;
b:=b*b*b;
Szescian:=a+b;
END;
(****************************************************************)
BEGIN

REPEAT
ClrScr;
Writeln(' Obliczenie sumy szescianow dwoch liczb calkowitych');
Writeln;
Write (' Podaj liczbe naturalna x= ');
Readln (x);
Write (' Podaj liczbe naturalna y= ');
Readln (y);
Writeln;
Writeln(' Obliczenie sumy szescianow dwoch liczb: x= ',x,' ','i y= ',y);
z:=Szescian(x,y);
Writeln (' Wartosc wyrazenia x*x*x = ',x);
Writeln (' Wartosc wyrazenia y*y*y = ',y);
Writeln (' Wartosc wyrazenia x*x*x+y*y*y = ',z);
Writeln;
Writeln (' Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase (ReadKey)
UNTIL NOT (Tak_Nie='T')
END. 
____________________________________5
PROGRAM Pole_prostokata_4_kom;
USES
Crt;
VAR
a,b,Pp:REAL;
BEGIN
ClrScr;
Writeln ('Obliczenie pola powierzchni prostokata');
Writeln;
Write ('Podaj wartosc boku a prostokata w cm, a= ');
Readln (a);
Writeln;
Write ('Podaj wartosc boku b prostokata w cm, b= ');
Readln (b);
Writeln;
IF a*b>0 THEN
(* Warunek sprawdzajacy istnienie prostokata - czy jednoczesnie
wartosci bokow a oraz b sa wieksze od zera *)
BEGIN
(* Jesli warunek jest spelniony to zostana wykonane instrukcje
zamkniete w bloku BEGIN_END*)

Writeln;
Writeln ('Boki wynosza a = ',a:6:2,' cm, b = ',b:6:2,' cm');
Pp:=a*b;
Writeln;
Write ('Pp = ',Pp:10:2,' cm kw. ');
END
ELSE
(* Jesli warunek istnienia prostokata nie jest spelniony
to zostanie wykonana instrukcja wystepujaca po ELSE *)
Write('Prostokat nie istnieje')

END.
____________________________________6
PROGRAM Suma_bez_pytania;
USES
Crt;
VAR
liczba, suma:REAL;

BEGIN
ClrScr;
suma:=0;
liczba:=0;
Writeln ('Obliczenie sumy wprowadzanych liczb rzeczywistych ');
Writeln ('* Podanie liczby -1e6 konczy wprowadzanie liczb * ');
Writeln;
WHILE liczba<>-1e6 DO
BEGIN
suma:=suma+liczba;
Write ('Podaj liczbe : ');
Readln (liczba);

END;
Writeln ('suma = ',suma:6:2);
END.
____________________________________7
PROGRAM Suma_150;
USES
Crt;
VAR
liczba, suma, i:INTEGER;
BEGIN
ClrScr;
Writeln('Obliczenie sredniej arytmetycznej wprowadzanych liczb');
Writeln('z chwila, gdy ich suma > 150');
Writeln;
i:=1;
Write('Podaj liczbe: ');
Readln (liczba);
suma:=0;
suma:=suma+liczba;
IF liczba <= 150 THEN
BEGIN
REPEAT
Write ('Podaj liczbe: ');
Readln (liczba);
suma:=suma+liczba;
i:=i+1;
UNTIL suma>150;
END;
Writeln('srednia ',i,' liczb = ',suma/i:6:2);
END.
____________________________________8
PROGRAM Rzut_moneta;
USES
Crt;
VAR
i, ORZEL, RESZKA, x : INTEGER;
Tak_Nie : CHAR;
CONST
n=20;
(********************************)

BEGIN
REPEAT
ClrScr;
RANDOMIZE ;
ORZEL:=0;
RESZKA:=0;
FOR i:=1 TO n DO
BEGIN
x:=RANDOM(2);
IF x=0 THEN ORZEL:=ORZEL+1
ELSE
RESZKA:=RESZKA+1;
END;


Writeln(' Losowy rzut moneta ');
Writeln(' Moneta rzucano ', i,' razy ');
Writeln;
Writeln(' Wylosowano orla.... ', ORZEL:2 ,' razy');
Writeln(' Wylosowano reszke.. ', RESZKA:2,' razy');
Writeln;
Writeln (' Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')

END.
____________________________________9
PROGRAM Toto_Multi_Lotek;
USES
Crt;
TYPE
t_zakres = 0..80; (* zakres liczb w totku; zero dodatkowo
z uwagi na sortowanie z wartownikiem *)

CONST
(* Z tej tablicy bedziemy losowali liczby;
wylosowane usuwamy, aby ich ponownie nie losowac *)
Liczby : ARRAY[1..80] OF t_zakres =
( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
11,12,13,14,15,16,17,18,19,20,
21,22,23,24,25,26,27,28,29,30,
31,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,
51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,
71,72,73,74,75,76,77,78,79,80);
VAR
i,j,nr_los,n,x : t_zakres;
wylosowane : ARRAY[0..20] OF t_zakres;
(********************************)

BEGIN
ClrScr;
Randomize;
(* losujemy liczby *)
FOR i:=1 TO 20 DO
BEGIN
nr_los:=RANDOM(80-i)+1; (* losujemy numer liczby z tablicy 'Liczby' *)
wylosowane[i]:=Liczby[nr_los];

FOR n:=nr_los TO 79-i DO
Liczby[n]:=Liczby[n+1];
(* wylosowana liczba jest usuwana z tablicy 'Liczby'
a pozostale przesuwamy do przodu *)
END;

(* sortujemy wylosowane liczby *)
FOR i:=2 TO 20 DO
BEGIN
x:=wylosowane[i];
wylosowane[0]:=x; (* 'wylosowane[0]' pelni role wartownika *)
j:=i-1;
WHILE x<wylosowane[j] DO
BEGIN
wylosowane[j+1]:=wylosowane[j];
j:=j-1; (* zmniejszamy j o 1 *)
END;
wylosowane[j+1]:=x
END;
Writeln(' Wylosowano nastepujace liczby w Multi_Lotku: ');

Writeln;
FOR i:=1 TO 20 DO
Write(wylosowane[i]:4);
Readln;
END.
____________________________________10
PROGRAM Szescian_n_1;
USES
Crt;
VAR
n,wynik:LONGINT;
Tak_Nie:CHAR;
BEGIN

REPEAT
ClrScr;
Writeln ('Obliczenie szescianu liczby naturalnej n ');
Writeln;
Write ('Podaj liczbe naturalna n, n= ');
Readln (n);
wynik:=n*n*n;
Writeln;
Write ('Dla n = ',n, ' wynik = ',wynik:10);
Writeln;
Writeln ('Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________11
PROGRAM NWD_1;
USES
Crt;
VAR
a, b : INTEGER;
zp_a : INTEGER;
zp_b : INTEGER;
reszta : INTEGER;

BEGIN
ClrScr;
Writeln('Najwiekszy wspolny podzielnik dwoch liczb');
REPEAT
Writeln;
Write ('Podaj pierwsza liczbe naturalna: a = ');
Readln (a);
Write ('Podaj druga liczbe naturalna: b = ');
Readln (b);
IF NOT ((a>0)AND(b>0)) THEN
Writeln ('Podaj liczby wieksze od 0 !!!');
UNTIL ((a>0)AND(b>0));
zp_a:=a;
zp_b:=b;

REPEAT
reszta:=zp_a MOD zp_b;
zp_a:=zp_b;
zp_b:=reszta;
UNTIL reszta=0;
Writeln;
Writeln ('Dla liczb ',a,' oraz ',b,', NWD = ',zp_a);
Readln
END.
____________________________________12
PROGRAM Podzielnosc_liczby;
USES
Crt;
VAR
a,b:INTEGER;
BEGIN
ClrScr;
Writeln ('Podzielnosc liczby calkowitej');
Writeln;
Write ('Podaj wartosc dzielnej a, a= ');
Readln(a);
Write ('Podaj wartosc dzielnika b, b= ');
Readln(b);
Writeln;
Writeln ('Sprawdzenie podzielnosci liczby ',a ,' przez ',b);
Writeln;
IF a MOD b=0 THEN
BEGIN
Writeln ('Liczba b = ',b,' jest podzielnikiem liczby a = ',a);
Writeln (a,':',b,'=',a/b:5:0,', reszta = 0');
END
ELSE
Writeln ('Liczba b = ',b,' nie jest podzielnikiem liczby a = ',a);

END.
____________________________________13
PROGRAM Pole_prostokata_4;
USES
Crt;
VAR
a,b,Pp:REAL;
BEGIN
ClrScr;
Writeln ('Obliczenie pola powierzchni prostokata');
Writeln;
Write ('Podaj wartosc boku a prostokata w cm, a= ');
Readln (a);
Writeln;
Write ('Podaj wartosc boku b prostokata w cm, b= ');
Readln (b);
Writeln;
IF a*b>0 THEN
BEGIN
Writeln;
Writeln ('Boki wynosza a = ',a:6:2,' cm, b = ',b:6:2,' cm');
Pp:=a*b;
Writeln;
Write ('Pp = ',Pp:10:2,' cm kw. ');
END
ELSE
Write('Prostokat nie istnieje')
END.
____________________________________14
Program Potegi_liczby_2;
USES
Crt;
VAR
wynik : LONGINT;
Tak_Nie : CHAR;
(***********************************)

FUNCTION Potega_2:LONGINT;
(* Obliczanie wyrazenia 2 do potegi n*)
VAR n, X:LONGINT;
BEGIN

WHILE n>30 DO
BEGIN
Write (' Podaj wykladnik potegi ( n<=30 ), n= ');
Readln(n);
END;
X:=1; Writeln;
Write(' 2 do potegi ',n);
BEGIN
FOR n:=1 to n DO
X:=X*2
END;
Potega_2:=X;
END;
(***********************************)

BEGIN
REPEAT
ClrScr;
Writeln;
Writeln(' Obliczenie wyrazenia: 2 do potegi n ');
Writeln;
wynik:=Potega_2;
Write(' = ',wynik);
Writeln;Writeln;
Writeln (' Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________15
PROGRAM Procedura_szescian_1;
USES
Crt;
VAR
n, wynik : LONGINT;
Tak_Nie : CHAR;
(****************************************************************)
PROCEDURE Szescian;
BEGIN
Writeln;
Writeln ('Obliczenie szescianu liczby naturalnej n ');
Writeln;
Write ('Podaj liczbe naturalna n = ');
Readln (n);
wynik:=n*n*n;
Writeln;
Write ('Dla n = ',n,' wynik = ',wynik);
Writeln;
END;
(****************************************************************)
BEGIN

REPEAT
ClrScr;
Szescian;
Writeln ('Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________16
PROGRAM Procedura_szescian_3;
USES
Crt;
VAR
n, wynik : LONGINT;
Tak_Nie : CHAR;
(****************************************************************)

PROCEDURE Szescian (a:LONGINT);
BEGIN
Writeln;
wynik:=a*a*a;
Write ('Dla n = ',a,' wynik = ',wynik);
Writeln;
END;
(****************************************************************)
BEGIN
REPEAT
ClrScr;
Writeln ('Obliczanie szescianu liczby naturalnej n ');
Writeln;
Write ('Podaj liczbe naturalna n = ');
Readln (n);
Szescian(n);
Writeln ('Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________17
PROGRAM Procedura_szescian_4;
USES
Crt;
VAR
n, wynik : LONGINT;
Tak_Nie : CHAR;
(****************************************************************)

PROCEDURE Szescian (a:LONGINT;VAR iloczyn:LONGINT);
BEGIN

Writeln;
iloczyn:=a*a*a;
Write ('Dla n = ',a,' wynik = ',iloczyn);
Writeln;
END;
(****************************************************************)

BEGIN
REPEAT
ClrScr;
Writeln;
Writeln ('Obliczenie szescianu liczby naturalnej n ');
Writeln;
Write ('Podaj liczbe naturalna n = ');
Readln (n);
Szescian(n,wynik);
Writeln ('Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________18
PROGRAM Procedura_szescian_2;
USES
Crt;
VAR
Tak_Nie:CHAR;
(********************)

PROCEDURE Szescian;
VAR
n, wynik : LONGINT;
BEGIN
Writeln;
Writeln ('Obliczenie szescianu liczby naturalnej n ');
Writeln;
Write ('Podaj liczbe naturalna n = ');
Readln (n);
wynik:=n*n*n;
Writeln;
Write ('Dla n = ',n,' wynik = ',wynik);
Writeln;
END;
(****************************************************************)
BEGIN
REPEAT
ClrScr;
Szescian;
Writeln ('Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________19
PROGRAM Dane_osobowe;
USES
Crt;
TYPE
Dane_personalne = RECORD
Imie : STRING[20];
Nazwisko : STRING[30];
Nr_ew : BYTE;
Plec : CHAR
END;

VAR
Dane : Dane_personalne;
Licznik : BYTE;
(*******************)
BEGIN
ClrScr;
Writeln(' Dane personalne pracownikow') ;

FOR Licznik := 1 TO 5 DO
BEGIN
Writeln;
Write('Podaj Nr_ew ',Licznik,'-ej osoby : ');
Readln(Dane.Nr_ew);
Write('Podaj Nazwisko ',Licznik,'-ej osoby : ');
Readln(Dane.Nazwisko);
Write('Podaj Imie ',Licznik,'-ej osoby : ');
Readln(Dane.Imie);
Write('Podaj Plec M/K ',Licznik,'-ej osoby : ');
Readln(Dane.Plec);
Writeln;
END;
END.
____________________________________20
PROGRAM Dane_osobowe;
USES
Crt;
TYPE
Dane_personalne = RECORD
Imie : STRING[20];
Nazwisko : STRING[30];
Nr_ew : BYTE;
Plec : CHAR
END;

f_plik = FILE OF Dane_personalne;

VAR
Lista_p : f_plik;
Dane : Dane_personalne;
Licznik : BYTE;
(**********************************)
PROCEDURE Zapisz;
BEGIN
ASSIGN(Lista_p,'plik_1a.dan');
REWRITE(Lista_p);
ClrScr;
Writeln(' Dane personalne pracownikow') ;

FOR Licznik := 1 TO 5 DO
BEGIN
Writeln;
Write('Podaj Nr_ew ',Licznik,'-ej osoby : ');
Readln(Dane.Nr_ew);
Write('Podaj Nazwisko ',Licznik,'-ej osoby : ');
Readln(Dane.Nazwisko);
Write('Podaj Imie ',Licznik,'-ej osoby : ');
Readln(Dane.Imie);
Write('Podaj Plec M/K ',Licznik,'-ej osoby : ');
Readln(Dane.Plec);
Write(Lista_p,Dane);
Writeln;
END;
CLOSE(Lista_p);
END;
(*********************)
PROCEDURE Odczyt;
BEGIN
Writeln;
Writeln(' Dane personalne pracownikow');
Writeln;
ASSIGN(Lista_p,'plik_1a.dan');
RESET(Lista_p);

WHILE NOT Eof(Lista_p) DO
BEGIN
Read(Lista_p,Dane);
Write(Dane.Nr_ew,' ');
Write(Dane.Nazwisko,' ');
Write(Dane.Imie,' ');
Write(Dane.Plec);
Writeln
END;
CLOSE(Lista_p);
END;
(*********************)
BEGIN
ClrScr;
Zapisz;
Odczyt;
REPEAT UNTIL KeyPressed
END.
____________________________________21
PROGRAM Silnia_rekurencyjna_1;
USES
Crt;
VAR
a : BYTE;
Tak_Nie : CHAR;
(****************************************************************)

FUNCTION Silnia(n:BYTE):LONGINT;
BEGIN
IF n=0 THEN
Silnia:=1;
IF n>0 THEN
Silnia:=n*Silnia(n-1);

END;
(****************************************************************)

BEGIN
REPEAT
ClrScr;
Writeln(' Obliczenie wyrazenia a! (a silnia)');
Writeln;
Write (' Podaj liczbe naturalna z zakresu: 1 - 10 : a= ');
Readln (a);
Writeln;
Write (' ', a,'! = ',Silnia(a));
Writeln;
Writeln (' Jeszcze raz ?(T)ak');
Tak_Nie:=UpCase(ReadKey)
UNTIL NOT (Tak_Nie='T')
END.
____________________________________22
PROGRAM Sito_Eratostenesa;
USES
Crt;
CONST
n_max=500;
TYPE
Sito_Era = ARRAY[1..n_max] OF INTEGER;
(* Tabela z liczbami naturalnymi do przeszukiwania *)

Pierwsze_liczby = Array[1..n_max] OF INTEGER;
(* liczby pierwsze *)

VAR
n (*:=500*) : INTEGER;
Sito : Sito_Era;
Pierwsze : Pierwsze_liczby;
ile_liczb : INTEGER; (* ile liczb zostalo w tablicy - Sito_Era *)
i, j, k : INTEGER;
(**************************************)

BEGIN
ClrScr;
Writeln(' * Sito Eratostenesa * ');
Writeln(' Wyznaczanie liczb pierwszych ');
Writeln;
Writeln(' Zakres przeszukiwanych liczb od 1 do 2n');
Write(' Podaj n (n<=500), n= ');
Readln(n);
ile_liczb:=n;
j:=1;

FOR i:=1 TO n DO
Sito[i]:=2*i+1; (* eliminujemy wielokrotnosci 2 *)
Pierwsze[j]:=2; (* wstawiamy 2 jako liczbe pierwsza*)

WHILE ile_liczb>1 DO (* dopoki sa jakies liczby do skreslenia *)
BEGIN
j:=j+1; (* zwiekszamy numer kolejnej liczby pierwszej *)
Pierwsze[j]:=Sito[1]; (* pierwsza nie skreslona liczba w sicie
jest to kolejna liczba pierwsza *)

k:=1; i:=1;
WHILE i<=ile_liczb DO
BEGIN
IF (Sito[i] MOD Pierwsze[j]) <> 0 THEN
(* jesli liczba nie dzieli sie przez Pierwsze[j] *)

BEGIN
Sito[k]:=Sito[i];
k:=k+1
END;
(* to wstaw ja ponownie do sita w nowym miejscu *)
(* liczby podzielne przez 'x' nie sa wstawiane *)
i:=i+1;
END;
ile_liczb:=k-1 (* po skresleniu tyle liczb pozostalo *)
END;

Writeln;
Writeln(' Liczby pierwsze z zakresu 1-',2*n);
FOR i:=1 TO j DO write(Pierwsze[i]:5);
REPEAT UNTIL KeyPressed
END.
____________________________________23
PROGRAM Sortowanie_przez_wstawianie;
USES
Crt;
CONST
n_max=20; (* maksymalna ilosc elementow *)
TYPE
Dane = ARRAY [1..n_max] OF INTEGER;
VAR
n : INTEGER;
T_1 : Dane;

(**********************************)
PROCEDURE Wprowadzanie( VAR T:Dane);
VAR
i :INTEGER; (* zmienna kontrolna *)
BEGIN
Writeln(' Wprowadzanie danych do tablicy ');
Writeln;
Write (' Podaj ilosc elementow (n<=20), n= ');
Readln (n);
Writeln;
Write (' Podaj elementy tablicy w kolejnosci');
Writeln;
Writeln;
FOR i:=1 TO n DO
BEGIN
Write(' element nr= ',i,', T_1[ ' , i ,' ] = ');
Readln (T[i]);
END;
END;
(**********************************)

PROCEDURE Odczyt_tablicy( VAR T:Dane);
VAR
i :INTEGER; (* zmienna kontrolna *)
BEGIN
Writeln;
Write (' Odczytaj elementy tablicy w kolejnosci');
Writeln;
Writeln;

FOR i:=1 TO n DO
BEGIN
Write(' element nr= ',i,', T_1[ ' ,i ,' ] = ');
Writeln (T[i])
END;

END;
(***********************************)
PROCEDURE Sort_wstaw( VAR T:Dane);
VAR
i, k :INTEGER; (* zmienna kontrolna *)
z_p :INTEGER;
(*z_p- zmienna pomocnicza do zamiany elementow *)

BEGIN
Writeln;
FOR i:=2 TO n DO
BEGIN
k:=i;
z_p:=T[k];
(* zapamietanie elementu do wstawienia *)

WHILE (k>1) AND (T[k-1]> T[k]) DO
(* przesuniecie elementow w prawo*)
BEGIN
T[k]:=T[k-1];
T[k-1]:=z_p;
k:=k-1
END;
T[k]:=z_p; (* wstawienie danego elementu *)

END;
Writeln;Writeln;
Writeln(' Tablica uporzadkowana');
END;
(***********************************)
BEGIN
ClrScr;
Wprowadzanie (T_1);
Sort_wstaw (T_1);
Odczyt_tablicy (T_1);
Writeln;
REPEAT UNTIL KeyPressed
END.
____________________________________24
PROGRAM Srednia_z_liczb_4;
USES
Crt;
VAR
ilosc, i : INTEGER;
a, suma : REAL;

BEGIN
ClrScr;
suma:=0;
Writeln ('OBLICZENIE SREDNIEJ ARTMETYCZNEJ ');
Writeln;
Write ('Podaj ilosc wprowadzanych liczb, i = ');
Readln (ilosc);
FOR i:=1 TO ilosc DO
BEGIN
Write('Podaj liczbe a',i,' =');
Readln (a);
suma:=suma+a;
END;
Writeln ('Srednia podanych ',ilosc,' liczb wynosi ',suma/ilosc:6:2);
END.
____________________________________25
PROGRAM Dlugosc_wyrazow;
USES
Crt;
VAR
Nazwisko : String[25];
Imie : String[20];
(******************************)
BEGIN
ClrScr;
Writeln;
Writeln('Wyznaczenie dlugosci nazwiska i imienia ');
Writeln;
Write('Pisanie nalezy zakonczyc nacisnieciem');
Writeln(' klawisza Enter ');
Writeln;
Write('Podaj nazwisko : ');
Readln(Nazwisko);
Write('Podaj imie : ');
Readln(Imie);
Writeln;
Writeln('Imie ',Imie,' zawiera ',Length(Imie),' liter');
Writeln('Nazwisko ',Nazwisko,' zawiera ', Length(Nazwisko),' liter');

REPEAT UNTIL KeyPressed
END.
____________________________________26
PROGRAM Tekst_rozstrzelony;
USES
Crt;
VAR
txt : STRING;
i : INTEGER;

BEGIN
ClrScr;
Writeln(' Napisz krotki tekst i nacisnij ENTER ');
Readln(txt);
FOR i:=1 TO LENGTH(txt) DO
Write(txt[i],' ');
Readln
END.
____________________________________27
PROGRAM Obecnosc_litery_a;
USES
Crt;
VAR
tekst : STRING;
i : INTEGER;
ile : INTEGER;
(*********************)
BEGIN
ClrScr;
Writeln(' Wyznaczenie liczby malych liter ''a'' w tekscie');
Writeln;
Writeln(' Napisz tekst i nacisnij ENTER');
Readln(tekst);
ile:=0;
FOR i:=1 TO LENGTH(tekst) DO
IF (tekst[i]='a') THEN
ile:=ile+1;
Writeln(' Liczba malych liter ''w'' w tekscie : ',ile);
REPEAT UNTIL KeyPressed
END.
____________________________________28
PROGRAM Promien_kola_1;
USES
Crt;
VAR
Promien_String : STRING[20];
Promien_Real : REAL ;
Pole_kola : REAL ;
Ocena : INTEGER ;
(***********************************)

BEGIN
ClrScr;
Writeln('Obliczenie pola kola - promien_string');
Writeln;
Write('Podaj promien kola w cm : ');
Readln(Promien_String);WriteLn;
VAL(Promien_String, Promien_Real, Ocena);
IF Ocena = 0 THEN
BEGIN
Pole_kola := Pi * Sqr(Promien_Real);
Writeln;
Write('Pole kola o promieniu r= ',
Promien_String,' wynosi ',Pole_kola: 8:3,' cm kw.');
Writeln;
END
ELSE
Writeln('Bledny znak na miejscu ',Ocena);
REPEAT UNTIL KeyPressed
END.
____________________________________29
PROGRAM Przejrzysta_postac_liczb;
USES
Crt;
VAR
Liczba_String : STRING[15];
Liczba : LONGINT;
Licznik : SHORTINT;
(*************************************************************)
BEGIN
ClrScr;
WriteLn(' Przejrzystosc liczb');
WriteLn;
Write(' Podaj liczbe calkowita (do 9 cyfr): ');
ReadLn(Liczba);
STR(Liczba,Liczba_String);
Licznik := LENGTH(Liczba_String) - 2;

WHILE Licznik > 0 DO
BEGIN
Insert (' ',Liczba_String, Licznik);
Licznik := Licznik - 3
END;
WriteLn;
WriteLn(' Przejrzysta postac : ', Liczba_String);

REPEAT UNTIL KeyPressed
END.
____________________________________30
PROGRAM Sortowanie_przez_wstawianie;
USES
Crt;
CONST
n_max=20; (* maksymalna liczba elementow *)
TYPE
Dane = ARRAY [1..n_max] OF INTEGER;
VAR
n : INTEGER;
T_1 : Dane;

(**********************************)
PROCEDURE Wprowadzanie( VAR T:Dane);
VAR
i :INTEGER; (* zmienna kontrolna *)
BEGIN
Writeln(' Wprowadzanie danych do tablicy ');
Writeln;
Write (' Podaj ilosc elementow (n<=20), n= ');
Readln (n);
Writeln;
Write (' Podaj elementy tablicy w kolejnosci');
Writeln;
Writeln;
FOR i:=1 TO n DO
BEGIN
Write(' element nr= ',i,', T_1[ ' , i ,' ] = ');
Readln (T[i]);
END;
END;
(**********************************)

PROCEDURE Odczyt_tablicy( VAR T:Dane);
VAR
i :INTEGER; { zmienna kontrolna }
BEGIN
Writeln;
Write (' Odczytaj elementy tablicy w kolejnosci');
Writeln;
Writeln;

FOR i:=1 TO n DO
BEGIN
Write(' element nr= ',i,', T_1[ ' ,i ,' ] = ');
Writeln (T[i])
END;

END;
(***********************************)
PROCEDURE Sort_wstaw( VAR T:Dane);
VAR
i, k :INTEGER; (* zmienna kontrolna *)
z_p :INTEGER;
(*z_p- zmienna pomocnicza do zamiany elementow *)

BEGIN
Writeln;
FOR i:=2 TO n DO
BEGIN
k:=i;
z_p:=T[k];
(* zapamietanie elementu do wstawienia *)

WHILE (k>1) AND (T[k-1]> T[k]) DO
(* przesuniecie elementow w prawo*)
BEGIN
T[k]:=T[k-1];
T[k-1]:=z_p;
k:=k-1
END;
T[k]:=z_p; (* wstawienie danego elementu *)

END;
Writeln;Writeln;
Writeln(' Tablica uporzadkowana');
END;
(***********************************)
BEGIN
ClrScr;
Wprowadzanie (T_1);
Sort_wstaw (T_1);
Odczyt_tablicy (T_1);
Writeln;
REPEAT UNTIL KeyPressed
END.
____________________________________31
PROGRAM Zakladanie_pliku_tekstowego;
USES
Crt;
VAR
f : Text;
z : CHAR;
n_plik : STRING[30];
tekst : STRING[80];
Nowy_plik : Boolean;
Wybrany_klawisz : CHAR;

TYPE
Dostep = STRING[40];

(*******************************)
(* Sprawdzenie czy plik juz istnieje *)
FUNCTION Istnieje_plik (Nazwa_pliku : Dostep) : Boolean;
BEGIN


(*$I-*) (* Wylaczenie systemu kontrolnego *)
Assign(f,Nazwa_pliku);
Reset(f);
(*$I+*) (* Uruchomienie systemu kontrolnego *)
IF IOResult = 0 THEN
BEGIN (* Plik istnieje ! *)
Close(f);
Istnieje_plik := TRUE
END
ELSE (* Plik jeszcze nie istnieje ! *)
Istnieje_plik := FALSE
END;

(**************************************************)

BEGIN
ClrScr;
Writeln;
Nowy_plik := TRUE;
Writeln(' Zakladanie pliku tekstowego ');
Writeln;
Write(' Podaj nazwe zakladanego pliku ....: ');
Writeln;
Write(' ( Nie podasz - nazwa domyslna pliku : ) ');
Writeln(' txt_1.dan ');
Writeln;
Write(' Nazwa pliku ....: ');
Readln(n_plik);
Writeln;
IF LENGTH(n_plik)=0 THEN
n_plik:='text_1.dan';
IF Istnieje_plik(n_plik) THEN

BEGIN (* Plik istnieje - to czy zastapic go nowym ? *)
Writeln;
Writeln(' Uwaga !!!');
Writeln(' Plik istnieje - Wszystkie ',+
' dotychczasowe dane zostana usuniete z pliku !');
Writeln;

REPEAT
Write(' Wykonywac dalej ? (T)ak / (N)ie : ');
Readln(Wybrany_klawisz);
UNTIL Wybrany_klawisz IN ['T','t','N','n'];

IF Wybrany_klawisz IN ['N','n'] THEN
Nowy_plik := FALSE (* Nie tworzyc nowego pliku ! *)
END;

Writeln;
IF Nowy_plik THEN

BEGIN (* Tworzenie nowego pliku *)
ClrScr;
Assign(f,n_plik);
Rewrite(f);
Writeln(' Nowo utworzony plik nosi nazwe : ',n_plik );
Writeln;
Writeln(' Pisz tekst w kazdym wierszu co najwyzej 70 znakow');
Writeln;
Writeln(' Gdy koniec tekstu wpisz wcisnij < ENTER >,');
Writeln(' wpisz < *** > i ponownie wcisnij < ENTER >');
Writeln;
Writeln;
Readln(tekst);
WHILE tekst<>'***' DO
BEGIN
Writeln(f,tekst);
Readln(tekst);
END;
CLOSE(f);
ClrScr;
Writeln;
Writeln(' Odczytanie tekstu z pliku ',n_plik );
Writeln;
RESET(f);
WHILE NOT Eof(f) DO
BEGIN
Readln(f,tekst);
Writeln(tekst);
END;
REPEAT UNTIL KeyPressed;
CLOSE(f);
ClrScr;
Write('Nacisnij dowolny klawisz.');
WHILE Keypressed DO z:=Readkey;
END;
END.
____________________________________32
PROGRAM Tworzenie_i_odczyt_listy;
USES
Crt;
TYPE
Wskaznik_na_element = ^Element ;

Element = RECORD
Nastepny : Wskaznik_na_element;
Dane : Char
END;
VAR
Wskaznik : Wskaznik_na_element;
Korzen : Wskaznik_na_element;

(********************************)
PROCEDURE Tworzenie_listy;
BEGIN
Korzen := NIL; (* Koniec listy *)
Writeln(' Tworzenie listy ');
Writeln;
Writeln(' Podaj elementy listy ');
Writeln(' Kazdy podany element zatwierdz klawiszem >>Enter<< ');
Writeln;
Writeln(' Podanie litery K ');
Writeln(' konczy wprowadzanie elementow listy');
Writeln;
REPEAT
New(Wskaznik); (* Nowy element w liscie *)
Readln(Wskaznik^.Dane); (* Wczytanie zawartosci obiektu *)
Wskaznik^.Nastepny := Korzen; (* Polaczenie z nastepnym
elementem *)
Korzen := Wskaznik (* Korzen wskazuje teraz na
ostatnio utworzony element *)
UNTIL Wskaznik^.Dane IN ['k','K']
END;

(********************************)
PROCEDURE Odczytanie_listy;
BEGIN
Writeln;
Writeln(' Odczytanie listy ');
Writeln;
Write(' Lista zawiera nastepujace elementy : ');
Wskaznik := Korzen;
(* Wskaznik wskazuje na element,
na ktory wskazuje Korzen *)
WHILE Wskaznik <> NIL DO
BEGIN
Write(Wskaznik^.Dane : 3);
Wskaznik := Wskaznik^.Nastepny
(*Przesuniecie wskaznika*)
END
END;

(********************************)
BEGIN
ClrScr;
Tworzenie_listy;
Odczytanie_listy;
REPEAT UNTIL KeyPressed;
END.
____________________________________33
PROGRAM Odwrocenie_listy_1;
USES
Crt;

TYPE
Wskaznik_na_element = ^Element;
Element = RECORD
liczba : INTEGER;
nast : Wskaznik_na_element
END;

(* wskazniki do: *)
VAR
poczatek : Wskaznik_na_element; (* poczatku listy *)
kolejny : Wskaznik_na_element; (* wybranego elementu*)
Pocz_Odwr : Wskaznik_na_element; (* poczatku listy odwroconej *)
Kol_Odwr : Wskaznik_na_element; (* danego elementu listy odwr.*)
P : POINTER; (* poczatku rezerwacji pamieci *)
i : INTEGER;
(**********************)
BEGIN
ClrScr;
Mark(P);
poczatek:=NIL;
New(poczatek);
poczatek^.liczba:=3;
poczatek^.nast:=NIL;
kolejny:=poczatek;
FOR i:=4 TO 11 DO
BEGIN
New(kolejny^.nast);
kolejny:=kolejny^.nast;
kolejny^.liczba:=i;
kolejny^.nast:=NIL;
END;
Writeln(' Tworzenie, odczyt i odwracanie listy ');
Writeln;
Writeln(' Odczyt wprowadzonej listy ');
Writeln(' Lista przed odwroceniem:');
Writeln;
kolejny:=poczatek;
WHILE kolejny <> NIL DO
BEGIN
Write(kolejny^.liczba:3);
kolejny:=kolejny^.nast
END;
Writeln;

Pocz_Odwr:=NIL; (* lista odwrocona chwilowo jest pusta *)
kolejny:=poczatek;
WHILE kolejny <> NIL DO
BEGIN
New(Kol_Odwr);
Kol_Odwr^.liczba:=kolejny^.liczba;
Kol_Odwr^.nast:=Pocz_Odwr;
Pocz_Odwr:=Kol_Odwr;
kolejny:=kolejny^.nast;
END;

Writeln;
Writeln(' Lista po odwroceniu:');
kolejny:=Pocz_Odwr;
Writeln;
WHILE kolejny <> NIL DO
BEGIN
Write(kolejny^.liczba:3);
kolejny:=kolejny^.nast
END;
Release(P);
Readln
END.
____________________________________34
PROGRAM Liczby_od_1_do_23;
USES
Crt;
VAR
liczba:INTEGER;
BEGIN
ClrScr;
liczba:=0;
Writeln ('Liczby naturalne od 1 do 23');
Writeln;
WHILE liczba<>23 DO
BEGIN
liczba:=liczba+1;
Write (' ',liczba);
END;
END.
____________________________________35
BEGIN
{program uzgodniony z nauczycielem}
END.


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