You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
318 lines
9.5 KiB
318 lines
9.5 KiB
unit uExtenso;
|
|
|
|
interface
|
|
|
|
function valorPorExtenso(vlr: real): string;
|
|
function Extenso(Valor : Extended; Moeda: Boolean; Tipo : Integer = 0): String;
|
|
|
|
implementation
|
|
|
|
uses SysUtils;
|
|
|
|
function valorPorExtenso(vlr: real): string;
|
|
const
|
|
unidade: array [1 .. 19] of string = ('um', 'dois', 'três', 'quatro', 'cinco',
|
|
'seis', 'sete', 'oito', 'nove', 'dez', 'onze', 'doze', 'treze', 'quatorze',
|
|
'quinze', 'dezesseis', 'dezessete', 'dezoito', 'dezenove');
|
|
centena: array [1 .. 9] of string = ('cento', 'duzentos', 'trezentos',
|
|
'quatrocentos', 'quinhentos', 'seiscentos', 'setecentos', 'oitocentos',
|
|
'novecentos');
|
|
dezena: array [2 .. 9] of string = ('vinte', 'trinta', 'quarenta',
|
|
'cinquenta', 'sessenta', 'setenta', 'oitenta', 'noventa');
|
|
qualificaS: array [0 .. 4] of string = ('', 'mil', 'milhão', 'bilhão',
|
|
'trilhão');
|
|
qualificaP: array [0 .. 4] of string = ('', 'mil', 'milhões', 'bilhões',
|
|
'trilhões');
|
|
var
|
|
inteiro: Int64;
|
|
resto: real;
|
|
vlrS, s, saux, vlrP, centavos: string;
|
|
n, unid, dez, cent, tam, i: integer;
|
|
umReal, tem: boolean;
|
|
begin
|
|
if (vlr = 0) then
|
|
begin
|
|
valorPorExtenso := 'zero';
|
|
exit;
|
|
end;
|
|
|
|
inteiro := trunc(vlr); // parte inteira do valor
|
|
resto := vlr - inteiro; // parte fracionária do valor
|
|
vlrS := inttostr(inteiro);
|
|
if (length(vlrS) > 15) then
|
|
begin
|
|
valorPorExtenso := 'Erro: valor superior a 999 trilhões.';
|
|
exit;
|
|
end;
|
|
|
|
s := '';
|
|
centavos := inttostr(round(resto * 100));
|
|
|
|
// definindo o extenso da parte inteira do valor
|
|
i := 0;
|
|
umReal := false;
|
|
tem := false;
|
|
while (vlrS <> '0') do
|
|
begin
|
|
tam := length(vlrS);
|
|
// retira do valor a 1a. parte, 2a. parte, por exemplo, para 123456789:
|
|
// 1a. parte = 789 (centena)
|
|
// 2a. parte = 456 (mil)
|
|
// 3a. parte = 123 (milhões)
|
|
if (tam > 3) then
|
|
begin
|
|
vlrP := copy(vlrS, tam - 2, tam);
|
|
vlrS := copy(vlrS, 1, tam - 3);
|
|
end
|
|
else
|
|
begin // última parte do valor
|
|
vlrP := vlrS;
|
|
vlrS := '0';
|
|
end;
|
|
if (vlrP <> '000') then
|
|
begin
|
|
saux := '';
|
|
if (vlrP = '100') then
|
|
saux := 'cem'
|
|
else
|
|
begin
|
|
n := strtoint(vlrP); // para n = 371, tem-se:
|
|
cent := n div 100; // cent = 3 (centena trezentos)
|
|
dez := (n mod 100) div 10; // dez = 7 (dezena setenta)
|
|
unid := (n mod 100) mod 10; // unid = 1 (unidade um)
|
|
if (cent <> 0) then
|
|
saux := centena[cent];
|
|
if ((dez <> 0) or (unid <> 0)) then
|
|
begin
|
|
if ((n mod 100) <= 19) then
|
|
begin
|
|
if (length(saux) <> 0) then
|
|
saux := saux + ' e ' + unidade[n mod 100]
|
|
else
|
|
saux := unidade[n mod 100];
|
|
end
|
|
else
|
|
begin
|
|
if (length(saux) <> 0) then
|
|
saux := saux + ' e ' + dezena[dez]
|
|
else
|
|
saux := dezena[dez];
|
|
if (unid <> 0) then
|
|
if (length(saux) <> 0) then
|
|
saux := saux + ' e ' + unidade[unid]
|
|
else
|
|
saux := unidade[unid];
|
|
end;
|
|
end;
|
|
end;
|
|
if ((vlrP = '1') or (vlrP = '001')) then
|
|
begin
|
|
if (i = 0) // 1a. parte do valor (um real)
|
|
then
|
|
umReal := true
|
|
else
|
|
saux := saux + ' ' + qualificaS[i];
|
|
end
|
|
else if (i <> 0) then
|
|
saux := saux + ' ' + qualificaP[i];
|
|
if (length(s) <> 0) then
|
|
s := saux + ', ' + s
|
|
else
|
|
s := saux;
|
|
end;
|
|
if (((i = 0) or (i = 1)) and (length(s) <> 0)) then
|
|
tem := true; // tem centena ou mil no valor
|
|
i := i + 1; // próximo qualificador: 1- mil, 2- milhão, 3- bilhão, ...
|
|
end;
|
|
|
|
if (length(s) <> 0) then
|
|
begin
|
|
if (umReal) then
|
|
s := s + ' real'
|
|
else if (tem) then
|
|
s := s + ' reais'
|
|
else
|
|
s := s + ' de reais';
|
|
end;
|
|
// definindo o extenso dos centavos do valor
|
|
if (centavos <> '0') // valor com centavos
|
|
then
|
|
begin
|
|
if (length(s) <> 0) // se não é valor somente com centavos
|
|
then
|
|
s := s + ' e ';
|
|
if (centavos = '1') then
|
|
s := s + 'um centavo'
|
|
else
|
|
begin
|
|
n := strtoint(centavos);
|
|
if (n <= 19) then
|
|
s := s + unidade[n]
|
|
else
|
|
begin // para n = 37, tem-se:
|
|
unid := n mod 10; // unid = 37 % 10 = 7 (unidade sete)
|
|
dez := n div 10; // dez = 37 / 10 = 3 (dezena trinta)
|
|
s := s + dezena[dez];
|
|
if (unid <> 0) then
|
|
s := s + ' e ' + unidade[unid];
|
|
end;
|
|
s := s + ' centavos';
|
|
end;
|
|
end;
|
|
valorPorExtenso := s;
|
|
end;
|
|
|
|
function Extenso(Valor : Extended; Moeda: Boolean; Tipo : Integer = 0): String;
|
|
var
|
|
Centavos, Centena, Milhar, Milhao, Bilhao, Texto : string;
|
|
const
|
|
Unidades: array [1..9] of string = ('um', 'dois', 'três','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', 'cinqüenta', '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: ShortString ): string;
|
|
var
|
|
Unidade, Dezena, Centena: String;
|
|
begin
|
|
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
|
|
if Moeda then
|
|
Result := ''
|
|
else
|
|
Result := 'zero';
|
|
|
|
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
|
|
begin
|
|
Milhao := Milhao
|
|
+ ifs( Copy( Texto, 4,
|
|
3 ) = '001', ' milhão', ' milhões');
|
|
end;
|
|
|
|
Bilhao := MiniExtenso( Copy( Texto, 1, 3 ) );
|
|
|
|
if Bilhao <> '' then
|
|
begin
|
|
Bilhao := Bilhao + ifs( Copy( Texto, 1, 3 ) = '001', ' bilhão',
|
|
' bilhões');
|
|
end;
|
|
|
|
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;
|
|
|
|
if Moeda then
|
|
begin
|
|
if Tipo=0 then
|
|
begin
|
|
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', ' reais');
|
|
if Centavos <> '' then
|
|
begin
|
|
if Valor > 1 then
|
|
Result := Result + ' e ' + Centavos + ifs( Copy(
|
|
Texto, 14, 2 )= '01', ' centavo', ' centavos' )
|
|
else
|
|
Result := Centavos + ifs( Copy( Texto, 14, 2 )= '01',
|
|
' centavo', ' centavos' );
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if (Bilhao <> '') and (Milhao + Milhar + Centena = '') then
|
|
Result := Bilhao + ' de dolares americanos'
|
|
else
|
|
if (Milhao <> '') and (Milhar + Centena = '') then
|
|
Result := Milhao + ' de dolares americanos'
|
|
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, ' dolar americano', ' dolares americanos');
|
|
|
|
if Centavos <> '' then
|
|
begin
|
|
if Valor > 1 then
|
|
Result := Result + ' e ' + Centavos + ifs( Copy( Texto, 14, 2 )=
|
|
'01', ' cent', ' cents' )
|
|
else
|
|
Result := Centavos + ifs( Copy( Texto, 14, 2 )= '01', ' cent', ' ' +
|
|
'cents' );
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|