Re: [delphi-br] Valor por extenso

[André Luis de Oliveira]

Eu uso essa função

const
  Centenas: array[1..9] of string[12] = ('CEM', 'DUZENTOS', 'TREZENTOS', 
'QUATROCENTOS',
    'QUINHENTOS', 'SEISCENTOS', 'SETECENTOS',
    'OITOCENTOS', 'NOVECENTOS');
  Dezenas: array[2..9] of string[10] = ('VINTE', 'TRINTA', 'QUARENTA', 
'CINQUENTA',
    'SESSENTA', 'SETENTA', 'OITENTA', 'NOVENTA');
  Dez: array[0..9] of string[10] = ('DEZ', 'ONZE', 'DOZE', 'TREZE', 'QUATORZE',
    'QUINZE', 'DEZESSEIS', 'DEZESSETE',
    'DEZOITO', 'DEZENOVE');
  Unidades: array[1..9] of string[10] = ('UM', 'DOIS', 'TRES', 'QUATRO', 
'CINCO',
    'SEIS', 'SETE', 'OITO', 'NOVE');
  MoedaSingular = 'REAL';
  MoedaPlural = 'REAIS';
  CentSingular = 'CENTAVO';
  CentPlural = 'CENTAVOS';
  Zero = 'ZERO';
  
  function Retorna_Valor_Extenso(Valor: Double): string;
  var
    ComoTexto: string;
    Parte: string;
  begin
    Result := '';
    ComoTexto := FloatToStrF(Abs(Valor), ffFixed, 18, 2);
  // Acrescenta zeros a esquerda ate 12 digitos
    while length(ComoTexto) < 15 do
      Insert('0', ComoTexto, 1);
  // Retira caracteres a esquerda para o máximo de 12 digitos
    while length(ComoTexto) > 15 do
      delete(ComoTexto, 1, 1);
  
  // Calcula os bilhões
    Parte := Ext3(copy(ComoTexto, 1, 3));
    if StrToInt(copy(ComoTexto, 1, 3)) = 1 then
      Parte := Parte + ' BILHAO'
    else
      if Parte <> '' then
        Parte := Parte + ' BILHOES';
    Result := Parte;
  
  // Calcula os nilhões
    Parte := Ext3(copy(ComoTexto, 4, 3));
    if Parte <> '' then
    begin
      if Result <> '' then
        Result := Result + ', ';
      if StrToInt(copy(ComoTexto, 4, 3)) = 1 then
        Parte := Parte + ' MILHAO'
      else
        Parte := Parte + ' MILHOES';
      Result := Result + Parte;
    end;
  
  // Calcula os nilhares
    Parte := Ext3(copy(ComoTexto, 7, 3));
    if Parte <> '' then
    begin
      if Result <> '' then
        Result := Result + ', ';
      Parte := Parte + ' MIL';
      Result := Result + Parte;
    end;
  
  // Calcula as unidades
    Parte := Ext3(copy(ComoTexto, 10, 3));
    if Parte <> '' then
    begin
      if Result <> '' then
        if Frac(Valor) = 0 then
          Result := Result + ' E '
        else
          Result := Result + ', ';
      Result := Result + Parte;
    end;
  
  // Acrescenta o texto da moeda
    if Int(Valor) = 1 then
      Parte := ' ' + MoedaSingular
    else
      Parte := ' ' + MoedaPlural;
    if copy(ComoTexto, 7, 6) = '000000' then
      Parte := 'DE ' + MoedaPlural;
    Result := Result + Parte;
  
  // Se o valor for zero, limpa o resultado
    if int(Valor) = 0 then Result := '';
  
  //Calcula os centavos
    Parte := Ext3('0' + copy(ComoTexto, 14, 2));
    if Parte <> '' then
    begin
      if Result <> '' then
        Result := Result + ' E ';
      if Parte = Unidades[1] then
        Parte := Parte + ' ' + CentSingular
      else
        Parte := Parte + ' ' + CentPlural;
      Result := Result + Parte;
    end;
  
    if Copy(Result, 1, 3) = 'UM ' then
      Result := 'H' + Result;
  
  // Se o valor for zero, assume a constante ZERO
    if Valor = 0 then
      Result := Zero;
  end;
  
  function Ext3(Parte: string): string;
  var
    Base: string;
    digito: integer;
  begin
    Base := '';
    digito := StrToInt(Parte[1]);
    if digito = 0 then
      Base := ''
    else
      Base := Centenas[digito];
    if (digito = 1) and (Parte > '100') then
      Base := 'CENTO';
    Digito := StrToInt(Parte[2]);
    if digito = 1 then
    begin
      Digito := StrToInt(Parte[3]);
      if Base <> '' then
        Base := Base + ' E ';
      Base := Base + Dez[Digito];
    end
    else
    begin
      if (Base <> '') and (Digito > 0) then
        Base := Base + ' E ';
      if Digito > 1 then
        Base := Base + Dezenas[digito];
      Digito := StrToInt(Parte[3]);
      if Digito > 0 then
      begin
        if Base <> '' then Base := Base + ' E ';
        Base := Base + Unidades[Digito];
      end;
    end;
    Result := Base;
end;

  ----- Original Message ----- 
  From: Fernando Luiz Bortolanzza 
  To: delphi-br@yahoogrupos.com.br 
  Sent: Thursday, July 06, 2006 1:30 PM
  Subject: [delphi-br] Valor por extenso


  Alguem ai tem uma função que passa o valor em real e retorna o texto do
  valor por extenso?



  Atenciosamente,

  -------------------------------------------------------------

  Fernando Luiz Bortolanzza

  Analista de desenvolvimento de sistemas
  CoreSinPR - http://www.corepr.org.br <http://www.corepr.org.br/> 
  Fone: +55 (41) 3223-5213  R.212
  -------------------------------------------------------------





  [As partes desta mensagem que não continham texto foram removidas]

   

[As partes desta mensagem que não continham texto foram removidas]



-- 
<<<<< 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