PC Toledo

Código: Selecionar todos

*------------------------------------------*
* PROGRAMA   : vendadet.prg                *
* DATA       : 01/09/2021                  *
* FINALIDADE : Pesquisa ISBN               *
*------------------------------------------*
parameters LINHA
do while .T.
   select INVENTAR
   MISBN = space(13)
   @ 23,2 say "Nr. ISBN : " get MISBN
   read
                        if MISBN = space(13)
                           exit
                        endif
   @ 23,2
   select ARQTEMP
   locate for ISBN = MISBN
        if eof()
           append blank
           replace ISBN with MISBN, NORDVEND with srt(PRORDV,6), ;
                   PRECO with INVENTAR->PRECVENDA
        endif
   @ LINHA,1  say ISBN
   @ LINHA,21 say INVENTAR->TITULO
   @ LINHA,col()+1 say PRECO
   @ LINHA,17 get QUANT picture "@Z" range 0,999
   read
   do TESTELIN with LINHA
enddo
select ARQTEMP

Código: Selecionar todos

*------------------------------------------*
* PROGRAMA   : vendadet.prg                *
* DATA       : 01/09/2021                  *
* FINALIDADE : Pesquisa ISBN               *
*------------------------------------------*

// Defina o nome da função ou procedure.
// Lembrando que procedures podem receber parâmetros e não retornam valor
// e que funções podem receber parâmetros e DEVEM retornar valor

PROCEDURE VendaDet( LINHA )

//   parameters LINHA  ==> Esta forma de passagem de parâmetros é obsoleta
//                     ==> pois cria os parâmetros como variáveis PRIVATE, que
//                     ==> não são a melhor opção
//                     ==> Passe os parâmetros na linha que define o nome
//                     ==> da procedure ou function. Isto vai criar os parâmetros
//                     ==> como variáveis LOCAL, o que é a melhor opção.

LOCAL MISBN, QUANT, GetList := {}  // ==> Sempre defina as variáveis que vai utilizar

do while .T.
   select INVENTAR
   MISBN = space(13)
   @ 23,2 say "Nr. ISBN : " get MISBN
   read
   if MISBN = space(13)
      exit
   endif

   @ 23,2
   select ARQTEMP
   locate for ISBN = MISBN  // ==> Procure criar e usar índices em tuas tabelas. LOCATE é muito lento
   if eof()
      append blank
      // PRORDV, PRECO ==> De onde vem isto? Deveriam ter sido enviadas como parâmetros
      replace ISBN with MISBN, NORDVEND with srt(PRORDV,6), ;
              PRECO with INVENTAR->PRECVENDA
   endif
   @ LINHA,1  say ISBN
   @ LINHA,21 say INVENTAR->TITULO
   @ LINHA,col()+1 say PRECO
   @ LINHA,17 get QUANT picture "@Z" range 0,999
   read
   // do TESTELIN with LINHA ==> Não use esta forma para chamar funções ou procedures. Use como abaixo
   TESTELIN( LINHA )
enddo
select ARQTEMP

RETURN // ==> Sempre coloque um RETURN (com ou sem valor) ao final do procedimento

Código: Selecionar todos

PROCEDURE x
PARAMETERS y

Código: Selecionar todos

