Ir para o conteúdo
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

Hercles

Função Simples para escrever por extenso uma idade num caixa de texto.

Mensagens Recomendadas

Hercles

Olá! Alguém tem algum codigo de simples entendimento para transformar um dado "idade" de numeral para extenso? Exemplo:

(numeral ) idade: 33 para extenso na caixa => idade: trinta e três anos.

Já vi codigo para extenso para valores escrito em cheque como do tipo: "Trinta e tres mil e cento e vinte e dois reais e dois centavos", achei muito complicado pra transformar em um codigo simples pra escrita da idade.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
nunopicado

Para idade não é preciso tanto, basta-te ir às centenas, mas esse código que viste não deverá fugir muito à regra.

Basta remover a parte das decimais, que não fazem falta aqui, assim como tudo que for igual ou superior aos milhares (muito embora eu pessoalmente pretenda viver mais de 1000 anos :P)

Tirando isto, o que sobra do código deverá ser bastante simples.


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Hercles

como eu tiro fora a parte fracionada deste codigo?

unit Um;

interface
function valorPorExtenso(vlr: real): string;

implementation
uses SysUtils;

function valorPorExtenso(vlr: real): string;
const
 unidade: array[1..19] of string = ('um', 'dois', 'três', 'quatro', 'cinco',
            'seis', 'sete', 'oito', 'nove', 'dez', 'onze',
            'doze', 'treze', 'quatorze', 'quinze', 'dezesseis',
            'dezessete', 'dezoito', 'dezenove');
 centena: array[1..9] of string = ('cento', 'duzentos', 'trezentos',
            'quatrocentos', 'quinhentos', 'seiscentos',
            'setecentos', 'oitocentos', 'novecentos');
 dezena: array[2..9] of string = ('vinte', 'trinta', 'quarenta', 'cinquenta',
            'sessenta', 'setenta', 'oitenta', 'noventa');
 qualificaS: array[0..4] of string = ('', 'mil', 'milhão', 'bilhão', 'trilhão');
 qualificaP: array[0..4] of string = ('', 'mil', 'milhões', 'bilhões', 'trilhões');
var
                       inteiro: Int64;
                         resto: real;
 vlrS, s, saux, vlrP, centavos: string;
    n, unid, dez, cent, tam, i: integer;
                   umReal, tem: boolean;
begin
 if (vlr = 0)
    then begin
           valorPorExtenso := 'zero';
           exit;
         end;

 inteiro := trunc(vlr); // parte inteira do valor
 resto := vlr - inteiro; // parte fracionária do valor
 vlrS := inttostr(inteiro);
 if (length(vlrS) > 15)
    then begin
           valorPorExtenso := 'Erro: valor superior a 999 trilhões.';
           exit;
         end;

 s := '';
 centavos := inttostr(round(resto * 100));

// definindo o extenso da parte inteira do valor
 i := 0;
 umReal := false; tem := false;
 while (vlrS <> '0') do
 begin
   tam := length(vlrS);
// retira do valor a 1a. parte, 2a. parte, por exemplo, para 123456789:
// 1a. parte = 789 (centena)
// 2a. parte = 456 (mil)
// 3a. parte = 123 (milhões)
   if (tam > 3)
      then begin
             vlrP := copy(vlrS, tam-2, tam);
             vlrS := copy(vlrS, 1, tam-3);
           end
   else begin // última parte do valor
          vlrP := vlrS;
          vlrS := '0';
        end;
   if (vlrP <> '000')
      then begin
             saux := '';
             if (vlrP = '100')
                then saux := 'cem'
             else begin
                    n := strtoint(vlrP);        // para n = 371, tem-se:
                    cent := n div 100;          // cent = 3 (centena trezentos)
                    dez := (n mod 100) div 10;  // dez  = 7 (dezena setenta)
                    unid := (n mod 100) mod 10; // unid = 1 (unidade um)
                    if (cent <> 0)
                       then saux := centena[cent];
                    if ((dez <> 0) or (unid <> 0))
                       then begin
                              if ((n mod 100) <= 19)
                                 then begin
                                        if (length(saux) <> 0)
                                           then saux := saux + ' e ' + unidade[n mod 100]
                                        else saux := unidade[n mod 100];
                                      end
                              else begin
                                     if (length(saux) <> 0)
                                        then saux := saux + ' e ' + dezena[dez]
                                     else saux := dezena[dez];
                                     if (unid <> 0)
                                        then if (length(saux) <> 0)
                                                then saux := saux + ' e ' + unidade[unid]
                                             else saux := unidade[unid];
                                   end;
                            end;
                  end;
             if ((vlrP = '1') or (vlrP = '001'))
                then begin
                       if (i = 0) // 1a. parte do valor (um real)
                          then umReal := true
                       else saux := saux + ' ' + qualificaS[i];
                     end
             else if (i <> 0)
                     then saux := saux + ' ' + qualificaP[i];
             if (length(s) <> 0)
                then s := saux + ', ' + s
             else s := saux;
           end;
   if (((i = 0) or (i = 1)) and (length(s) <> 0))
      then tem := true; // tem centena ou mil no valor
   i := i + 1; // próximo qualificador: 1- mil, 2- milhão, 3- bilhão, ...
 end;

 if (length(s) <> 0)
    then begin
           if (umReal)
              then s := s + ' real'
           else if (tem)
                   then s := s + ' anos'
                else s := s + ' de reais';
         end;
