VT 21

Řešení

úvod

ukázkový program

proměnné a  deklarace

čísla a operace 

pravdivostní výrazy

znaky

typy

výčtový typ

pole

vstupy a výstupy

záznamy

podprogramy

typ množina

uspořádání programu

soubory

ukazatele

datové struktury

řazení

strukturované programování

moduly

Šablona pascalského programu

program název;
uses crt; {nutné proto, aby fungoval příkaz "repeat until keypressed"}
uses wincrt; {v prostředí Windows}

var  proměnná 1, proměnná 2 : Real; 
       proměnná 3, proměnná 4   : Integer;
begin
   clrscr; {smaže na začátku obrazovku - aby nezůstával text z předchozích aplikací}

   delay (1000); {< - po čká 1 sekundu}

   write ('stiskni cokoli a program skončí');

   repeat until keypressed; 

       {PC čeká na stisk libovolné klávesy - aby zůstal vidět výsledek na obrazovce}

end.

3 Největší dělitel - verze obrněná proti idiotským vstupům

pro úspěšné řešení neumíš jedinou věc - ABS(A) je absolutní hodnota čísla A!

program NejvDelitel;

var A, B : Integer;

begin

        Write ( 'Největší společný dělitel ' );

        Write ( 'Zadejte dvě čísla ' );

        Read ( A, B );

        if A * B = 0 then

             Writeln ( 'Nula nemá dělitele' )

        else

              begin

                  A := Abs(A);

                  B := Abs(B);

                  while A <> B do

                       if A > B then A := A - B

                  else B := B - A;

                       Write ( 'Největší společný dělitel je ', A );

                end;

end.

3.4 Porovnání cyklu while oproti cyklu repeat until:

program while_versus_repeat_until;

uses wincrt; {nutné proto, aby fungoval príkaz "repeat until keypressed"}
var cislo : Real;

begin
   clrscr; {smaze na zacátku obrazovku - aby nezustával text z predchozích aplikací}
   writeln ('*********************************************************');

   (* ----------cyklus repeat - until ---------*)
   writeln ('Testovani cyklu repeat: ');
   repeat
      writeln ('Zadej kladné císlo a cyklus repeat skonci: ');
      readln (cislo);
      if cislo <= 0 then
             writeln ('Cislo ', cislo, 'neni kladne! Cyklus repeat pokracuje...');
   until cislo >0;
  (* -------- cyklus repeat - until konec --------*)

  writeln ('stiskni cokoli a program pokracuje k testovani cyklu while');
  repeat until keypressed;
    {PC ceká na stisk libovolné klávesy - aby zustal videt výsledek na obrazovce}

  (* --------cyklus while--------------- *)
  cislo :=-100 (* quli nasledujici podmince musim nadefinovat promennou cislo jako zapornou*);
  while cislo < 0 do
    begin
       writeln ('Zadej kladné císlo a cyklus while skonci: ');
       readln (cislo);
    end;
  (*-------- cyklus while konec -----------*)

  writeln ('bylo zadano kladne cislo, stiskni cokoli a program skonci');
  writeln ('*********************************************************');
  repeat until keypressed;
   {PC ceká na stisk libovolné klávesy - aby zustal videt výsledek na obrazovce}
  clrscr; {smaze na konci obrazovku}

end.

4 Obvod a plocha pravoúhlého trojúhelníka

program Pythagoras;

var A, B, C : Real;

begin

   Write ( 'Velikost pravoúhlého trojúhelníka ' );

   Write ( 'Zadejte odvěsny A a B: ' );

   Read ( A, B );

   C := Sqrt( Sqr(A) + Sqr(B) );

   Write ( ' Obvod = ', A+B+C );

   Write ( ' Plocha = ', (A*B)/2 );

end.

4.2 Výpočty ze vztahů:

po napsání v okně uvedeného programu ti vyjdou dole uvedené hodnoty 

(ale jde to v pohodě i zpaměti bez programování!)

5.2.3 Dělitelnost 
program cislo5;
(* author Milan Volejnik http://hledej.to.zde.cz *)
(* program zjisti, zda je cislo delitelne peti a neni pritom sude *)

uses wincrt; {nutné proto, aby fungoval príkaz "repeat until keypressed"}
var cislo : longint;
const je = 'cislo je delitelne 5 a neni sude';
         neni = 'cislo je sude nebo neni delitelne 5';

begin
       clrscr; {smaze na zacátku obrazovku - aby nezustával text z predchozích aplikací}
       writeln ('*********************************************************');
       writeln ('vloz nejake cislo...');
       writeln ('999 program ukonci');
       readln (cislo);

       while cislo <> 999 do
         begin
           if ((cislo mod 5) = 0) and ((cislo mod 2) <> 0)
              then
                  writeln (cislo, ': ', je)
              else
                  writeln (cislo, ': ', neni);
           readln (cislo);
       end;

       writeln ('stiskni cokoli a program skonci');
       writeln ('*********************************************************');
       repeat until keypressed;
       {PC ceká na stisk libovolné klávesy - aby zustal videt výsledek na obrazovce}
       clrscr; {smaze na konci obrazovku}
       (* a nyní podpis v rámečku...*)
       writeln ('***************************');
       writeln ('* autor:.....................                  *');
       writeln ('* http://hledej.to.zde.cz          *');
       writeln ('***************************');

end.

6.1.5 ASCII tabulka: efektně a radostně (by Martin Zamastil)

Předpokládám, že neznámé příkazy nepotřebují komentář...

Program ASCII_table;

{author Martin Zamastil}

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,R-,S+,V+,X+}

