valor real por extenso

[luana rs 0]

Oi pessoal eu tenho que receber um valor real por extenso até mil,só que é muito complicado como eu faço pra chegar até os centavos.

[marcio.theis 3]

você precisa recceber um valor por extenso, ou escrever um valor por extenso ?Teria um exemplo ?

[marcio.theis 3]

Bom... Tem componente que faz isto, ou então pode usar uma function que você passa o valor e ela lhe retorna escrito por extenso, um exemplo de função que escreve por extenso seria:

 

function TForm1.EscreveExtenso(valor: Extended): string;var	contador, cont_aux,x,y,cont_dez,cont_cem,cont_mil : integer;	numero, ret: string;	foi: boolean;	unidade : ARRAY [1..9] of string[6];	dezena : ARRAY [1..18] of string[9];	centena : ARRAY [1..9] of string[12];beginunidade[1] := ('UM');unidade[2] := ('DOIS');unidade[3] := ('TRÊS');unidade[4] := ('QUATRO');unidade[5] := ('CINCO');unidade[6] := ('SEIS');unidade[7] := ('SETE');unidade[8] := ('OITO');unidade[9] := ('NOVE');dezena[1] := ('DEZ');dezena[2] := ('ONZE');dezena[3] := ('DOZE');dezena[4] := ('TREZE');dezena[5] := ('QUATORZE');dezena[6] := ('QUINZE');dezena[7] := ('DEZESSEIS');dezena[8] := ('DEZESSETE');dezena[9] := ('DEZOITO');dezena[10] := ('DEZENOVE');dezena[11] := ('VINTE');dezena[12] := ('TRINTA');dezena[13] := ('QUARENTA');dezena[14] := ('CINQÜENTA');dezena[15] := ('SESSENTA');dezena[16] := ('SETENTA');dezena[17] := ('OITENTA');dezena[18] := ('NOVENTA');centena[1] := ('CENTO');centena[2] := ('DUZENTOS');centena[3] := ('TREZENTOS');centena[4] := ('QUATROCENTOS');centena[5] := ('QUINHENTOS');centena[6] := ('SEISCENTOS');centena[7] := ('SETECENTOS');centena[8] := ('OITOCENTOS');centena[9] := ('NOVECENTOS');contador:=1;numero:=FloatToStrF(valor,ffNumber,15,2);while (numero[contador] in ['R','$']) do	begin	numero[contador]:=' ';	contador:=contador+1;	end;numero:=Trim(numero);contador:=1;while (numero[contador] <> '') do	contador:=contador + 1;contador:=contador - 1;if ((numero[1] = '1') and (numero[3] = '0') and (numero[4] = '0') and (contador=4)) then	  ret:=' UM REAL'else   begin   if ((numero[contador] = '0') and (numero[contador-1] = '0')) then	  ret:=' REAIS'   else	  if (numero[contador] = '1') and (numero[contador-1] = '0') then		 ret:=' CENTAVO'	  else		 ret:=' CENTAVOS';   cont_dez:=0;   cont_cem:=0;   cont_mil:=0;   cont_aux:=contador;   while cont_aux > 0 do	   begin	   for x:=1 to 9 do		   begin		   if numero[cont_aux] = inttostr(x) then			   begin			   if cont_dez = 0 then  // se é unidade				   begin				   if numero[cont_aux-1] <> '1' then					   ret:=' ' + unidade[x] + ret;				   end			   else				   if cont_dez = 1 then   // se é dezena					   begin					   if ((numero[cont_aux+1] = '0') and (numero[cont_aux] = '1')) then  //se é 10						   ret:=' ' + dezena[1] + ret					   else						   if ((numero[cont_aux] = '1') and (numero[cont_aux+1] <> '0')) then  // se > 10 e < 20							  begin							  for y:=1 to 9 do								  if numero[cont_aux+1] = inttostr(y) then  //testa unidade									  ret:=' ' + dezena[Y+1] + ret;							  end						   else								 // se >= 20							  begin							  if numero[cont_aux+1] = '0' then								   ret:=' ' + dezena[x+9] + ret							  else								  for y:=1 to 9 do									 if numero[cont_aux+1] = inttostr(y) then										ret:=' ' + dezena[x+9] + ' E' + ret;							  end;					   end				   else  // teste da centena					  if cont_dez = 2 then						 begin						 if numero[cont_aux] = '1' then							 begin							 if ((numero[cont_aux+1] = '0') and (numero[cont_aux+2] = '0')) then								 ret:= ' CEM' + ret							 else								 begin								 ret:=' ' + centena[1] + ' E' + ret;								 end;							 end						 else							 begin							 for y:=2 to 9 do								 begin								 if numero[cont_aux] = inttostr(y) then									 if ((numero[cont_aux+1] <> '0') or (numero[cont_aux+2] <> '0')) then										 ret:=' ' + centena[y] + ' E' + ret									 else										 ret:=' ' + centena[y] + ret;								 end;							 end;						 end;			   end;		   end;  // encerra for		   cont_dez := cont_dez +1;		   cont_aux := cont_aux -1;		   if (numero[cont_aux] = ',') then			  begin			  if numero[cont_aux] = ',' then				 begin				 if (numero[1] <> '0') or (cont_aux <> 2) then					 if (numero[1] = '1') and (cont_aux = 2) then						 ret:=' REAL E' + ret					 else						 if ((numero[cont_aux+1] <> '0') or (numero[cont_aux+2] <> '0')) then							 ret:=' REAIS E' + ret;				 end;			  cont_aux := cont_aux - 1;			  cont_dez := 0;			  end;		   if numero[cont_aux] = '.' then			  cont_aux := cont_aux - 1;		   if (cont_dez = 3) then			  begin			  if ((cont_cem = 0) and (cont_aux >= 1)) then				  begin				  foi:=false;				  if cont_aux>=5 then					 if (numero[cont_aux]='0') and (numero[cont_aux-1]='0') and (numero[cont_aux-2]='0') then						if (numero[cont_aux+2]='0') and (numero[cont_aux+3]='0') and (numero[cont_aux+4]='0') then							begin							ret:=' DE' + ret;							foi:=true;							end						else							begin							ret:=' E' + ret;							foi:=true;							end;				  if not foi then					 if ((numero[cont_aux+2] <> '0') or (numero[cont_aux+3] <> '0') or (numero[cont_aux+4] <> '0')) then						ret:=' MIL E' + ret					 else						ret:=' MIL' + ret;				  end;			  cont_cem := cont_cem + 1;			  cont_dez := 0;			  end;		   if cont_cem = 2 then			  begin			  if ((cont_mil = 0) and (cont_aux >= 1)) then				 begin				 if ((numero[cont_aux+2] <> '0') or (numero[cont_aux+3] <> '0') or (numero[cont_aux+4] <> '0')) then					 ret:=' E' + ret;				 if ((numero[cont_aux] = '1') and (cont_aux = 1)) then					 ret:=' MILHÃO' + ret				 else					 ret:=' MILHÕES' + ret;				 end;			  cont_mil:=cont_mil +1;			  cont_cem:=0;			  end;		   if numero[cont_aux] = '.' then			  cont_dez := 0;	   end;	 // encerra while   end;contador:=1;while ret[contador+1] <> '' do	begin	ret[contador]:=ret[contador+1];	contador:=contador+1;	end;ret[contador]:=#0;EscreveExtenso:=ret;end;

 

Precisando declarar:

 

function EscreveExtenso(valor: Extended): string;

Um exemplo de chamada passando o valor seria:

 

procedure TForm1.BitBtn1Click(Sender: TObject);var	valor: Extended;beginvalor:=1536.15;Edit1.Text:=EscreveExtenso(valor);end;

Onde que é passado o valor de R$ 1.536.15 e a função retorna preenchendo um edit com o valor por extenso...

 

 

 

Para testar, basta colocar um Edit na tela e um botão, código completo:

 

unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, Buttons;type  TForm1 = class(TForm)	BitBtn1: TBitBtn;	Edit1: TEdit;	procedure BitBtn1Click(Sender: TObject);  private	{ Private declarations }	function EscreveExtenso(valor: Extended): string;  public	{ Public declarations }  end;var  Form1: TForm1;implementation{$R *.dfm}function TForm1.EscreveExtenso(valor: Extended): string;var	contador, cont_aux,x,y,cont_dez,cont_cem,cont_mil : integer;	numero, ret: string;	foi: boolean;	unidade : ARRAY [1..9] of string[6];	dezena : ARRAY [1..18] of string[9];	centena : ARRAY [1..9] of string[12];beginunidade[1] := ('UM');unidade[2] := ('DOIS');unidade[3] := ('TRÊS');unidade[4] := ('QUATRO');unidade[5] := ('CINCO');unidade[6] := ('SEIS');unidade[7] := ('SETE');unidade[8] := ('OITO');unidade[9] := ('NOVE');dezena[1] := ('DEZ');dezena[2] := ('ONZE');dezena[3] := ('DOZE');dezena[4] := ('TREZE');dezena[5] := ('QUATORZE');dezena[6] := ('QUINZE');dezena[7] := ('DEZESSEIS');dezena[8] := ('DEZESSETE');dezena[9] := ('DEZOITO');dezena[10] := ('DEZENOVE');dezena[11] := ('VINTE');dezena[12] := ('TRINTA');dezena[13] := ('QUARENTA');dezena[14] := ('CINQÜENTA');dezena[15] := ('SESSENTA');dezena[16] := ('SETENTA');dezena[17] := ('OITENTA');dezena[18] := ('NOVENTA');centena[1] := ('CENTO');centena[2] := ('DUZENTOS');centena[3] := ('TREZENTOS');centena[4] := ('QUATROCENTOS');centena[5] := ('QUINHENTOS');centena[6] := ('SEISCENTOS');centena[7] := ('SETECENTOS');centena[8] := ('OITOCENTOS');centena[9] := ('NOVECENTOS');contador:=1;numero:=FloatToStrF(valor,ffNumber,15,2);while (numero[contador] in ['R','$']) do	begin	numero[contador]:=' ';	contador:=contador+1;	end;numero:=Trim(numero);contador:=1;while (numero[contador] <> '') do	contador:=contador + 1;contador:=contador - 1;if ((numero[1] = '1') and (numero[3] = '0') and (numero[4] = '0') and (contador=4)) then	  ret:=' UM REAL'else   begin   if ((numero[contador] = '0') and (numero[contador-1] = '0')) then	  ret:=' REAIS'   else	  if (numero[contador] = '1') and (numero[contador-1] = '0') then		 ret:=' CENTAVO'	  else		 ret:=' CENTAVOS';   cont_dez:=0;   cont_cem:=0;   cont_mil:=0;   cont_aux:=contador;   while cont_aux > 0 do	   begin	   for x:=1 to 9 do		   begin		   if numero[cont_aux] = inttostr(x) then			   begin			   if cont_dez = 0 then  // se é unidade				   begin				   if numero[cont_aux-1] <> '1' then					   ret:=' ' + unidade[x] + ret;				   end			   else				   if cont_dez = 1 then   // se é dezena					   begin					   if ((numero[cont_aux+1] = '0') and (numero[cont_aux] = '1')) then  //se é 10						   ret:=' ' + dezena[1] + ret					   else						   if ((numero[cont_aux] = '1') and (numero[cont_aux+1] <> '0')) then  // se > 10 e < 20							  begin							  for y:=1 to 9 do								  if numero[cont_aux+1] = inttostr(y) then  //testa unidade									  ret:=' ' + dezena[Y+1] + ret;							  end						   else								 // se >= 20							  begin							  if numero[cont_aux+1] = '0' then								   ret:=' ' + dezena[x+9] + ret							  else								  for y:=1 to 9 do									 if numero[cont_aux+1] = inttostr(y) then										ret:=' ' + dezena[x+9] + ' E' + ret;							  end;					   end				   else  // teste da centena					  if cont_dez = 2 then						 begin						 if numero[cont_aux] = '1' then							 begin							 if ((numero[cont_aux+1] = '0') and (numero[cont_aux+2] = '0')) then								 ret:= ' CEM' + ret							 else								 begin								 ret:=' ' + centena[1] + ' E' + ret;								 end;							 end						 else							 begin							 for y:=2 to 9 do								 begin								 if numero[cont_aux] = inttostr(y) then									 if ((numero[cont_aux+1] <> '0') or (numero[cont_aux+2] <> '0')) then										 ret:=' ' + centena[y] + ' E' + ret									 else										 ret:=' ' + centena[y] + ret;								 end;							 end;						 end;			   end;		   end;  // encerra for		   cont_dez := cont_dez +1;		   cont_aux := cont_aux -1;		   if (numero[cont_aux] = ',') then			  begin			  if numero[cont_aux] = ',' then				 begin				 if (numero[1] <> '0') or (cont_aux <> 2) then					 if (numero[1] = '1') and (cont_aux = 2) then						 ret:=' REAL E' + ret					 else						 if ((numero[cont_aux+1] <> '0') or (numero[cont_aux+2] <> '0')) then							 ret:=' REAIS E' + ret;				 end;			  cont_aux := cont_aux - 1;			  cont_dez := 0;			  end;		   if numero[cont_aux] = '.' then			  cont_aux := cont_aux - 1;		   if (cont_dez = 3) then			  begin			  if ((cont_cem = 0) and (cont_aux >= 1)) then				  begin				  foi:=false;				  if cont_aux>=5 then					 if (numero[cont_aux]='0') and (numero[cont_aux-1]='0') and (numero[cont_aux-2]='0') then						if (numero[cont_aux+2]='0') and (numero[cont_aux+3]='0') and (numero[cont_aux+4]='0') then							begin							ret:=' DE' + ret;							foi:=true;							end						else							begin							ret:=' E' + ret;							foi:=true;							end;				  if not foi then					 if ((numero[cont_aux+2] <> '0') or (numero[cont_aux+3] <> '0') or (numero[cont_aux+4] <> '0')) then						ret:=' MIL E' + ret					 else						ret:=' MIL' + ret;				  end;			  cont_cem := cont_cem + 1;			  cont_dez := 0;			  end;		   if cont_cem = 2 then			  begin			  if ((cont_mil = 0) and (cont_aux >= 1)) then				 begin				 if ((numero[cont_aux+2] <> '0') or (numero[cont_aux+3] <> '0') or (numero[cont_aux+4] <> '0')) then					 ret:=' E' + ret;				 if ((numero[cont_aux] = '1') and (cont_aux = 1)) then					 ret:=' MILHÃO' + ret				 else					 ret:=' MILHÕES' + ret;				 end;			  cont_mil:=cont_mil +1;			  cont_cem:=0;			  end;		   if numero[cont_aux] = '.' then			  cont_dez := 0;	   end;	 // encerra while   end;contador:=1;while ret[contador+1] <> '' do	begin	ret[contador]:=ret[contador+1];	contador:=contador+1;	end;ret[contador]:=#0;EscreveExtenso:=ret;end;procedure TForm1.BitBtn1Click(Sender: TObject);var	valor: Extended;beginvalor:=1536.15;Edit1.Text:=EscreveExtenso(valor);end;end.

[Renanbg 1]

Bela função, só tenho uma duvida

 

Tenho um dbedit onde digito um valor e no evento de exit dele gostaria de carregar o valor por extenso em um TLabel

 

Como seria?

[marcio.theis 3]

No evento onExit basta fazer:

 

label1.Text:=EscreveExtenso(tabelCAMPO.Value);