PROCEDURE x( y )

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : menu4.prg                *
* DATA       : 01/09/2021               *
* FINALIDADE : GERENCIAR ARQUIVOS       *
*---------------------------------------*
do inicio4
do while .T.
   select VENDAS
   OPCAO = space(01)
   clear
   do INSIG with "Sistema de Ordens de Vendas"
   @  8,26 say "1 - Entre com a Ordem de Venda"
   if reccount() > 0
      @ row()+1,26 say "2 - Editar uma Ordem de Venda"
      @ row()+1,26 say "3 - Cancelar uma Ordem de Venda"
      @ row()+1,26 say "4 - Imprimir Ordens de Venda"
      @ row()+1,26 say "5 - Preparar Listas de Vendas"
      @ row()+1,26 say "6 - Ordens Pendentes"
      @ row()+1,26 say "7 - Deletar Ordens com mais de 1 ano"
   endif
      @ row()+1,26 say "0 - Retorna ao Menu Principal"
      @ row()+1,26 say "# - Escolha Um"
      @ row()+1,26 get OPCAO
      read
      do case
         case OPCAO = "1"
             do menu41
         case OPCAO = "2"
             do menu42
         case OPCAO = "3"
             do menu43
         case OPCAO = "4"
             do menu44
         case OPCAO = "5"
             do menu45
         case OPCAO = "6"
             do menu46
         case OPCAO = "7"
             do menu47
         case OPCAO = "0"
            return
      endcase
enddo

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : inicio4.prg              *
* DATA       : 01/09/2021               *
* FINALIDADE : ABRIR ARQUIVOS           *
*---------------------------------------*
clear
? "Abrindo Arquivos de Ordens de Venda"
select CLIENTES
                     close index
select 4
                     use vendas alias VENDAS
select 5            
                     use vendadet alias VENDADET
select 6
                     use ordabert alias ORDABERT

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : menu41.prg               *
* DATA       : 01/09/2021               *
* FINALIDADE : ENTRADA DE DADOS         *
*---------------------------------------*
INSIGMSG = "Entrada de Ordens de Venda"
PRORDV   = 100000
do while .T.
   MNOME    = space(30)
   MNORDCMP = space(08)
   clear
   do INSIG with INSIGMSG
   select CLIENTES
   set index to idcli
   select VENDAS
   go bottom
   if reccount() > 0
      PRORDV   = val(NORDVEND)+17
      skip -10
      set relation to idcli into CLIENTES
      list off next 11 NORDVEND, CLIENTES->NOME, NORDCOMP, DATA
   endif
   select CLIENTES
   set index to nomecli
   MNOME = space(30)

   @ 23,2 say "Digite o Nome do Cliente : " get MNOME
   read
                        if eof() .or. MNOME = space(30)
                           return
                        endif
   do menu1s
   clear gets
   do PERG with "Este eh o cliente correto (S/N)? ",23,2,RESP
   if RESP = "S"
      @ 23,2
      @ 23,2 say "Numero da Ordem de Compra do Cliente " get MNORDCMP picture "@!"
      read
      do menu41a
      if NORDVEND = str(PRORDV,6)
         select ORDABERT
         append blank
         replace NORDVEND with str(PRORDV,6)
         select VENDAS
         set relation to
         append blank
         replace NORDVEND with str(PRORDV,6), DATA with date(), ;
                 IDCLI with CLIENTES->IDCLI, NORDCOMP with MNORDCMP
         do menu4p with VENDAS->NORDVEND
      endif
   endif
enddo

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : menu41a.prg              *
* DATA       : 01/09/2021               *
* FINALIDADE : CRIA ARQ. TEMPORARIO     *
*---------------------------------------*
select VENDADET
copy structure to arqtemp
use arqtemp
clear
@ 1,1 say "Nr. ISBN      Quant      Titulo              Preco"
@ 2,1 say BAR
do VENDADET with 3
delete for QUANT = 0
pack
use vendadet
append from arqtemp
erase arqtemp.dbf

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : menu42.prg               *
* DATA       : 01/09/2021               *
* FINALIDADE : EDITAR DADOS             *
*---------------------------------------*
clear
INSIGMSG = "Editar REgistros de Ordens de Venda"
select CLIENTES
set index to idcli
select VENDAS
set relation to IDCLI into CLIENTES
go bottom
do while .T.
   MNORDVND = space(6)
   select ORDABERT
   do INSIG with INSIGMSG
   @ 23,2 say "Ordens de Venda para Edicao " get MNORDVND picture "999999"
   read
                         if MNORDVND = space(6)
                            return
                         endif
   @ 22,2
   locate for NORDVEND = MNORDVND
          if eof()
             if MNORDVND <= VENDAS->NORDVEND
                do ERROMSG with MNORDVND + " estah ocupado ...",22,2
             else
                do ERROMSG with MNORDVND + " nao eh valido ...",22,2
             endif
             loop
          endif
   select VENDAS
   go bottom
   do while NORDVEND > MNORDVND .and. .not. bof()
      skip -1
   enddo
   if NORDVEND = MNORDVND
      @ 6,2 say IDCLI+"       "+CLIENTES->NOME
      select VENDAS
      @ 8,2 say "Ordens de Compra de Clientes " get NORDCOMP
      read
      select VENDADET
      do PROCURA with MNORDVND,"NORDVEND"
      if .not. eof()
         do menu42a
      endif
      clear
   endif

