PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Rotina estilo DBase ... não funciona

https://pctoledo.org/viewtopic.php?t=26361

Página 1 de 1

Rotina estilo DBase ... não funciona

Enviado: 13 Abr 2022 21:21
por arcanjoebc
Olá amigos! Novamente estou aqui precisando de ajuda ... Fiz um pequeno programa com meus conhecimentos de DBase e estou enfrentando uma dificuldade. Criei uma rotina de inclusão de lançamentos, onde se deve digitar o código do usuário, e o programa mostra os dados do dbf usuarios na tela e, quando digitar o código da conta, mostrar o conteúdo do dbf contas na tela. O problema é que ao digitar qualquer código de usuário ou de conta, o programa mostra sempre o primeiro registro cadastrado, independente deu eu mudar os códigos, sempre mostra o registro do início da base de dados ... abaixo coloco o fonte em questão para que deem uma analisada e me digam onde eu estou errando:

Código: Selecionar todos

*----------------------------------------*
* PROGRAMA   : desi003.prg               *
* DATA       : 13/04/2022                *
* FINALIDADE : CADASTRAR LANCAMENTOS     *
*----------------------------------------*
USE contas SHARED NEW ALIAS CONTAS 
OrdSetFocus("idctacod")

USE usuarios SHARED NEW ALIAS USUARIOS
OrdSetFocus("idusucod")

USE lancam SHARED NEW ALIAS LANCAM
OrdSetFocus("idcodlan")


PUBLIC MEM_CODLANC, MEM_CODUSU, MEM_CODCTA, MEM_MES 
PUBLIC MEM_CONTA, MEM_CRDB, MEM_VENC, MEM_NOME 
PUBLIC MEM_NASC, MEM_SEXO, MEM_FONE, MEM_CPF
PUBLIC MEM_EC, MEM_PROF, MEM_VALOR, CONFIRMA

DO WHILE .T.
  CLEAR
  @ 00,00 TO 23,79 DOUBLE
  @ 01,(79-LEN('INCLUIR'))/2 SAY "INCLUSAO DE LANCAMENTOS"
  @ 03,03 SAY "CODLANC.:"
  @ 05,03 SAY "COD. USUARIO:"
  @ 07,03 SAY "DATA NASC   /  /     SEXO:   ESTADO CIVIL:"
  @ 09,03 SAY "TELEFONE: (  )     -      CPF:    .   .   -  "
  @ 11,03 SAY "PROFISSAO: "
  @ 13,03 SAY "MES/ANO  : "
  @ 15,03 SAY "VENC.    : "
  @ 17,03 SAY "CONTA    : "
  @ 19,03 SAY "VALOR    : "
  @ 21,03 SAY "CONFIRMA ? (S/N)"
  @ 22,03 SAY "MENSAGEM : "
  GO BOTTOM
  MEM_CODLANC = 00000
  OrdSetFocus("idctacod")  
  MEM_CODCTA = CONTAS->COD
  MEM_CONTA = CONTAS->CONTA
  MEM_CRDB = CONTAS->CRDB
  OrdSetFocus("idcodlan")
  MEM_MES = MES
  MEM_VENC = CTOD("  /  /    ")
  MEM_VALOR = 0000000
  OrdSetFocus("idusucod")
  MEM_CODUSU = USUARIOS->COD
  MEM_NOME = USUARIOS->NOME
  MEM_NASC = USUARIOS->NASC
  MEM_SEXO = USUARIOS->SEXO
  MEM_EC   = USUARIOS->EC
  MEM_FONE = USUARIOS->FONE
  MEM_CPF  = USUARIOS->CPF
  MEM_PROF = USUARIOS->PROF
  CONFIRMA = SPACE(01)
  @ 05,17 GET MEM_CODUSU PICT "99999"
  READ
  IF MEM_CODUSU = 0
    EXIT
  ENDIF
  OrdSetFocus("idcodlan")
  @ 03,13 SAY MEM_CODLANC PICT "99999"
  @ 05,17 SAY MEM_CODUSU PICT "99999"
  @ 05,22 SAY MEM_NOME PICT "@!35"
  @ 07,13 SAY MEM_NASC PICT "  /  /    "
  @ 07,30 SAY MEM_SEXO PICT "!"
  @ 07,46 SAY MEM_EC PICT "!"
  @ 09,13 SAY MEM_FONE PICT "(99)99999-9999"
  @ 09,34 SAY MEM_CPF PICT "999.999.999-99"
  @ 11,14 SAY MEM_PROF PICT "@!20"
  @ 13,14 GET MEM_MES PICT "!!!/9999"
  @ 15,14 GET MEM_VENC PICT "  /  /    "
  @ 17,14 GET MEM_CODCTA PICT "99999"
  @ 17,21 SAY MEM_CONTA PICT "@!30"
  @ 17,51 SAY "CR./DB.:"
  @ 17,60 SAY MEM_CRDB  PICT "!"
  @ 19,14 GET MEM_VALOR PICT "999,999.99"
  @ 21,20 GET CONFIRMA PICT "!" 
  READ
  IF CONFIRMA = "S"
    APPEND BLANK
    REPLACE CODUSU WITH MEM_CODUSU
    REPLACE NOME   WITH MEM_NOME
    REPLACE CODCTA WITH MEM_CODCTA
    REPLACE CONTA  WITH MEM_CONTA
    REPLACE MES    WITH MEM_MES
    REPLACE VENC   WITH MEM_VENC
    REPLACE VALOR  WITH MEM_VALOR
  ENDIF
