Fiz esse programinha usando o método 2 do livro “Feng Shui e a Astrologia” de cálculo para obter o numero do I ching da personalidade do individuo. Funcionamento bem simples, o usuario digita o ano do seu nascimento e o programa retorna o numero.
program anoIChing; Uses CRT; var cAno: Array [1..4] of char; {ano em caracter, pois readkey só funciona com este} iAno: Array [1..4] of integer; {vou converter o caracter para inteiro para fazer conta} iChing, iSoma, c: integer; {simples contador} {Esse trecho somente PEGA e CONVERTE o que o ano que o usuario digita} Procedure entraAno; begin For c:=1 to 4 Do Begin cAno[c]:=readkey; Case cAno[c] of '0': iAno[c]:=0; '1': iAno[c]:=1; '2': iAno[c]:=2; '3': iAno[c]:=3; '4': iAno[c]:=4; '5': iAno[c]:=5; '6': iAno[c]:=6; '7': iAno[c]:=7; '8': iAno[c]:=8; '9': iAno[c]:=9; end; write(cAno[c]); end; end; {Esse trecho somente IMPRIME o que o ano que o usuario digita} Procedure imprimeAno; Begin For c:=1 to 4 Do Begin write(iAno[c]); end; end; {Esse trecho somente SOMA todos os digitos de ano} Procedure SomaAno; Begin iSoma:=0; For c:=1 to 4 Do Begin iSoma:=iAno[c]+iSoma; end; end; {Esse trecho somente SOMA a SOMA de todos os digitos de ano} Procedure obtemIChing; var d, u, s: integer; Begin d:=ISoma div 10; u:=ISoma mod 10; s:=d+u; iChing:=11-s; write('I Ching ', iChing, ' '); end; Procedure descreveIChing; Begin Case iChing of 1: Begin{agua} write('Agua (yin)'); End; 2: Begin{Terra} write('Terra (yin)'); End; 3: Begin{Arvore} write('Arvore (yin)'); End; 4: Begin{Arvore} write('Terra (yin'); End; 5: Begin{Terra} write('Terra (yine yang)'); End; 6: Begin{Metal} write('Metal (yiang)'); End; 7: Begin{Metal} write('Metal (yiang)'); End; 8: Begin{Terra} write('Terra (yaing)'); End; 9: Begin{Fogo} write('Fogo (yiang)'); End; end; end; { P R I N C I P A L } Begin writeln; writeln; writeln; Write('Digite o ano de seu nascimento : ');entraAno; writeln; write('o numero que vc digitou foi : ' ); imprimeAno; writeln; writeln; somaAno; writeln; obtemIChing; descreveIChing; writeln; writeln; writeln; writeln; writeln; End.
Este artigo foi útil ?
SimNão
Last modified: 24 de outubro de 2007