1-po vstupe n cisel vypocita ich aritmeticky priemer
zobrazi cisla do stlpca v opacnom poradi
uses crt;
var p:array[1..10] of real;
priem,suc:real;
n,i:integer;
begin
clrscr;
writeln('vypocet priemeru n realnych cisel');
writeln('napis pocet cisel do 10 kolko chces zadat ');
readln(n);
writeln('pis cisla');
suc:=0;
for i:=1 to n do
begin
readln(p[i]);
suc:=suc+p[i];
end;
priem:=suc/n;
writeln('priemer cisel je: ',priem:5:3);
writeln(' v opacnom poradi: ');
for i:=n downto 1 do writeln(p[i]:5:1);
readln;
end.
2- vypocita kolko jednotiek je treba na prepis daneho cisla do dvojkovej sustavy
uses crt;
var n,i,z:integer;
begin
clrscr;
writeln('zadaj cislo ktore chces previest do binarnej');
readln(n);
z:=0;
while not (n=0) do
begin i:=n mod 2;
z:=z+1;
n:=n div 2;
end;
writeln('pocet potrebnych jednotiek na zapisanie je:',z);
readln;
end.
3-program kalkulacka
uses crt;
var: A,B: integer;
C: real;
Z: char;
begin
clrsrc;
writeln('zadaj dve cele kladne cisla');
readln(A,B);
writeln('Vyber si operaciu +,-,*,/');
Z:=readkey;
case Z of
'+':C:=A+B;
'-':C:=A-B;
'*':C:=A*B;
'/':C:=A/B;
end;
writeln(A,Z,B,'=',C:6:3);
readln;
end.
4-zadate na vstupe cele kladne cialo a vystupom bude jeho ciferny sucet
uses crt;
var a,s:integer;
BEGIN
clrscr;
s:=0;
write('Zadaj cislo: ');
readln(a);
repeat
s:=s+a-(a div 10)*10;
a:=a div 10;
until a=0;
write('Ciferny sucet je: ',sucet);
readln;
END.
5-program euro_kalkulacka
uses crt;
var a,b,vysa,vysb:real;
c,smer:char;
begin
repeat
clrscr;
writeln('Zadaj smer a= Euro na SKK , b=SKK na euro');
readln(smer);
clrscr;
IF smer='a' then
begin
writeln('Zadaj pocet Eur, ktore preratam na SKK');
readln(a);
clrscr;
vysa:=a*30.1260;
writeln(a:2:2,' Eur je ',vysa:2:2,' SKK');
end;
if smer='b' then
begin
writeln('Zadaj pocet SKK, ktore preratam na Eura');
readln(b);
clrscr;
vysb:=b/30.1260;
writeln(b:2:2,' SKK je ',vysb:2:2,' Eur');
end;
writeln('Opakovat vypocet? y/n');
readln(c);
until c='n';
end.
6-program na zaheslovanie pristupu, najprv si vypita textove heslo, potom ciselne
program heslo;
uses crt;
var a,b,c,d:string;
begin
a:='heslo';
b:='12345';
clrscr;
writeln('zadaj textove heslo: ');
readln(c);
if c=a then writeln('spravne') else
repeat
clrscr;
writeln('nespravne, zadaj znova: ');
readln(c);
until c=a;
if c=a then writeln('spravne');
writeln;
writeln('oki, teraz zadaj ciselne heslo: ');
readln(d);
if d=b then writeln('spravne') else
repeat
clrscr;
writeln('nespravne, zadaj znova: ');
readln(d);
until d=b;
if d=b then writeln('spravne');
writeln;
readln;
end.
7-nakresli pomocou cyklu s konecnym opakovanim dany utvar pre lub cele cislo max 15
uses crt;
var i,n:integer;
BEGIN
clrscr;
write('Zadaj n: ');
readln(n);
if n>15 then writeln('Musis zadat cislo mensie ako 15') else
for i:=1 to n do
begin
gotoxy(i,2); write('*');
gotoxy(i,n+1); write('*');
gotoxy(1,i+1); write('*');
gotoxy(n,i+1); write('*');
end;
readln;
END.
8-program pre pocitanie suctu rozdielu nasobenia delenia (celociselneho) dvoch cisel
program interval;
uses crt;
var x,y:integer;
a:char;
begin
clrscr;
repeat
writeln('vyber si funkciu');
writeln('1 sucet');
writeln('2 rozdiel');
writeln('3 sucin');
writeln('4 podiel');
readln(a);
writeln('napis dve cisla:');
readln (x,y);
if (a='1')then writeln ('x+y=',x+y);
if (a='2')then writeln ('x-y=',x-y);
if (a='3')then writeln ('x/y=',x*y);
if (a='4')then writeln ('x*y=',(x div y),'zvysok:', (x mod y) );
writeln('chcete opakovat? a/n');
readln(p);
until p='n';
end.
9-nacita suradnice bodu a urci v ktorom kvadrante sa nachadza definujte funkciu ktorej parametrami su suradnice daneho bodu funkcia nadobuda hodnoty 1..4 oznacuju kvadrant
program debilina;
uses crt;
var x,y:real;
kvad:0..4;
function kvadrant(x,y:real):integer;
begin
if x*y=0 then kvadrant:=0;
if(x>0) and (y>0) then kvadrant:=1;
if(x<0) and (y>0) then kvadrant:=2;
if(x<0) and (y<0) then kvadrant:=3;
if(x>0) and (y<0) then kvadrant:=4;
end;
begin
writeln('napis suradnice bodu(realne cisla)');
write('x=');
readln(x);
write('y=');
readln(y);
kvad:=kvadrant(x,y);
if kvad=0 then writeln('bod lezi na niektorej osi') else
writeln('bod lezi ',kvad,' kvadrante');
readln;
end.
10-program na vypocet kvadratickej funkcie
program kvadrat;
uses crt;
var a,b,c,d,x1,x2:real;
procedure diskriminant;
begin
d:= b*b-4*a*c;
end;
procedure korene;
begin
if (d>0) then writeln ('x1=',(-b+sqrt(d))/2*(a):1:1,' x2=',-b-sqrt(d)/2*(a):1:1);
if (d=0) then writeln ('x=' ,-b/2*(a):1:1);
if (d<0) then writeln ('nema riesenie');
end;
begin
clrscr;
writeln(' zadaj a');
readln(a);
writeln('zadaj b');
readln(b);
writeln('zadaj c');
readln(c);
diskriminant;
korene;
readln;
end.
11-zisti pocet medzier v subore
program medzery;
uses crt;
var a:char;
t:text;
poc:integer;
begin
clrscr;
assign(t,'medzery.txt');
reset(t);
poc:=0;
while not EOF(t) do
begin
read(t,a);
if a= ' ' then poc:=poc+1;
write(a);
end;
writeln;
writeln;
writeln('v subore sa nachadza :',poc,'medzier');
close(t);
readln;
end.
12-program pre osetrenie vstupno vystupnej operacie nad typom definovanym uzivatelom umozni zadanie cisla mesiaca a jeho vypisanie
vytvorte typ definovany uzivatelom
vypise hlasenie o tpm ktory mesiac bol zadany
ak vacsia ako 12 chyba
program kalendar;
uses crt;
type mesiac=(januar,februar,marec,april,maj,jun,jul,august,september,oktober,
november,december,chyba);
var mes:mesiac;
n:integer;
slovo:string;
begin
clrscr;
writeln('napis cislo mesiaca');
readln(n);
case n of 1:mes:=januar;
2: mes:=februar;
3: mes:=marec;
4: mes:=april;
5: mes:=maj;
6: mes:=jun;
7: mes:=jul;
8: mes:=august;
9: mes:=september;
10: mes:= oktober;
11: mes:=november;
12: mes:=december;
else mes:=chyba;
end;
case mes of januar:slovo:='januar';
februar:slovo:='februar';
marec:slovo:='marec';
april:slovo:='april';
maj:slovo:='maj';
jun:slovo:='jun';
jul:slovo:='jul';
august:slovo:='august';
september:slovo:='september';
oktober:slovo:='oktober';
november:slovo:='november';
december:slovo:='december';
else slovo:='neexistuje';
end;
writeln(n,' mesiac-',slovo);
readln;
end.
13-program ktory vygeneruje pole velkost 10 prvkov=nahodne hodnoty do 1000 a zisti ci sa vami zadane cislo tam nachadza
program po;
uses crt;
var pole:array[1..10] of integer;
a,n,i:integer;
nasiel:boolean;
begin
clrscr;
randomize;
n:=10;
nasiel:=false;
for i:=1 to 10 do
begin
pole[i]:=random(1001);
write(pole[i],',');
end;
writeln;
writeln('zadaj prvok ktory chces najst');
readln(a);
for i:=1 to n do if pole[i]=a then nasiel:=true;
if nasiel=true then writeln (a, 'prvok sa nachadza v poli')
else writeln(a, 'prvok sa nenachadza v poli');
readln;
end.
14-nacita text z klavesnice min 3 slova
vypise pocet znakov najdlhsieho slova
program jeden;
uses crt;
var a,b:string;
p,l,c:integer;
x:char;
begin
clrscr;
p:=0;
writeln('zadaj 3slova a stlac [ENTER]');
readln(a);
l:=length(a);
b:=' ';
repeat
c:=pos(b,a);
if c>p then p:=c else p:=p;
a:=copy(a,c+1,100);
l:=length(a);
until c=0;
if l>p then writeln('pocet prvkov najdlhsieho slova je: ',l) else
writeln('pocet prvkov najdlhsieho slova je: ',p-1);
readln;
end.
15-vypise malu nasobilku pre zadane cislo n
vystup v tvare tabulky v ktorej n-ty riadok a stlpec budu zvyraznene
program hh;
uses crt;
var i,j,n:integer;
begin
textcolor(15);
writeln('tabulka nasobkov');
write('zadaj cislo do 10) n=');
textcolor(9);
readln(n);
writeln;
for i:=1 to 10 do begin
for j:=1 to 10 do begin;
if (i<>n) and (j<>n) then
textcolor(15) else textcolor(9);
write(i*j:4);
end;
writeln;
end;
readln;
end.
16-program na vypocet objemu a povrchu valca kuzela a gule
program Objem;
uses crt;
var
V,r,vyska : real;
menu : integer;
begin
clrscr;
writeln('a.Objem gule');
writeln('b.Objem valca');
writeln('c.Objem kuzela');
readln(menu);
clrscr;
IF menu = 1 THEN
begin
writeln('Zadaj polomer');
readln(r);
readln(vyska);
clrscr;
V := 4/3 * Pi * r * r*r ;
writeln('Povrch Gule je ',V : 2 : 2);
readln;
end;
IF menu = 2 THEN
begin
writeln('Zadaj polomer');
readln(r);
clrscr;
writeln('Zadaj vysku');
readln(vyska);
clrscr;
V := Pi * r * r * vyska;
writeln('Objem valca je ',V : 2 : 2);
readln;
end;
IF menu = 3 THEN
begin
writeln('Zadaj polomer');
readln(r);
clrscr;
writeln('Zadaj vysku');
readln(vyska);
clrscr;
V :=1/3* Pi * r * r * vyska;
writeln('Objem valca je ',V : 2 : 2);
readln;
end;
end.
17-program zisti kolko krat sa nachadza zadany podretazec v retazci
program x;
uses crt;
var t:text;
pod, ret:string;
pocet,p:integer;
begin
clrscr;
writeln('zadaj podretazec, tory ces hladat: ');
readln(pod);
assign(t,'ret.txt');
reset(t);
readln(t,ret);
pocet:=0;
repeat
p:=pos(pod,ret);
begin
if p<>0 then pocet:=pocet+1;
ret:=copy(ret,p+length(pod),300);
end;
until p=0;
close(t);
writeln;
writeln(pocet);
readln;
end.
18-program, ktory vypocita priemer znamok ziaka z predmetu za styri roky
program priemer_znamok;
uses crt;
var p:array[1..36] of byte;
priem1:array[1..36] of real;
priem2:array[1..36] of real;
priem3:array[1..36] of real;
priem4:array[1..36] of real;
priem:array[1..36] of real;
n, i, zn:byte;
nazov:string;
begin
clrscr;
writeln('zadaj nazov predmetu: ');
readln(nazov);
writeln('zadaj pocet ziakov, max 36 (myslim, ze tolko moze byt v triede podla zakona :D)');
readln(n);
for i:=1 to n do begin
priem[i]:=0;
writeln('zadaj znamku z predmetu za prvy rocnik pre ',i,'. ziaka: ');
readln(priem1[i]);
writeln('zadaj znamku z predmetu za druhy rocnik pre ',i,'. ziaka : ');
readln(priem2[i]);
writeln('zadaj znamku z predmetu za treti rocnik pre ',i,'. ziaka: ');
readln(priem3[i]);
writeln('zadaj znamku z predmetu za stvrty rocnik pre ',i,'. ziaka: ');
readln(priem4[i]);
priem[i]:=((priem1[i]+priem2[i]+priem3[i]+priem4[i])/4);
clrscr;
end;
writeln(nazov);
writeln;
for i:=1 to n do begin
writeln(i,', ziak');
writeln(' prvy rocnik: ',priem1[i]:1:2);
writeln(' druhy rocnik ',priem2[i]:1:2);
writeln(' treti rocnik: ',priem3[i]:1:2);
writeln(' stvrty rocnik: ',priem4[i]:1:2);
writeln(' priemer za 4 roky: ',priem[i]:1:2);
writeln;
end;
readln;
end.
19-zisti ci je cislo prvocislo
program bb;
uses crt;
var x,y,z:integer;
begin
writeln('zadaj cislo');
readln(x);
if x=0 then writeln (' nie je prvocislo')else
if x=1 then writeln(' nie je prvocislo')else
if x=2 then writeln('je prvocislo');
for y:=2 to x-1 do
if x mod y=0 then z:=1;
if z=1 then writeln ('nie je prvocislo')
else writeln(' je prvocislo');
readln;
end.
20-SEMAFOR
Program Semafor;
Uses Crt, Graph;
Const polomer = 40;
okraje = 20;
Var i integer;
Procedure Kruh(poradie, farba integer);
Begin
poradie= poradie - 2;
SetColor(farba);
Circle (320, 240+poradie(2polomer+okraje), polomer);
SetFillStyle(1, farba);
FloodFill(320, 240+poradie(2polomer+okraje), farba);
End;
Procedure Inicializacia;
Var Gd, Gm, x1, y1, x2, y2 Integer;
Begin
Gd= 0;
Gm= 0;
InitGraph(Gd, Gm, 'CTP7BGI');
ClearDevice;
If GraphResult 0 Then Halt;
{horny lavy bod}
x1=320-okraje-polomer;
y1=240-2okraje-3polomer;
{dolny pravy bod}
x2=320+okraje+polomer;
y2=240+2okraje+3polomer;
{dvojty obdlznik}
SetColor(7);
Rectangle(x1, y1, x2, y2);
Rectangle(x1+1, y1+1, x2-1, y2-1);
{cervebe svetlo}
Kruh(1, Red);
End;
Procedure Zmena(poradieinteger);
Begin
{najprv vsetky zhasneme, potom zapneme to svetlo, ktore treba}
Kruh(1, 0);
Kruh(2, 0);
Kruh(3, 0);
Case poradie Of
1 Kruh(1, 4);
2 Kruh(2, 6);
3 Kruh(3, 2);
End;
End;
Begin
Inicializacia;
Repeat
Zmena((i Mod 3)+1);
Inc(i);
Until Ord(Readkey) = 27;
End.
21-program ktory ci cislo je je cele,parne a neparny ak parne zinicializuje grafiku a nakresli smajla
program dd;
uses crt,grafika;
var a,b:integer;
begin
clrscr;
writeln('zadaj cislo');
readln(a);
if (a mod 2)<>0 then writeln('cislo je neparne') else
begin
repeat
writeln('zadaj parne cislo');
readln(a);
until (a mod 2)=0;
end;
setcolor(8);
circle(200,200,100);
line(150,250,250,250);
line(150,125,150,150);
line(250,125,250,150);
readln;
end.
22-ktory bude pocitat sucet cisel text dokumentu ktory si vytvorimw
zisti kolko cisel sa nachadza v subore cisla.txt
vypocita priemer
vypise na obrazovku ich sucet pocet a priemer
program subor;
uses crt;
var t:text;
a:integer;
sucet,pocet:longint;
priemer:real;
begin
clrscr;
assign(t,'cisla.txt');
reset(t);
sucet:=0;
pocet:=0;
while not eof(t) do begin
read(t,a);
sucet:=sucet+a;
pocet:=pocet+1;
end;
priemer:=sucet/pocet;
writeln('sucet cisel:', sucet);
writeln('pocet cisel:', pocet);
writeln('pocet cisel:',priemer:2:2);
close(t);
readln;
end.
23-
program min2_max2;
uses crt;
var
i,sucet:integer;
n:integer;
min1:real;
min2:real;
max1:real;
max2:real;
v:array[1..5000] of integer;
begin
ClrScr;
Write('Zadaj pocet cisel.' );
ReadLn(n);
for i:=1 to n do
begin
Write('Zadaj cislo[',i,']=');
ReadLn(v[i]);
end;
min1 := v[1];
max1 := v[1];
for i:=1 to n do
begin
if( v[i] < min1 )then
min1 := v[i];
if( v[i] > max1 )then
max1 := v[i];
end;
begin
for i:=1 to n do
sucet:=0;
sucet:=sucet+v[i];
end;
WriteLn;
WriteLn('Najmensie cislo je: ', min1:8:3);
WriteLn;
WriteLn('Najvacsie cislo je: ', max1:8:3);
writeln('Sucet prvkov:',sucet);
ReadLn;
end.
24-
program rad;
uses crt;
var n,i:integer;
sucet:real;
begin
writeln('zadaj cislo');
readln(n);
sucet:=1;
write('sucet radu ');
for i:=2 to n do
begin
sucet:=sucet+1/i;
end;
writeln('je ',sucet:8:6);
readln;
end.
25-na riesenie ulohy o vyplate penazi v ktorycjh treba urcit kolko 500,200,100,50,20,10,5,2,1
eurobankoviek potrebujeme na vyplatenie danej sumy tak aby sme pouzili co najmensi pocet platidiel
program hh;
uses crt;
const b:array[1..9] of integer=(500,200,100,50,20,10,5,2,1);
var a:array[1..9] of integer;
j:integer;
suma :longint;
begin
writeln('zadaj sumu v eurach:');
readln(suma);
for j:=1 to 9 do
begin
a[j]:=suma div b[j];
writeln(b[j]:4,'eur treba ',a[j]:2,' ks');
suma:=suma mod b[j];
end;
readln;
end.
26-{nacita dlzky stran trojuholnika
pomocou procedur zisti ktora strana cislo je najvacsie
pomocou tojuholnikovej nerovnosti ci dany trojuholnik existuje
pomocou pytagorovej ci je pravouhly}
program cisla;
uses crt;
var a,b,c:integer;
procedure najvacsie;
begin
if (a>b) and (a>c) then writeln ('strana a je najdlhsia');
if (b>a) and(b>c) then writeln ('strana b je najdlhsia');
if (c>a) and (c>b) then writeln ('strana c je najdlhsia');
if (a=c) and (c=b) then writeln ('vsetky strany su rovnake');
if (a=c) and (a>b) then writeln ('strana a,c su najdlhsia');
if (a=b) and (a>c) then writeln ('strana a,b su najdlhsia');
if (b=c) and (b>a) then writeln ('strana b,c su najdlhsia');
end;
procedure existuje;
begin
if ((a+b)>c) and ((a+c)>b) and ((b+c)>a)then writeln ('trojuholnik existuje')
else writeln('trojuholnik neexistuje');
end;
procedure pravouhly;
begin
if( sqr(a)+sqr(b)=sqr (c))then writeln('trojuholnik je pravouhly')
else writeln('trojuholnik nie je pravouhly');
end;
begin
clrscr;
writeln ('zadaj strany trojuholnika:');
readln (a,b,c);
najvacsie;
existuje;
pravouhly;
readln;
end.
27-usporiada zadane slova podla dlzky
program slova;
uses crt;
var i,j,n,max:integer;
s:array[1..10]of string;
f:text;
begin
writeln('zadaj pocet slov');
readln(n);
max:=0;
for i:=1 to n do
begin
readln(s[i]);
end;
if length(s[i])>max then max := length(s[i]);
writeln('slova usporiadane podla dlzky:');
assign(f,'slova.txt');
rewrite(f);
for i:=1 to max do
for i:=1 to n do
if length(s[j])=i then
begin
writeln(s[j]);
write(f,s[j]);end;
close(f);
readln;
end.
28-usporiada 10 prvkov pola, pouziva cyklus repeat until
program usporiadane_repeat_until;
uses crt;
var p:array[1..10] of integer;
n, i:integer;
begin
clrscr;
randomize;
for i:=1 to 10 do begin
p[i]:=random(301);
end;
for i:=1 to 10 do begin
write(p[i],', ');
end;
writeln;
writeln;
repeat
if p[1]>p[2]then begin
n:=p[1];
p[1]:=p[2];
p[2]:=n;
end;
if p[2]>p[3]then begin
n:=p[2];
p[2]:=p[3];
p[3]:=n;
end;
if p[3]>p[4]then begin
n:=p[3];
p[3]:=p[4];
p[4]:=n;
end;
if p[4]>p[5]then begin
n:=p[4];
p[4]:=p[5];
p[5]:=n;
end;
if p[5]>p[6]then begin
n:=p[5];
p[5]:=p[6];
p[6]:=n;
end;
if p[6]>p[7]then begin
n:=p[6];
p[6]:=p[7];
p[7]:=n;
end;
if p[7]>p[8]then begin
n:=p[7];
p[7]:=p[8];
p[8]:=n;
end;
if p[8]>p[9]then begin
n:=p[8];
p[8]:=p[9];
p[9]:=n;
end;
if p[9]>p[10]then begin
n:=p[9];
p[9]:=p[10];
p[10]:=n;
end;
i:=i+1;
until i=10;
for i:=1 to 10 do writeln(p[i],', ');
readln;
end.
29-prekopiruje vytvoreny subor do noveho a zmeni vsetky pismena na velke
program kopiruj;
uses crt;
var a:char;
t1,t2:text;
begin
clrscr;
assign(t1,'povodne.txt');
reset(t1);
assign(t2,'zmena.txt');
rewrite(t2);
while not EOF(t1) do
begin
read(t1,a);
a:=upcase(a);
write(t2,a);
end;
close(t1);
close(t2);
end.
30-zisti kolkokrat sa nachadza podretazec v retazci ktory zadame na vstupe
program podretazec;
uses crt;
var ret,podret:string;
p,pocet:integer;
begin
clrscr;
writeln('Zadajte retazec');
readln(ret);
writeln('zadajte hladany podretazec');
readln(podret);
pocet:=0;
repeat
p:=pos(podret,ret);
begin
if p<>0 then pocet:=pocet+1;
ret:=copy(ret,p+length(podret),300);
end;
until
p=0;
writeln(pocet);
readln;
end.