Pascal

1.

(*program pozdravi*)
program pozdrav;
begin
      writeln ('ahoj');readln;
end.
2.
(*scitac*)
program soucet;
var a,b,c:integer;
begin read(a,b);
c:=a+b;
writeln(c);
readln
3.
(*obvod a obsah ctverce*)
program obvod;
var     a,y,o:integer;
begin   write('zadej strany ctverce');
        readln(a);
        y:=(4*a);
        o:=(a*a);
        writeln('obsah ctverce je',y);
        writeln('obvod ctverce je',o);
        writeln('to koukas co');
        readln;
end.
4.
(*obvod a obsah obdelnika*)
program obvod;
var     a,b,y,o:integer;
begin   writeln('zadej strany obdelnika');
        writeln('stranu a');
        readln(a);
        writeln('stranu b');
        readln(b);
        y:=(2*(a*b));
        o:=(a*b);
        writeln('obsah obdelnika je',o);
        writeln('obvod obdelnika je',y);
        writeln('to koukas co');
        readln;
end.               
5.
(*obvod a obsah kruhu*)
program kruh;
var     r:integer;
        o,s:real;
begin   writeln('zadej polomer r');
        readln(r);
        o:=2*3.14*r;
        s:=3.14*r*r;
        writeln('obvod je',o:8:3);
        writeln('obsah je',s:8:3);
        writeln('nezdrzuj, priste si vem kalkulacku');
        readln
end.
6.
(*obvod a obsah pravouhleho trojuhelnika*)
program trojuhelnik;
var     a,b,c:real;
        o,s:real;
begin   writeln('napis stranu a');
        readln(a);
        writeln('napis stranu b');
        readln(b);
        c:=sqrt(a*a+b*b);
        o:=(a+b+c);
        s:=(a*b)/2;
        writeln('strana c je');
        writeln(c:8:3);
        writeln('obvod je');
        writeln(o:8:3);
        writeln('a obsah je');
        writeln(s:8:3);
        writeln('diky za pocitani, pro ukonceni stisknete ENTER');
        readln;
end.
7.
(*prevod*)
program   prevadec;
var       a,b,c:real;
begin     writeln('napis cislo');
          readln(a);
          writeln('pro prevod na milimetry stiskni 1');
          writeln('pro prevod na decimetry stiskni 2');
          writeln('pro prevod na kilometry stiskni 3');
          readln(b);
          if b=1 then c:=(a*1000);
          if b=2 then c:=(a*100);
          if b=3 then c:=(a/1000);
          writeln(c:8:3);
          readln;
end.
8.
(*vypise sousedy znaku*)
program  vypisovac;
var      z,p,n:char;
begin    writeln('napis znak');
         readln(z);
         p:=pred(z);
         n:=succ(z);
         writeln('predchudce je');
         writeln(p);
         writeln('nasledovnik je');
         writeln(n);
         readln;
end.
9.
(*pocet kraliku a slepic*)
program pocitac;
var     a,b,c,d:integer;
begin   writeln('napis pocet kraliku');
        readln(a);
        writeln('napis pocet slepic');
        readln(b);
        c:=(a*4+b*2);
        d:=(a+b);
        writeln('pocet hlav je');
        writeln(d);
        writeln('pocet nohou je');
        writeln(c);
        readln;
end.
10.
(*celociselny podil a zbytek*)
program       podil;
uses          crt;
var           a,b,c,d:integer;
begin         clrscr;
              writeln('zadej 2 cisla');
              readln(a);
              readln(b);
              c:=a div b;
              textcolor(yellow);
              writeln('vysledek je', c);
              d:=a mod 2;
              textcolor(red);
              writeln('zbytek je', d);
              readln;
end.
11.
(*prekoduje znak o dany pocet pozic*)
program     prekodovac;
uses        crt;
var         vs,vy,q,w:char;
            a,b:integer;
begin       clrscr;
            readln(vs,a);
            b:=ord (vs);
            b:=b+a;
            vy:=chr(b);
            writeln(vy);
            writeln('zmackni q pro ukonceni');
            repeat
            if keypressed then readln(w);
            until w='q';
end.
12.
(*vytiskni vetsi ze 2 cisel*)
program    vetsi;
uses       crt;
var        w:char;
           a,b,c:real;
begin      clrscr;
           writeln('napis cislo a');
           readln(a);
           writeln('napis cislo b');
           readln(b);
           if a<b then writeln('a je mensi jak b');
           if a>b then writeln('a je vetsi jak b');
           if a=b then writeln('nezkousej to na me, jsou stejny');
           textcolor(red);
           writeln('napis q pro ukonceni');
           repeat
           if keypressed then readln(w);
           until w='q';
