GARANTIR DESCONTO

Fórum Valores Por extenso #238593

19/06/2004

0

Delphi

Ola Galéra alguem poderia me ajudar como faço para gerar o valor por extenso, de uma soma de uma tabela.

tenho um campo em moeda em uma tabela que vai ser somada e gerada
um total e desse total quero gerar por extenso.

se alguem poder me ajudar eu agradeco.
/
//
Grato[color=blue:862c0b5bc1][/color:862c0b5bc1][size=18:862c0b5bc1][/size:862c0b5bc1]


Ricardo.cabral

Ricardo.cabral

Responder

Posts

19/06/2004

Xanatos

Pega essas funções ai!

function Extenso( pValor:Extended ):String;
Const
   aCifra : Array[1..6,1..2] of String = ((´TRILHÃO,´,´TRILHOES,´),
                                          (´BILHAO,´ ,´BILHÕES,´ ),
                                          (´MILHAO,´ ,´MILHÕES,´ ),
                                          (´MIL,´    ,´MIL,´     ),
                                          (´   ´     ,´   ´      ),
                                          (´CENTAVO´ ,´CENTAVOS´));
Var
   tStr,tExtenso,tSubs:String;
   tX,tCentavos:Integer;
begin
   tSubs := ´ ´;
   tExtenso := ´ ´;
   tStr := StrZero(pValor,18,2);
   tCentavos := StrToInt( Copy(tStr,17,2) );
   if pValor > 0 then
   begin
      if tCentavos > 0 then
        tExtenso := ExtCem( StrZero( tCentavos,3,0 )) + aCifra[6,Trunc(iif(tCentavos = 1,1,2))];
      if trunc( pValor ) > 0 then
        tExtenso := iif(trunc( pValor ) = 1,´REAL´,´ REAIS´)+iif(tCentavos > 0, ´ E ´,´´)+tExtenso;
      for tX := 5 Downto 1 do
      begin
         tSubs := Copy(tStr,(tX*3)-2,3);
         if StrToInt( tSubs ) > 0 then
           tExtenso := ExtCem( tSubs ) + aCifra[tX,Trunc(iif(StrToInt( tSubs )=1,1,2))]+´ ´+tExtenso;
      end;
   end;
   Result := StripDouble( tExtenso );
end;

function ExtCem( pCem:String ):String; 
Const 
   aCent:Array[1..9] of string = (´CENTO´,´DUZENTOS´,´TREZENTOS´,´QUATROCENTOS´,
         ´QUINHENTOS´,´SEISCENTOS´,´SETECENTOS´,´OITOCENTOS´,´NOVECENTOS´);
   aVint:Array[1..9] of string =  (´ONZE´,´DOZE´,´TREZE´,´QUATORZE´,
         ´QUINZE´,´DEZESSEIS´,´DEZESSETE´,´DEZOITO´,´DEZENOVE´);
   aDez :Array[1..9] of string = (´DEZ´,´VINTE´,´TRINTA´,´QUARENTA´,
         ´CINQUENTA´,´SESSENTA´,´SETENTA´,´OITENTA´,´NOVENTA´);
   aUnit:Array[1..9] of string = (´UM´,´DOIS´,´TREIS´,´QUATRO´,
         ´CINCO´,´SEIS´,´SETE´,´OITO´,´NOVE´);
Var
   aVal:Array[1..3] of integer;
   text : String; 
begin
   text := ´´;
   aVal[1] := StrToInt( Copy( pCem,1,1) ); 
   aVal[2] := StrToInt( Copy( pCem,2,1) ); 
   aVal[3] := StrToInt( Copy( pCem,3,1) ); 
   if StrToInt(pCem) > 0 then 
   begin 
      if StrToInt(pCem) = 100 then 
         text := ´CEM´ 
      else begin 
         if aVal[1] > 0 then 
           text := aCent[aVal[1]]+iif((aVal[2]+aVal[3]) > 0,´ E ´,´ ´); 
         if (aVal[2] = 1)  and (aVal[3] > 0) then 
            text := text + ´ ´ + aVint[Aval[3]]
         else begin
            if aVal[2] > 0 then 
             text := text+´ ´+aDez[aVal[2]]+iif(aVal[3]>0, ´ E ´,´ ´);
            text := text+iif(aVal[3]>0,´ ´+aUnit[aVal[3]],´ ´);
         end; 
      end; 
   end; 
   text := text + ´ ´; 
   Result := text; 
end;
:wink:


Responder

Gostei + 0

01/07/2004

Ricardo.cabral

Ola cara fico muito grato pela ajuda, estou tentando fazer com esta função que voce me passou e não funciona, esta dando problema com Array, será que não é pelo motivo de ser o Delphi 5 que estou usando ??.

seria possivel voce passar um exemplo desta função funcionando.

Grato.


Responder

Gostei + 0

01/07/2004

Paulo_amorim

Olá

Tem um monte de arrays no algoritmo kra...qual tá dando erro?

Até+


Responder

Gostei + 0