// definindo o extenso dos centavos do valor
 if (centavos <> '0') // valor com centavos
    then begin
           if (length(s) <> 0) // se não é valor somente com centavos
              then s := s + ' e ';
           if (centavos = '1')
              then s := s + 'um centavo'
           else begin
                  n := strtoint(centavos);
                  if (n <= 19)
                     then s := s + unidade[n]
                  else begin                 // para n = 37, tem-se:
                         unid := n mod 10;   // unid = 37 % 10 = 7 (unidade sete)
                         dez := n div 10;    // dez  = 37 / 10 = 3 (dezena trinta)
                         s := s + dezena[dez];
                         if (unid <> 0)
                            then s := s + ' e ' + unidade[unid];
                      end;
                  s := s + ' centavos';
                end;
         end;
 valorPorExtenso := s;
end;

end.

Leia mais em: Valor por Extenso: Delphi http://www.devmedia.com.br/valor-por-extenso-delphi/21974#ixzz2bC813Ynj

Editado por nunopicado
Adicionadas tags GeShi

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
nunopicado

Mas que grande código...

Tens de absorver as ideias por trás do código que vês...

Se analisares o código encontras facilmente (aliás, está até mais ou menos bem comentado).

Olha aí um mais simples, só para a idade (entre 0 e 999):

function IdadeExtenso(Idade:Word):String;
const
 cUnidades:Array[1..19] of string=('um','dois','três','quatro','cinco','seis','sete','oito','nove','dez','onze','doze','treze','catorze','quinze','dezasseis','dezassete','dezoito','dezanove');
 cDezenas:Array[2..9] of string=('vinte','trinta','quarente','cinquenta','sessenta','setenta','oitenta','noventa');
 cCentenas:Array[1..9] of string=('cento','duzentos','trezentos','quatrocentos','quinhentos','seiscentos','setecentos','oitocentos','novecentos');
 cZero='zero';
 cCem='cem';
 cSeparador:Array[boolean] of String=('',' e ');
begin
 Result:='';
 if Idade>999
	then Exit;

 if Idade=0
	then Result:=cZero
	else if Idade=100
			then Result:=cCem
			else begin
					  if (Idade Mod 10=0) and (Idade<>10)
						 then Result:=''
						 else if Trunc((Idade Mod 100) div 10)=1
								 then Result:=cUnidades[(Idade Mod 100)]
								 else Result:=cUnidades[idade Mod 10];

					  if Idade Mod 100>=20
						 then Result:=cDezenas[Trunc((Idade Mod 100) div 10)]+cSeparador[idade Mod 10>0]+Result;

					  if Idade>100
						 then Result:=cCentenas[Trunc((Idade Mod 1000) div 100)]+cSeparador[idade Mod 100>0]+Result;
				 end;
end;

Editado por nunopicado

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
Hercles

Show!!!!!! só faltou concatenizar anos.

if Idade Mod 100>=20
                            then Result:=cDezenas[Trunc((Idade Mod 100) div 10)]+cSeparador[integer(Idade Mod 10>0)]+Result + '  anos';

                         if Idade>100
                            then Result:=cCentenas[Trunc((Idade Mod 1000) div 100)]+cSeparador[integer(Idade Mod 100>0)]+Resul + '  anos';
end;
end;

Valeu Amigão!!!!

Editado por nunopicado
Adicionadas tags GeShi

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
nunopicado

Não pus de propósito, porque assim serve para numeros inteiros em geral e não apenas idade.

De qualquer maneira, se queres, recomendo que, em vez de meteres onde meteste, duplicando código, metas no fim, antes do último end da função, assim:

Result:=Result+' anos';


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.