Založiť novú webovú stránku alebo e-shopChcem nový web

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 priemerna_vyska; PÍSOMKA!
var v,s,p:integer;
    priemer:real;
 
begin
     writeln('zadavaj vysky studentov prechadzajucich dverami skoly');
     s:=0;
     p:=0;
     repeat
           readln(v);
           s:=s+v;
           p:=p+1;
     until v=0;
     priemer:=s/(p-1);
     writeln('priemerna vyska studentov je: ',priemer:6:2);
     readln;
end.

program prevod8;
var n,bc,moc,p,z:longint;
 
begin
     writeln('zadaj cislo v osmickovej sustave');
     readln(n);
     bc:=0;
     moc:=1;
     repeat
           z:=n mod 10;
           bc:=bc+z*moc;
           n:=n div 10;
           moc:=moc*8;
     until n=0;
     writeln('desiatkove cislo: ',bc);
     readln;
end.

program prevod;
var n,bc,moc,p,z:longint;
 
begin
     writeln('zadaj cislo v dvojkovej sustave');
     readln(n);
     bc:=0;
     moc:=1;
     repeat
           z:=n mod 10;
           bc:=bc+z*moc;
           n:=n div 10;
           moc:=moc*2;
     until n=0;
     writeln('desiatkove cislo: ',bc);
     readln;
end.

{ciferny sucet cislic}
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.

program hadanie; PÍSOMKA!
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.

program baliky;
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.

program baliky; PÍSOMKA!
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.

program faktorial;
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.

program parnecisla;
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.

program delenie;
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.

program priemer;
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.

program max; PÍSOMKA! (súčasť programu priemer)
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.

{n cisel
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.

{n cisel
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.

program maxcislo;
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.

program kolkopatri;
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.


 

TOPlist