end.
13.
(*vytiskni vetsi ze 2 cisel*)
program    vetsi;
uses       crt;
var        w:char;
           a,b,c:real;
begin      clrscr;
           writeln('napis cislo a');
           readln(a);
           if a<0 then writeln('cislo je zaporne');
           if a>0 then writeln('cislo je kladne');
           if a=0 then writeln('neni kladne, ani zaporne');
           textcolor(red);
           writeln('napis q pro ukonceni');
           repeat
           if keypressed then readln(w);
           until w='q';
end.
14.
(*vytiskni vetsi ze 2 cisel*)
program    vetsi;
uses       crt;
var        w:char;
           a,b,c:real;
begin      clrscr;
           writeln('napis cislo a');
           readln(a);
           if a<0 then writeln('cislo je zaporne');
           if a>0 then writeln('cislo je kladne');
           if a=0 then writeln('neni kladne, ani zaporne');
           textcolor(red);
           writeln('napis q pro ukonceni');
           repeat
           if keypressed then readln(w);
           until w='q';
end.
15.
(*rozhodnete kolikaciferne cislo je*)
program      cifry;
uses         crt;
var          a:integer;
begin        clrscr;
             writeln('napis cislo');
             readln(a);
             if a<10 then writeln('jednociferne')
             else if a>99 then writeln('viceciferne');
             readln;
end.
16.
(*vetsi cislo*)
program cislo;
uses    crt;
var     x:char;
        a,b,c:integer;
begin   clrscr;
        writeln('zadej cislo');
        readln(a);
        writeln('zadej druhe cislo');
        readln(b);
        if a>b then writeln(a:5,b:5);
        if a<b then writeln(b:5,a:5);
        if a=b then writeln('jsou stejny');
        textcolor(4);
        writeln('pro ukonceni zmackni q');
        repeat
        if keypressed then readln(x);
        until x='q';

end.
17.
18.
(*pozdrav podle hodin*)
program hodiny;
uses    crt;
var     a,b,c:integer;
begin   clrscr;
        writeln('napiste kolik je hodin, bez minut');
        readln(a);
        if a<12 then writeln('dobre dopoledne')
                else if a<=18 then writeln('dobre odpoledne')
                     else if a<=24 then writeln('dobry vecer')
                          else writeln('neblbni');
        readln;
end.

19. (*program ktery rozhodne typ znaku*)
program znaky;
uses crt;
var a: char;
begin clrscr;
writeln ('zadej znak');
readln (a);
if (a>'A') and (a<='Z') then writeln ('velke pismenu')
else if (a>='a')and(a<='z') then write ('male pismeno')
else if (a>='0') and (a<='9') then write('cislo')
else write ('jiny znak');
readln;
end.

kalkulacka

(*kalkulacka*)
program pocitani;
uses crt;
var cis1,cis2,vys:integer;
ope:char;
begin clrscr;
writeln ('zadej cislo 1:');
readln (cis1);
writeln ('zadej operator:');
readln (ope);
writeln ('zadej cislo 2:');
readln (cis2);
if(ope='+') then vys:=cis1+cis2;
if(ope='-') then vys:=cis1-cis2;
if(ope='*') then vys:=cis1*cis2;
if(ope='/') then vys:=cis1 div cis2;
writeln ('vyjde nam ', vys);
readln;
end.

Pekař

(*pekar*)
program delta;
uses    crt;
var     a,b,c,d: real;
begin   clrscr;
        writeln ('ze vikend ma');
        readln (a);
        c:=(a/100)*15;
        b:=(a-c)-1000;
        writeln ('za mesic zbyde   ',b:8:3);
        d:=b*52;
        writeln ('za rok ma   ',d:8:3);
if      d<15000
then    writeln  ('nekoupi si auto');
if      d>15000
then    writeln ('muze si koupit auto za 15000Kc');
if      d>25000
then    writeln ('muze si kopuit auto za 25000Kc');
        readln;

end.

(*opakovaniapodminka*)
program vypisovac;
uses    crt;
var     n,i: integer;
begin   clrscr;
        writeln ('zadej cislo');
        readln (n);
        i:=0;
repeat  i:=i+1;
        writeln (i)
until   i=n;
        readln;
end.

Vypisovac