ENDDO
CLOSE ALL
RETURN
Cabe salientar, para que possam me ajudar, que estou usando índices CDX, ok. Aguardo resposta futura!

Everaldo

Rotina estilo DBase ... não funciona

Enviado: 13 Abr 2022 21:50
por Itamar M. Lins Jr.
Olá!
Tá aprendendo ? É algum teste para emprego ? Pq seu código mistura comandos que não são do dbase.
go bottom faz o que ? seek ou dbseek() faz o quê ? find faz o quê ?

Se é um Hobby, precisa colocar o comando para achar o que precisa.

Código: Selecionar todos

READ

IF USUARIOS->( DBSEEK (MEM_CODUSU) )
   ACHEI
  MEM_NOME := USUARIOS->NOME
  MEM_NASC := USUARIOS->NASC
  MEM_SEXO := USUARIOS->SEXO
  MEM_EC   := USUARIOS->EC
  MEM_FONE := USUARIOS->FONE
  MEM_CPF  := USUARIOS->CPF
  MEM_PROF := USUARIOS->PROF

ELSE
  NAO ACHEI
ENDIF

  CONFIRMA := SPACE(01)
Use := para atribuir use = para comparar e == comparar exatamente(qtd espaços em branco a direita)

Saudações,
Itamar M. Lins Jr.

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 00:45
por arcanjoebc
Na realidade, eu comecei a estudar DBase há muitos anos atrás, mas, infelizmente, fiquei muito doente e tive que parar. Somente há dois anos, comecei a rever coisas do passado, pois sempre quis ser programador. Mas muita coisa eu já esqueci ... e agora estou voltando aos estudos. Peço desculpas se não fui muito claro em minha pegunta.

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 07:36
por Itamar M. Lins Jr.
Olá!
Peço desculpas se não fui muito claro em minha pegunta.
Oi, a pergunta está blz, Coloque um código bem pequeno.
Para achar qualquer coisa em uma base indexada, tanto faz NTX/CDX usamos SEEK.

Código: Selecionar todos

