Valor por extenso

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.

Motta...

Obrigada pela ajuda, funcionou perfeitamente.

Att, Catharina.