2008 09


program Napisy;

begin

writeln('Te dwa napisy');

writeln('znajduja sie w kolejnych wierszach.');

writeln; { wiersz odstepu }

write('Ale te dwa napisy znajduja sie ');

writeln('w tym samym wierszu.')

{ przed end nie musi byc srednika }

end.

program obliczanie_iloczynu;

uses crt;

var i,n, iloczyn:word;

begin

clrScr;

iloczyn:=1;

writeln('podaj liczbe danych');

readln(n);

for i:=1 to n do iloczyn:=iloczyn*i;

writeln('iloczyn =', iloczyn);

readln;

end.

program pierw_rown_kwadrat2;

{program wyznacza pierwiastki rownania ax*x+bx+c=0}

uses crt;

var

a,b,c,delta:integer;

x1,x2:real;

begin

clrscr;

write('a= ');readln(a);

write('b= ');readln(b);

write('c= ');readln(c);

delta:=(b*b)-(4*a*c);

if delta<=0 then

write('Rownanie nie ma pierwiastkow, gdyz delta=',delta,' <0 ')

else x1:=(-b-sqrt(delta))/2*a; x2:=(-b+sqrt(delta))/2*a;

write('delta= ',delta, ' x1=',x1:0:2,' x2=',x2:0:2);

readln

end.

(12.03.2009 czwartek)

program rownanie; (17.03.2009 wtorek)

var a, c, x: real;

begin

writeln ('Podaj wspolczynniki a, c');

readln (a, c);

if a=0 then if c=0

then writeln ('Rownanie tozsame')

else

writeln ('Rownanie sprzeczne')

else

writeln ('x=', -c/a);

end.

program liniowa_(a, b, c); {tutaj nazywam program}

var a, b, c, x, y: real; {definiuje zmienne ktore beda potrzebne w programie}

begin {poczatek programu}

writeln('Podaj wsp˘lczynniki a, b, c r˘wnania ax+by=c'); {prosze o podanie wspolczynnikow}

readln(a, b, c); {wczytuje wspolczynniki}

if a = 0 then if b = 0 then if c = 0 then writeln('r˘wnanie tozsamosciowe') {sprawdzam czy a=0 jesli tak

sprawdzam czy b=0 jesli tak

sprawdzam czy c=0 jesli tak

wypisuje "rownanie tozsamosciowe"}

else

