Fórum função para converter (extenso) #217808

unit uExtenso;

interface

Uses SysUtils;

function Extenso( Numero : Extended ) : String;

implementation

{Fonte: http://lrsistema.vila.bol.com.br/funcoes.htm#extenso }
{ A função extenso divide os números em grupos de tres e chama a função
  extenso3em3 para o extenso de cada parte. }
function Extenso( Numero : Extended ) : String;
  function Extenso3em3( Numero : Word ) : String;
  const Valores : Array[1..36] of LongInt = ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
                       13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90,
                       100, 200, 300, 400, 500, 600, 700, 800, 900 );
        Nomes : Array[0..36] of String[12] = ( ´´, ´um´, ´dois´, ´três´, ´quatro´,
                       ´cinco´, ´seis´, ´sete´, ´oito´, ´nove´, ´dez´, ´onze´,
                       ´doze´, ´treze´, ´quatorze´, ´quinze´, ´dezesseis´,
                       ´dezessete´, ´dezoito´, ´dezenove´, ´vinte´, ´trinta´,
                       ´quarenta´, ´cinqüenta´, ´sessenta´, ´setenta´, ´oitenta´,
                       ´noventa´, ´cento´, ´duzentos´, ´trezentos´, ´quatrocentos´,
                       ´quinhentos´, ´seiscentos´, ´setecentos´, ´oitocentos´,
                       ´novecentos´ );
  var i         : byte;
      resposta  : String;
      inteiro   : Word;
      resto     : LongInt;
  begin
    Inteiro := Numero;
    Resposta := ´´;
    for i := 36 downto 1 do begin
        Resto := ( Inteiro div valores[i] ) * valores[i];
        if ( Resto = valores[i] ) and ( Inteiro >= Resto ) then begin
           Resposta := Resposta + Nomes[i] + ´ e ´;
           Inteiro := Inteiro - Valores[i];
        end;
    end;
    Extenso3em3 := Copy( Resposta, 1, Length( Resposta ) - 3 );

  end;

Const NoSingular : Array[1..5] of String = ( ´bilhão´, ´milhão´, ´mil´,
                                           ´real´, ´centavo´ );
      NoPlural   : Array[1..5] of String = ( ´bilhões´, ´milhões´, ´mil´,
                                           ´reais´, ´centavos´ );
var i         : byte;
    resposta  : Array[1..5] of String; { de centavos a bilhões }
    plural    : Array[1..5] of Boolean;
    inteiro   : LongInt;
    NumStr    : String;
    Trio      : Word;
    SomaTrio  : Word;

begin
 Inteiro  := Trunc( Numero * 100 );

 { Inicializa os vetores }
 for i := 1 to 5 do begin
     resposta[i] := ´´;
     plural[i]   := False;
 end;

 { O número é partido em partes distintas, agrupadas de três em três casas:
   centenas, milhares, milhões e bilhões. A última parte (a quinta)
   contém apenas os centavos, com duas casas }
 Str( Inteiro : 14, NumStr );
 i        := 1;
 SomaTrio := 0;
 Inteiro  := Inteiro div 100; { remove os centavos }

 while NumStr[i] = ´ ´ do begin
   NumStr[i] := ´0´;
   i         := i + 1;
 end;

 for i := 1 to 5 do begin
      Trio := StrToInt( Copy( NumStr, 3 * i - 2, 3 ) );
      if trio <> 0 then begin
         resposta[i] := resposta[i] + extenso3em3( trio );
         if Trio > 1 then Plural[i] := True;
         if i <> 5 then SomaTrio := SomaTrio + Trio; {Não somar os centavos}
      end;
 end;

 { Gerar a resposta propriamente dita }
 NumStr := ´´;
 { se não atribuir um valor à resposta 5, a palavra ´real´ poderá não ser
   impressa em algumas situações. Entretanto, a palavra ´real´ não poderá ser
   impressa se o valor contiver apenas centavos
 }
 if (resposta[4]=´´) and ( SomaTrio <> 0 ) then begin
    resposta[4] := ´ ´;
    plural[4]   := True;
 end;

 { Basta ser maior que um para que a palavra ´real´ seja escrita no plural }
 if SomaTrio > 1 then plural[4] := True;

 for i := 1 to 5 do begin
     { se for apenas cem, não escrever ´cento´ }
     if resposta[i] = ´cento´ then resposta[i] := ´cem´;
     if resposta[i] <> ´´ then begin
        NumStr := NumStr + resposta[i] + ´ ´;
        if plural[i] then
           NumStr := NumStr + NoPlural[i] + ´ ´
        else
           NumStr := NumStr + NoSingular[i] + ´ ´;

        { Verifica a necessidade da particula ´e´ para os números }
        if (i < 4) and (resposta[i] <> ´´) and (resposta[i+1] <> ´´)
           and (resposta[i+1] <> ´ ´) then
           NumStr := NumStr + ´e ´;
     end;

     { se for apenas bilhões ou milhões, acrescenta o ´de´ }
     if ( i=3 ) and ( SomaTrio <> 0 ) and ( ( Inteiro mod 1000000 = 0 )
        or ( Inteiro mod 1000000000 = 0 ) ) then
        NumStr := NumStr + ´de´;

     { se tiver centavos, acrescenta a partícula ´e´, mas somente se houver
       qualquer valor na parte inteira }
     if ( i = 4 ) and ( resposta[5] <> ´´ ) and ( inteiro > 0 ) then
        NumStr := NumStr + ´ e ´;
 end;

 { Eliminar algumas situações em que o extenso gera 2 ou 3 espaços dentro
   da resposta.}
 i := pos( ´   ´, NumStr );
 if i <> 0 then
    delete( NumStr, i, 2 );
 i := pos( ´  ´, NumStr );
 if i <> 0 then
    delete( NumStr, i, 1 );
 Extenso := NumStr;
end;

end.