enddo

Código: Selecionar todos

*---------------------------------------*
* PROGRAMA   : menu42a.prg              *
* DATA       : 03/09/2021               *
* FINALIDADE : EDITAR DADOS             *
*---------------------------------------*
PRIMREG = recno()
PRORDV  = val(NORDVEND)
copy to arqtemp while NORDVEND = VENDAS->NORDVEND
select 9
use ARQTEMP
clear
set relation to isbn into INVENTAR
do INSIG with "Editar REgistros de Ordens de Vendas"
display off all ISBN, QUANT, INVENTAR->TITULO, PRECO
set relation to
LINHA = row()
do TESTELIN with LINHA
do VENDADET with LINHA
set relation to recno()+PRIMREC -1 into VENDADET
go top
do while .not. eof()
   select VENDADET
   if NORDVEND # ARQTEMP->NORDVEND
      append blank
   endif
   replace QUANT with ARQTEMP->QUANT, ISBN with ARQTEMP->ISBN,;
           PRECO with ARQTEMP->PRECO, NORDVEND with ARQTEMP->NORDVEND
   select ARQTEMP
   skip
enddo

use

Código: Selecionar todos

*------------------------------------------*
* PROGRAMA   : vendadet.prg                *
* DATA       : 01/09/2021                  *
* FINALIDADE : Pesquisa ISBN               *
*------------------------------------------*
PROCEDURE VENDADET( LINHA )
LOCAL MISBN, QUANT, GetList := {}

do while .T.
   select INVENTAR
   MISBN = space(13)
   @ 23,2 say "Nr. ISBN : " get MISBN
   read
                        if MISBN = space(13)
                           exit
                        endif
   @ 23,2
   select ARQTEMP
   locate for ISBN = MISBN
        if eof()
           append blank
           replace ISBN with MISBN, NORDVEND with srt(PRORDV,6), ;
                   PRECO with INVENTAR->PRECVENDA
        endif
   @ LINHA,1  say ISBN
   @ LINHA,21 say INVENTAR->TITULO
   @ LINHA,col()+1 say PRECO
   @ LINHA,17 get QUANT picture "@Z" range 0,999
   read
   TESTELIN( LINHA )
enddo
select ARQTEMP

RETURN

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu43.prg                   *
* DATA       :  02/08/2021                   *
* FINALIDADE :  Cancelar Ord. de Venda       *
*--------------------------------------------*
clear
select CLIENTES
set index to idcli
select VENDAS
set relation to idcli into CLIENTES
go bottom
do while .T.
   do INSIG with "Cancelar Ordens de Venda"
   MNORDVND = space(6)
   select ORDABERT
   @ 23,2 say "Ordens de Venda a Cancelar" get MNORDVND picture "999999"
   read
                  if MNORDVND = space(6)
                     return
                  endif
   locate for NORDVEND = MNORDVND
          if eof()
             if MNORDVND <= VENDAS->NORDVEND
                do ERROMSG with MNORDVND + " estah cancelado",22,2
             else
                do ERROMSG with MNORDVND + " nao eh valido",22,2
             endif
             loop
          endif
   @ 22,2
   select VENDAS
   go bottom
   do while NORDVEND > MNORDVND .and. .not. bof()
      skip -1
   enddo
   if NORDVEND = MNORDVND
      @ 22,2
      @  6,2 say IDCLI + "      " + CLIENTES->NOME
      @  8,2 SAY "Ordens de Compra de Clientes"+NORDCOMP
      do PERG with "Cancela estas Ordens de Vendas (S/N)?",23,2,RESP
      if RESP = "S"
         replace ORDVCANC with .T.
         select VENDADET
         do PROCURA with MNORDVND,"NORDVEND"
         replace QUANT with 0 while NORDVEND = MNORDVND
         select ORDABERT
         delete for NORDVEND = MNORDVND
         pack
      endif
   endif