writeln('r˘wnanie sprzeczne') {jesli c nie jest rowne 0 wtedy

wypisuje "rownanie sprzeczne}

else

writeln(' y = ', c / b) {jesli b jest rozne od 0 wtedy wypisuje

"y=" i wyliczona wartosc c/b}

else

if b = 0 then writeln('x = ', c / a) {jesli a jest rozne od 0 sprawdzam czy b=0

jesli tak to wypisuje "x=" i wyliczone c/a}

else

if c = 0 then writeln(a, 'x = -',b) {jesli a i b sa rozne od 0 sprawdzam c

jesli jest rowne 0 to wypisuje

wartosc a "x=-" wartosc b "y"}

else

writeln(a, 'x +', b, 'y = ', c); {jesli a, b i c sa rozne od 0 wypisuje

wartosc a "x+" wartosc b "y=" wartosc c}

end. {koniec programu}

program T7_Zadanie1;

var

a,b:real;

begin

Write('Podaj dwie liczby rzeczywiste: ');

ReadLn(a,b);

if a>b then

WriteLn('Wieksza liczba to ',a:6:2)

else

WriteLn('Wieksza liczba to ',b:6:2);

end.

program T7_Zadanie2; (17.03.2009 wtorek)

var

a,b:real;

begin

Write('Podaj dwie liczby rzeczywiste: ');

ReadLn(a,b);

if a>b then

WriteLn('Wieksza liczba to ',a:6:2)

else if a<b then

WriteLn('Wieksza liczba to ',b:6:2)

else

WriteLn('Liczby sa rowne');

end.

program T7_Zadanie4;

var

a,b,c:byte;

i:integer;

begin

for i:=1 to 10 do

begin

WriteLn('*** Tr˘jkĄt nr ',i);

Write('Podaj dlugosci bokow trojkata: ');

ReadLn(a, b, c);

if (a+b>c) and (a+c>b) and (b+c>a) then

WriteLn('Mozna zbudowac trojkat')

else

WriteLn('Nie mozna zbudowac trojkata');

end;

end.

program T7_Zadanie5;

var

a,b,c:byte;

a2,b2,c2:word;

i:integer;

begin

for i:=1 to 10 do

begin

WriteLn('*** Trojkat nr ',i);

Write('Podaj dlugosci bok˘w trojkata: ');

ReadLn(a, b, c);

a2:=a*a;

b2:=b*b;

c2:=c*c;

if (a2+b2=c2) or (a2+c2=b2) or (b2+c2=a2) then

WriteLn('Tak')

else

WriteLn('Nie');

end;

end.

Czwartek 2 kwietnia

program T7_Zadanie7;

var

x,w:real;

i,n:integer;

begin

Write('Podaj liczbe danych: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj liczbe: ');

ReadLn(x);

if x>=0 then w:=x

else w:=-x;

Writeln('Wartosc bezwzgledna liczby ',x:6:2,'=',w:6:2);

end;

end.

program T7_Zadanie8a;

var

a,b,w:integer;

begin

Write('Podaj dwie liczby: ');

ReadLn(a, b);

if a=b then

WriteLn('Liczby sa rowne')

else

begin

if a>b then w:=a

else w:=b;

WriteLn('Wieksza z dwoch liczb to ',w)

end;

end.

program T7_Zadanie8b;

var

x,fx:real;

i,n:integer;

begin

Write('Podaj liczbe danych: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj x: ');

ReadLn(x);

if x<-1 then fx:=-1

else if x<=1 then fx:=x

else fx:=1;

WriteLn('F(',x:6:2,')=',fx:6:2);

end;

end.

program T7_Zadanie9;

var

x,fx:real;

begin

Write('Podaj x: ');

ReadLn(x);

if x<=0 then fx:=-1

else fx:=x-1;

WriteLn('F(',x:6:2,')=',fx:6:2);

end.

program T7_Zadanie10;

var

a,b,x:real;

i,n:integer;

begin

Write('Podaj liczbe danych: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj a, b: ');

ReadLn(a, b);

if a=0 then

if b=0 then

WriteLn('Nieskonczenie wiele rozwiazan')

else

WriteLn('Rownanie sprzeczne')

else

begin

x:=-b/a;

Writeln('x=',x:6:2);

end;

end;

end.

program T7_Zadanie11;

var

i,n:integer;

a,suma:real;

begin

suma:=0;

Write('Podaj liczbe danych: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj a: ');

ReadLn(a);

suma:=suma+a;

end;

WriteLn('Suma= ',suma:6:2);

end.

program T7_Zadanie12;

var

m,n:integer;

i,j:integer;

znak:char;

begin

Write('Podaj m: ');

ReadLn(m);

Write('Podaj n: ');

ReadLn(n);

for j:=1 to n do

begin

if j mod 2=1 then

znak:='A'

else

znak:='B';

for i:=1 to m do

Write(znak);

WriteLn;

end;

end.

program T7_Zadanie13;

var

m,n:integer;

i,j:integer;

ri,rj:integer;

begin

Write('Podaj m: ');

ReadLn(m);

Write('Podaj n: ');

ReadLn(n);

for j:=1 to n do

begin

for i:=1 to m do

begin

ri:=i mod 2;

rj:=j mod 2;

Write((ri+rj) mod 2);

end;

WriteLn;

end;

end.

program T7_Zadanie14;

var

a,b,c,d,pd:real;

begin

Write('Podaj a: '); ReadLn(a);

Write('Podaj b: '); ReadLn(b);

Write('Podaj c: '); ReadLn(c);

d:=b*b-4*a*c;

if d<0 then

WriteLn('Brak rozwiazan')

else if d=0 then

begin

WriteLn('x1=x2=',-b/(2*a):6:2);

end

else

begin

pd:=sqrt(d);

WriteLn('x1=',(-b-pd)/(2*a):6:2);

WriteLn('x2=',(-b+pd)/(2*a):6:2);

end;

end.

Program Dzielenie;

USES

Crt;

BEGIN

ClrScr;

Write('(2*3+17)/9 =',(2*3+17)/9:7:4);

END.

PROGRAM Pole_prostokata;

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.

program gwiazdki; 16 kwiecień 2009 r.

var z1, z2:char;

begin

writeln ('Podaj pierwszy znak: ');

readln (z1);

writeln ('Podaj drugi znak: ');

readln (z2);

if (z1='*') and (z2='*') then

writeln ('Obydwa znaki to *')

else

if z1='*' then

writeln ('Pierwszy znak to *')

else

if z2='*' then

writeln ('Drugi znak to *')

else

writeln ('Zaden nie jest gwiazka');

writeln ('Potwierdz');

readln

end.

program asci1;

uses crt;

var z:char;

x:integer;

begin

clrscr;

writeln ('Podaj kod z zakresu 32-255');

readln (x);

z:=char(x);

writeln(z);

writeln ('potwierdz');

readln;

end.

program silnia1;

var n, silnia, i :longint;

begin

writeln(' Podaj liczbe silni ');

readln(n);

i:=n;

while i > 1 do

begin

silnia:=n;

i:=i-1;

silnia:=silnia*i;

end;

writeln('silnia liczby ', n, ' wynosi ', silnia);

writeln('Wcisnij klawisz');

readln

end.

program srednia;

var n, i: integer;

sr, s, x: real;

begin

write ('podaj ilosc liczb:');

readln (n);

s:=0;

for i:=1 to n do

begin

write ('podaj liczbe:');

readln (x);

s:=s+x;

end;

sr:=s/n;

writeln ('suma=',s:10:3);

writeln ('srednia=',sr);

end.

program srednia;

var n, i: integer;

sr, s, x: real;

begin

write ('podaj ilosc liczb:');

readln (n);

s:=0;

i:=0;

repeat

i:=i+1;

write ('podaj liczbe:');

readln (x);

s:=s+x;

until i >= n;

sr:=s/n;

writeln ('suma=',s:10:3);

writeln ('srednia=',sr);

end.

program sumawhil;

var n, s, i :integer;

begin

writeln(' Podaj iloo? liczb');

readln(n);

s:=0;

i:=1;

while i <= n do

begin

s:=s + i;

i:=i + 1;

end;

writeln('Suma kolejnych liczb od 1 do ', n, ' wynosi ', s);

end.

program T8_Zadanie1;

uses

CRT;

(*

** UWAGA! Ekran ma 25 wierszy, jednak wypisanie znaku

** w prawym dolnym rogu ekranu powoduje "przewiniecie"

** zawartosci ekranu o jedna linie, skutkiem czego

** pozycje znak˘w uleglyby przesunieciu

*)

procedure Znak(c:char);

begin

ClrScr;

GotoXY(1,1); Write(c);

GotoXY(80,1); Write(c);

GotoXY(1,24); Write(c);

GotoXY(80,24); Write(c);

end;

begin

Znak('@');

end.

program zadanie3;

uses Crt;

var k1, k2:integer;

procedure Test(var x, y:integer);

var t: integer;

begin

t:=x;

x:=y;

y:=t+1;

end;

begin

ClrScr;

Readln (k1,k2);

Test(k1,k2);

Writeln('k1 = ',k1);

Writeln('k2 = ',k2);

Readln;

end.

program T8_Zadanie4;

var

i,n:integer;

ujemne,nieujemne:integer;

x:integer;

procedure Zliczaj(x:integer);

begin

if x<0 then ujemne:=ujemne+1

else nieujemne:=nieujemne+1;

end;

begin

ujemne:=0;

nieujemne:=0;

Write('Podaj liczbe element˘w: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj liczb©: ');

ReadLn(x);

Zliczaj(x);

end;

WriteLn('Liczba elementow ujemnych: ', ujemne);

WriteLn('Liczba elementow nieujemnych: ', nieujemne);

end.

program T8_Zadanie6;

uses

CRT;

var

i:integer;

procedure Wiersz(n:integer);

var

i:integer;

begin

for i:=1 to n do

Write('$');

WriteLn;

end;

begin

ClrScr;

for i:=10 downto 1 do

Wiersz(i);

end.

program T8_Zadanie7;

uses

CRT;

var

i,n:integer;

procedure Pytaj(var n:integer);

begin

repeat

Write('Podaj wielkosc figury (1-79): ');

ReadLn(n);

until (n>=1) and (n<80);

end;

procedure Wiersz(n:integer);

var

i:integer;

begin

for i:=1 to n do

Write('$');

WriteLn;

end;

begin

ClrScr;

Pytaj(n);

for i:=n downto 1 do

Wiersz(i);

end.

program T8_Zadanie8;

uses

CRT;

var

i,n:integer;

procedure Pytaj(var n:integer);

begin

repeat

Write('Podaj wielkosc choinki (1-79): ');

ReadLn(n);

until (n>=1) and (n<80);

end;

procedure Wiersz(poziom:integer);

var

i:integer;

begin

for i:=1 to n-poziom do

Write(' ');

for i:=1 to poziom*2-1 do

Write('$');

WriteLn;

end;

begin

ClrScr;

Pytaj(n);

for i:=1 to n do

Wiersz(i);

for i:=1 to 3 do

Wiersz(1);

end.

23 kwiecień

program T9_Zadanie1;

uses

CRT;

var

i:integer;

tab: array [1..10] of real;

procedure Czytaj;

begin

WriteLn('*** Wprowadzanie liczb:');

for i:=1 to 10 do

begin

Write('Podaj liczbe nr ',i,': ');

ReadLn(tab[i]);

end;

end;

begin

ClrScr;

Czytaj;

ClrScr;

WriteLn('*** Wyprowadzanie liczb:');

for i:=10 downto 1 do

begin

GoToXY(38,11-i+1);

Write(tab[i]:6:2);

end;

end.

program Licz_znaki;

var

tekst:string;

i,j,n,liczba_sp:integer;

procedure Zliczaj(var licznik:integer);

begin

licznik:=licznik+1;

end;

begin

Write('Podaj liczbe tekst˘w: ');

ReadLn(n);

for j:=1 to n do

begin

Write('Podaj tekst nr ',j,': ');

ReadLn(tekst);

liczba_sp:=0;

for i:=1 to Length(tekst) do

if tekst[i]=' ' then

zliczaj(liczba_sp);

WriteLn('Liczba spacji w tekscie: ',liczba_sp);

end;

end.

program T9_Zadanie3;

var

tab: array[1..8] of integer;

zero:boolean;

i:integer;

procedure Czytaj;

begin

WriteLn('*** Wprowadzanie liczb:');

for i:=1 to 8 do

begin

Write('Podaj liczb© nr ',i,': ');

ReadLn(tab[i]);

end;

end;

begin

Czytaj;

zero:=FALSE;

for i:=1 to 8 do

if tab[i]=0 then

zero:=TRUE;

if zero then

begin

WriteLn('Elementy zerowe:');

for i:=1 to 8 do

if tab[i]=0 then

WriteLn(i);

end

else

WriteLn('brak elementu zerowego');

end.

program T9_Zadanie4;

var

i,n:integer;

x,y:real;

operacja:char;

procedure Dodawanie(x,y:real);

begin

WriteLn('Suma=',x+y);

end;

procedure Odejmowanie(x,y:real);

begin

WriteLn('R˘ľnica=',x-y);

end;

procedure Mnozenie(x,y:real);

begin

WriteLn('Iloczyn=',x*y);

end;

procedure Dzielenie(x,y:real);

begin

WriteLn('Iloraz=',x/y);

end;

begin

Write('Podaj liczb© operacji: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj operacj©: ');

ReadLn(operacja);

Write('Podaj pierwszy argument:');

ReadLn(x);

Write('Podaj drugi argument:');

ReadLn(y);

case operacja of

'+': Dodawanie(x,y);

'-': Odejmowanie(x,y);

'*': Mnozenie(x,y);

'/': Dzielenie(x,y);

else WriteLn('Nieznana operacja');

end;

end;

end.

program T9_Zadanie5;

var

i,n:integer;

x,y:real;

operacja:char;

procedure Dodawanie(x,y:real);

begin

WriteLn('Suma=',x+y);

end;

procedure Odejmowanie(x,y:real);

begin

WriteLn('R˘znica=',x-y);

end;

procedure Mnozenie(x,y:real);

begin

WriteLn('Iloczyn=',x*y);

end;

procedure Dzielenie(x,y:real);

begin

if y=0 then

WriteLn('*** BˆĄd - dzielenie przez zero')

else

WriteLn('Iloraz=',x/y);

end;

begin

Write('Podaj liczbe operacji: ');

ReadLn(n);

for i:=1 to n do

begin

Write('Podaj operacje: ');

ReadLn(operacja);

Write('Podaj pierwszy argument:');

ReadLn(x);

Write('Podaj drugi argument:');

ReadLn(y);

case operacja of

'+': Dodawanie(x,y);

'-': Odejmowanie(x,y);

'*': Mnozenie(x,y);

'/': Dzielenie(x,y);

else WriteLn('Nieznana operacja');

end;

end;

end.

program T9_Zadanie6;

var

tekst:string;

i:integer;

begin

Write('Podaj tekst: ');

ReadLn(tekst);

for i:=1 to Length(tekst) do

if tekst[i]='a' then

tekst[i]:='b';

Write('Tekst po zmianach: ',tekst);

end.

program T9_Zadanie7;

uses

CRT;

const

N=20;

var

napis:string[N];

function Odwroc(s:string):string;

var

wynik:string;

i:integer;

begin

wynik:='';

for i:=Length(s) downto 1 do

wynik:=wynik+s[i];

Odwroc:=wynik;

end;

begin

ClrScr;

WriteLn('Wpisz wyraz: ');

ReadLn(napis);

if napis=Odwroc(napis) then

WriteLn('Wyraz jest palindromem')

else

WriteLn('Wyraz nie jest palindromem');

end.

program T9_Zadanie8;

var

znak:char;

begin

Write('Podaj znak: ');

ReadLn(znak);

if UpCase(znak)='I' then

WriteLn('Adam')

else if UpCase(znak)='N' then

WriteLn('Kowalski')

else

WriteLn('zly znak');

end.

program T9_Zadanie9;

var

z1,z2,z3:integer;

i,n:integer;

c:char;

procedure Zliczaj(var licznik:integer);

begin

licznik:=licznik+1;

end;

begin

Write('Podaj liczbe znak˘w: ');

ReadLn(n);

z1:=0;

z2:=0;

z3:=0;

for i:=1 to n do

begin

Write('Podaj znak: ');

ReadLn(c);

case c of

'*': Zliczaj(z1);

'%': Zliczaj(z2);

'x': Zliczaj(z3);

end;

end;

WriteLn('Liczba znakow ''*'': ',z1);

WriteLn('Liczba znakow ''%'': ',z2);

WriteLn('Liczba znakow ''x'': ',z3);

end.

program T9_Zadanie10;

var

i,spolgloski:integer;

tekst:string;

begin

Write('Podaj tekst: ');

ReadLn(tekst);

spolgloski:=0;

for i:=1 to Length(tekst) do

case tekst[i] of

'b','c','d','f','g','h','j','k','l','m',

'n','p','q','r','s','t','v','w','x','z':

spolgloski:=spolgloski+1;

end;

WriteLn('Liczba spolglosek: ',spolgloski);

end.

program T9_Zadanie11;

var

imie:string;

znak:char;

i:integer;

begin

Write('Podaj imie: ');

ReadLn(imie);

for i:=1 to Length(imie) do

imie[i]:=UpCase(imie[i]);

znak:=imie[Length(imie)];

if (znak='A') then

begin

if imie='BONAWENTURA' then

WriteLn('Imie meskie')

else if imie='MARIA' then

WriteLn('Imie meskie lub zenskie')

else

WriteLn('Imie meskie');

end

else

WriteLn('Imie meskie');

end.

(*

** Zakladamy, ze wyrazy sa rozdzielone spacjami

** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad

** i traktujemy je jako jedna spacje

*)

program T9_Zadanie13;

var

s:string;

i,wyrazy:integer;

bylaSpacja:boolean;

begin

Write('Podaj napis: ');

ReadLn(s);

bylaSpacja:=TRUE;

wyrazy:=0;

for i:=1 to Length(s) do

if s[i]=' ' then

bylaSpacja:=TRUE

else

begin

if bylaSpacja then

Inc(wyrazy);

bylaSpacja:=FALSE;

end;

WriteLn('Liczba wyrazow: ',wyrazy);

end.

(*

** Zakladamy, ze wyrazy sa rozdzielone spacjami

** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad

** i traktujemy je jako jedna spacje

*)

program T9_Zadanie14;

var

s:string;

i:integer;

bylaSpacja:boolean;

begin

Write('Podaj napis: ');

ReadLn(s);

bylaSpacja:=TRUE;

for i:=1 to Length(s) do

if s[i]=' ' then

bylaSpacja:=TRUE

else

begin

if bylaSpacja then

WriteLn;

Write(s[i]);

bylaSpacja:=FALSE;

end;

end.

(*

** Zakladamy, ze wyrazy sa rozdzielone spacjami

** Dopuszczamy mozliwosc wystapienia kilku spacji pod rzad

** i traktujemy je jako jedna spacje

*)

program T9_Zadanie15;

var

s, slowo:string;

i:integer;

bylaSpacja:boolean;

function JestPalindromem(s:string):boolean;

var

i, dlugosc:integer;

begin

JestPalindromem:=TRUE;

dlugosc:=Length(s);

for i:=1 to dlugosc div 2 do

if UpCase(s[i])<>UpCase(s[dlugosc-i+1]) then

begin

JestPalindromem:=FALSE;

exit;

end;

end;

begin

Write('Podaj napis: ');

ReadLn(s);

s:=s+' '; (* Wartownik *)

bylaSpacja:=TRUE;

for i:=1 to Length(s) do

if s[i]=' ' then

begin

if slowo<>'' then

begin

Write('Slowo "',slowo,'" ');

if not JestPalindromem(slowo) then

Write('nie ');

WriteLn('jest palindromem');

end;

bylaSpacja:=TRUE;

slowo:='';

end

else

begin

slowo:=slowo+s[i];

bylaSpacja:=FALSE;

end;

end.

program T9_Zadanie16;

var

s:string;

i:integer;

liczba:longint;

function JestPalindromem(s:string):boolean;

var

i, dlugosc:integer;

begin

JestPalindromem:=TRUE;

dlugosc:=Length(s);

for i:=1 to dlugosc div 2 do

if UpCase(s[i])<>UpCase(s[dlugosc-i+1]) then

begin

JestPalindromem:=FALSE;

exit;

end;

end;

begin

Write('Podaj liczbe: ');

ReadLn(liczba);

Str(liczba,s);

WriteLn(JestPalindromem(s));

end.

program T9_Zadanie17;

var

suma, liczba, potega:longint;

i, n:integer;

begin

Write('Podaj n: ');

ReadLn(n);

suma:=0;

liczba:=0;

potega:=1;

for i:=1 to n do

begin

liczba:=liczba+potega;

suma:=suma+liczba;

potega:=potega*10;

end;

WriteLn('Suma=',suma);

end.

program T9_Zadanie19;

const

M=6;

N=4;

type

Tablica=array [1..M,1..N] of real;

var

Tab:Tablica;

procedure CzytajTablice(var t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

Write('Podaj dane z wiersza ',i,' :' );

for j:=1 to N do

Read(t[i,j]);

ReadLn;

end;

end;

procedure WypiszTablice(t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

for j:=1 to N do

Write(t[i,j]:6:2);

WriteLn;

end;

end;

begin

CzytajTablice(Tab);

WriteLn('Oto wprowadzona przez Ciebie tablica:');

WypiszTablice(Tab);

end.

program T9_Zadanie20;

const

M=5;

N=5;

type

Tablica=array [1..M,1..N] of real;

var

Tab:Tablica;

procedure CzytajTablice(var t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

Write('Podaj dane z wiersza ',i,' :' );

for j:=1 to N do

Read(t[i,j]);

ReadLn;

end;

end;

procedure WypiszTablice(t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

for j:=1 to N do

Write(t[i,j]:6:2);

WriteLn;

end;

end;

function SumaPrzekatnej(t:Tablica):real;

var

i,min:integer;

wynik:real;

begin

wynik:=0.0;

if M<N then min:=M

else min:=N;

for i:=1 to min do

wynik:=wynik+t[i,i];

SumaPrzekatnej:=wynik;

end;

begin

CzytajTablice(Tab);

WypiszTablice(Tab);

WriteLn('Suma przekatnej=',SumaPrzekatnej(Tab):6:2);

end.

program T9_Zadanie21;

const

M=5;

N=5;

type

Tablica=array [1..M,1..N] of real;

var

Tab:Tablica;

procedure CzytajTablice(var t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

Write('Podaj dane z wiersza ',i,' :' );

for j:=1 to N do

Read(t[i,j]);

ReadLn;

end;

end;

procedure WypiszTablice(t:Tablica);

var

i,j:integer;

begin

for i:=1 to M do

begin

for j:=1 to N do

Write(t[i,j]:6:2);

WriteLn;

end;

end;

function SumaNadPrzekatna(t:Tablica):real;

var

i,j,min:integer;

wynik:real;

begin

wynik:=0.0;

if M<N then min:=M

else min:=N;

for i:=2 to min do

for j:=1 to i-1 do

wynik:=wynik+t[j,i];

SumaNadPrzekatna:=wynik;

end;

begin

CzytajTablice(Tab);

WypiszTablice(Tab);1

WriteLn('Suma element˘w nad przekatna=',SumaNadPrzekatna(Tab):6:2);

end.

28 kwietnia

program T10_Zadanie1;

var

i,j,liczba:integer;

begin

i:=0;

j:=0;

repeat

Write('Podaj liczbe: ');

ReadLn(liczba);

if liczba<0 then

i:=i+1

else if liczba>0 then

j:=j+1;

until liczba=0;

WriteLn('Liczba elementow dodatnich: ',j);

WriteLn('Liczba elementow ujemnych: ',i);

end.

program T10_Zadanie2;

var

liczba,suma,n:integer;

begin

n:=0;

suma:=0;

repeat

Write('Podaj liczbe: ');

ReadLn(liczba);

if liczba>0 then

begin

suma:=suma+liczba;

n:=n+1;

end;

until liczba<=0;

if n>0 then

WriteLn('srednia=',suma/n:6:2)

else

WriteLn('Nie wprowadzono zadnych liczb');

end.

program T10_Zadanie4;

var

z1,z2,z3:integer;

i,n:integer;

c:char;

procedure Zliczaj(var licznik:integer);

begin

licznik:=licznik+1;

end;

begin

z1:=0;

z2:=0;

z3:=0;

repeat

Write('Podaj znak: ');

ReadLn(c);

case c of

'*': Zliczaj(z1);

'%': Zliczaj(z2);

'x': Zliczaj(z3);

end;

until c='@';

WriteLn('Liczba znak˘w ''*'': ',z1);

WriteLn('Liczba znak˘w ''%'': ',z2);

WriteLn('Liczba znak˘w ''x'': ',z3);

end.

program T10_Zadanie6;

var

n,m:integer;

function Max(n:integer):integer;

var

i,liczba,wynik:integer;

begin

for i:=1 to n do

begin

Write('Podaj liczbe: ');

ReadLn(liczba);

if i=1 then

wynik:=liczba

else

if liczba>wynik then

wynik:=liczba;

end;

max:=wynik;

end;

begin

Write('Podaj liczbe element˘w: ');

ReadLn(n);

m:=Max(n);

WriteLn('Maksimum = ',m);

end.

program T10_Zadanie8;

var

a,b:integer;

begin

Write('Podaj a, b: ');

ReadLn(a, b);

while a<>b do

if a>b then a:=a-b

else b:=b-a;

WriteLn('NWD=',a);

end.

program T10_Zadanie12;

const

LICZBA_ELEMENTOW=5;

var

Elementy:array [1..LICZBA_ELEMENTOW] of integer;

iMin, iMax:integer;

procedure Czytaj(n:integer);

var

i:integer;

begin

for i:=1 to n do

begin

Write('Podaj liczbe ',i,': ');

ReadLn(Elementy[i]);

end;

end;

(*

** Funkcja znajduje _indeksy_ najmniejszego i najwiekszego elementu

** i umieszcza je w zmiennych odpowiednio iMin oraz iMax

*)

procedure MinMax(n:integer; var iMin,iMix:integer);

var

i:integer;

min,max:integer;

begin

iMin:=1;

min:=Elementy[iMin];

iMax:=1;

max:=Elementy[iMax];

for i:=2 to n do

begin

if Elementy[i]<min then

begin

iMin:=i;

min:=Elementy[iMin];

end;

if Elementy[i]>max then

begin

iMax:=i;

max:=Elementy[iMax];

end

end;

end;

begin

WriteLn('Podaj elementy:');

Czytaj(LICZBA_ELEMENTOW);

MinMax(LICZBA_ELEMENTOW, iMin, iMax);

WriteLn('Roznica = ',Elementy[iMax] - Elementy[iMin]);

end.

program T10_Zadanie13;

const

LICZBA_ELEMENTOW=5;

var

Elementy:array [1..LICZBA_ELEMENTOW] of integer;

sr:integer;

procedure Czytaj(n:integer);

var

i:integer;

begin

for i:=1 to n do

begin

Write('Podaj liczbe ',i,': ');

ReadLn(Elementy[i]);

end;

end;

function Srednia(n:integer):integer;

var

i:integer;

suma:longint;

begin

suma:=0;

for i:=1 to n do

suma:=suma+Elementy[i];

Srednia:=suma div n;

end;

function Mediana(n, srednia:integer):integer;

var

i:integer;

med, roznica, roznica2:integer;

begin

med:=Elementy[1];

roznica:=Abs(med-srednia);

for i:=2 to n do

begin

roznica2:=Abs(Elementy[i]-srednia);

if roznica2<roznica then

begin

roznica:=roznica2;

med:=Elementy[i];

end;

end;

Mediana:=med;

end;

begin

WriteLn('Podaj elementy:');

Czytaj(LICZBA_ELEMENTOW);

sr:=Srednia(LICZBA_ELEMENTOW);

WriteLn('srednia = ',sr);

WriteLn('Element najblizszy sredniej = ',

Mediana(LICZBA_ELEMENTOW, sr));

end.

program T10_Zadanie14;

const

LICZBA_ELEMENTOW=10;

var

Parzyste, Nieparzyste: array[1..LICZBA_ELEMENTOW] of word;

maxP, maxN: integer;

(*

** Po zakonczeniu procedury w zmiennych maxP i maxN

** znajda sie odpowiednio: indeks ostatniej liczby parzystej

** oraz indeks ostatniej liczby nieparzystej

*)

procedure Czytaj(var maxP, maxN:integer);

var

i:integer;

x:word;

begin

maxP:=0;

maxN:=0;

i:=1;

repeat

Write('Podaj liczbe ',i,': ');

ReadLn(x);

if x<>0 then (* Nie koniec *)

if x mod 2=0 then (* Parzysta *)

begin

maxP:=maxP + 1;

Parzyste[maxP]:=x;

end

else

begin

maxN:=maxN + 1;

Nieparzyste[maxN]:=x;

end;

i:=i+1;

until (i>LICZBA_ELEMENTOW) or (x=0);

end;

procedure WypiszParzyste(maxP:integer);

var

i:integer;

begin

WriteLn('*** Liczby parzyste:');

for i:=1 to maxP do

Write(Parzyste[i]:8);

WriteLn;

end;

procedure WypiszNieparzyste(maxN:integer);

var

i:integer;

begin

WriteLn('*** Liczby nieparzyste:');

for i:=1 to maxN do

Write(Nieparzyste[i]:8);

WriteLn;

end;

begin

Czytaj(maxP, maxN);

WypiszParzyste(maxP);

WypiszNieparzyste(maxN);

end.

program T10_Zadanie15;

var

a,b:word;

function Euklides(a,b: word):word;

var

t:word;

begin

while b<>0 do

begin

t:=a;

a:=b;

b:=t mod b;

end;

Euklides:=a;

end;

begin

Write('Podaj a, b: ');

ReadLn(a,b);

WriteLn('NWD(',a,',',b,')=',Euklides(a,b));

end.

program T10_Zadanie16;

var

l1, l2:integer;

sl1, sl2:word;

function SumaCyfr(n:integer):word;

var

suma:word;

begin

if n<0 then

n:=-n;

suma:=0;

while n<>0 do

begin

suma:=suma + n mod 10; (* Wartosc cyfry = reszta z dzielenia przez 10 *)

n:=n div 10;

end;

SumaCyfr:=suma;

end;

function WprowadzLiczbe:integer;

var

n:integer;

begin

repeat

Write('Podaj liczbe wieksza od 1: ');

ReadLn(n);

until n>1;

WprowadzLiczbe:=n;

end;

begin

Writeln('*** Wprowadzanie pierwszej liczby');

l1:=WprowadzLiczbe;

Writeln('*** Wprowadzanie drugiej liczby');

l2:=WprowadzLiczbe;

sl1:=SumaCyfr(l1);

sl2:=SumaCyfr(l2);

if sl1=sl2 then

WriteLn('Sumy cyfr sa rowne')

else if sl1>sl2 then

WriteLn('Liczba o wiekszej sumie cyfr to: ',l1,' (suma=',sl1,')')

else

WriteLn('Liczba o wiekszej sumie cyfr to: ',l2,' (suma=',sl1,')');

end.

program T10_Zadanie17;

var

liczba:word;

function JestPierwsza(n:word):boolean;

var

i:word;

begin

JestPierwsza:=TRUE;

for i:=2 to Trunc(Sqrt(n)) do

if n mod i=0 then (* Podzielna *)

begin

JestPierwsza:=FALSE;

exit;

end;

end;

begin

Write('Podaj liczbe: ');

ReadLn(liczba);

if JestPierwsza(liczba) then

WriteLn('Liczba ',liczba,' jest pierwsza')

else

WriteLn('Liczba ',liczba,' nie jest pierwsza');

end.

program T10_Zadanie18;

var

licznik,liczba:word;

function JestPierwsza(n:word):boolean;

var

i:word;

begin

JestPierwsza:=TRUE;

for i:=2 to Trunc(Sqrt(n)) do

if n mod i=0 then (* Podzielna *)

begin

JestPierwsza:=FALSE;

exit;

end;

end;

begin

licznik:=1;

liczba:=3;

WriteLn('*** Liczby blizniacze:');

repeat

if JestPierwsza(liczba) then

begin

if JestPierwsza(liczba+2) then

begin

WriteLn(liczba,' ',liczba+2);

licznik:=licznik+1;

end;

liczba:=liczba+2

end

else

liczba:=liczba+1;

until licznik>20;

end.

program T10_Zadanie19;

const

MAX_WSP=4;

type

TWsp=array [0..MAX_WSP] of real;

var

MojeWsp:TWsp;

x:real;

procedure WprowadzWsp(var w:TWsp);

var

i:integer;

begin

for i:=MAX_WSP downto 0 do

begin

Write('Podaj wspolczynnik nr ',i,': ');

ReadLn(w[i]);

end;

end;

procedure WypiszWielomian(var w:TWsp);

var

i:integer;

begin

for i:=MAX_WSP downto 1 do

Write(w[i]:6:2,'*x^',i,' + ');

WriteLn(w[0]:6:2);

end;

function Horner(var w:TWsp; x:real):real;

var

i:integer;

wynik:real;

begin

wynik:=w[MAX_WSP];

for i:=MAX_WSP-1 downto 0 do

wynik:=w[i]+x*wynik;

Horner:=wynik;

end;

begin

WriteLn('*** Wprowadzanie wspolczynnikow wielomianu ***');

WprowadzWsp(MojeWsp);

WypiszWielomian(MojeWsp);

WriteLn('Podaj wartosc x: ');

ReadLn(x);

WriteLn('Wartosc wielomianu=',Horner(MojeWsp,x):8:2);

end.

33



Wyszukiwarka

Podobne podstrony:
Wyklad 4 HP 2008 09
moj 2008 09
2008 09 KOL1, różne, Algebra semestr 1
Automatyka(000507) 2008 09 17 06
E1 2008 09 zad 4
2008 09 Trzy wymiary Blendera [Grafika]
K2 2008 09 zad 4 id 229677
egzamin 2008 09
PPN -Wykład I - periodyzacja - materiały, Wykłady dla IV roku/ studia stacjonarne pięcioletnie 2008/
E1 2008 09 zad 5
K2 2008-09, zad. 2
K1 2008-09, zad. 5
Egzamin 1, 2008-09
2008 09 14 3023 37 (2)
E1 Teoria 2008 09 id 149145 Nieznany
Wyklad 13 HP 2008 09
Wyklad 14 HP 2008 09
Wyklad 7 HP 2008 09

więcej podobnych podstron