uses crt,dos;

var

    znb,a,b,c,d: byte;

begin

        textbackground(1);

        clrscr;

        b:= 2;

        c:= 1;

        textcolor(7);

        for a:= 0 to 255 do

        begin

            mem[$B800:((c-1)*160)+(b*2)]:=a;

            mem[$B800:((c-1)*160)+(b*2)+1]:= 14+16;

            gotoXY(b+3,c);

            write(a);

            inc(c);

            if c>24 then

                 begin

                     c:= 1;

                     inc(b,7);

                  end;

           end;

          readln;

end.

7. Autobus - aneb vstup dat téměř blbovzdorně

program vytizeni;
(* author Milan Volejnik http://hledej.to.zde.cz *)
(* program vypocte vytizeni autobusu *)

uses wincrt; {nutné proto, aby fungoval príkaz "repeat until keypressed"}

const MaxLidi = 45;
Konec = -1;
type Kapacita = Konec..MaxLidi;
var
       i, cest, idiot : integer;
       znak, pom : char;
       Cestujici : Kapacita;
       CestCelkem, VozuCelkem : Integer;

begin
  clrscr; {smaze na zacátku obrazovku - aby nezustával text z predchozích aplikací}
  writeln ('*********************************************************');
  Writeln ( 'Vytízení autobusů. ' );
  Writeln ( 'Zadávejte pocty cestujících, 9999 ukoncí. ' );
  CestCelkem := 0;
  VozuCelkem := 0;
  pom := 'n';
  while pom = 'n' do
    begin
      Read ( cest );

      case cest of
         1..45 : 
             begin
               writeln ('dekuji - zadal si ocekavane cislo');
               CestCelkem := CestCelkem + Cest;
               VozuCelkem := VozuCelkem + 1;
             end;
         -9999..0 : writeln ('opravdu si myslis, ze cestujicich muze byt zaporne mnozstvi????');
           46..150 : writeln ('opravdu si myslis, ze cestujicich se tam muze namackat ', cest, '?' );
            151..9998 : writeln ('hele nejsme v Indii: ', cest, ' v autobuse - to je kravina!' );
            9999..maxint : 
               begin
                     writeln ('' );
                     pom := 'x';
                end;
           end; (*pro case*)
          end;

       if VozuCelkem > 0 then
               Writeln ( 'Prumerne vytízení ',
               Round (CestCelkem/VozuCelkem/MaxLidi*100), '%' )
         else
               Writeln ( 'zádná data, není co pocítat.' );


       writeln ('stiskni cokoli a program skonci');
       writeln ('*********************************************************');
       repeat until keypressed;
       {PC ceká na stisk libovolné klávesy - aby zustal videt výsledek na obrazovce}
       clrscr; {smaze na konci obrazovku}
        writeln ('***************************');
        writeln ('* autor:............................................*');
        writeln ('* .....http://hledej.to.zde.cz....... *');
        writeln ('***************************');
end.

9.2.3 Píle pracovnic

program Pracovnice;

const PocetProd = 8;

var Obslouzeno : array [1..PocetProd] of Integer;

      Prod, MaxProd, MaxZak : Integer;

begin

      for Prod := 1 to PocetProd do

             Obslouzeno[Prod] := 0;

             Write ( 'Píle prodavaček. ' );

             Write ( 'Zadávejte čísla, 0 ukončí. ' );

             Read ( Prod );

             while (Prod > 0) and (Prod <= PocetProd) do

                         begin

                           Obslouzeno[Prod] := Obslouzeno[Prod] + 1;

                           Read ( Prod );

                         end;

             MaxProd := 1; MaxZak := Obslouzeno[1];

             for Prod := 2 to PocetProd do

                if Obslouzeno[Prod] > MaxZak then

                       begin

                          MaxProd := Prod;

                          MaxZak := Obslouzeno[Prod];

                        end;

      Write ( 'Nejpilnější je ', MaxProd );

end.

9.3.4 Délka slov

program DelkySlov;

const MaxDelka = 80; {max. délka slova}

         Konec = '@'; {ukončující znak}

var PocetSlov : array [1..MaxDelka] of Integer;

      Delka : Integer;

      Znak : Char;

begin

   for Delka := 1 to MaxDelka do

         PocetSlov[Delka] := 0;

         Delka := 0; Read ( Znak );

         while Znak <> Konec do

            begin

              case Znak of

                 'A'..'Z', 'a'..'z' : Delka := Delka + 1;

                 else

                     begin

                        if Delka > 0 then

                           if Delka > MaxDelka then

                                      Write ( 'Slibovali mi maximálně ',

                                                              MaxDelka, ' znaků!' )

                            else

                                       PocetSlov[Delka] := PocetSlov[Delka] + 1;

                     Delka := 0;

                 end;

              end;

              Read ( Znak );

       end;

       if Delka > 0 then

                  if Delka > MaxDelka then

                          Write ( 'Slibovali mi maximálně ',

                                       MaxDelka, ' znaků!' )

                  else

                          PocetSlov[Delka] := PocetSlov[Delka] + 1;

        for Delka := 1 to MaxDelka do

               if PocetSlov[Delka] > 0 then

                     Write ( PocetSlov[Delka], 'x slovo délky ', Delka, ', ' );

end.

9.3.5 program ObraceniTextu;
const Konec = '@';

         var Slovo, MaxSlovo : string;

               Znak : Char;

               I: Integer;

begin

          Write ( 'Obracení zadaného textu - napiš slovo a já ti řeknu jak je opačně ');

          Write ( 'Vstup ukonči znakem ''@''. ');

          Slovo := ''; MaxSlovo := '';

          Read ( Znak );

          while Znak <> Konec do

                 begin

                     case Znak of

                          'A'..'Z', 'a'..'z' : Slovo := Slovo + Znak;

                     else

                         begin

                            for I := Lenght (Slovo) downto 1 do

                                write (Slovo[I]);

                             write (Znak);

                          end; {konec beginu}

                     end; {konec case!!!}

          Read ( Znak );

       end;

       for I := Lenght (Slovo) downto 1 do

                    write (Slovo[I]);

       write (Znak);

end.

12.2.4 Přepona

function Prepona : Real;

begin

   Prepona := Sqrt (A*A + B*B);

end;

12.6 Fibonacci

function Fibonacci1 ( N : Integer ) : Integer;

begin

  if N < 0 then Fibonacci1 := 0

  else

      if N <= 1 then Fibonacci1 := 1

      else

             Fibonacci1 := Fibonacci1(N-1) + Fibonacci1(N-2);

end;

function Fibonacci2 ( N : Integer ) : Integer;

var Novy, Minuly, Predminuly, I : Integer;

begin

    if N < 0 then Fibonacci2 := 0

    else

          begin

             Minuly := 1;

             Predminuly := 0;

             for I := 1 to N do

                  begin

                         Novy := Minuly + Predminuly;

                         Predminuly := Minuly;

                         Minuly := Novy;

                  end;

             Fibonacci2 := Minuly;

          end;

end;

Fibonacci 1 by měla být katastrofálně neefektivní (=pomalý).

13.6 Typ množina

program VsechnaPismena;

const Konec = '@';

type MnozinaZnaku = set of Char;

var Znak : Char;

      BylyTam : MnozinaZnaku;

procedure Inicializace;

begin

         Writeln ( 'Test přítomnosti malých písmen.' );

         Writeln ( 'Vstup ukončete znakem "', Konec, '"' );

         BylyTam := [];

end;

procedure ZpracujText;

begin

         Read ( Znak );

         while Znak <> Konec do

             begin

              if Znak in ['a'..'z'] then

              BylyTam := BylyTam + [Znak];

              Read ( Znak );

             end;

end;

procedure PisVysledek;

begin

            Write ( 'Vstupní text ' );

            if BylyTam = ['a'..'z'] then Write ( 'obsahoval' )

               else Write ( 'neobsahoval' );

                       Writeln ( ' všechna malá písmena.' );

end;

begin

Inicializace;

ZpracujText;

PisVysledek;

end.

13.7 Typ množina

program VsechnaPismena;

const Konec = '@';

type MnozinaZnaku = set of Char;

var Znak : Char;

      BylyTam : MnozinaZnaku;

procedure Inicializace;

begin

         Writeln ( 'Test přítomnosti malých písmen.' );

         Writeln ( 'Vstup ukončete znakem "', Konec, '"' );

         BylyTam := [];

end;

procedure ZpracujText;

begin

         Read ( Znak );

         while Znak <> Konec do

             begin

              if Znak in ['a'..'z'] then

              BylyTam := BylyTam + [Znak];

              Read ( Znak );

             end;

end;

procedure PisVysledek;

var C : Char;

begin

            if BylyTam = ['a'..'z'] then 

                 Writeln ( 'text obsahoval všechna malá písmena' )

            else 

                  begin

                     Write ( 'text neobsahoval' );

                     for C := 'a' to 'z' do

                           if not ( C in BylyTam ) then

                                write ( C:2 );

                     writeln;

                  end;

end;

begin

Inicializace;

ZpracujText;

PisVysledek;

end

Poznámky

• uvedené programy jsou citovány dle knihy Pavel Satrapa, Pascal pro zelenáče, Neokortex, Na rovnosti 3, 130 00 Praha 3, http://www.neo.cz , zpracoval: Milan Volejník
• citace z tohoto materiálu jsou možné za předpokladu uvedení zdroje http://hledej.to.zde.cz  a autora
• online podpora knihy je na http://www.kit.vslib.cz/~satrapa/knihy/z-pascal/