clear
enddo

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu44.prg                   *
* DATA       :  02/08/2021                   *
* FINALIDADE :  Imprimir Ordens de Venda     *
*--------------------------------------------*
clear
OPCAO = space(01)
do INSIG with "Imprimir Ordens de Venda"
@  8,26 say "1 - Imprimir Ordens de Vendas Individualmente"
@  9,26 say "2 - Imprimir Ordens de Vendas a partir de Data"
@ 10,26 say "0 - Saida"
@ 13,26 say "# - Escolha Um " get OPCAO picture "9"
read
do while OPCAO = "1"
   select VENDAS
   MNORDVND = space(6)
   do PEGREG with "Numero de Ordens de Venda",MNORDVND,"NORDVEND"
                  if MNORDVND = space(6)
                     return
                  endif
   do menu4p with MNORDVND
enddo
if OPCAO = "2"
   select VENDAS
   MDATA1 = DATA
   @ 23,2 say "Entre com a data para impressao " get MDATA range MDATA1,MDATA
   read
   do PROCURA with MDATA,"DATA"
   do while DATA = MDATA .and. .not. eof()
      do menu4p with VENDAS->NORDVEND
      select VENDAS
      skip
   enddo

endif

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu45.prg                   *
* DATA       :  02/08/2021                   *
* FINALIDADE :  Relat. Diário de Vendas      *
*--------------------------------------------*
clear
select VENDAS
go bottom
VENDAS = 0
DIAVENDA = DATA

do while DATA = DIAVENDA .and. .not. bof()
   skip -1
   if .not. ORDCANC
      VENDAS = VENDAS + 1
   endif
enddo
locate rest for DATA = DIAVENDA   && para tras para o comeco do dia da venda
select VENDADET
do PROCURA with VENDAS->NORDVEND,"NORDVEND"
sum rest QUANT, QUANT * PRECO, 1 to SALDO,VALOR,ENTRADAS for QUANT > 0

set device to print

@  5,1  say "Lista de Vendas a partir de "+dtoc(DIAVENDA)
@  9,1  say "Ordens de Vendas Processadas"
@  9,30 say VENDAS                                 picture "###,###,###"
@ 11,1  say "Saldo de Livros"
@ 11,30 say SALDO                                  picture "###,###,###"
@ 13,1  say "Media de Livros por Ordem de Venda"
@ 13,30 say round(VALOR/VENDAS,1)                  picture "###,###,###.#"
@ 15,1  say "Media de Valor por Ordem de Venda"
@ 15,30 say round(VALOR/VENDAS,1)                  picture "###,###,###.#"
@ 17,1  say "Nr de Titulos por Ordem de Venda"
@ 17,30 say ENTRADAS/VENDAS                        picture "###,###,###.#"
@ 19,1  say "Total em Valor por Ordens de Venda"
@ 19,30 say VALOR                                  picture "###,###,###.##"
eject
set device to screen

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu46.prg                   *
* DATA       :  02/08/2021                   *
* FINALIDADE :  Ordens Abertas - Nao preench *
*--------------------------------------------*
clear
select ORDABERT
   if reccount() = 0
      wait "Arquivo Ordens de Venda nao estah aberto - press. qualquer tecla"
      return
   endif
   go top
select CLIENTES
   set index to idcli
select VENDAS
   go bottom
   do while NORDVEND > ORDABERT->NORDVEND .and. .not. bof()
      skip -1
   enddo
   set relation to idcli into CLIENTES
select ORDABERT
do INSIG with "Abrindo arquivo de Ordens de Venda"
do PERG with "Voce precisa de uma copia impressa (S/N)",23,2,RESP
@  4,0 clear
do while .not. eof()
   if RESP = "S"
      set print on
      set device to print
      @  6,1  say "Ordens de Venda aberta a partir de "+dtoc(date())
      ?
   endif
   ? "Ordens de                 Ordens de"
   ? "Vendas          Data      Compra         Nome do Cliente"
   ?
   do while prow() < 55 .and. .not. eof()
      select VENDAS
      locate rest for NORDVEND = ORDABERT->NORDVEND
      ? NORDVEND,"   ",DATA,"   ", NORDCOMP,"   ", CLIENTES->NOME
      select ORDABERT
      skip
      if eof() .or. (RESP = "N" .and. row() = 23)
         set print off
         wait "Pressione qualquer tecla para continuar"
         set print on
         @ 4,0 clear
      endif
   enddo
   if RESP = "S"
      eject
   endif
enddo
select VENDAS
set print off
set device to screen
set relation to

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu47.prg                   *
* DATA       :  02/08/2021                   *
* FINALIDADE :  Deletar Ordens + de 1 ano    *
*--------------------------------------------*
clear
do INSIG with "Cancelando Registros de Ordens com mais de 1 ano"
select VENDAS
go top
delete while DATA <= date() - 365
if recno() > 1
   set talk on
   pack
   set talk off
   go top
   select VENDADET
   go top
   delete while NORDVEND < VENDAS->NORDVEND
   if recno() > 1
      set talk on
      pack
      set talk off
   endif
endif

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

Código: Selecionar todos

*--------------------------------------------*
* PROGRAMA   :  menu.prg                     *
* AUTOR      :  EVERALDO BERNARDO CUNHA      *
* DATA       :  29/07/2021                   *
* FINALIDADE :  MENU PRINCIPAL DO SISTEMA    *
*--------------------------------------------*
REQUEST DBFNTX

PROCEDURE Main

RDDSETDEFAULT("DBFNTX")

OPCAO = space(01)


struct()
indices()

do inicio

do while .T.
   clear
   do INSIG with "BOB'S REVENDA DE LIVROS"

   @  8,26 say "1 - Arquivo de Clientes"
   @  9,26 say "2 - Listas e Rotulos Postais"
   @ 10,26 say "3 - Inventario"
   @ 11,26 say "4 - Ordens de Venda"
   @ 12,26 say "5 - Faturas"
   @ 13,26 say "6 - Contas Recebidas"
   @ 14,26 say "7 - Cobrancas"
   @ 15,26 say "8 - Utilitarios"
   @ 17,26 say "0 - Fim"
   @ 19,26 say "# - Escolha um"
   @ 19,26 get OPCAO 
   read
   do case
      case OPCAO = "1"
         do menu1
      case OPCAO = "2"
         do menu2
      case OPCAO = "3"
         do menu3
      case OPCAO = "4"
         do menu4
      case OPCAO = "5"
     *   do
      case OPCAO = "6"
     *   do
      case OPCAO = "7"
     *   do
      case OPCAO = "8"
     *   do
      case OPCAO = "0"
         EXIT
   endcase

enddo

RETURN 

Código: Selecionar todos

hbmk2 *.prg -w0 -es0 -m -n -omenu

Código: Selecionar todos

hbmk2: Error: Referenced, missing, but unrecognized Harbour function(s):
       INICIO(), MENU1(), MENU2(), MENU3(), MENU1S(), MENU4P(), SRT()