Código: Selecionar todos
#include "inkey.ch"
#define AR_SKIPBLOCK(atb,ai,VETOR) atb:skipblock={|n, sa| sa:=ai,iif(ai+n > LEN(VETOR), ai:= LEN(VETOR), iif(ai+n < 1, ai:=1, ai += n)), ai-sa}
set score off
set date british
set cent on
set dele on
set epoc to 2000
cls
setcolor('gr+/b')
SELE A
use lancnf
INDEX ON (STR(NF,10)+DTOS(DATEMI)+STR(ITEM,3)) TO XCOMP
set index to xcomp
SELE B
Use Fornec
Index on forn to xfornome
index on cod to xcodfor
set index to xcodfor,xfornome
Sele C
Use Cadpeca
index on cod to xNprod
index on desc to xCdesc
Sele A
dbgotop()
vNF=1
vdatemi=ctod("01/01/2007")
VCAMPO=0
vforn:=vprod:=SPACE(16)
aindex=1
@02,01 SAY 'NOTA FISCAL.:'
@02,30 SAY "DATA DE EMISSAO.:"
@02,14 GET VNF PICT '9999999999'
@02,47 GET VDATEMI PICT '99/99/9999'
READ
IF LASTKEY()=27
DBCLOSEAREA()
RETURN
ENDIF
setcolor('w+/b')
VETOR:={}
chave=(STR(VNF,10,0)+DTOS(VDATEMI))
IF !DBSEEK(CHAVE)
@ 24,00 SAY PADC("Nota n„o encontrada !",80) COLOR "N/W"
INKEY(3)
return
ENDIF
Do while (chave)=str(NF,10)+dtos(datemi)
AADD(VETOR,{NF,ITEM,DATEMI,MOSTFORN,FORN,MOSTPROD,PROD})
skip
Enddo
VETOR:=tabela(VETOR)
Sele A
DBgotop()
SEEK STR(VNF,10,0)+DTOS(VDATEMI)
FOR I=1 TO LEN(VETOR)
REPLA NF WITH VETOR[I,1]
REPLA ITEM WITH VETOR[I,2]
REPLA DATEMI WITH VETOR[I,3]
REPLA MOSTFORN WITH VETOR[I,4]
REPLA FORN WITH VETOR[I,5]
REPLA MOSTPROD WITH VETOR[I,6]
REPLA PROD WITH VETOR[I,7]
SKIP
NEXT
****************************<FUNÇAO TABELA>************************
FUNCTION TABELA(VETOR)
SELE A
dbgotop()
setcolor('W+/B')
@06,03 clear to 20,76
dispbox(06,03,20,76)
oMybrowser:=TBrowseDb(07,04,19,75)
oMybrowser:HeadSep :=Chr(196) + Chr(196) + CHr(196)
oMybrowser:ColSep :=Space(01) + Chr(179) + Space(01)
oMybrowser:gobottomblock={||aindex:=LEN(VETOR)}
oMybrowser:gotopblock={||aindex:=1}
AR_SKIPBLOCK(oMybrowser,aindex,VETOR)
oMybrowser:ColorSpec:='W+/B'
ocolum1:=tbcolumnnew('NUMERO DA NOTA',{|| VETOR[aindex,1]})
ocolum2:=tbcolumnnew('ITEM' ,{|| VETOR[aindex,2]})
ocolum3:=tbcolumnnew('DATA EMISSAO' ,{|| VETOR[aindex,3]})
ocolum4:=tbcolumnnew('NOME FORNECEDOR',{|| VETOR[aindex,4]})
ocolum6:=tbcolumnnew('PRODUTO' {|| VETOR[aindex,6]})
oMybrowser:addcolumn(ocolum1)
oMybrowser:addcolumn(ocolum2)
oMybrowser:addcolumn(ocolum3)
oMybrowser:addcolumn(ocolum4)
oMybrowser:addcolumn(ocolum6)
oMybrowser:freeze:=2
do while .t.
do while(! oMybrowser:stabilize())
enddo
set cursor on
if oMybrowser:stable
if oMybrowser:hitTop()
@20,60 say" INICIO " color('G+/B')
Elseif oMybrowser:hitBottom()
@20,60 say" FIM " color('G+/B')
else
@20,60 say "ÄÄÄÄÄÄÄÄÄÄÄÄ"
endif
endif
nkey:=inkey(0)
if nkey == K_UP
oMyBrowser:up()
elseif nkey == K_DOWN
oMybrowser:down()
elseif nkey == K_LEFT
oMybrowser:left()
elseif nkey == K_RIGHT
oMybrowser:right()
elseif nkey == K_HOME
oMybrowser:home()
elseif nkey == K_END
oMybrowser:end()
elseif nkey == K_PGUP
oMybrowser:pageUp()
elseif nkey == K_PGDN
oMybrowser:pageDown()
elseif nkey == K_CTRL_PGUP
oMybrowser:goTop()
elseif nkey == K_CTRL_PGDN
oMybrowser:goBottom()
elseif nkey == K_CTRL_HOME
oMybrowser:panHome()
elseif nkey == K_CTRL_END
oMybrowser:panEnd()
elseif nkey == K_CTRL_LEFT
oMybrowser:panLeft()
elseif nkey == K_CTRL_RIGHT
oMybrowser:panRight()
elseif nKey== K_ENTER
if (oMybrowser:COLPOS)=1
VCOL:=8
VLIN:=(oMybrowser:RowPos())+8
@ VLIN,VCOL get vcampo pict "@9"
READ
IF !LASTKEY()=27
VETOR[AINDEX,1]:=Vcampo
ENDIF
elseif (oMybrowser:COLPOS)=2
ALERT('ESTE CAMPO NAO;PODE SER ALTERARADO!',,'N/GB')
Elseif (oMybrowser:COLPOS)=3
VCOL:=29
VLIN:=(oMybrowser:RowPos())+8
VCAMPO:=VETOR[3,AINDEX]
@ VLIN,VCOL GET VCAMPO PICT "@D"
READ
IF !LASTKEY()=27
VETOR[AINDEX,3]:=VCAMPO
ENDIF
elseif (oMybrowser:COLPOS)=4
SELE B
DBGOTOP()
SET ORDER TO 2
VTELA:=SAVESCREEN(00,00,25,80)
@07,44 SAY "NOME FORNECEDOR:"COLOR('GR+/B')
@07,60 GET Vforn PICT "@!"COLOR('W+/B')
READ
vNOM:=VFORN
VNOM:=ALLTRIM(VNOM)
IF DBSEEK(VNOM)
Public vforn1:=ARRAY(1),VFORN2:=ARRAY(1)
VFORN1[1]:="FORN"
VFORN2[1]:=" PESQUISA "
setcolor('N/GB')
DISPBOX(09,43,15,66)
Dbedit(10,44,14,65,vforn1,"","",VFORN2,"ÄÄ")
RESTSCREEN(00,00,24,80,VTELA)
SETCOLOR("W+/B")
IF !LASTKEY()=27
VETOR[AINDEX,4]:=Forn
VETOR[AINDEX,5]:=cod
vFORN=forn;vFORN:=substr(vFORN,1,16)
endif
ELSE
ALERT("FORNECEDOR INEXISTENTE !",,"N/GB")
vforn=empty(vforn)
ENDIF
elseif (oMybrowser:COLPOS)=5
SELE C
DBgotop()
set order to 2
VTELA:=SAVESCREEN(00,00,25,80)
VPROD=SPACE(16)
@07,37 SAY "NOME PRODUTO:"COLOR('GR+/B')
@07,50 GET VPROD PICT "@!"COLOR('W+/B')
READ
VPRO=VCAMPO
Vpro:=ALLTRIM(VPRO)
IF DBSEEK(VPRO)
Public vPROD1:=ARRAY(1),VPROD2:=ARRAY(1)
VPROD1[1] :="DESC"
VPROD2[1]:=" PESQUISA "
setcolor('N/GB')
DISPBOX(09,43,15,66)
Dbedit(10,44,14,65,vPROD1,"","",VPROD2,"ÄÄ")
RESTSCREEN(00,00,24,80,VTELA)
SETCOLOR("W+/B")
IF !LASTKEY()=27
VETOR[AINDEX,7]:=cod
VETOR[AINDEX,6]:=desc
ENDIF
ELSE
ALERT("PRODUTO INEXISTENTE !",,"N/GB")
vprod=space(16)
ENDIF
SET CURSOR OFF
endif
oMybrowser:refreshCurrent()
oMybrowser:down()
elseif nkey == K_ESC
EXIT
endif
ENDDO
RETURN VETOR