Examples

     .  The following example searches for "Doe" using the SEEK
        command:

        USE Customer NEW
        SET ORDER TO Customer
        ? SET( _SET_SOFTSEEK )      // (.F.)
        SEEK "Doe"
        ? SET( _SET_SOFTSEEK )      // Still (.F.)
        IF FOUND()
           .
           . < statements >
           .
        ENDIF

     .  The following example performs a soft seek for "Doe" using
        SOFTSEEK clause of the SEEK command:

        USE Customer NEW
        SET ORDER TO Customer
        ? SET( _SET_SOFTSEEK )      // (.F.)
        SEEK "Doe" SOFTSEEK
        ? SET( _SET_SOFTSEEK )      // Still (.F.)
        IF !FOUND()
           ? Customer->Name         // Returns next logical name after "Doe"
        ENDIF
Saudações,
Itamar M. Lins Jr.

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 18:48
por arcanjoebc
Eu fiz o seguinte código:

Código: Selecionar todos

REQUEST DBFCDX

PROCEDURE Main

RDDSETDEFAULT("DBFCDX")

USE usuarios NEW ALIAS USUARIOS
OrdSetFocus("idusucod")

CLEAR
? SET( _SET_SOFTSEEK )      // (.F.)
SEEK USUARIOS->COD
? SET( _SET_SOFTSEEK )      // Still (.F.)
IF FOUND()
   ? USUARIOS->NOME         // Returns next logical name
ENDIF
E o resultado foi esse:

Código: Selecionar todos

                                                                                                                                                              
.F.                                                                                                                                                           
.F.                                                                                                                                                           
ALAOR DUTRA MACHADO                                                                                                                                          
everaldo@vostro-3681:~/Despesas$
No caso do resultado .F. não deveria ser .T.? A questão é que sempre pega o primeiro registro do DBF e escolhendo-se outro código, lá no meu programa, ele sempre apresenta o primeiro registro, compreendes? Ou seja, independente de trocar o campo código o programa sempre mostra na tela o primeiro registro ... tu podes me dizer o porquê disso? Aguardo resposta ...

Everaldo

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 20:22
por Itamar M. Lins Jr.
Olá!
sempre mostra na tela o primeiro registro
Tá tudo certo.
O programa fez o que vc pediu.
O exemplo que postei tem uma coisa e vc fez outra.
Quer procurar algo peça seek "0001" ou seek "JOAO"...
Vc pediu seek usuario->cod que é o primeiro ele achou o primeiro mesmo.

Reveja o exemplo que postei.
Leia mais sobre o softseek que nada mais é que levar o ponteiro para final do DBF(quando off) ou posicioná-lo no próximo mais parecido (caso não achei) (On-ligado)

Saudações,
Itamar M. Lins Jr.

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 20:40
por JoséQuintas
arcanjoebc escreveu:para que deem uma analisada e me digam onde eu estou errando:
Não está pesquisando código nenhum, acaba mostrando sempre a mesma coisa.

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 20:49
por JoséQuintas
Consegue rodar sem dar erro?

Está abrindo sem índice nenhum, e mesmo assim seleciona índice, apesar que pode ter criado os índices com AUTOOPEN, o que eu particularmente não recomendo.

Está pegando os dados do usuário antes de pedir o código do usuário?
E a conta antes de pedir o código da conta?
E sem pesquisa?
E o código do lançamento vai ser sempre zero?

É inclusão mesmo, ou trata-se de alteração?

Rotina estilo DBase ... não funciona

Enviado: 14 Abr 2022 21:14
por JoséQuintas
Um chute aproximado, alterando tudo que é nome de variável.

Código: Selecionar todos

* PROGRAMA   : desi003.prg               *
* DATA       : 13/04/2022                *
* FINALIDADE : CADASTRAR LANCAMENTOS     *

