Código: Selecionar todos
#include "inkey.ch"
#define AR_SKIPBLOCK(atb,ai,NFS) atb:skipblock={|n, sa| sa:=ai,iif(ai+n > LEN(NFS), ai:= LEN(NFS), iif(ai+n < 1, ai:=1, ai += n)), ai-sa}
/* Mudei o nome de VETOR para NFS, assim fica mais padronizado. Pois
como ha necessidade de outros vetores, melhor identificar pelo nome */
set score off
set date british
set cent on
set dele on
set epoc to 2000
SET CONSOLE OFF
SETBLINK(.F.)
cls
setcolor('gr+/b')
EXISTE_BD() // criei esta funcao para os colegas queiram compilar e para
// que possam executar este exemplo (que irah criar os DBFs)
SELE 1 // Desculpe mudar, mas eu prefiro usar como numerico
use lancnf SHARE // Aqui deveria abrir em modo compartilhado
/*Permita-me te dar um conselho: esta quest„o de criar SEMPRE
o seu arquivo de ¡ndices. N„o ‚ uma boa. Voce deveria tomar
duas medidas:
1. Fa‡a isto antes de indexar:
IF !FILE("XCOMP.NTX")
INDEX ON (STR(NF,10)+DTOS(DATEMI)+STR(ITEM,3)) TO XCOMP
ENDIF
2. Em todos os outros modulos que utiliza o arquivo LANCNF e
que venham a gravar nele. Abra o LANCNF em todos esses
modulos da seguinte forma:
USE LANCNF SHARED
SET INDEX TO XCOMP,XPROD,XDAT... (‚ dizer todos os indices relacionados a este arquivo)
*/
INDEX ON (STR(NF,10)+DTOS(DATEMI)+STR(ITEM,3)) TO XCOMP
set index to xcomp
SELE 2
Use Fornec SHARED
/* Acho que nao haverah necessidade de indexar este arquivo, porque pelo
visto eh um arquivo pequeno (vamos utilizar o ASCAN em lugar do SEEK)
para procura/localizacao. E servirah como exemplo.
Index on forn to xfornome
index on cod to xcodfor
set index to xcodfor,xfornome
*/
FORN_DES:={}
FORN_COD:={}
dbgotop()
DO WHILE (2->(!EOF()))
IF (2->COD)>0
AADD(FORN_DES,SUBSTR(ALLTRIM(2->FORN),1,15))
AADD(FORN_COD,STRZERO(2->COD,3,0)) // Atribuo com STRZERO para
// garantir a pesquisa com ASCAN()
ENDIF
SKIP
ENDDO
SELE 3
Use Cadpeca SHARED
index on STRZERO(cod,13,0) to xNprod // utilizo STRZERO (acho mais seguro)
index on desc to xCdesc
SET INDEX TO xNprod,xCdesc // Aqui tinha faltado seu SET INDEX TO...
SELE 1
// dbgotop() // Nao ha necessidade
vNF=0 // melhor que comece com zero
vdatemi=ctod(" / / ") // melhor que comece vazio
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')
NFS:={}
chave=(STR(VNF,10,0)+DTOS(VDATEMI))
IF !DBSEEK(CHAVE)
@ 24,00 SAY PADC("Nota n„o encontrada !",80) COLOR "N/W"
INKEY(3)
DBCLOSEAREA() // Faltou este aqui
return
ENDIF
Do while (chave)=str(NF,10)+dtos(datemi)
// AADD(NFS,{NF,ITEM,DATEMI,MOSTFORN,FORN,MOSTPROD,PROD})
/* Depois de ter visto seu codigo abaixo, e entender o que sao esses CAMPOS
acima, pude ver que h uma REDUNDANCIA no seu LANCNF e tambem agora no seu
TBROWSE. Voce tem o campo FORN (que agora eu entendo que eh o codigo do
fornecedor) e tambem tem o campo MOSTFORN (que eh a descricao do fornec.),
na minha opiniao voce poderia eliminar o campo MOSTFORN e MOSTPROD que
vem a ser a mesma coisa (ora que traduzida) pelo CODIGO em DESCRICAO.
MATRIZES, sao muito boa, mas eh bom economizar elementos e pela sua vez...
economizar memoria. Entao veja que vou mudar, e vou exibir menos
colunas e vamos eliminar os RE-processamentos que nao ha necessidade*/
AADD(NFS,{(1->NF),(1->ITEM),(1->DATEMI),(1->FORN),(1->PROD),(1->(RECNO()))})
/* Se voce quiser mudar a estrutura do seu LANCNF.DBF, esteja a vontade
( me refiro a eliminacao dos campos MOSTFORN e MOSTPROD )
mas essa eh outra questao que nao sei onde irah incidir nos outros
modulos do seu sistema.
Veja tambem que foi adicionado o numero do REGISTRO para poder fazer
o REPLACE adequadamente, ja que voce optou por editar no TBROWSE o
campo DATEMI (Data emissao). E o campo DATEMI faz parte da chave de
indexacao. Portanto a unica forma possivel eh atraves do numero REG.
*/
skip
Enddo
NFS:=tabela(NFS)
SELE 1
SET ORDER TO 0
FOR ponteiro=1 TO LEN(NFS)
GOTO (NFS[ponteiro,6])
IF (1->(RECNO()))==(NFS[ponteiro,6])
IF RLOCK()
REPLACE NF WITH NFS[ponteiro,1]
// REPLACE ITEM WITH NFS[ponteiro,2]
// Este item nao precisa ja que voce designou nao editar no TBROWSE
REPLACE DATEMI WITH NFS[ponteiro,3]
REPLACE FORN WITH NFS[ponteiro,4]
REPLACE MOSTFORN WITH VQFORN(NFS[ponteiro,4])
REPLACE PROD WITH NFS[ponteiro,5]
REPLACE MOSTPROD WITH VQPROD(NFS[ponteiro,5])
ENDIF
ENDIF
NEXT
FUNCTION TABELA(NFS)
// SELE 1
// dbgotop()
/* Isso acima, nao est correto, aqui voce esta insistindo em posicionar a
sua area no inicio do arquivo. Sendo que voce tinha se posicionado usando
o SEEK para buscar a sua NF
*/
SET CURSOR OFF
setcolor('W+/B')
@ 06,00 clear to 20,79
dispbox(06,00,20,79)
oMybrowser:=TBrowseDb(07,01,19,78) // utilize o maximo da tela !
oMybrowser:HeadSep :=Chr(196) + Chr(196) + CHr(196)
oMybrowser:ColSep :=Space(01) + Chr(179) + Space(01)
oMybrowser:gobottomblock={||aindex:=LEN(NFS)}
oMybrowser:gotopblock={||aindex:=1}
AR_SKIPBLOCK(oMybrowser,aindex,NFS)
oMybrowser:ColorSpec:='W+/B'
ocolum1:=tbcolumnnew( ' Nota Fisc.', {|| NFS[aindex,1] } )
ocolum2:=tbcolumnnew( 'Item' , {|| NFS[aindex,2] } )
ocolum3:=tbcolumnnew( 'Data' , {|| NFS[aindex,3] } )
// Tem certeza que seja conveniente deixar o usuario mudar esta data ????
ocolum4:=tbcolumnnew( 'Fornecedor', {|| SUBSTR(VQFORN(NFS[aindex,4]),1,15) } )
ocolum5:=tbcolumnnew( 'Produto' , {|| VQPROD(NFS[aindex,5]) } )
// aqui ^ estava faltando uma virgula
oMybrowser:addcolumn(ocolum1)
oMybrowser:addcolumn(ocolum2)
oMybrowser:addcolumn(ocolum3)
oMybrowser:addcolumn(ocolum4)
oMybrowser:addcolumn(ocolum5)
oMybrowser:freeze:=2
do while .t.
do while(! oMybrowser:stabilize())
enddo
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
IF (oMybrowser:COLPOS)=3 // Isto faz com que pule a coluna 2
oMybrowser:left()
oMybrowser:left()
ELSE
oMybrowser:left()
ENDIF
elseif nkey == K_RIGHT
IF (oMybrowser:COLPOS)=1 // Isto faz com que pule a coluna 2
oMybrowser:right()
oMybrowser:right()
ELSE
oMybrowser:right()
ENDIF
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_ENTER
DO CASE
CASE (oMybrowser:COLPOS)=1
VCOL:=2
VLIN:=(oMybrowser:RowPos())+8
vcampo:=NFS[AINDEX,1] // Faltou atribuir esta variavel
SET CURSOR ON
@ VLIN,VCOL get vcampo pict "@9"
READ
SET CURSOR OFF
IF !LASTKEY()=27
NFS[AINDEX,1]:=Vcampo
oMybrowser:refreshCurrent()
ENDIF
CASE (oMybrowser:COLPOS)=2
// ALERT('ESTE CAMPO NAO;PODE SER ALTERARADO!',,'N/GB')
/* Quer um conselho ?. Voce pode fazer pular esta coluna
em lugar de dar esta mensagem. E fazer com que a navega‡ao
sempre pule esta coluna. Vou fazer altera‡ao abaixo */
CASE (oMybrowser:COLPOS)=3
VCOL:=22
VLIN:=(oMybrowser:RowPos())+8
// VCAMPO:=NFS[3,AINDEX] // Aqui estah errado...
VCAMPO:=NFS[AINDEX,3] // Assim eh correto na MATRIZ CONVENCIONAL
SET CURSOR ON
@ VLIN,VCOL GET VCAMPO PICT "@D"
READ
SET CURSOR OFF
IF !LASTKEY()=27
NFS[AINDEX,3]:=VCAMPO
oMybrowser:refreshCurrent()
ENDIF
CASE (oMybrowser:COLPOS)=4
/* Desculpe o que vou te dizer... Mas este procedimento, nao
tem necessidade de ser assim. Deh para o usuario as alternativas
certas, nao faca com que o usuario possa errar.
Veja como eu fiz com GET e AUTO-PRENCHIMENTO, isto eh feito
atraves do SEEK. Portanto eu vou remover o que estava aqui. */
VCOL:=44
VLIN:=(oMybrowser:RowPos())+10
IF VLIN>20
VLIN:=(oMybrowser:RowPos())-5
ENDIF
VQCOR:=SETCOLOR()
VTELA:=SAVESCREEN(06,40,22,75)
JANELA(VLIN-1,VCOL-1,VLIN+2,VCOL+16,"N/W,W+/R")
VOP:=ACHOICE(VLIN,VCOL,VLIN+2,VCOL+15,FORN_DES)
IF !LASTKEY()=27
NFS[AINDEX,4]:=VAL(FORN_COD[VOP])
ENDIF
RESTSCREEN(06,40,22,75,VTELA)
SETCOLOR(VQCOR)
oMybrowser:refreshCurrent()
CASE (oMybrowser:COLPOS)=5
VCOL:=48
VLIN:=(oMybrowser:RowPos())+8
VCAMPO:=NFS[AINDEX,5]
NFS[AINDEX,5]:=EDI_5(VCAMPO,VLIN,VCOL)
oMybrowser:refreshCurrent()
ENDCASE
elseif nkey == K_ESC
EXIT
endif
ENDDO
RETURN NFS
FUNCTION EXISTE_BD()
IF !FILE("LANCNF.DBF")
CAMPOS:={{"NF" ,"N",010,000},;
{"ITEM" ,"N",003,000},;
{"DATEMI" ,"D",008,000},;
{"FORN" ,"N",003,000},;
{"MOSTFORN","C",030,000},;
{"PROD" ,"N",013,000},;
{"MOSTPROD","C",030,000},;
{"GASET" ,"N",003,000},;
{"SET" ,"C",030,000},;
{"UNI" ,"C",005,000},;
{"QUANT" ,"N",009,002},;
{"VOL" ,"N",003,000},;
{"VALUNI" ,"N",009,002},;
{"VALTOT" ,"N",009,002},;
{"DATLANC" ,"D",008,000},;
{"OBS" ,"C",030,000} }
DBCREATE("LANCNF.DBF",CAMPOS)
SELE 1
USE LANCNF EXCLUSIVE
TEXT TO FILE("LANCNF.TXT" )
1,1,20070101,2,"JURANDIR",3,"OLEO SOLUVEL",1,"FIACAO","BD",2.00,2,50.00,100.00,20070502,""
1,2,20070101,2,"JURANDIR",2,"ROLAMENTO",3,"TEXTIMA","PC",5.00,1,15.00,75.00,20070502,""
1,3,20070101,2,"JURANDIR",20,"TAMBOR PARA OLEO",1,"FIACAO","TB",1.00,1,100.50,100.50,20070502,""
2,1,20070101,1,"EDER",22,"BORRACHA",7,"ESCRITORIO TECNICO","CX",50.00,5,0.30,15.00,20070502,""
2,2,20070101,1,"EDER",21,"CANETA",7,"ESCRITORIO TECNICO","CX",50.00,2,0.50,25.00,20070502,""
ENDTEXT
APPEND FROM LANCNF.TXT DELI
GOTO 1
DELE
PACK
CLOSE 1
ENDIF
IF !FILE("FORNEC.DBF")
CAMPOS:={{"COD" ,"N",003,000},;
{"FORN" ,"C",030,000} }
DBCREATE("FORNEC.DBF",CAMPOS)
SELE 2
USE FORNEC EXCLUSIVE
TEXT TO FILE("FORNEC.TXT" )
1,"EDER"
2,"JURANDIR"
ENDTEXT
APPEND FROM FORNEC.TXT DELI
GOTO 1
DELE
PACK
CLOSE 2
ENDIF
IF !FILE("CADPECA.DBF")
CAMPOS:={{"COD" ,"N",013,000},;
{"DESC" ,"C",030,000} }
DBCREATE("CADPECA.DBF",CAMPOS)
SELE 3
USE CADPECA EXCLUSIVE
TEXT TO FILE("CADPECA.TXT" )
2,"ROLAMENTO"
3,"OLEO SOLUVEL"
20,"TAMBOR PARA OLEO"
21,"CANETA"
22,"BORRACHA"
ENDTEXT
APPEND FROM CADPECA.TXT DELI
GOTO 1
DELE
PACK
CLOSE 3
ENDIF
RETURN NIL
FUNCTION VQFORN(VFORN)
VP:=ASCAN(FORN_COD,STRZERO(VFORN,3,0))
IF VP>0
VRET:=FORN_DES[VFORN]
ELSE
VRET:=PADR(STRZERO(VFORN,3,0),30)
ENDIF
RETURN VRET
FUNCTION VQPROD(VPROD)
VQSEL1:=SELECT()
SELE 3
IF VALTYPE(VPROD)="C"
SET ORDER TO 2
SEEK VPROD
IF FOUND()
VRET:=(3->COD)
ELSE
VRET:=0
ENDIF
ELSE
SET ORDER TO 1
SEEK STRZERO(VPROD,13,0)
IF FOUND()
VRET:=(3->DESC)
ELSE
VRET:=SPACE(30)
ENDIF
ENDIF
SELECT(VQSEL1)
RETURN VRET
FUNCTION EDI_5(VPROD,VLN,VCL)
SELE 3
SET ORDER TO 2
XGTS:=""
WRET:=VPROD
DO WHILE .T.
SET CURSOR ON
@ VLN,VCL SAY XGTS COLOR "N/W"
@ VLN,VCL+LEN(XGTS) SAY "" COLOR "N/W"
VQK:=UPPER(CHR(INKEY(0)))
DO CASE
CASE LASTKEY()=13
WRET:=VQPROD(XGTS)
IF WRET=0
WRET:=VPROD
ELSE
SET CURSOR OFF
@ VLN,VCL SAY VQPROD(WRET) COLOR "N/W"
ENDIF
EXIT
CASE LASTKEY()=27
WRET:=VPROD
EXIT
OTHERWISE
IF VQK="‡"
VQK="€"
ENDIF
SEEK XGTS+VQK
IF FOUND()
XGTS:=XGTS+VQK
SKIP
IF !(SUBSTR(3->DESC,1,LEN(XGTS))=XGTS)
WRET:=VQPROD(XGTS)
SET CURSOR OFF
@ VLN,VCL SAY VQPROD(WRET) COLOR "N/W"
EXIT
ENDIF
ELSE
XGTS=""
ENDIF
IF LEN(ALLTRIM(XGTS))>=30
EXIT
ENDIF
ENDCASE
ENDDO
RETURN WRET
FUNCTION JANELA(li,ci,lf,cf,cor)
setcolor(cor)
@ li,ci clear to lf,cf
@ li,ci to lf,cf
sombra(li,ci,lf,cf)
return .t.
FUNCTION SOMBRA(_Li, _Ci, _Lf, _Cf)
Local Tela1, Tela2, Tela3, Tela4
Tela3 := savescreen(_Li + 1, _Cf + 1, _Lf + 1, _Cf + 2)
Tela4 := savescreen(_Lf + 1, _Ci + 2, _Lf + 1, _Cf + 2)
for Tela1:= 2 to len(Tela3) step 2
Tela2:= shadow(asc(substr(Tela3,Tela1,1)))
Tela3:= stuff(Tela3,Tela1,1,Tela2)
end
for Tela1:= 2 to len(Tela4) step 2
Tela2:= shadow(asc(substr(Tela4, Tela1,1)))
Tela4:= stuff(Tela4,Tela1,1,Tela2)
end
restscreen(_Li + 1, _Cf + 1, _Lf + 1, _Cf + 2, Tela3)
restscreen(_Lf + 1, _Ci + 2, _Lf + 1, _Cf + 2, Tela4)
return NIL
FUNCTION SHADOW(_Car)
Local Var1, Var2, Var3
Var1:= _Car % 16
Var2:= (_Car - Var1) / 16
Var3:= {0, 0, 8, 8, 0, 8, 0, 8, 0, 1, 2, 3, 4, 5, 6, 7}
Var1:= Var3[Var1 + 1]
Var2:= Var3[Var2 + 1]
return Chr(16 * Var2 + Var1)
. Eles (me incluo também), pegam trechos do que está sendo questionado (com identificação de quem questiona) e é respondido logo a seguir. Esse método, dá maior inteiração na nossa comunicação.