Delphi: Valor por extenso de moedas

1

Posted on : 14-05-2011 | By : Paulo H Oliveira | In : Delphi

Quem nunca precisou transformar um valor real em extenso. Aqui fica minha função que uso para transformar, aproveitem !

{ Valor por extenso de moedas Modo de usar sVariavel := Extenso(1234,56); }
 
function Extenso(Valor : Extended): String;
var
  Centavos, Centena, Milhar, Milhao, Bilhao, Texto : string;
const
  Unidades: array [1..9] of string = ('um', 'dois', 'tres', 'quatro',
    'cinco',
    'seis', 'sete', 'oito',
    'nove');
  Dez : array [1..9] of string = ('onze', 'doze', 'treze',
    'quatorze', 'quinze',
    'dezesseis', 'dezessete',
    'dezoito', 'dezenove');
  Dezenas: array [1..9] of string = ('dez', 'vinte', 'trinta',
    'quarenta', 'cinquenta',
    'sessenta', 'setenta',
    'oitenta', 'noventa');
  Centenas: array [1..9] of string = ('cento', 'duzentos',
    'trezentos', 'quatrocentos',
    'quinhentos', 'seiscentos',
    'setecentos',
    'oitocentos', 'novecentos');
 
function ifs( Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
  if Expressao then Result := CasoVerdadeiro else Result := CasoFalso;
end;
 
function MiniExtenso( Valor: String ): string;
var
  Unidade, Dezena, Centena: String;
begin
 
  Unidade := '';
  Dezena  := '';
  Centena := '';
 
  if (Valor[2] = '1') and (Valor[3] <> '0') then begin
    Unidade := Dez[StrToInt(Valor[3])];
    Dezena := '';
  end else begin
    if Valor[2] <> '0' then
      Dezena := Dezenas[StrToInt(Valor[2])];
    if Valor[3] <> '0' then
      Unidade := Unidades[StrToInt(Valor[3])];
  end;
 
  if (Valor[1] = '1') and (Unidade = '') and (Dezena = '') then
    Centena := 'cem'
  else
    if Valor[1] <> '0' then Centena :=
      Centenas[StrToInt(Valor[1])]
    else Centena := '';
 
  Result := Centena +
  ifs( (Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '') + Dezena +
  ifs( (Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;
end;
 
begin
 
  if Valor = 0 then begin
    Result := '';
    Exit;
  end;
 
  Texto := FormatFloat( '000000000000.00', Valor );
  Centavos := MiniExtenso( '0' + Copy( Texto, 14, 2 ) );
  Centena := MiniExtenso( Copy( Texto, 10, 3 ) );
  Milhar := MiniExtenso( Copy( Texto, 7, 3 ) );
 
  if Milhar <> '' then
    Milhar := Milhar + ' mil';
    Milhao := MiniExtenso( Copy( Texto, 4, 3 ) );
 
  if Milhao <> '' then
    Milhao := Milhao + ifs( Copy( Texto, 4, 3 ) = '001', ' milhao',
      ' milhoes');
    Bilhao := MiniExtenso( Copy( Texto, 1, 3 ) );
 
  if Bilhao <> '' then
    Bilhao := Bilhao + ifs( Copy( Texto, 1, 3 ) = '001', ' bilhao',
      ' bilhoes');
 
  if (Bilhao <> '') and (Milhao + Milhar + Centena = '') then
    Result := Bilhao + ' de reais'
  else if (Milhao <> '') and (Milhar + Centena = '') then
    Result := Milhao + ' de reais'
  else
    Result := Bilhao +
  ifs( (Bilhao <> '') and (Milhao + Milhar + Centena <> ''),
  ifs((Pos(' e ', Bilhao) > 0) or (Pos( ' e ', Milhao + Milhar + Centena ) > 0 ), ', ', ' e '), '') + Milhao +
  ifs( (Milhao <> '') and (Milhar + Centena <> ''),
  ifs((Pos(' e ', Milhao) > 0) or (Pos( ' e ', Milhar + Centena ) > 0 ), ', ', ' e '), '') + Milhar +
  ifs( (Milhar <> '') and (Centena <> ''),
  ifs(Pos( ' e ', Centena ) > 0, ', ', ' e '), '') + Centena + ifs( Int(Valor) = 1, ' real',
  ifs( Int(Valor)>1,' reais', '') );
  if Centavos <> '' then
    Result := Result + ifs(Centena <> '', ' e ', '') + Centavos +
    ifs( Copy( Texto, 14, 2 )= '01', ' centavo', ' centavos' );
end;

Compartilhe :

  • Stumble upon
  • twitter

Comentários (1)

Código Muito Bom mesmo, ajudou bastante aqui, valew!

Escreva um comentário

Security Code: