Program s menu

21. 2. 2014 00:00

Při řešení tohoto podprogramu budeme využívat lekce č. 12 - podprogramy. Pro vytvoření menu použijeme příkaz case. Jako obsah programu použijeme již vytvořené podprogramy, které však vložíme do jednoho programu.

Program podprogramy;
 
Uses CRT;
Var zjisti:integer;
    c: char;
 
function cifer(cislo:integer):integer;
begin
   cifer:= 0;
   repeat
      if cislo <> 0
      then
      begin
        cislo:= ABS(cislo);
        cifer:= cifer + (cislo mod 10);
        cislo:= cislo DIV 10;
      end;
   until cislo = 0;
end;
 
function ciferkor(cislo:integer):integer;
begin
   ciferkor:= 0;
   repeat
      if cislo <> 0
      then
      begin
        cislo:= ABS(cislo);
        ciferkor:= ciferkor + (cislo mod 10);
        cislo:= cislo DIV 10;
      end;
   until cislo = 0;
 
   if ciferkor > 9
   then
      ciferkor:=ciferkor(ciferkor);
end;
 
function prevrat(cislo:integer):integer;
var zapor:boolean;
begin
   prevrat:= 0;
   if cislo <> 0
   then
   begin
      if cislo < 0
      then
      begin
         zapor:= true;
         cislo:= Abs(cislo);
      end
   else
      zapor:= false;
 
   repeat
      prevrat:= (prevrat * 10) + (cislo mod 10);
      cislo:= cislo DIV 10;
      until cislo = 0;
   end
   else
   begin
      zapor:= false;
      prevrat:= 0;
   end;
 
   if zapor = true
   then
      prevrat:= -prevrat;
end;
 
function symetricka(cislo:integer):string;
var a, prevrat:integer;
begin
   prevrat:= 0;
   a:= 0;
   if cislo <> 0
   then
   begin
      cislo:= abs(cislo);
      symetricka := 'Ne neni symetricke';
      a:= cislo;
      repeat
         prevrat:= (prevrat * 10) + (cislo mod 10);
         cislo:= cislo DIV 10;
      until cislo = 0;
   end
   else
   begin
      a:= 1;
      prevrat:= 1;
   end;
 
   if a = prevrat
   then
      symetricka:= 'Ano, je symetricke.'
   else
      symetricka := 'Ne, neni symetricke.';
end;
 
begin
 
clrscr;
 
write('Vita vas program podprogramy, ktery byl vytvoren jako nazorna ukazka prace s');
writeln('podprogramy. Lze si vybrat z peti typu podprogramu pomoci menu.');
repeat
   writeln('');
   writeln('Napoveda k menu: c - ciferny soucet');
   writeln('                 k - korenovy ciferny soucet');
   writeln('                 p - prevrati cislo');
   writeln('                 s - zjisti, zda je cislo symetricke');
   writeln('');
   write('Vyberte podporgram: ');
   readln(c);
   writeln('');
   case Upcase(c) of
      'C':begin
         writeln('Byl vybran podporgram pro ciferny soucet.');
         write('Zadejte cislo pro zjisteni ciferneho souctu: ');
         readln(zjisti);
         writeln('Cislo ', zjisti, ' ma ciferny soucet ', cifer(zjisti));
      end;
 
      'K':begin
         writeln('Byl vybran podporgram pro korenovy ciferny soucet.');
         write('Zadejte cislo pro zjisteni korenoveho ciferneho souctu: ');
         readln(zjisti);
         writeln('Cislo ', zjisti, ' ma korenovy ciferny soucet ', ciferkor(zjisti));
      end;
 
      'P':begin
         writeln('Byl vybran podporgram pro prevraceni cisla.');
         write('Zadejte cislo, ktere chcete prevratit: ');
         readln(zjisti);
         writeln('Cislo ', zjisti, ' ma v prevracenem tvaru tvar ', prevrat(zjisti));
      end;
 
      'S':begin
         writeln('Byl vybran podporgram pro zjisteni symetricnosti cisla.');
         write('Zadejte cislo, u ktereho chcete zjistit symetricnost: ');
         readln(zjisti);
         writeln('U cisla ', zjisti, ' byl zjisten vysledek symetricnosti: ', symetricka(zjisti));
      end;
 
      else begin
         writeln('Byl zadan spatny kod !!!');
      end;
   end;
   writeln('');
   writeln('================================================================================');
   writeln('Chcete skoncit? ');
   readln(c);
 
until upcase(c) = 'A';
end.