Clipper On Line • Ver Tópico - Função genérica para extenso de valores passados em números

Função genérica para extenso de valores passados em números

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

 

Função genérica para extenso de valores passados em números

Mensagempor gilsonpaulo » 23 Nov 2010 07:48

/*
* EXTCEM()  -  Valor por extenso de string numérica com tres d¡gitos
*              de "000" a "999"
*/

FUNCTION ExtCem( pCem )

LOCAL aVal:= { VAL( SUBSTR( pCem, 1, 1 )),;
               VAL( SUBSTR( pCem, 2, 1 )),;
               VAL( SUBSTR( pCem, 3, 1 )) }
LOCAL tTam, tExt:= ""

LOCAL aCent:= { "Cento", "Duzentos", "Trezentos", "Quatrocentos",;
                "Quinhentos", "Seiscentos", "Setecentos","Oitocentos",;
                "Novecentos" }

LOCAL aVint:= { "Onze", "Doze", "Treze", "Quatorze", "Quinze", "Dezesseis",;
                "Dezessete", "Dezoito", "Dezenove" }

LOCAL aDez:=  { "Dez", "Vinte", "Trinta", "Quarenta", "Cinquenta", "Sessenta",;
                "Setenta", "Oitenta", "Noventa" }

LOCAL aUnit:= { "Um", "Dois", "Tres", "Quatro", "Cinco", "Seis", "Sete",;
                "Oito", "Nove" }

IF ( VAL( pCem ) > 0 )
   IF ( VAL( pCem ) == 100 )
      tExt:= "Cem"
     ELSE
      IF ( aVal[1] > 0 )
         tExt:= aCent[ aVal[1] ] + IIF(( aVal[2] + aVal[3] > 0 ), " e ", " " )
      ENDIF
      IF ( aVal[2] = 1 ) .AND. ( aVal[3] > 0 )
         tExt:= tExt + " " + aVint[ aVal[3] ] + " "
        ELSE
         IF ( aVal[2] > 0 )
            tExt:= tExt + " " + aDez[ aVal[2] ] + IIF( aVal[3] > 0, " e ", " " )
         ENDIF

         tExt:= tExt + IIF( aVal[3] > 0, " " + aUnit[ aVal[3] ], "" )
      ENDIF
   ENDIF
ENDIF

RETURN( tExt:= tExt + " " )

/*
* EXTENSO()
*/

FUNCTION Extenso( pValor )

LOCAL tStr:= STRZERO( ABS( pValor), 18, 2 )
LOCAL aCifra:= {  { "Trilhao", "Trilhoes" },;
                  { "Bilhao",  "Bilhoes"  },;
                  { "Milhao",  "Milhoes"  },;
                  { "Mil",     "Mil"      },;
                  { "",        ""         },;
                  { "Centavo", "Centavos" }  }

LOCAL tX, tEx1
LOCAL tExtenso:=  ""
LOCAL tSubs:=     ""
LOCAL tCentavos:= VAL( SUBSTR( tStr, 17 ))

IF ( pValor > 0 )

   IF ( tCentavos > 0 )
      tExtenso:= ExtCem( STRZERO( tCentavos, 3 )) +;
                 aCifra[ 6 ][ IIF( tCentavos = 1, 1, 2 ) ]
   ENDIF

   IF ( INT( pValor ) > 0 )
      tExtenso:= IIF( INT( pValor ) = 1, "Real","Reais" ) +;
                 IIF( tCentavos > 0 ," e ", "" ) + tExtenso
   ENDIF

   FOR tX:= 5 TO 1 STEP -1
      IF ( VAL( tSubs:= SUBSTR( tStr, ( tX * 3 ) - 2, 3 )) > 0 )
         tExtenso:= ExtCem( tSubs ) +;
                    aCifra[tX, IIF( VAL( tSubs) = 1, 1, 2 ) ] + " " +;
                    tExtenso
      ENDIF

   NEXT tX

ENDIF

RETURN( StripDouble( tExtenso, " " ))
// eof rvlext.prg


Exemplo de como usar.:

*--
*   FT2930.PRG   -   
*--

#include  "Acesso.ch"
#include  "SetCurs.ch"
#include  "Inkey.ch"

#define   nomeREL         "Emissao de duplicata"

PRIVATE    dat,nfis,fin,icm,frete,total,conta,conta1,cod,quant,unit,ipi,for,doc,;
         conta,conta1,foraux,acum,custo,medio,ped,pfre,val,tval,val1,val2,val3,;
         ped,pedaux,pedt,desc,ate,cep

emp = SPACE(1)
foraux = 0
val1=0.00
val2=0.00
val3=0.00
val4=0.00
val5=0.00
cep = SPACE(8)
tval =0.00
dat=ctod("00.00.00")
fis1 = 0
nfis1=SPACE(5)
fis2 = 0
nfis2=SPACE(5)
fis3 = 0
nfis3=SPACE(5)

tip = SPACE(1)
des = SPACE(45)
pra = SPACE(30)
for = SPACE(4)
moe = SPACE(1)
foraux = 0
eve = SPACE(4)
hisaux = 0
his = SPACE(3)
var = SPACE(40)

SELECT 1
USE CADCLI SHARED ALIAS CLI

IF NETERR()
   Mensagem("Erro na abertura do arquivo, tente novamente")
   INKEY(0)
   TONE(1000,2)
   RETURN
ENDIF

SET INDEX TO INDCLI,INDNOM
GO TOP

SET ORDER TO 1

SELECT 2
USE CADNOT INDEX INDNOT SHARED ALIAS NOTA

IF NETERR()
   Mensagem("Alguem esta usando a nota fiscal.")
   INKEY(0)
   TONE(1000,2)
   CLOSE ALL
   RETURN
ENDIF

GO TOP

DO WHILE .T.

   CALL DUP

   venc1= CTOD("00.00.00")
   venc2= CTOD("00.00.00")   
   venc3= CTOD("00.00.00")
   venc4= CTOD("00.00.00")
   venc5= CTOD("00.00.00")
   val1=0.00
   eve = SPACE(4)
   hisaux = 0
   his = SPACE(3)
   var = SPACE(40)

   val2=0.00
   val3=0.00
   val4=0.00
   val5=0.00

   nom= SPACE(40)
   ende= SPACE(30)
   cgc= SPACE(20)
   ins= SPACE(16)
   mun= SPACE(15)
   bai= SPACE(15)
   ufd = SPACE(2)

   v1 = CTOD("00.00.00")
   v2 = CTOD("00.00.00")
   v3 = CTOD("00.00.00")
   v4 = CTOD("00.00.00")
   v5 = CTOD("00.00.00")

   nf1 = 0
   nf2 = 0
   nf3 = 0
   nf4 = 0
   nf5 = 0

   nfv1 = 0.00
   nfv2 = 0.00
   nfv3 = 0.00
   nfv4 = 0.00
   nfv5 = 0.00

   SET COLOR TO N/W,N/W
   @ 12,08 GET fis1 PICTURE "@K 99999" VALID fis1 > 0
   @ 12,14 GET fis2 PICTURE "@K 99999"
   @ 12,20 GET fis3 PICTURE "@K 99999"
   SET CURSOR ON
   READ
   SET CURSOR OFF
   IF LASTKEY() = 27
      CLOSE ALL
      RETURN
   ENDIF

   nfis1 = STRZERO(fis1,5,0)
   nfis2 = STRZERO(fis2,5,0)
   nfis3 = STRZERO(fis3,5,0)

   @ 12,08 SAY nfis1

   SELECT NOTA
   GO TOP
   SEEK nfis1
   IF FOUND()
      foraux = VAL(CLINOT)
      nom= SUBSTR(NOMCLI,1,40)
      ende= SUBSTR(ENDCLI,1,30)
      cgc= CGCCLI
      ins= INSCLI
      mun= SUBSTR(MUNCLI,1,15)
      ufd = UFDCLI
      cep = CEPCLI
      dat = DATNOT   
      tval = TOTALNOTA
      venc1= VENC1NOT
      venc2 = VENC2NOT
      venc3= VENC3NOT
      val1 = VAL1NOT
      val2 = VAL2NOT
      val3 = VAL3NOT

      SELECT CLI
      SET ORDER TO 1
      GO TOP
      SEEK STRZERO(foraux,4,0)

      pra = RTRIM(mun)+"-"+RTRIM(ende)+"-CEP:"+cep

      SELECT NOTA
      GO TOP
      SEEK nfis2
      IF FOUND()
         val1 = val1 + VAL1NOT
         val2 = val2 + VAL2NOT
         val3 = val3 + VAL3NOT
      ENDIF

      SELECT NOTA
      GO TOP
      SEEK nfis3
      IF FOUND()
         val1 = val1 + VAL1NOT
         val2 = val2 + VAL2NOT
         val3 = val3 + VAL3NOT
      ENDIF

   ELSE
   

      SET COLOR TO N/W,N/W
      @ 06,12 GET foraux PICTURE "@K 9999"
      SET CURSOR ON
      READ
      SET CURSOR OFF
      IF LASTKEY()=27
         LOOP
      ENDIF

      for = STRZERO(foraux,4,0)

      @ 06,12 SAY for

      SELECT CLI
      SET ORDER TO 1
      GO TOP
      SEEK for
      IF .NOT. FOUND()
         TONE(1000,2)
         LOOP
      ENDIF

      nom= SPACE(40)
      ende= SPACE(30)
      cgc= SPACE(20)
      ins= SPACE(16)
      mun= SPACE(15)
      bai= SPACE(15)
      ufd = SPACE(2)

      nom= DESCLI
      ende= ENDCLI
      cgc= CGCCLI
      ins= INSCLI
      mun= CIDCLI
      ufd = UFDCLI
      pra = RTRIM(mun)+"-"+RTRIM(ende)+"-CEP:"+cep
      cep = CEPCLI

   ENDIF

   SET COLOR TO N/W,N/W
   @ 06,17 GET nom PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
   @ 06,65 GET dat PICTURE "@K 99.99.99" VALID !EMPTY(dat)
   @ 07,12 GET ende PICTURE "@KX"
   @ 07,54 GET mun PICTURE "@KX"
   @ 08,12 GET ufd PICTURE "@KX"
   @ 09,11 GET cgc PICTURE "@KX"
   @ 09,52 GET ins PICTURE "@KX"
   @ 10,11 GET cep PICTURE "@KR 99999/999"
   @ 11,11 GET pra PICTURE "@K XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
   SET CURSOR ON
   READ
   SET CURSOR OFF
   IF LASTKEY() = 27
      LOOP
   ENDIF

   tval = val1+val2+val3

   SET COLOR TO N/W,N/W
   @ 12,34 GET tval PICTURE "@K 99999.99" VALID tval > 0.00
   SET CURSOR ON
   READ
   SET CURSOR OFF
   IF LASTKEY()=27
      LOOP
   ENDIF

   SET COLOR TO N/W,N/W
   @ 16,07 GET venc1 PICTURE "@K 99.99.99" VALID !EMPTY(venc1)
   @ 16,19 GET val1 PICTURE "@K 99999999999.99"
   @ 17,07 GET venc2 PICTURE "@K 99.99.99"
   @ 17,19 GET val2 PICTURE "@K 99999999999.99"
   @ 18,07 GET venc3 PICTURE "@K 99.99.99"
   @ 18,19 GET val3 PICTURE "@K 99999999999.99"
   @ 19,07 GET venc4 PICTURE "@K 99.99.99"
   @ 19,19 GET val4 PICTURE "@K 99999999999.99"
   @ 20,07 GET venc5 PICTURE "@K 99.99.99"
   @ 20,19 GET val5 PICTURE "@K 99999999999.99"

   SET CURSOR ON
   READ
   SET CURSOR OFF
   IF LASTKEY()=27
      LOOP
   ENDIF

   IF .NOT. Confirma("Posso prosseguir S/N?")
      LOOP
   ENDIF

        Impdup()

