Valor por extenso

Poe teu e-mail que te mando um Exemplo.

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+´ ´;
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;

Valeu pela ajuda marcelo