Fórum FUNÇÃO QUE TRANSFORMA UM VALOR PARA EXTENSO, ALGUÉM CONHECE? #133929

Procure na opção COMPONENTES que com certeza ali deve ter um objeto para este proposito...

unit Ext;
interface
function extenso (valor: real): string;
// retirei da internet, não testei, veja se funciona.

implementation
uses
SysUtils, Dialogs;
function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = (´Um´, ´Dois´, ´Tres´, ´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´, ´Cinquenta´, ´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 (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:=´´;
Dezena:=´´;
Centena:=´´;
if (trio[2]=´1´) and (trio[3]<>´0´) then
begin
Unidade:=Dez[strtoint(trio[3])];
Dezena:=´´;
end
else
begin
if trio[2]<>´0´ then Dezena:=Dezenas[strtoint(trio[2])];
if trio[3]<>´0´ then Unidade:=Unidades[strtoint(trio[3])];
end;
if (trio[1]=´1´) and (Unidade=´´) and (Dezena=´´)
then Centena:=´cem´
else
if trio[1]<>´0´
then Centena:=Centenas[strtoint(trio[1])]
else Centena:=´´;
Result:= Centena + ifs((Centena<>´´) and ((Dezena<>´´) or (Unidade<>´´)), ´ e ´, ´´)
+ Dezena + ifs((Dezena<>´´) and (Unidade<>´´),´ e ´, ´´) + Unidade;
end;
begin
if (valor>999999.99) or (valor<0) then
begin
msg:=´O valor está fora do intervalo permitido.´;
msg:=msg+´O número deve ser maior ou igual a zero e menor que 999.999,99.´;
msg:=msg+´ Se não for corrigido o número não será escrito por extenso.´;
showmessage(msg);
Result:=´´;
exit;
end;
if valor=0 then
begin
Result:=´´;
Exit;
end;
Texto:=formatfloat(´000000.00´,valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso(´0´+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>´´ then
if copy(texto,4,3)=´000´ then
Result:=Result+´ Mil Reais´
else
Result:=Result+´ Mil, ´;
if (((copy(texto,4,2)=´00´) and (Milhar<>´´)
and (copy(texto,6,1)<>´0´)) or (centavos=´´))
and (Centena<>´´) then Result:=Result+´ e ´;
if (Milhar+Centena <>´´) then Result:=Result+Centena;
if (Milhar=´´) and (copy(texto,4,3)=´001´) then
Result:=Result+´ Real´
else
if (copy(texto,4,3)<>´000´) then Result:=Result+´ Reais´;
if Centavos=´´ then
begin
Result:=Result+´.´;
Exit;
end
else
begin
if Milhar+Centena=´´ then
Result:=Centavos
else
Result:=Result+´, e ´+Centavos;
if (copy(texto,8,2)=´01´) and (Centavos<>´´) then
Result:=Result+´ Centavo.´
else
Result:=Result+´ Centavos.´;
end;
end;
end.