ENDDO

//============
PROCEDURE IMPDUP

DO WHILE .T.

   num = SPACE(2)
   valor =0.00
   ve = CTOD("00.00.00")

   DECLARE op[10]
   op[1] = "1. Vencimento"
   op[2] = "2. Vencimento"
   op[3] = "3. Vencimento"
   op[4] = "4. Vencimento"
   op[5] = "5. Vencimento"
   op[6] = "Abandonar"

   Boxsdin(07,20,14,40,.T.)
   SET COLOR TO N/GR,W*/N+

   mo = ACHOICE(08,21,13,39,op)

   IF LASTKEY() = 27
      RETURN
   ENDIF

   IF mo=1

      IF val1 = 0.00 .OR. EMPTY(venc1)
         TONE(1000,2)
         LOOP
      ENDIF            

      vlext   = SPACE(300)
      vlex1   = SPACE(58)            &&... primeira linha do empenho
      vlex2   = SPACE(58)            &&... segunda linha extenso
      vlex3   = SPACE(58)            &&... terceira linha extenso

      IF .NOT. Confirma("Posso Imprimir?S/N")
         LOOP
      ENDIF

      num = "01"
      ve = venc1
      valor = val1

      IMP2930()

   ENDIF

   IF mo=2

      IF val2 = 0.00 .OR. EMPTY(venc2)
         TONE(1000,2)
         LOOP
      ENDIF            

      vlext   = SPACE(300)
      vlex1   = SPACE(58)            &&... primeira linha do empenho
      vlex2   = SPACE(58)            &&... segunda linha extenso
      vlex3   = SPACE(58)            &&... terceira linha extenso

      IF .NOT. Confirma("Posso Imprimir?S/N")
         LOOP
      ENDIF

      num = "02"
      ve = venc2
      valor = val2

      IMP2930()

   ENDIF

   IF mo=3

      IF val3 = 0.00 .OR. EMPTY(venc3)
         TONE(1000,2)
         LOOP
      ENDIF            

      vlext   = SPACE(300)
      vlex1   = SPACE(58)            &&... primeira linha do empenho
      vlex2   = SPACE(58)            &&... segunda linha extenso
      vlex3   = SPACE(58)            &&... terceira linha extenso

      IF .NOT. Confirma("Posso Imprimir?S/N")
         LOOP
      ENDIF

      num = "03"
      ve = venc3
      valor = val3

                IMP2930()

   ENDIF

   IF mo=4

      IF val4 = 0.00 .OR. EMPTY(venc4)
         TONE(1000,2)
         LOOP
      ENDIF            

      vlext   = SPACE(300)
      vlex1   = SPACE(58)            &&... primeira linha do empenho
      vlex2   = SPACE(58)            &&... segunda linha extenso
      vlex3   = SPACE(58)            &&... terceira linha extenso

      IF .NOT. Confirma("Posso Imprimir?S/N")
         LOOP
      ENDIF

      num = "04"
      ve = venc4
      valor = val4

      IMP2930()

   ENDIF

   IF mo=5

      IF val5 = 0.00 .OR. EMPTY(venc5)
         TONE(1000,2)
         LOOP
      ENDIF            

      vlext   = SPACE(300)
      vlex1   = SPACE(58)            &&... primeira linha do empenho
      vlex2   = SPACE(58)            &&... segunda linha extenso
      vlex3   = SPACE(58)            &&... terceira linha extenso

      IF .NOT. Confirma("Posso Imprimir?S/N")
         LOOP
      ENDIF

      num = "05"
      ve = venc5
      valor = val5

      IMP2930()

   ENDIF

   IF mo= 6
      EXIT
   ENDIF

