Horoskop a čínský horoskop v Pascalu

Program po zadání data narození (den, měsíc a rok) určí horoskopové znamení. Rovněž se určí i čínské znamení. Program má jednoduché zabezpečení proti špatnému rozsahu vstupních dat – toto zabezpečení lze vylepšit dalšími podmínkami.

program ZNAMENI;

var
     d: integer;     {cislo dne}
     m: integer;     {cislo mesice}
     r: integer;     {cislo roku}
     z: string;      {znameni}
     c: string;      {cinske znameni}

     cpkrysa:  shortint;
     cpbuvol:  shortint;
     cptygr:   shortint;
     cpzajic:  shortint;
     cpdrak:   shortint;
     cphad:    shortint;
     cpkun:    shortint;
     cpkoza:   shortint;
     cpopice:  shortint;
     cpkohout: shortint;
     cppes:    shortint;
     cpprase:  shortint;

     cprok:  shortint;


begin
     {--------------------------zadani vstupnich dat---------------------------}

     writeln ('...::: Program zjisti vase znameni dle datumu narozeni :::...');
     writeln ('');
     writeln ('1. Zadejte den narozeni v mesici (1-31) a stisknete ENTER: ');
     readln (d);
     writeln ('');
     writeln ('2. Zadejte mesic narozeni(1-12) a stisknete ENTER: ');
     readln (m);
     writeln ('');
     writeln ('3. Zadejte rok narození (1900-2020) a stisknete ENTER: ');
     readln (r);
     writeln ('');

     {--------------------------vypis udaju------------------------------------}

      if (m>12) or (d>31) then
         begin
          writeln ('');
          writeln ('Chyba: Vase datum narozeni je mimo rozsah!');
          writeln ('');
         end;
       if (m<=12) or (d<=31) then
         begin
          writeln ('_________________________________________________');
          writeln ('');
          writeln ('Vase datum narozeni je: ',d,'.',m,'.',r);
          writeln ('_________________________________________________');
         end;

     {-----------------------zjisteni mesice a nasledne znameni----------------}

     case m of
          1:
            begin
                 if d<=20 then
                    z:='KOZOROH'
                   else
                     z:='VODNAR'
            end;

          2:
            begin
                 if d<=20 then
                    z:='VODNAR'
                   else
                     z:='RYBY'
            end;

          3:
            begin
                 if d<=20 then
                    z:='RYBY'
                   else
                     z:='BERAN'
            end;

          4:
            begin
                 if d<=20 then
                    z:='BERAN'
                   else
                     z:='BYK'
            end;

          5:
            begin
                 if d<=21 then
                    z:='BYK'
                   else
                     z:='BLIZENCI'
            end;

          6:
            begin
                 if d<=21 then
                    z:='BLIZENCI'
                   else
                     z:='RAK'
            end;

          7:
            begin
                 if d<=22 then
                    z:='RAK'
                   else
                     z:='LEV'
            end;

          8:
            begin
                 if d<=22 then
                    z:='LEV'
                   else
                     z:='PANNA'
            end;

          9:
            begin
                 if d<=22 then
                    z:='PANNA'
                   else
                     z:='VAHY'
            end;

          10:
            begin
                 if d<=23 then
                    z:='VAHY'
                   else
                     z:='STIR'
            end;

          11:
            begin
                 if d<=22 then
                    z:='STIR'
                   else
                     z:='STRELEC'
            end;

          12:
            begin
                 if d<=21 then
                    z:='STRELEC'
                   else
                     z:='KOZOROH'
            end;

          end;

{------------------------vypocet cinskeho znameni------------------------------}

     cpkrysa:=2008 mod 12;
     cpbuvol:=2009 mod 12;
     cptygr:=2010 mod 12;
     cpzajic:=2011 mod 12;
     cpdrak:=2012 mod 12;
     cphad:=2013 mod 12;
     cpkun:=2014 mod 12;
     cpkoza:=2015 mod 12;
     cpopice:=2016 mod 12;
     cpkohout:=2017 mod 12;
     cppes:=2018 mod 12;
     cpprase:=2019 mod 12;

     cprok:=r mod 12;

{----------------------prirazeni cinskeho zanmeni------------------------------}

     if cprok=cpkrysa then
         c:='PRASE'
        else if cprok=cpbuvol then
              c:='BUVOL'
             else if cprok=cptygr then
                  c:='TYGR'
                 else if cprok=cpzajic then
                      c:='ZAJIC'
                     else if cprok=cpdrak then
                          c:='DRAK'
                         else if cprok=cphad then
                              c:='HAD'
                             else if cprok=cpkun then
                                  c:='KUN'
                                 else if cprok=cpkoza then
                                      c:='KOZA'
                                     else if cprok=cpopice then
                                          c:='OPICE'
                                         else if cprok=cpkohout then
                                              c:='KOHOUT'
                                             else if cprok=cppes then
                                                  c:='PES'
                                                 else if cprok=cpprase then
                                                      c:='PRASE'
                                                     else
                                                         c:='Nastala chyba';

{----------------------zobrazeni udaju na monitor------------------------------}


           writeln('________________________________________________________');
           writeln ('');
           writeln('Vase znameni je: ',z);
           writeln ('');
           writeln('Narodil/a jste se dle cinskeho kalendare ve znameni: ',c);
           writeln('________________________________________________________');
           writeln ('');
           writeln('Pro ukonceni stisknete ENTER');


      readln;
end.