Re: [delphi-br] Função que retorna um valor por extenso

[Oséias Ferreira]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Eu uso esta:

// ------ Valor por extenso de um número ------------------------
function Extenso(Valor: double; Singular, Plural: string): string;
var
  Ind: integer;
  Num: integer;
  Code: integer;
  Ve: array[0..11] of string;
  Str_Valor: string;
  Aux: string;
begin
  Result := '';

  if Valor > 0.0 then
  begin
    Ve[00] := 'Trilhão';                // Inicializa Vetor
    Ve[01] := 'Trilhões';
    Ve[02] := 'Bilhão';
    Ve[03] := 'Bilhões';
    Ve[04] := 'Milhão';
    Ve[05] := 'Milhões';
    Ve[06] := 'Mil';
    Ve[07] := 'Mil';
    Ve[08] := Singular;
    Ve[09] := Plural;
    Ve[10] := 'Centavo';
    Ve[11] := 'Centavos';

    Str_Valor := Format('%18.2f', [Valor]);
    Str_Valor[16] := '0';               // Tira ponto decimal;

    for Ind := 0 to 5 do
    begin             // Trata grupo de 3 dígitos (Trih.., Bilh.., Milh..)
      Aux := Copy(Str_Valor, Ind * 3 + 1, 3);
      Val(Aux, Num, code);

      if Num > 0 then
      begin
        Aux := ExtNum(Aux);
        if (Ind = 5) and (Valor > 1) then                    // Trata
Centavos
          Aux := 'e ' + Aux;
        if Num = 1 then
          Result := Result + Aux + ' ' + Ve[Ind * 2] + ' '     //
Singular ( ...lhão)
        else
          Result := Result + Aux + ' ' + Ve[Ind * 2 + 1] + ' ';
        // Plural   ( ...lhões)
      end;

      if Valor > 1000 then
      begin
        if (Num = 0) and (Ind = 3) then       // Bilhões, Milhões de ....
          Result := Result + 'de ';

        if (Num = 0) and (Ind = 4) then       // Mil <Plural Moeda> ....
          Result := Result + Plural + ' ';
      end;
    end; // for
  end;
end;

// ------ Valor por extenso de 1 ate 999 ( sem unidade )---------

function ExtNum(Str_Valor: string): string;
const
  Vu: array [1..19] of string = ('Hum', 'Dois', 'Três', 'Quatro', 'Cinco',
    'Seis', 'Sete', 'Oito',
    'Nove', 'Dez', 'Onze', 'Doze', 'Treze',
    'Quatorze', 'Quinze',
    'Dezeseis', 'Dezesete', 'Dezoito', 'Dezenove');
  Vd: array [2..10] of string = ('Vinte', 'Trinta', 'Quarenta',
'Cinquenta', 'Sessenta',
    'Setenta', 'Oitenta', 'Noventa', 'Cem');
  Vc: array [1..9] of string = ('Cento', 'Duzentos', 'Trezentos',
    'Quatrocentos', 'Quinhentos',
    'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
var
  Num: integer;
  Code: integer;
  Cent: integer;
  Dez: integer;
  Unid: integer;
  CnUn: integer;
begin
  Result := '';
  Val(Str_Valor, Num, Code);                   // Converte String para
Número

  if Num > 0 then
  begin
    Str_Valor := Format('%03d', [Num]);
    // Ajusta string do valor com zeros à esquerda
    Val(Copy(Str_Valor, 2,2), CnUn, Code);     // Copia Centena e Unidade
    Val(Copy(Str_Valor, 3,1), Unid, Code);     // Copia Unidade
    Val(Copy(Str_Valor, 2,1), Dez, Code);     // Copia Dezena
    Val(Copy(Str_Valor, 1,1), Cent, Code);     // Copia Centena

    if Num = 100 then
      Result := Vd[10]                       // Trata: 'Cem'
    else
    begin
      if Cent > 0 then
      begin                    // Trata: 'Cento e', 'Duzentos e', ...
        Result := Vc[Cent];
        if CnUn > 0 then
          Result := Result + ' e ';
      end;

      if Dez > 1 then
      begin                    // Trata: 'Vinte', 'Trinta', ...
        Result := Result + Vd[Dez];
        if Unid > 0 then
          Result := Result + ' e '         // Trata: 'Vinte e ', 'Trinta
e ', ...
      end;

      if (CnUn >= 1) and (CnUn <= 19) then   // Trata: 'Hum' a ' 'Dezenove'
        Result := Result + Vu[CnUn];

      if (Dez > 1) and (Unid >= 1) then           // Trata: .... ' Hum',
' Dois', ...
        Result := Result + Vu[Unid];
    end;
  end;
end;

// ---FIM---- //


Fabrício Pinheiro França escreveu:
> Ai pessoal será que alguem ai tem o código de uma função para retorna um 
> valor por extenso.
> 
> Obrigado
> Fabrício
> 
> [As partes desta mensagem que não continham texto foram removidas]
> 
> 
> 
> 
> 
> 

- --
Oséias Ferreira.            oseiasferreira (arroba) yahoo.com.br
  Linux counter #333243
  GPG/PGP: 0x60084245
  fingerprint: B1A2 81EF 0560 66D3 8B22 1BC0 1CA6 0374 6008 4245

-----BEGIN PGP SIGNATURE-----
Comment: Using GnuPG with Thunderbird - http://enigmail.mozdev.org

iD8DBQFDaN3iHKYDdGAIQkURAkPBAKCWE0FZ9xJfCPPu7EkxuuOP4OJk7gCfR4GK
0nEg8jWf5wepi170/FXtBWc=
=YikH
-----END PGP SIGNATURE-----

        

        
                
_______________________________________________________ 
Yahoo! Acesso Grátis: Internet rápida e grátis. 
Instale o discador agora!
http://br.acesso.yahoo.com/



-- 
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>

<*> Para ver as mensagens antigas, acesse:
    http://br.groups.yahoo.com/group/delphi-br/messages

<*> Para falar com o moderador, envie um e-mail para:
    [EMAIL PROTECTED]
 
Links do Yahoo! Grupos

<*> Para visitar o site do seu grupo na web, acesse:
    http://br.groups.yahoo.com/group/delphi-br/

<*> Para sair deste grupo, envie um e-mail para:
    [EMAIL PROTECTED]

<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
    http://br.yahoo.com/info/utos.html