ENDDO

RETURN

PROCEDURE Imp2930

IF !Onprinter(nomeREL)
   RETURN
ENDIF

?? CHR(27)+"0"

clin = 0

clin = clin + 10
@ clin,58 SAY DAY(dat) PICTURE "99"
@ clin,64 SAY MONTH(dat) PICTURE "99"
@ clin,69 SAY YEAR(dat) PICTURE "9999"
clin = clin + 6

@ clin,03 SAY tval PICTURE "99999.99"
@ clin,18 SAY nfis1 PICTURE "99999"
IF fis3 <> 0
   @ clin,13 SAY "/"
   @ clin,14 SAY SUBSTR(nfis3,4,2)
ELSEIF fis2 <> 0
   @ clin,13 SAY "/"
   @ clin,14 SAY SUBSTR(nfis2,4,2)
ENDIF
@ clin,26 SAY valor PICTURE "@E 999,999.99"
@ clin,43 SAY nfis1 PICTURE "999999"
@ clin,48 SAY "-"
@ clin,49 SAY num
@ clin,51 SAY ve PICTURE "99.99.99"

clin = clin + 6

//IF desc > 0.00
//   @ clin,18 SAY desc PICTURE "@E 999,999.99"
//   @ clin,50 SAY ate
//ENDIF

@ clin,28 SAY nom
clin = clin + 2
@ clin,28 SAY ende
clin = clin + 2
@ clin,28 SAY mun
clin = clin + 2
?? CHR(15)
@ clin,28+20 SAY pra
?? CHR(18)
@ clin,63 SAY ufd
@ clin,71 SAY cep PICTURE "@R 99999/999"
clin = clin + 2
@ clin,28 SAY cgc
@ clin,60 SAY ins

vlext = Extenso(valor)

vlext=vlext+REPLICATE("*",(116-LEN(vlext)))

clin = clin + 2
@ clin,27 SAY SUBSTR(vlext,1,52)
//@ clin,79 SAY "*"
clin = clin + 1
@ clin,28 SAY SUBSTR(vlext,53,52)
clin = clin + 1