01/07/2004

Motta 


unit uExtenso;

interface

Uses SysUtils;

function Extenso( Numero : Extended ) : String;

implementation

{Fonte: http://lrsistema.vila.bol.com.br/funcoes.htm#extenso }
{ A função extenso divide os números em grupos de tres e chama a função
  extenso3em3 para o extenso de cada parte. }
function Extenso( Numero : Extended ) : String;
  function Extenso3em3( Numero : Word ) : String;
  const Valores : Array[1..36] of LongInt = ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
                       13, 14, 15, 16, 17, 18, 19, 20, 30, 40, 50, 60, 70, 80, 90,
                       100, 200, 300, 400, 500, 600, 700, 800, 900 );
        Nomes : Array[0..36] of String[12] = ( ´´, ´um´, ´dois´, ´três´, ´quatro´,
                       ´cinco´, ´seis´, ´sete´, ´oito´, ´nove´, ´dez´, ´onze´,
                       ´doze´, ´treze´, ´quatorze´, ´quinze´, ´dezesseis´,
                       ´dezessete´, ´dezoito´, ´dezenove´, ´vinte´, ´trinta´,
                       ´quarenta´, ´cinqüenta´, ´sessenta´, ´setenta´, ´oitenta´,
                       ´noventa´, ´cento´, ´duzentos´, ´trezentos´, ´quatrocentos´,
                       ´quinhentos´, ´seiscentos´, ´setecentos´, ´oitocentos´,
                       ´novecentos´ );
  var i         : byte;
      resposta  : String;
      inteiro   : Word;
      resto     : LongInt;
  begin
    Inteiro := Numero;
    Resposta := ´´;
    for i := 36 downto 1 do begin
        Resto := ( Inteiro div valores[i] ) * valores[i];
        if ( Resto = valores[i] ) and ( Inteiro >= Resto ) then begin
           Resposta := Resposta + Nomes[i] + ´ e ´;
           Inteiro := Inteiro - Valores[i];
        end;
    end;
    Extenso3em3 := Copy( Resposta, 1, Length( Resposta ) - 3 );

  end;

Const NoSingular : Array[1..5] of String = ( ´bilhão´, ´milhão´, ´mil´,
                                           ´real´, ´centavo´ );
      NoPlural   : Array[1..5] of String = ( ´bilhões´, ´milhões´, ´mil´,
                                           ´reais´, ´centavos´ );
var i         : byte;
    resposta  : Array[1..5] of String; { de centavos a bilhões }
    plural    : Array[1..5] of Boolean;
    inteiro   : LongInt;
    NumStr    : String;
    Trio      : Word;
    SomaTrio  : Word;

begin
 Inteiro  := Trunc( Numero * 100 );

 { Inicializa os vetores }
 for i := 1 to 5 do begin
     resposta[i] := ´´;
     plural[i]   := False;
 end;

 { O número é partido em partes distintas, agrupadas de três em três casas:
   centenas, milhares, milhões e bilhões. A última parte (a quinta)
   contém apenas os centavos, com duas casas }
 Str( Inteiro : 14, NumStr );
 i        := 1;
 SomaTrio := 0;
 Inteiro  := Inteiro div 100; { remove os centavos }

 while NumStr[i] = ´ ´ do begin
   NumStr[i] := ´0´;
   i         := i + 1;
 end;

 for i := 1 to 5 do begin
      Trio := StrToInt( Copy( NumStr, 3 * i - 2, 3 ) );
      if trio <> 0 then begin
         resposta[i] := resposta[i] + extenso3em3( trio );
         if Trio > 1 then Plural[i] := True;
         if i <> 5 then SomaTrio := SomaTrio + Trio; {Não somar os centavos}
      end;
 end;

 { Gerar a resposta propriamente dita }
 NumStr := ´´;
 { se não atribuir um valor à resposta 5, a palavra "real" poderá não ser
   impressa em algumas situações. Entretanto, a palavra "real" não poderá ser
   impressa se o valor contiver apenas centavos
 }
 if (resposta[4]=´´) and ( SomaTrio <> 0 ) then begin
    resposta[4] := ´ ´;
    plural[4]   := True;
 end;

 { Basta ser maior que um para que a palavra "real" seja escrita no plural }
 if SomaTrio > 1 then plural[4] := True;

 for i := 1 to 5 do begin
     { se for apenas cem, não escrever ´cento´ }
     if resposta[i] = ´cento´ then resposta[i] := ´cem´;
     if resposta[i] <> ´´ then begin
        NumStr := NumStr + resposta[i] + ´ ´;
        if plural[i] then
           NumStr := NumStr + NoPlural[i] + ´ ´
        else
           NumStr := NumStr + NoSingular[i] + ´ ´;

        { Verifica a necessidade da particula ´e´ para os números }
        if (i < 4) and (resposta[i] <> ´´) and (resposta[i+1] <> ´´)
           and (resposta[i+1] <> ´ ´) then
           NumStr := NumStr + ´e ´;
     end;

     { se for apenas bilhões ou milhões, acrescenta o ´de´ }
     if ( i=3 ) and ( SomaTrio <> 0 ) and ( ( Inteiro mod 1000000 = 0 )
        or ( Inteiro mod 1000000000 = 0 ) ) then
        NumStr := NumStr + ´de´;

     { se tiver centavos, acrescenta a partícula ´e´, mas somente se houver
       qualquer valor na parte inteira }
     if ( i = 4 ) and ( resposta[5] <> ´´ ) and ( inteiro > 0 ) then
        NumStr := NumStr + ´ e ´;
 end;

 { Eliminar algumas situações em que o extenso gera 2 ou 3 espaços dentro
   da resposta.}
 i := pos( ´   ´, NumStr );
 if i <> 0 then
    delete( NumStr, i, 2 );
 i := pos( ´  ´, NumStr );
 if i <> 0 then
    delete( NumStr, i, 1 );
 Extenso := NumStr;
