SEPTIMA
program telesa; PÍSOMKA (z plošných telies týmto spôsobom)
var x:integer;
a,b,c,v,s,r,h:real;
begin
writeln('Ideme pocitat objemy a povrchy.');
writeln('Ktore teleso chces?');
writeln('1 - kocka');
writeln('2 - kvader');
writeln('3 - valec');
writeln('4 - kuzel');
readln(x);
case x of
1:begin
write('zadaj hranu: ');
readln(a);
writeln('objem je ',a*a*a:6:2);
writeln('povrch je ',6*a*a:6:2);
end;
2:begin
write('zadaj hrany: ');
readln(a,b,c);
v:=a*b*c;
s:=2*(a*b+b*c+a*c);
writeln('objem je ',v:6:2);
writeln('povrch je ',s:6:2);
end;
3:begin
write('zadaj polomer a vysku: ');
readln(r,h);
v:=3.14*r*r*h;
s:=2*3.14*r*(r+h);
writeln('objem je ',v:6:2);
writeln('povrch je ',s:6:2);
end;
4:begin
write('zadaj polomer a vysku: ');
readln(r,h);
v:=1/3*3.14*r*r*h;
s:=3.14*r*r+3.14*r*sqrt(h*h+r*r);
writeln('objem je ',v:6:2);
writeln('povrch je ',s:6:2);
end;
else writeln('nerozumies slovensky?');
end;
readln;
end.
program mesiac;
var a:integer;
begin
writeln('Zadaj poradove cislo mesiaca: ');
readln(a);
case a of
1,3,5,7,8,10,12:writeln('31 dni');
2:writeln('28 alebo 29');
4,6,9,11:writeln('30 dni');
else writeln('douc sa elementarne vedomosti');
end;
readln;
end.
program kalkulacka; PÍSOMKA!
var x,y,v,z:integer;
a:char;
begin
writeln('Zadaj 2 cisla: ');
readln(x,y);
writeln('Zadaj operaciu (+ - * /): ');
readln(a);
case a of
'+':begin
v:=x+y;
writeln(x,a,y,'=',v);
end;
'-':begin
v:=x-y;
writeln(x,a,y,'=',v);
end;
'*':begin
v:=x*y;
writeln(x,a,y,'=',v);
end;
'/':begin
v:=x div y;
z:=x mod y;
writeln(x,a,y,'=',v,', zvysok: ',z);
end;
else writeln('neznama operacia');
end;
readln;
end.
program trojuholnik; PÍSOMKA!
var a,b,c:integer;
begin
writeln('zadaj 3 cisla: ');
readln(a,b,c);
if (a+b>c) and (a+c>b) and (b+c>a) then
begin
if (sqr(a)=sqr(b)+sqr(c)) or (sqr(b)=sqr(a)+sqr(c)) or (sqr(c)=sqr(a)+sqr(b))
then writeln('pravouhly')
else writeln('nie je pravouhly');
if (a=b) and (b=c) then writeln('rovnostranny');
if (a=b) or (b=c) or (a=c) then writeln('rovnoramenny');
end
else writeln('Nie su to strany trojuholnika');
readln;
end.
program kvadraticka; PÍSOMKA!
uses crt;
var a,b,c,d,x1,x2:real;
begin
writeln('Zadaj koeficienty kvadratickej rovnice: ');
readln(a,b,c);
if a=0 then
begin
writeln('a nesmie byt 0, zadaj este raz');
readln(a);
end;
d:=sqr(b)-(4*a*c);
if d>0 then
begin
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
writeln('x1=',x1:5:2);
writeln('x2=',x2:5:2);
end;
if d=0 then
begin
x1:=-b/(2*a);
writeln('x=',x1:5:2);
end;
if d<0 then writeln('Rovnica nema ziadne riesenie');
readln;
end.
program mrzne;
var t:integer;
begin
write('Zadaj teplotu (celociselnu): ');
readln(t);
if t>0 then writeln ('Nemrzne.')
else writeln ('Mrzne.');
readln;
end.
program cas;
var t,z,h,m,s:integer;
begin
writeln('Zadaj cas v sekundach: ');
readln(t);
h:=t div 3600;
z:=t mod 3600;
m:=z div 60;
s:=z mod 60;
writeln(t,'s = ',h,'h ',m,'m ',s,'s');
readln;
end.
program turnaj;
uses crt;
var d,z:integer;
begin
writeln('Zadaj pocet sutaziacich druzstiev: ');
readln(d);
z:=d*(d-1)div 2;
writeln('Pocet zapasov je ',z);
readln;
end.
program kuzel;
uses crt;
var r,h,b,s,v:real;
const pi=3.14;
begin
writeln('kuzel');
writeln('zadaj polomer a vysku');
readln(r,h);
v:=1/3*pi*r*r*h;
b:=sqrt(h*h+r*r);
s:=pi*r*(r+b);
writeln('povrch: ',s:6:2);
writeln('objem: ',v:6:2);
readln;
end.
program srdiecko;
uses crt;
var z:char;
begin
textbackground(white);
clrscr;
textcolor(black);
writeln('zadaj znak');
writeln('e = koniec');
readln(z);
if z='e' then exit;
textcolor(red);
writeln;
writeln(' ',z,z,' ',z,z);
writeln(z,' ',z,' ',z);
writeln(z,' ',z);
writeln(' ',z,' ',z,' ');
writeln(' ',z,' ',z,' ');
writeln(' ',z,' ');
textcolor(black);
readln;
end.
program cifsucet; PÍSOMKA! + vedieť vypočítať zrkadlové číslo)
var n,cs:longint;
begin
writeln('zadaj viacciferne cislo');
cs:=0;
repeat
cs:=cs+(n mod 10);
n:=n div 10;
until n=0;
writeln('ciferny sucet: ',cs);
readln;
end.
var m,h,p:integer;
begin
writeln('myslim si cislo od 1 do 100. Hadaj');
randomize;
m:=random(100)+1;
p:=0;
repeat
readln(h);
p:=p+1
if h<m then writeln ('pridaj');
if h>m then writeln ('uber');
until h=m;
writeln('gratulujem! uhadol si na ',p,'. krat. myslel som si cislo ',m);
if p>7 then writeln('si lama');
readln;
end.
var s,m:real;
begin
s:=0;
repeat
writeln('zadaj hmotnost balika');
readln(m);
s:=s+m;
writeln('aktualna hmotnost balikov: ',s);
until s>300;
writeln('posledny balik uz nie!');
readln;
end.
var s,m:real;
begin
s:=0;
while s<=300 do
begin
writeln('zadaj hmotnost balika');
readln(m);
s:=s+m;
writeln('aktualna hmotnost balikov: ',s);
end;
writeln('posledny balik uz nie!);
readln;
end.
var i,n,f,k:integer;
begin
writeln('Zadaj cislo');
readln(n);
f:=1;
for i:=1 to n do f:=f*i;
writeln('faktorial cisla ',n,' je ',f);
readln;
end.
var i,n,a,p:integer;
begin
writeln('zadaj pocet cisel');
readln(n);
p:=0;
for i:=1 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a);
if a mod 2=0 then p:=p+1
end;
writeln('Pocet parnych cisel v rade je ',p);
readln;
end.
var i,n,a:integer;
begin
writeln('zadaj pocet cisel');
readln(n);
for i:=1 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a);
if a mod 7=0 then writeln('je delitelne 7')
else writeln('nie je delitelne 7')
end;
readln;
end.
var i,n,a,s:integer;
p:real;
begin
writeln('zadaj pocet cisel');
readln(n);
s:=0;
for i:=1 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a);
s:=s+a;
end;
p:=s/n;
writeln('priemer: ',p:5:2);
readln;
end.
var i,n,a,max:integer;
p:real;
begin
writeln('zadaj pocet cisel');
readln(n);
max:=0;
for i:=1 to n do
begin
writeln('zadaj cislo');
readln(a);
if a>max then max:=a
end;
writeln('najvacsie cislo je: ',max);
readln;
end.
najmensie cislo z radu}
program min; PÍSOMKA! (súčasť programu priemer)
var n,i,a,m:integer;
begin
writeln('Zadajte pocet cisel.');
readln(n);
m:=32767;
for i:=1 to n do
begin
writeln('Zadajte cislo');
readln(a);
if a<m then m:=a
end;
writeln('najmensie cislo je ',m,'.');
readln;
end.
pocet tych cisel z radu, ktore daju pri deleni 3 zvysok 2}
program cyklus1;
var n,i,a,p,z:integer;
begin
writeln('Napis pocet cisel');
readln(n);
p:=0;
for i:=1 to n do
begin
writeln('zadaj cislo');
readln(a);
z:=a mod 3;
if z=2 then p:=p+1
end;
writeln('Pocet cisel z radu, ktore po deleni tromi daju zvysok 2 je ',p);
readln;
end.
var n,i,a,max:integer;
begin
writeln('Napis pocet cisel');
readln(n);
max:=0;
for i:=1 to n do
begin
writeln('Zadaj cislo');
readln(a);
if a>max then max:=a
end;
writeln('najvacsie cislo: ',max);
readln;
end.
uses crt;
var i,n,a,p:integer;
begin
writeln('zadaj pocet cisel');
readln(n);
p:=0;
for i:=1 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a);
if (a>=10)and(a>30) then p:=p+1
end;
writeln('pocet cisel patriacich do toho intervalu je ',p);
readln;
clrscr;
end.
program bunblinkove_triedenie;
var a:array[1..20] of byte;
n,i,j,min,p:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
for i:=1 to n do
begin
a[i]:=random(50)+1;
write(a[i]:5)
end;
writeln;
writeln('zoradim cisla od najmensieho po najvacsie');
for j:=n downto 2 do
begin
for i:=1 to j-1 do
if a[i]>a[i+1] then
begin
p:=a[i];
a[i]:=a[i+1];
a[i+1]:=p;
end;
end;
for i:=1 to n do write(a[i]:5);
readln
end.
program triedenie_cez_minimum;
var a:array[1..20] of byte;
n,i,j,min,p:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
for i:=1 to n do
begin
a[i]:=random(50)+1;
write(a[i]:5)
end;
writeln;
writeln('zoradim cisla od najmensieho po najvacsie');
for j:=1 to n-1 do
begin
min:=a[j];
p:=j;
for i:=j+1 to n do
if a[i]<min then
begin
min:=a[i];
p:=i;
end;
a[p]:=a[j];
a[j]:=min;
end;
for i:=1 to n do write(a[i]:5);
readln
end.
program desat_dva;
var a:array[1..20] of byte;
n:integer;
p,i:byte;
begin
writeln('zadaj cislo v desiatkovej sustave');
readln(n);
i:=1;
while n>0 do
begin
a[i]:=n mod 2;
n:=n div 2;
i:=i+1;
end;
p:=i-1;
for i:=p downto 1 do write(a[i]);
readln
end.
program binarne_vyhladavanie;
var a:array[1..20] of byte;
n,i,x,d,h,s:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
a[1]:=1;
write(a[1]:5);
for i:=2 to n do
begin
a[i]:=a[i-1]+random(3)+1;
write(a[i]:5)
end;
writeln;
writeln('ktore cislo mam najst?');
readln(x);
d:=1;
h:=n;
repeat
s:=(d+h) div 2;
if x>a[s] then d:=s;
if x<a[s] then h:=s;
until (x=a[s]) or (d+1=h);
if x=a[s] then write('cislo je na pozicii ',s) else write('cislo sa nenaslo');
readln
end.
program vlozenie_prvku;
var a:array[1..21] of byte;
n,i,x,p:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
a[1]:=1;
write(a[1]:5);
for i:=2 to n do
begin
a[i]:=a[i-1]+random(3)+1;
write(a[i]:5)
end;
writeln;
writeln('ktore cislo mam do zoradeneho zoznamu pridat?');
readln(x);
i:=1;
while a[i]<x do i:=i+1;
p:=i;
for i:=n downto p do a[i+1]:=a[i];
a[p]:=x;
n:=n+1;
for i:=1 to n do write(a[i]:5);
readln
end.
program odstranenie_prvku;
var a:array[1..20] of byte;
n,i,x,p:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
a[1]:=1;
write(a[1]:5);
for i:=2 to n do
begin
a[i]:=a[i-1]+random(3)+1;
write(a[i]:5)
end;
writeln;
writeln('ktore cislo mam odstranit?');
readln(x);
i:=1;
while a[i]<x do i:=i+1;
p:=i;
for i:=p to n do a[i]:=a[i+1];
n:=n-1;
for i:=1 to n do write(a[i]:5);
readln
end.
program linearne_vyhladavanie;
var a,b:array[1..20] of byte;
p,n,m,i,j:byte;
begin
randomize;
writeln('zadaj pocet nahodnych cisel (do 20)');
readln(n);
for i:=1 to n do
begin
a[i]:=random(10)+1;
write(a[i]:5)
end;
writeln;
writeln('ake ciselko mam hladat?');
readln(m);
p:=0;
j:=1;
for i:=1 to n do
begin
if a[i]=m then
begin
p:=p+1;
b[j]:=i;
j:=j+1
end
end;
write('zadane cislo sa v nahodnom rade nachadza ',p,'-krat na poziciach: ');
for i:=1 to j-1 do write(b[i],', ');
readln
end.
program maxkoniec_minzaciatok;
var n,i,min,max,pmin,pmax:integer;
a:array[1..10] of integer;
begin
writeln('zadaj pocet cisel');
readln(n);
writeln('zadaj 1. cislo');
readln(a[1]);
max:=a[1];
min:=a[1];
for i:=2 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a[i]);
if a[i]<min then
begin
min:=a[i];
pmin:=i
end;
if a[i]>max then
begin
max:=a[i];
pmax:=i
end
end;
a[pmin]:=a[1];
a[1]:=min;
a[pmax]:=a[n];
a[n]:=max;
writeln('poradie po vymene prveho cisla v poradi s najnizsim cislom a posledneho cisla s najvyssim cislom');
for i:=1 to n do
write(a[i]:5);
readln;
end.
program min_zaciatok;
var n,i,min,pom,p:integer;
a:array[1..10] of integer;
begin
writeln('zadaj pocet cisel');
readln(n);
writeln('zadaj 1. cislo');
readln(a[1]);
min:=a[1];
for i:=2 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a[i]);
if a[i]<min then
begin
min:=a[i];
p:=i
end
end;
a[p]:=a[1];
a[1]:=min;
writeln('poradie po vymene prveho cisla v poradi s najnizsim cislom');
for i:=1 to n do
write(a[i]:5);
readln;
end.
program odchylky;
var n,i,sucet:integer;
p:real;
a:array[1..10] of integer;
begin
writeln('zadaj pocet cisel');
readln(n);
sucet:=0;
for i:=1 to n do
begin
writeln('zadaj ',i,'. cislo');
readln(a[i]);
sucet:=sucet+a[i]
end;
p:=sucet/n;
writeln('priemer je: ',p:5:2);
writeln('odchylky:');
for i:=1 to n do
writeln(a[i]-p:5:2);
readln;
end.
program priezviska;
var m:string;
l:byte;
begin
writeln('napis muzske priezvisko');
readln(m);
l:=length(m);
if (m[l]='o') or (m[l]='a') then
begin
delete(m,l,1);
insert('ova',m,l);
end;
if m[l]='y' then
begin
delete(m,l,1);
insert('a',m,l);
end;
if (m[l]<>'y') and (m[l]<>'a') and (m[l]<>'o') then insert('ova',m,l+1);
writeln('zenske priezvisko: ',m);
readln
end.
program palindromy;
var b:boolean;
l,i:byte;
s:string;
begin
writeln('som palindromolog. napis slovo. schvalne.');
readln(s);
l:=length(s);
b:=true;
for i:=1 to (l div 2) do if s[i]<>s[l+1-i] then b:=false;
if b then writeln('je to palindrom')
else writeln('nie je to palindrom');
readln;
end.
program zatvorky; PÍSOMKA! (tento program spraviť nie poľom ale podmieňovacím príkazom)
var v:string;
i,l,p:byte;
begin
writeln('napis vyraz');
readln(v);
p:=0;
l:=0;
for i:=1 to length(v) do
begin
if v[i]='(' then l:=l+1;
if v[i]=')' then p:=p+1;
end;
if p=l then writeln('vyraz je spravne ozatvorkovany');
if p<l then writeln('pravych zatvoriek je menej! ozatvorkuj vyraz lepsie!');
if p>l then writeln('lavych zatvoriek je menej! ozatvorkuj vyraz lepsie!');
readln
end.
program vyskyt_pismena;
var s,t:string;
a,b:byte;
begin
writeln('zadaj slovo!');
readln(s);
t:=s;
b:=0;
while pos('a',s)>0 do
begin
a:=pos('a',s);
b:=b+1;
delete(s,a,1);
end;
writeln('pismeno a sa v slove ',t,' nachadza ',b,'-krat');
readln
end.
program string1;
var m:string;
d,i:byte;
begin
writeln('ako sa volas?');
readln(m);
d:=length(m);
for i:=d downto 1 do write(m[i]);
readln
end.