PROCEDURE DESI003

   LOCAL nIdLanc, nIdUsuario := 0, nIdConta := 0, cMes := "XX/9999"
   LOCAL dVencto := Ctod(""), nValor := 0, cConfirma := "N"
   LOCAL GetList := {}

   USE contas SHARED NEW 
   OrdSetFocus("idctacod")

   USE usuarios SHARED NEW
   OrdSetFocus("idusucod")

   USE lancam SHARED NEW 
   OrdSetFocus("idcodlan")

   DO WHILE .T.
      CLS
      @ 00,00 TO 23,79 DOUBLE
      @ 01,(79-Len('INCLUIR'))/2 SAY "INCLUSAO DE LANCAMENTOS"
      @ 03,03 SAY "CODLANC.:"
      @ 05,03 SAY "COD. USUARIO:"
      @ 07,03 SAY "DATA NASC   /  /     SEXO:   ESTADO CIVIL:"
      @ 09,03 SAY "TELEFONE: (  )     -      CPF:    .   .   -  "
      @ 11,03 SAY "PROFISSAO: "
      @ 13,03 SAY "MES/ANO  : "
      @ 15,03 SAY "VENC.    : "
      @ 17,03 SAY "CONTA    : "
      @ 17,51 SAY "CR./DB.:"
      @ 19,03 SAY "VALOR    : "
      @ 21,03 SAY "CONFIRMA ? (S/N)"
      @ 22,03 SAY "MENSAGEM : "

      GOTO BOTTOM
      nIdLanc := lancam->CodLanc + 1 // não se sabe o nome do campo é esse mesmo

      @ 03,13 SAY nIdLanc PICTURE "99999"
      @ 05,17 GET nIdUsuario PICTURE "99999"
      IF nIdUsuario = 0
         EXIT
      ENDIF
      SELECT usuarios
      SEEK nIdUsuario
      @ 05,22 SAY usuarios->Nome
      @ 07,13 SAY usuarios->Nasc
      @ 07,30 SAY usuarios->Sexo
      @ 07,46 SAY usuarios->Ec
      @ 09,13 SAY usuarios->Fone
      @ 09,34 SAY usuarios->CPF
      @ 11,14 SAY usuarios->Prof
      @ 13,14 GET cMes PICT "!!!/9999"
      @ 15,14 GET dVencto
      @ 17,14 GET nIdConta PICT "99999"
      READ
      SELECT contas
      SEEK nIdConta
      @ 17,21 SAY contas->Nome
      @ 17,60 SAY contas->CrDb PICT "!"
      @ 19,14 GET nValor PICT "999,999.99"
      @ 21,20 GET cConfirma PICT "!"
      READ
      SELECT lancam
      IF cConfirma == "S"
         APPEND BLANK
         REPLACE ;
            CODUSU WITH nIdUsuario, ;
            NOME   WITH usuarios->Nome, ;
            CODCTA WITH nIdConta, ;
            CONTA  WITH contas->Nome, ;
            MES    WITH cMes, ;
            VENC   WITH dVencto, ;
            VALOR  WITH nValor
      ENDIF
   ENDDO
   CLOSE DATABASES

   RETURN

Rotina estilo DBase ... não funciona[Resolvido]

Enviado: 15 Abr 2022 02:29
por arcanjoebc
Obrigado José Quintas! Funciona! Só tive que fazer algumas modificações, o código ficou assim:

Código: Selecionar todos

* PROGRAMA   : desi003b.prg              *
* DATA       : 13/04/2022                *
* FINALIDADE : CADASTRAR LANCAMENTOS     *
	 
PROCEDURE desi003b
	 
LOCAL nIdLanc, nIdUsuario := 9, nIdConta := 9, cMes := "XXX/9999"
LOCAL dVencto := Ctod(""), nValor := 0, cConfirma := "N"
LOCAL GetList := {}
	 
USE contas SHARED NEW
OrdSetFocus("idctacod")
	 
USE usuarios SHARED NEW
OrdSetFocus("idusucod")
	 
USE lancam SHARED NEW
OrdSetFocus("idcodlan")
	 
DO WHILE .T.
   CLS
   @ 00,00 TO 23,79 DOUBLE
   @ 01,(79-Len('INCLUIR'))/2 SAY "INCLUSAO DE LANCAMENTOS"
   @ 03,03 SAY "CODLANC.:"
   @ 05,03 SAY "COD. USUARIO:"
   @ 07,03 SAY "DATA NASC   /  /     SEXO:   ESTADO CIVIL:"
   @ 09,03 SAY "TELEFONE: (  )     -      CPF:    .   .   -  "
   @ 11,03 SAY "PROFISSAO: "
   @ 13,03 SAY "MES/ANO  : "
   @ 15,03 SAY "VENC.    : "
   @ 17,03 SAY "CONTA    : "
   @ 17,51 SAY "CR./DB.:"
   @ 19,03 SAY "VALOR    : "
   @ 21,03 SAY "CONFIRMA ? (S/N)"
   @ 22,03 SAY "MENSAGEM : "
	 
   GOTO BOTTOM
   nIdLanc := lancam->Cod // + 1 // não se sabe o nome do campo é esse mesmo
	 
   @ 03,13 SAY nIdLanc PICTURE "99999"
   @ 05,17 GET nIdUsuario PICTURE "99999"
   READ
   IF nIdUsuario = 0
      EXIT
   ENDIF
   SELECT usuarios
   SEEK nIdUsuario
   @ 05,23 SAY usuarios->Nome
   @ 07,13 SAY usuarios->Nasc
   @ 07,30 SAY usuarios->Sexo
   @ 07,46 SAY usuarios->Ec
   @ 09,13 SAY usuarios->Fone
   @ 09,34 SAY usuarios->CPF
   @ 11,14 SAY usuarios->Prof
   @ 13,14 GET cMes PICT "!!!/9999"
   @ 15,14 GET dVencto
   @ 17,14 GET nIdConta PICT "99999"
   READ
   SELECT contas
   SEEK nIdConta
   @ 17,21 SAY contas->Conta
   @ 17,60 SAY contas->CrDb PICT "!"
   @ 19,14 GET nValor PICT "999,999.99"
   @ 21,20 GET cConfirma PICT "!"
   READ
   SELECT lancam
   IF cConfirma == "S"
   APPEND BLANK
   REPLACE ;
      CODUSU WITH nIdUsuario, ;
      NOME   WITH usuarios->Nome, ;
      CODCTA WITH nIdConta, ;
      CONTA  WITH contas->Conta, ;
      MES    WITH cMes, ;
      VENC   WITH dVencto, ;
      VALOR  WITH nValor
   ENDIF
ENDDO
CLOSE DATABASES
	 
RETURN
Agora, baseado nesse fonte, vou fazer as mudanças necessárias em outras rotinas ... obrigado, mais uma vez e tudo de bom ...

Everaldo

Rotina estilo DBase ... não funciona

Enviado: 15 Abr 2022 17:49
por JoséQuintas
arcanjoebc escreveu:Agora, baseado nesse fonte, vou fazer as mudanças necessárias em outras rotinas ...
Errado.
Primeiro testa, retesta, confirma se tudo acontece como devia, com coisa certa e coisa errada.
Por exemplo, compilando com checagem máxima, vai descobrir que não está salvando o número de lançamento em lugar nenhum.
Coloque alias em todos os nomes que indicam campos, etc. etc.
Se é pra servir de modelo, precisa estar impecável.

Código fonte NÃO é para o computador, é para o programador.
Já se foi a época que tinha que abreviar nomes de variáveis, ou escrever códigos complexos que só o computador entende.

Analise o fonte.

Será que não precisa testar se foi teclado ESC pra abandonar a digitação?
Será que precisa avisar quando digitar código que não existe?
Será que deveria aceitar código negativo?

E por aí vai.
Com certeza vai precisar tudo isso em outros fontes também.
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB