Amigo alxsts, segui o teu conselho e continua dando o mesmo erro ... outros usuários também deram dicas, então, postarei os outros fontes abaixo:
Código: Selecionar todos
*--------------------------------------------*
* PROGRAMA : menuproc.prg *
* DATA : 29/07/2021 *
* FINALIDADE : Arquivo de Procedimentos *
*--------------------------------------------*
PROCEDURE CHECKDUPL
skip
REGDUPL = (NOME = trim(MNOME))
MIDCLI = SPACE(6)
skip -1
if REGDUPL
do while NOME = trim(MNOME) .AND. readkey() # 12 .AND. MIDCLI = SPACE(6)
clear
? "Existem multiplos registros para "+MNOME
?
display off next 15 IDCLI,NOME,ENDER while NOME = trim(MNOME)
?
? "Para selecao: digite o No ID Cliente"
? "Para abortar: pressione a tecla ESC"
? "Retornar: pressione a tecla Return"
@ row(), col()+2 get MIDCLI picture "9999999"
read
MIDCLI = SPACE(LEN(MIDCLI)-LEN(RTRIM(MIDCLI)))+rtrim(MIDCLI)
enddo
if MIDCLI # space(6) .and. readkey() # 12 && entrada valida
set order to 2 && indexado pelo cliente
seek MIDCLI
POSICAO = recno() && numero do registro
set order to 1 && indexado por nome
if .not. found()
?? SINO
wait "&MIDCLI nao e valido - pressione Return"
else
go POSICAO
endif
else
seek chr(13) && posiciona o fim do arquivo
endif
endif
RETURN
PROCEDURE ENTR
parameters CODTECS
ENTR = 500 && valor impossivel
do while .not. str(ENTR,3) $ CODTECS
ENTR = inkey()
enddo
RETURN
PROCEDURE ERROMSG
parameters MENSAG, LINHA, COLUNA
@ LINHA,COLUNA
@ LINHA,COLUNA say MENSAG
?? chr(7) && toca a sineta
RETURN
PROCEDURE indices
IF .NOT. FILE("idcli.ntx")
SELE 1
USE clientes
INDEX ON IDCLI TO idcli
USE
ENDIF
//
IF .NOT. FILE("nomecli.ntx")
SELE 1
USE clientes
INDEX ON NOME TO nomecli
USE
ENDIF
IF .NOT. FILE("codforn.ntx")
SELE 2
USE fornec
INDEX ON CODFORN TO codforn
USE
ENDIF
IF .NOT. FILE("isbn-0.ntx")
SELE 3
USE livroped
INDEX ON ISBN TO isbn-0
USE
ENDIF
IF .NOT. FILE("isbn.ntx")
SELE 4
USE inv
INDEX ON ISBN TO isbn
USE
ENDIF
RETURN
PROCEDURE INSIG
parameters INSIG
@ 2,2
@ 2,2 say cdow(date())
@ 2,(80-len(INSIG))/2 say INSIG
@ 2,78 - len(CDATA) say CDATA
@ 3,1 say BAR
RETURN
PROCEDURE ISBNTESTE
parameters MISBN, MFORN, TESTE
private DIGVERIF, NRIDIN, RES, TRACO, GRUPO, IDLIVRO, ISBNTESTE, CHEQUE
DIGVERIF = right(MISBN,1)
RES = left(MISBN,11)
if "-" $ RES
TRACO = at("-",RES)
GRUPO = left(RES,TRACO-1)
RES = right(RES,len(RES)-TRACO)
endif
if "-" $ RES
TRACO = at("-",RES)
MFORN = left(RES,TRACO-1)
IDLIVRO = right(RES,len(RES)-TRACO)
endif
NRIDIN = GRUPO+MFORN+IDLIVRO
if len(NRIDIN) = 9 .and. DIGVERIF $ "0123456789X"
CHEQUE = iif(DIGVERIF = "X",10,val(DIGVERIF))
X = 1
do while X <= 9
CHEQUE = CHEQUE + val(substr(NRIDIN,X,1)) * (11-X)
X = X + 1
enddo
if mod(CHEQUE,11) = 0 && cheque é divisível por onze
TESTE = .T.
endif
endif
RETURN
PROCEDURE LINABX
parameters LFS
? replicate(chr(10),LFS)
RETURN
RETURN
PROCEDURE OPCAO
PARAMETERS COLUNA, FAIXA
OPCAO = " "
LINHA = row()
do while .not. OPCAO $ FAIXA
@ LINHA,COLUNA get OPCAO
read
enddo
RETURN
PROCEDURE PEGREG
parameters LEGENDA, VARMEM, NOMECAMP
private all
do while .T.
VARMEM = space(6)
@ 22,2 say LEGENDA get VARMEM picture "999999"
read
if VARMEM = space(6)
exit
endif
if .not. mod(val(VARMEM) - 100000,17) = 0
do ERROMSG with VARMEM + " eh invalido",22,2
loop
endif
@ 22,2
go bottom
EQUIV = (val(&NOMECAMP) - VAL(VARMEM)/17)
if recno() - EQUIV > 0
go recno() - EQUIV
else
go top
endif
locate rest for &NOMECAMP >= VARMEM
if &NOMECAMP = VARMEM
exit
endif
do ERROMSG with VARMEM + " nao existe",22,2
enddo
RETURN
PROCEDURE PERG
parameters LEGENDA, LINHA, COLUNA, RESP
RESP = " "
@ LINHA,COLUNA
do while .not. RESP $ "SN"
@ LINHA,COLUNA say LEGENDA get RESP picture "!"
read
enddo
@ LINHA,COLUNA
RETURN
procedure PROCLI
parameters LEGENDA,MNOME
do while .T.
MNOME = space(30)
@ 23,2 say LEGENDA get MNOME picture "@!"
read
if MNOME = space(30)
exit
endif
seek trim(MNOME)
if eof()
do ERROMSG with "Sem registro para "+MNOME, 21, 2
loop
endif
@ 21,2
do CHECKDUPL
exit
enddo
RETURN
PROCEDURE PROCURA
parameters PROCVAR, PROCARQ
private all
TAMSALT = reccount()
do while TAMSALT > 1
if PROCVAR = &PROCARQ
exit
endif
if PROCVAR < &PROCARQ .and. recno() > TAMSALT
go recno() - TAMSALT
endif
if PROCVAR > &PROCARQ .and. recno() + TAMSALT <= reccount()
go recno() + TAMSALT
endif
TAMSALT = int(round(TAMSALT/2,0))
enddo
do while .not. bof()
skip -1
if &PROCARQ < PROCVAR
exit
endif
enddo
locate rest for &PROARQ >= PROCVAR
if .not. &PROCARQ = PROCVAR
go bottom
endif
RETURN
PROCEDURE PROISBN
parameters LEGENDA, MISBN
do while .T.
private all
VALTESTE = .F.
MISBN = space(13)
@ 23,2 say LEGENDA get MISBN picture "@!"
read
@ 23,40
if MISBN = space(13)
exit
endif
seek MISBN
if found()
exit
endif
do ISBNTESTE with MISBN, "XXXXX", VALTESTE
do ERROMSG with ;
MISBN + iif(VALTESTE," nao estah no arquivo"," eh invalido"),23,40
enddo
RETURN
PROCEDURE struct
IF .NOT. FILE("clientes.dbf")
aDBF := {}
//
AADD(aDBF,{"NOME","C",30,0})
AADD(aDBF,{"ATENC","C",30,0})
AADD(aDBF,{"ENDER","C",25,0})
AADD(aDBF,{"CIDADE","C",20,0})
AADD(aDBF,{"ESTADO","C",02,0})
AADD(aDBF,{"CEP","C",10,0})
AADD(aDBF,{"FONE","C",15,0})
AADD(aDBF,{"DATA","D",08,0})
AADD(aDBF,{"IDCLI","C",10,0})
AADD(aDBF,{"CREDIT","C",01,0})
//
DBCREATE("clientes",aDBF)
ENDIF
IF .NOT. FILE("inv.dbf")
aDBF := {}
//
AADD(aDBF,{"ISBN","C",13,0})
AADD(aDBF,{"CODFORN","C",7,0})
AADD(aDBF,{"AUTOR","C",30,0})
AADD(aDBF,{"TITULO","C",30,0})
AADD(aDBF,{"ASSUNTO","C",15,0})
AADD(aDBF,{"QTANO","N",4,0})
AADD(aDBF,{"QTANOPAS","N",4,0})
AADD(aDBF,{"ULTVENDA","D",08,0})
AADD(aDBF,{"QTULTREC","N",3,0})
AADD(aDBF,{"DTULTREC","D",08,0})
AADD(aDBF,{"PRECVENDA","N",06,2})
AADD(aDBF,{"CUSTO","N",06,2})
AADD(aDBF,{"QTPEDIDA","N",03,0})
AADD(aDBF,{"ESTOQMIN","N",03,0})
AADD(aDBF,{"QTESTQ","N",03,0})
//
DBCREATE("inv",aDBF)
ENDIF
IF .NOT. FILE("fornec.dbf")
aDBF := {}
//
AADD(aDBF,{"NOME","C",30,0})
AADD(aDBF,{"ATENC","C",30,0})
AADD(aDBF,{"ENDER","C",25,0})
AADD(aDBF,{"CIDADE","C",20,0})
AADD(aDBF,{"ESTADO","C",02,0})
AADD(aDBF,{"CEP","C",10,0})
AADD(aDBF,{"CODFORN","C",07,0})
AADD(aDBF,{"FONE","C",15,0})
//
DBCREATE("fornec",aDBF)
ENDIF
IF .NOT. FILE("livroped.dbf")
aDBF := {}
//
AADD(aDBF,{"ISBN","C",13,0})
AADD(aDBF,{"NORDCOMP","C",06,0})
AADD(aDBF,{"CODFORN","C",07,0})
AADD(aDBF,{"CUSTO","N",06,2})
AADD(aDBF,{"DATPEDIDO","D",08,0})
AADD(aDBF,{"QTPEDIDA","N",03,0})
AADD(aDBF,{"QTULTREC","N",03,0})
//
DBCREATE("livroped",aDBF)
ENDIF
IF .NOT. FILE("controle.dbf")
aDBF := {}
//
AADD(aDBF,{"IDCLI","N",10,0})
AADD(aDBF,{"ULTEDIT","C",10,0})
AADD(aDBF,{"REGINV","C",13,0})
AADD(aDBF,{"ATLZPAGAM","N",01,0})
AADD(aDBF,{"NORDCOMP","N",06,0})
AADD(aDBF,{"DORDCOMP","D",08,0})
//
DBCREATE("controle",aDBF)
ENDIF
IF .NOT. FILE("atlzinv.dbf")
aDBF := {}
//
AADD(aDBF,{"ISBN","C",13,0})
AADD(aDBF,{"QTULTREC","N",03,0})
//
DBCREATE("atlzinv",aDBF)
ENDIF
IF .NOT. FILE("vendas.dbf")
aDBF := {}
//
AADD(aDBF,{"NORDVEND","C",6,0})
AADD(aDBF,{"IDCLI","C",6,0})
AADD(aDBF,{"DATA","D",8,0})
AADD(aDBF,{"NORDCOMP","C",8,0})
AADD(aDBF,{"VOID","L",1,0})
//
DBCREATE("vendas",aDBF)
ENDIF
IF .NOT. FILE("vendadet.dbf")
aDBF := {}
//
AADD(aDBF,{"NORDVEND","C",6,0})
AADD(aDBF,{"ISBN","C",13,0})
AADD(aDBF,{"QUANT","N",3,0})
AADD(aDBF,{"PRECO","N",6,2})
//
DBCREATE("vendadet",aDBF)
ENDIF
IF .NOT. FILE("ordabert.dbf")
aDBF := {}
//
AADD(aDBF,{"NORDVEND","C",6,0})
//
DBCREATE("ordabert",aDBF)
ENDIF
RETURN
PROCEDURE TESTELIN
parameters LINHA
clear gets
if LINHA >= 22
?
?
else
LINHA = LINHA + 1
endif
RETURN
Esses códigos postados acima, são uma parte do que já fiz. Como podem perceber, é DBase III Plus mesmo, excetuando-se algumas procedures em "menuproc.prg" sendo que neste, encontra-se a procedure "INSIG", que antes de alaborar a opção "4" do Menu Principal, funcionava corretamente e não apresentava o erro de não abertura do "prg" ... abaixo, coloco também, o menu principal do sistema:
