Buscar por:

Colocando valor por extenso

Código

{Bom dia caros amigos,

  É a minha primeira vez que estou escrevendo um   artigo no site, espero que goste, e simple mas de grande utilidade. 

  mãos na massa, pouco tempo atrás tive um problema para colocar o valores por extenso.

1º temos que criar uma função assim :

  function Extenso( pValor:Extended ):String;

depois de criada pressioner a tecla ctrl+shift+c para colocar a implementação da função.

2º depois só usar esta funcção :

}

function Extenso( pValor:Extended ):String;

const

  aCifra : Array[1..6,1..2] of String = (('TRILHÃO,','TRILHOES,'),

                                         ('BILHAO,' ,'BILHÕES,' ),

                                         ('MILHAO,' ,'MILHÕES,' ),

                                         ('MIL,'     ,'MIL,'     ),

                                         ('    '     ,'   '      ),

                                         ('CENTAVO' ,'CENTAVOS'));

var

  tStr,tExtenso,tSubs:String;

  tX,tCentavos:Integer;

begin

  tSubs := ' ';

  tExtenso := ' ';

  tStr := StrZero(pValor,18,2);  {funcao disponível neste livro}

  tCentavos := StrToInt( Copy(tStr,17,2) );

  if pValor > 0 then

  begin

    if tCentavos > 0 then

      tExtenso := ExtCem( StrZero( tCentavos,3,0 )) + aCifra[6,Trunc(iif(tCentavos =1,1,2))];

    if trunc( pValor ) > 0 then

      tExtenso := iif(trunc( pValor ) = 1,'REAL',' REAIS')+iif(tCentavos > 0, ' E   ','')+tExtenso;

    for tX := 5 Downto 1 do

    begin

      tSubs := Copy(tStr,(tX*3)-2,3);

      if StrToInt( tSubs ) > 0 then

        tExtenso := ExtCem( tSubs ) + aCifra[tX,Trunc(iif(StrToInt( tSubs )=1,1,2))]+'   '+tExtenso;

    end;

  end;

  Result := StripDouble( tExtenso );

end;

{3º como usar ?

crie uma nova aplicação no delphi, depois de criada coloque no form.

Label

Edit

Colocado na tela vai no evento do onchange de um click, e coloque este codigo :

label.Caption := Extenso(strtoFloat(edit.text));

depois de feito isto rode sua aplicação e digite o valor que automaticamente será mostrado do label o valor por extenso.

espero que goste .

até o próximo artigo.

Email para contato

Email : rbbarreto@hotmail.com

}