end;

end.



Responder

Gostei + 0

26/10/2004

Christian_adriano

olá Motta,

estava precisando de uma rotina para escrever valor monetários por extenso ae opitei pela sua.

Só q ocorre um problema, nos CENTAVOS, as vezes não escreve o valor certo.

Tipo:
100000,50
CEM MIL E QUARENTA E NOVE CENTAVOS.

Dessa forma q as vezes acontece. Ele escreve o valor anterior do certo.

Vc sabe o pq q pode esta ocorrendo isso ?

Desde já agradeço atenção.

[]´s

Christian.


Responder

Gostei + 0

26/10/2004

Marcio.theis

Outra forma:


procedure escreve_extenso;
var
contador, cont_aux,x,y,cont_dez,cont_cem,cont_mil : integer;
numero : string;
foi: boolean;
unidade : ARRAY [1..9] of string[6];
dezena : ARRAY [1..18] of string[9];
centena : ARRAY [1..9] of string[12];
begin
unidade[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:=extenso;
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;
//Inicio da escrita
if ((numero[1] = ´1´) and (numero[3] = ´0´) and (numero[4] = ´0´) and (contador=4)) then
extenso := ´ UM REAL´
else
begin
if ((numero[contador] = ´0´) and (numero[contador-1] = ´0´)) then
extenso := ´ REAIS´
else
if (numero[contador] = ´1´) and (numero[contador-1] = ´0´) then
extenso := ´ CENTAVO´
else
extenso := ´ 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
extenso := ´ ´ + unidade[x] + extenso;
end
else
if cont_dez = 1 then // se é dezena
begin
if ((numero[cont_aux+1] = ´0´) and (numero[cont_aux] = ´1´)) then //se é 10
extenso := ´ ´ + dezena[1] + extenso
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
extenso := ´ ´ + dezena[Y+1] + extenso;
end
else // se >= 20
begin
if numero[cont_aux+1] = ´0´ then
extenso := ´ ´ + dezena[x+9] + extenso
else
for y:=1 to 9 do
if numero[cont_aux+1] = inttostr(y) then
extenso := ´ ´ + dezena[x+9] + ´ E´ + extenso;
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
extenso := ´ CEM´ + extenso
else
begin
extenso := ´ ´ + centena[1] + ´ E´ + extenso;
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
extenso := ´ ´ + centena[y] + ´ E´ + extenso
else
extenso := ´ ´ + centena[y] + extenso;
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
extenso := ´ REAL E´ + extenso
else
if ((numero[cont_aux+1] ´0´) or (numero[cont_aux+2] ´0´)) then
extenso := ´ REAIS E´ + extenso;
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
extenso := ´ DE´ + extenso;
foi:=true;
end
else
begin
extenso := ´ E´ + extenso;
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
extenso := ´ MIL E´ + extenso
else
extenso := ´ MIL´ + extenso;
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
extenso := ´ E´ + extenso;
if ((numero[cont_aux] = ´1´) and (cont_aux = 1)) then
extenso := ´ MILHÃO´ + extenso
else
extenso := ´ MILHÕES´ + extenso;
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 extenso[contador+1] ´´ do
begin
extenso[contador]:=extenso[contador+1];
contador:=contador+1;
end;
extenso[contador]:=#0;
// fim do cálculo do valor por extenso
end;


Responder

Gostei + 0

26/10/2004

Motta

christian

a rotina eu baixei da Internet, tenho na biblioteca, mas nunca a utilizei, não sei o que pode ser, só debugando.Tente a outra.


Responder

Gostei + 0

26/10/2004

Dopi

Mais uma rotina para extenso....

O projeto ACBr tem o componente ACBrExtenso


Responder

Gostei + 0

26/10/2004

Christian_adriano

Obrigado a todos pela atenção... mais já consegui outra...

http://www.guiadodelphi.com.br/ler.php?codigo=567

[]´s.

Christian.


Responder

Gostei + 0

27/10/2004

Cirilo

Componente CJVQRExtenso com fontes

http://www.veloso.kit.net


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar