/*
* 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
*=====================