(*opakovaniapodminka*)
program vypisovac;
uses crt;
var n,i: integer;
begin clrscr;
writeln ('zadej cislo');
readln (n);
i:=0;
repeat i:=i+1;
writeln (i)
until i=n;
readln;
end.

(*rozhoduje co je znak*)
program     rozhodovac;
uses        crt;
var         a,b:char;

begin       clrscr;

            writeln('klikni na libovolnou klavesnici');
            repeat
            readln(a);
            case a of
              '0'..'9':writeln('cislo');
              'a'..'z':writeln('male pismeno');
              'A'..'Z':writeln('velke pismeno');
              else writeln('jiny znak');
              end;
            until a=';';
end.

(*zaradi datum*)
program  zarazovac;
uses     crt;
var      a,b:integer;

begin    clrscr;

         writeln('napiste datum (den)');
         readln(a);
         writeln('napiste mesic (cislem)');
         readln(b);

         case b of
         1..3:writeln('1 ctvrtleti');
         4..6:writeln('2 ctvrtleti');
         7..9:writeln('3 ctvrtleti');
         10..12:writeln('4 ctvrtleti');
         else writeln('nevymyslej blbosti');
         end;

         readln;

end.

(*bmi index*)
program      bmi;
uses         crt;
var          a,b,c,d:integer;
             e,f:real;
             x:char;
begin        clrscr;
             repeat
             writeln('zadej svou vahu (kg)');
             readln(a);
             writeln('zadej svou vysku (m)');
             readln(f);
             e:=a/(f*f);
             writeln('tvuj idex je ',e:8:3);
             case round(e) of
             0..20:writeln('podvaha');
             21..25:writeln('normal');
             26..100:writeln('nadvaha');
             end;
             writeln('pro ukonceni zmackni ; nebo pokracuj ENTER');
             x:=readkey;
             until x=';'
end.

(*rodne cislo*)
program rodne;
uses    crt,dos;
var     r,m,d,a:integer;
        rok,mesic,den,dent:word;
        x:char;
begin   clrscr;
        repeat
        GetDate(rok,mesic,den,dent);
        writeln('napis prvni 2 cisla z rodneho cisla');
        readln(r);
        writeln('napis druhe 2 cisla z rodneho cisla');
        readln(m);
        writeln('napis treti 2 cisla z rodneho cisla');
        readln(d);
        case m of
        1..12:writeln('muz');
        13..62:writeln('zena');
end;
        if m>13 then m:=m-50;
        writeln('narodil si se ', d);
        case m of
        1:writeln('leden');
        2:writeln('unor');
        3:writeln('brezen');
        4:writeln('duben');
        5:writeln('kveten');
        6:writeln('cerven');
        7:writeln('cervenec');
        8:writeln('srpen');
        9:writeln('zari');
        10:writeln('rijen');
        11:writeln('listopad');
        12:writeln('prosinec');
end;
        writeln('v roce 19',r);
        if r<88 then writeln('jsi plnolety')
                else writeln('nejsi plnolety');
        if (den=d)and(mesic=m) then writeln('happy birthday');
        writeln('pro pokracovani stiskni ENTER, pro konec ;');
        x:=readkey;
        until x=';';
end.

(*rodne cislo*)
program rodne;
uses    crt,dos;
var     r,m,d,a:integer;
        rok,mesic,den,dent:word;
        x:char;
begin   clrscr;
        repeat
        GetDate(rok,mesic,den,dent);
        writeln('napis prvni 2 cisla z rodneho cisla');
        readln(r);
        writeln('napis druhe 2 cisla z rodneho cisla');
        readln(m);
        writeln('napis treti 2 cisla z rodneho cisla');
        readln(d);
        case m of
        1..12:writeln('muz');
        13..62:writeln('zena');
end;
        if m>13 then m:=m-50;
        writeln('narodil si se ', d);
        case m of
        1:writeln('leden');
        2:writeln('unor');
        3:writeln('brezen');
        4:writeln('duben');
        5:writeln('kveten');
        6:writeln('cerven');
        7:writeln('cervenec');
        8:writeln('srpen');
        9:writeln('zari');
        10:writeln('rijen');
        11:writeln('listopad');
        12:writeln('prosinec');
end;
        writeln('v roce 19',r);
        if r<88 then writeln('jsi plnolety')
                else writeln('nejsi plnolety');
        if (den=d)and(mesic=m) then writeln('happy birthday');
        case m of
        1:if d<=21 then writeln('si vodnar')
                   else writeln('si ryba');
        2:if d<=21 then writeln('si ryba')
                   else writeln('si beran');
        3:if d<=21 then writeln('si beran')
                   else writeln('si byk');
        4:if d<=21 then writeln('si byk')
                   else writeln('si blizenec');
end;
        writeln('pro pokracovani stiskni ENTER, pro konec ;');
        x:=readkey;
        until x=';';
end.

(*geometricke tvary*)
program       geometrie;
uses          crt;
var           a,b,c:integer;
              o,s,f:real;
              x:char;
begin         clrscr;
              repeat
              writeln('pro vypocet kruhu zmackni 1, pro ctverec 2, pro obdelnik 3');
              readln(c);
              case c of
              1:begin
                     writeln('zadej polomer');
                     readln(a);
                     o:=(2*3.14)*a;
                     s:=3.14*(a*a);
                end;
              2:begin
                     writeln('zadej stranu a');
                     readln(a);
                     o:=4*a;
                     s:=a*a;
                end;
              3:begin
                     writeln('zadej stranu a');
                     readln(a);
                     writeln('zadej stranu b');
                     readln(b);
                     o:=2*(a+b);
                     s:=a*b;
                end;
              end;
              writeln('obvod je ', o:8:3);
              writeln('obsah je ', s:8:3);
              writeln('pro pokracovani stiskni ENTER, pro konec ;');
              x:=readkey;
              until x=';';
end.

(*priklad 27*)
program   dvacetsedm;
uses      crt;
var       n,i:integer;

begin     clrscr;
          readln(n);
          i:=0;
          while i<n do
begin
          i:=i+1;
          writeln(i);
          end;
          readln;
end.

(*priklad 27 tretim cyklem*)
program   dvacetsedm;
uses      crt;
var       n,i:integer;

begin     clrscr;
          readln(n);
          for i:=1 to n do writeln(i);
          readln;
end.

(*cykly*)
program   cykly;
uses      crt;
var       n,i,a:integer;

begin     clrscr;
          writeln('napis libovolne cislo');
          readln(n);
          i:=0;
          a:=0;
          repeat
          i:=i+1;
          if i=n then write(i)
                 else write(i,'+');
          a:=a+i;
          until i=n;
          writeln('=',a);
          readln;
end.

(*vytiskni prvni n livhych cisel*)
program    vytiskovac;
uses       crt;
var        n,i:integer;
           a,x:char;
begin      clrscr;
           writeln('napis libovolne cislo');
           readln(n);
           i:=1;
           repeat
           i:=i+2;
           writeln(i);
           until i>n;
           readln;
end.

(*kladne cislo*)
program        kladnecislo;
uses           crt;
var            i,n,p:integer;
               o:real;
begin          clrscr;
               randomize;
               textcolor(random(15+1));
               repeat
               writeln('napis cislo');
               readln(n);
               p:=p+1;
               if n<=0 then writeln('ses nula zadej kladne cislo');
               until n>0;
               writeln('pocet je pokusu', p);
               o:=sqrt(n);
               writeln('odmocnina je',o:8:3);
               readln;
end.

(*deset nasobku cisla*)
program        nasobky;
uses           crt;
var            i,n:integer;

begin          clrscr;
               writeln('napis cislo');
               readln(n);
               for i:=1 to 10 do
               write(i,'*',n,'=',i*n,' ');
               readln;
end.

(*nevim*)
program  nevim;
uses     crt;
var      a:integer;
begin    clrscr;
         randomize;
         a:=0;
         repeat
         textcolor(random(15+1));
         writeln('AHOJ');
         a:=a+1;
         until a=16;
         readln;
end.

(*udela neaky moznosti bez operatoru*)
program bezoperatoru;
uses    crt;
var     a,b,c,i:integer;
begin   clrscr;
        writeln('zadej cislo a');
        readln(a);
        writeln('zadej cislo b');
        readln(b);
        c:=0;
        i:=0;
        repeat
        c:=a+c;
        i:=i+1;
        if i=b then write(a) else write(a,'+');
        until i=b;
        writeln('=',c);
        readln;
end.

(*33ka*)
program         prg;
uses            crt;
var             a,b,n,pocet,i:integer;
begin           clrscr;
                readln(n);
                pocet:=0;
                for i:=1 to n do
               begin
                if (n mod i)=0 then
               begin
                write(i:4);
                pocet:=pocet+1;
end;
end;
                textcolor(2);
                writeln('     pocet delitelu je', pocet);
                readln;
end.

(*34 novym zpusobem*)
program            upgrade34;
uses               crt;
var                i,n:integer;
begin              clrscr;
                   readln(n);
                   for i:=1 to n do
                   writeln(i);
                   readln;
end.

(*33ka*)
program         prg;
uses            crt;
var             a,b,n,pocet,i:integer;
begin           clrscr;
                readln(n);
                pocet:=0;
                for i:=1 to n do
               begin
                if (n mod i)=0 then
               begin
                write(i:4);
                pocet:=pocet+1;
end;
end;
                textcolor(2);
                writeln('     pocet delitelu je', pocet);
                textcolor(9);
                if pocet<=2 then writeln('prvocislo');
                readln;
end.

dalsi ulohy:

(*napsat prvnich deset nesobku cosla7*)
var c:integer;
begin c:=0;
repeat c:=c+7;
writeln (c);
until c=70;
readln;
end.

(*38 je dano n cisel,vytisknete primer n=3: 1,2,3 prumer soucet/pocet 6/3=2.maximu, je 3*)
program cisla;
var n, cislo, soucet, i:integer; prumer: real;
begin readln(n);soucet:=0;
for i:=1 to n do
begin readln (cislo);
soucet:=soucet+cislo

end;
prumer:=soucet/n;
writeln ('prumer je:', prumer:0:2);
readln
end.

(*36 je dano n cisel,vytisknete primer n=3: 1,2,3 prumer soucet/pocet 6/3=2.maximu, je 3*)
program cisla;
var n, cislo, max, i:integer;  prumer: real;
begin readln(n);max:=0;
for i:=1  to n do
45begin readln (cislo);
if cislo>max then max:=cislo

end;
writeln ('max je:', max);
readln
end.

(*48*)
program uloha48;
uses crt,dos;
var h,m,s,ss:word;
begin
repeat clrscr;
delay(1000);
gettime (h,m,s,ss);
writeln (h,':',m,':',s);
until keypressed;
end.

(*10cisel (10-50)*)
program nasobky;
uses crt;
var c,i:integer;
begin clrscr;
randomize;
for i:=1 to 10 do
begin c:=random(41)+10 ;
writeln(c);
if (c mod 2)=0  then writeln('sude') else
end;
readkey;
end.

(*48*)
program uloha48;
uses crt,dos;
var h,m,s,ss:word;
begin
repeat clrscr;
delay(1000);
gettime (h,m,s,ss);
writeln (h,':',m,':',s);
until keypressed;
end.

(*vytisknete prvnich 10 nasobku cisla n a soucet techto nasobku*)
program nasobky;
uses    crt;
var n,i,s:integer;
begin    clrscr;
writeln ('zadejte cislo');
readln(n);
for i:=1 to 10 do
begin
writeln(i*n); s:=s+i*n;
end;
writeln ('soucet je',s);
readln;
end.
 

(*odecitani od 100 n*)
program odecitani;
uses crt;
var n,p:integer;
begin clrscr;
p:=100;
repeat writeln (p);
p:=p-n;
until p<=0;
readkey;
end.

program pade;
uses crt;
var a:integer;
    ch: char;
begin
repeat
writeln ('stiskni nekterou klavesu');
ch:=readkey;
case ch of
'a'..'z':writeln ('male pismeno');
'0'..'9':writeln ('cislice');
'A'..'Z':writeln ('velke pismeno');
#27:writeln('ESC');
#13:writeln('ENTER');
#0:begin ch:=readkey;
      if ch = #72 then writeln ('sipka nahoru');
      if ch = #80 then writeln ('sipka dolu');
      if ch = #77 then writeln ('sipka doprava');
      if ch = #75 then writeln ('sipka doleva');

end;
end;
until ch=#27;
end.

(*50*)
program pade;
uses crt;
var  a: integer;
     ch: char;
begin clrscr;
repeat
ch:=readkey;
textcolor(10);
writeln('program ukoncis kl.zkratkou');
textcolor(8);
writeln(ord(ch));
until ord(ch)=1;
end.

(*53 malovani*)
program malovani;
uses crt;
var x,y:integer;
    ch:char;
begin textbackground(9); clrscr; x:=40; y:=25;
repeat gotoxy(x,y);
textcolor(10);
textbackground(1);
writeln('*');
ch:=readkey;
if ch=#0 then ch:=readkey;
case ch of
#72:y:=y-1;
#80:y:=y+1;
#77:x:=x+1;
#75:x:=x-1;
end;
until ch=#27
end.