Ola Fer... ai vai:
function ValorExtenso(Valor :Currency) :String;
var
StrValores, StrPart, StrValor, PartDec :String;
i, Parcela, Posicao :Integer;
begin
StrValores := 'trilhão '+'trilhões '+'bilhão
'+'bilhões '+
'milhão '+'milhões '+'mil
'+'mil ';
//Formata o valor corretamente...
StrValor := CurrToStr(Valor);
Posicao := Pos('.',StrValor);
if Posicao > 0 then
begin
PartDec := Copy(StrValor,Posicao+1,2);
if Length(PartDec) < 2 then
begin
StrValor := StrValor+'0';
PartDec := PartDec +'0';
end;
StrValor :=
StringReplace(StrValor,'.','',[rfReplaceAll]);
end
else
begin
PartDec := '00';
StrValor := StrValor+PartDec;
end;
while Length(StrValor) < 17 do StrValor :=
'0'+StrValor;
//Fim da formatação...
for i := 1 to 5 do begin
StrPart := Copy(StrValor,((i-1)*3)+1,3);
Parcela := StrToInt(StrPart);
if Parcela = 1 then Posicao := 1 else Posicao
:= 10;
if Parcela > 0 then
begin
if Length(Result) > 0 then Result :=
Result+' e ';
Result := Result+Centenas(Parcela);
Result :=
Result+TrimRight(Copy(StrValores,((i-1)*18)+Posicao,9));
if not i = 5 then Result := Result+' ';
end;
end;
if Length(Result) > 0 then
if Int(Valor) = 1 then
Result := Result+'real '
else
Result := Result+' reais ';
Parcela := StrToInt(PartDec);
if Parcela > 0 then
begin
if Length(Result) > 0 then Result := Result+'
e ';
if Parcela = 1 then
Result := Result+'um centavo'
else
Result :=
Result+Dezenas(Parcela)+'centavos';
end;
Result := Ajusta(Result);
end;
function Ajusta(Valor :String) :String;
begin
Valor := Trim(StringReplace(Valor,' ','
',[rfReplaceAll]));
if Pos('um mil ',Valor) = 1 then
Valor := StringReplace(Valor,'um
mil','mil',[rfReplaceAll]);
if (Copy(Valor,Length(Valor)-8,9) = 'tos
reais') or
(Copy(Valor,Length(Valor)-8,9) = 'mil
reais') then
begin
Result := Valor;
Exit;
end;
//Ajusta milhares
Valor := StringReplace(Valor,'mil e cento'
,'mil cento' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e duzentos'
,'mil duzentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e trezentos'
,'mil trezentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
quatrocentos','mil quatrocentos',[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
quinhentos' ,'mil quinhentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
seiscentos' ,'mil seiscentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
setecentos' ,'mil setecentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
oitocentos' ,'mil oitocentos' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'mil e
novecentos' ,'mil novecentos' ,[rfReplaceAll]);
//Ajusta trilhões, bilhões e milhões
Valor := StringReplace(Valor,'ão reais' ,'ão
de reais' ,[rfReplaceAll]);
Valor := StringReplace(Valor,'ões reais','ões
de reais',[rfReplaceAll]);
//Retorna valor
Result := Valor;
end;
function Centenas(Valor :Integer) :String;
var
StrValor, StrDig :String;
begin
if Valor = 100 then
Result := 'cem '
else
begin
Result := '';
StrDig := '00'+IntToStr(Valor);
StrDig := Copy(StrDig,Length(StrDig)-2,3);
StrValor := 'cento '+'duzentos
'+'trezentos '+
'quatrocentos'+'quinhentos
'+'seiscentos '+
'setecentos '+'oitocentos
'+'novecentos ';
if StrToInt(StrDig[1]) > 0 then
Result :=
TrimRight(Copy(StrValor,((StrToInt(StrDig[1])-1)*12)+1,12))+'
';
if StrToInt(Copy(StrDig,2,2)) > 0 then
begin
if Length(Result) > 0 then Result :=
Result+'e ';
Result :=
Result+Dezenas(StrToInt(Copy(StrDig,2,2)))
end;
end;
end;
function Dezenas(Valor :Integer) :String;
var
StrValor, StrDig :String;
begin
if Valor < 20 then
Result := Unidades(Valor)
else
begin
Result := '';
StrDig := '00'+IntToStr(Valor);
StrDig := Copy(StrDig,Length(StrDig)-1,2);
StrValor := 'vinte '+'trinta
'+'quarenta '+'cinquenta'+
'sessenta '+'setenta '+'oitenta
'+'noventa ';
Result :=
TrimRight(Copy(StrValor,((StrToInt(StrDig[1])-2)*9)+1,9))+'
';
if StrToInt(StrDig[2]) > 0 then
Result := Result+'e
'+Unidades(StrToInt(StrDig[2]));
end;
end;
function Unidades(Valor :Integer) :String;
const
StrValor :Array[0..18] of pChar =
('um','dois','três','quatro','cinco','seis',
'sete','oito','nove','dez','onze','doze',
'treze','quatorze','quinze','dezesseis',
'dezessete','dezoito','dezenove');
begin
Result := StrValor[Valor-1]+' ';
end;
--- fpsp2000 <[EMAIL PROTECTED]> escreveu:
---------------------------------
Ola!
Alguem poderia me passar uma funçao q converta
valor para extenso.
Desde já agradeço,
Fernanda
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA
MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou
[EMAIL PROTECTED]
Yahoo! Grupos, um serviço oferecido por:
São
Paulo Rio
de Janeiro Curitiba
Porto Alegre Belo
Horizonte
Brasília
---------------------------------
Links do Yahoo! Grupos
Para visitar o site do seu grupo na web,
acesse:
http://br.groups.yahoo.com/group/delphi-br/
Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
O uso que você faz do Yahoo! Grupos está
sujeito aos Termos do Serviço do Yahoo!.
=====
Leandro...
[> Mutuka <]
_______________________________________________________
Yahoo! Acesso Grátis - Instale o discador do Yahoo! agora.
http://br.acesso.yahoo.com/ - Internet rápida e grátis
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