clin = clin + 4

EJECT

?? CHR(27)+"2"
offprinter()

RETURN
*=====================
gilsonpaulo
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 135
Data de registro: 02 Fev 2008 10:30
Cidade/Estado: Quatro Barras
Curtiu: 0 vez
Mens.Curtidas: 0 vez

Função genérica para extenso de valores passados em números

Mensagempor deividdjs » 12 Abr 2021 22:44

boa noite amigo...

quando eu coloco o valor de 1.000.000,00 ... a função não retorna o "de"

exemplo

un milhão "de" Reais ...

como faço para fazer funcionar isso ??

Abraço!!

Deivid Souza
Windows 11 + Harbour 3.2 + Visual Lib + GTWVG
Avatar de usuário

deividdjs
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 245
Data de registro: 19 Set 2006 09:39
Cidade/Estado: Foz do Iguaçu / Pr
Curtiu: 81 vezes
Mens.Curtidas: 8 vezes

Função genérica para extenso de valores passados em números

Mensagempor JoséQuintas » 13 Abr 2021 12:31

se retorna MILHAO REAIS ou MILHOES REAIS, só trocar

FUNCTION MeuExtenso( nValor )

LOCAL cExtenso

cExtenso := RotinaAnterior( nValor )
cExtenso := StrTran( cExtenso, "ILHAO REAIS", "ILHAO DE REAIS" )
cExtenso := StrTran( cExtenso, "ILHOES REAIS", "ILHOES DE REAIS" )

RETURN cExtenso
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Função genérica para extenso de valores passados em números

Mensagempor deividdjs » 13 Abr 2021 14:21

OBRIGADO MEU AMIGO ... acabei resolvendo ontem de outra forma ... showww!!

//------------------------------------//
* EXTENSO() /////////// EM ESPANHOL
//----------------------------------///

FUNCTION Extenso_ES( pValor,cSing,cPlural ) // RETORNA MOEDA SINGULAR E PLURAL

LOCAL tStr:= STRZERO( ABS(pValor), 18, 2 )
LOCAL aCifra:= { { "Trill¢n", "Trillones" },;
{ "Mil Millones", "Mil Millones" },;
{ "Mill¢n", "Millones" },;
{ "Mil", "Mil" },;
{ "", "" },;
{ "Centavo", "Centavos" }}

LOCAL tX, tEx1
LOCAL tExtenso:= ""
LOCAL tSubs:= ""
LOCAL tCentavos:= VAL( SUBSTR( tStr, 17 ))

IF ( pValor > 0 )

IF ( tCentavos > 0 )
tExtenso:= ExtCem_ES( STRZERO( tCentavos, 3 )) +;
aCifra[ 6 ][ IIF( tCentavos = 1, 1, 2 ) ]
ENDIF

IF ( INT( pValor ) > 0 )
tExtenso:= IIF( INT( pValor ) = 1,cSing,IIF(SUBSTR(tStr,10,6) = "000000"," de " + cPlural,cPlural)) +;
IIF( tCentavos > 0 ," con " + transform(tCentavos,"99") + "/100", "" ) // + tExtenso
ENDIF

FOR tX:= 5 TO 1 STEP -1
IF ( VAL( tSubs:= SUBSTR( tStr, ( tX * 3 ) - 2, 3 )) > 0 )
tExtenso:= ExtCem_ES( tSubs ) + aCifra[tX, IIF(VAL(tSubs) = 1, 1, 2 ) ] + " " + tExtenso
ENDIF

NEXT tX

ENDIF

RETURN( StripDouble( tExtenso, " " ))


NESTA PARTE DO CODIGO!!

IF ( INT( pValor ) > 0 )
tExtenso:= IIF( INT( pValor ) = 1,cSing,IIF(SUBSTR(tStr,10,6) = "000000"," de " + cPlural,cPlural)) +;
IIF( tCentavos > 0 ," con " + transform(tCentavos,"99") + "/100", "" ) // + tExtenso
ENDIF


Forte Abraço!
Windows 11 + Harbour 3.2 + Visual Lib + GTWVG
Avatar de usuário

deividdjs
Usuário Nível 3

Usuário Nível 3
 
Mensagens: 245
Data de registro: 19 Set 2006 09:39
Cidade/Estado: Foz do Iguaçu / Pr
Curtiu: 81 vezes
Mens.Curtidas: 8 vezes




Retornar para Contribuições, Dicas e Tutoriais

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 22 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro