PC Toledo

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

Rotina de codigo automático

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

Página 2 de 2

Re: Rotina de codigo automático

Enviado: 08 Ago 2010 20:17
por asimoes
Exemplo:

Código: Selecionar todos

IF lAdicionar
         cCodigo:=StrZero(PsqControle( DBF() ),2)
         DbAppend()
         C0001->Cod := cCodigo
      ELSE
         C0001->(DbRLock())
      ENDIF
      fNatureza.oEdit2.Save
      C0001->(DbCommit())
      C0001->(DbUnlock())
ENDIF

FUNCTION PsqControle( cDataBase )
   // Inicializa controle com um numero diferente do total de registros
   //Exemplo:
   //CLIENTES->IDCLIENTE := PsqControle( DBF() )
   //APPEND BLANK
   //...
   //COMMIT
   //...
   DEFAULT cDirSys TO ""
   nControle := IIF( RecCount()=0, 1, RecCount()+(RecCount()/2) )
   cDirSys:=""
   // Guarda a área atual do .DBf a ser controlado
   OldArea := Select()
   IF !File(cDirSys+"CONTROLE")
      // Cria a estrutura do controlador caso ainda não exista
      aStru_Table := { ;
           { "DATABASE"  , "C",12, 0 } , ;  // Guarda o nome do DBF/ALIAS
           { "CONTADOR"  , "N", 9, 0 } }    // Armazena o contador
            DBCREATE( cDirSys+"CONTROLE", aStru_Table,"DBFCDX" ) //SQLRDD
   ENDIF
   IF Select("CONTROLE") == 0 // Se ainda não estiver aberto, abre...
      USE &cDirSys.CONTROLE NEW VIA "DBFCDX"
   ELSE
      DbSelectar("CONTROLE")  // Se ja estiver aberto SELECIONA
   ENDIF
   // Verifica a existencia da chave( que pode ser também uma palavra )
   LOCATE FOR UPPER(CONTROLE->DataBase) = UPPER(cDataBase)
   IF Found()
      // Encontrando incrementa o contador
      nControle := CONTROLE->Contador + 1
      RLOCK() // Usado no caso de rede
      CONTROLE->Contador := nControle
      CONTROLE->(DbCommit())
      CONTROLE->(DbUnlock())
   ELSE
      // Caso a chave ainda não exista será criada
      DbAppend()
      CONTROLE->DataBase := cDataBase
      CONTROLE->Contador := nControle
      CONTROLE->(DbCommit())
   ENDIF
   // Volta a área antiga
   SELECT (OldArea)
   // Retorna o numero de controle
RETURN nControle

Re: Rotina de codigo automático

Enviado: 11 Ago 2010 19:55
por Josmar dos Santos
Ola, o que será q estou fazendo errado ??? Praticamente ta tuudo funcionando. Somente uma coisa: Ao entrar no cadastro qualquer e cadastrar, o codigo ta pulando de dois em dois, exemplo: 190,192,194,...etc, mas isso ocorre quando eu cadastro somente um e saio. Ao entrar novamente ocorre o que foi escrito anteriormente, caso eu entre no cadastro sem sair do mesmo, ai fica normal !, ou seja, cadastrar sequencialmente. Também ocorre de uma outra maneira: Se eu entrar e sair sem cadastrar nada, ele pula de um em um,ou seja, Dar <Enter> e <Esc> e assim sucessivamente. Olha nao sei o q isso ! por isso peço ajuda de vocês...

Bom peço ajuda dos senhores novamente, sei que foi postado varios exemplos, mas preciso matar essa charada nessa rotina q esta presente, pois so esta faltando isso para completar a conversão de ntx para cdx

sem mais, obrigado
Josmar

Eis o codigo:

Código: Selecionar todos

LOCAL CONTAR
RE_GISTROS:={}

IF !ABRECLI()
   ALERT("NAO CONSEGUI ABRIR")
ENDIF
M->MOSTRA_RESULTADO := .F.
PRIVATE ME_MO, COD_CLI, NOM_CLI, DAT_CLI, V_CLI, OBS_CLI
WHILE .T.
   MENSAGEM( "Tecle <ESC> para retornar" )
      CARREG01( INCLUSAO )
      M->MOSTRA_RESULTADO := .T.
   // -> Carrega tela de cadastro
   IF CARGET01( INCLUSAO )=.F.
      EXIT
   ENDIF
   IF PERG( "Confirma as informa‡”es ?" ) = "N"
      LOOP
   ENDIF
   alert("Numero gerado:" +m->cod_cli)
   M->MOSTRA_RESULTADO := .F.
   IF !ADIREG( 0 )
      MENSAGEM( "Inclus„o n„o foi bem sucedida", 3 )
      LOOP
   ENDIF
   SALVAR01()
   COMMIT
   UNLOCK
ENDDO
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )

FUNCTION CARREG01( TIPO_ACAO )
M->ME_MO := "[memo]"
IF TIPO_ACAO = INCLUSAO
   GOTO BOTT
   SKIP
ENDIF
M->COD_CLI :=  CLIENTES->COD_CLI
M->NOM_CLI :=  CLIENTES->NOM_CLI
M->DAT_CLI :=  CLIENTES->DAT_CLI
M->V_CLI :=  CLIENTES->V_CLI
M->OBS_CLI :=  CLIENTES->OBS_CLI
M->DAT_CLI:=DATE()

IF TIPO_ACAO = INCLUSAO
   ordsetfocus("client_1")
   M->COD_CLI:=alltrim(STRZERO(PSQCONTROLE("clientes"),5))
  ENDIF

FUNCTION CARGET01( TIPO_ACAO )

IF TIPO_ACAO != MOSTRA_PAG_1
   M->AL_TERAR := .F.
ENDIF
JANELA( 3, 3, 16, 63, "CLIENTES" )
COR( "CERCADURAS" )
@  4,  4 TO 15, 62 DOUBL
COR( "GETS" )
@  4, 22 SAY "CADASTRO DE CLIENTES"
*@  6,  7 SAY "CODIGO:" GET M->COD_CLI PICTURE "99999"
@  6, 29 SAY "DATA:" GET M->DAT_CLI
@  9,  7 SAY "NOME..:" GET M->NOM_CLI PICTURE "@!"
@ 12,  7 SAY "VALOR.:" GET M->V_CLI PICTURE "@Z 9,999,999.99"
@ 12, 35 SAY "OBS:" GET ME_MO PICT "9memo]" VALID EDITOR( @OBS_CLI, "OBS:" )
IF TIPO_ACAO = MOSTRA_PAG_1
   CLEAR GETS
   RETURN .F.
ENDIF
IF TIPO_ACAO = CONSULTA .OR. TIPO_ACAO = EXCLUSAO
   CLEAR GETS
   IF TIPO_ACAO = EXCLUSAO
      RETURN .T.
   ENDIF
   MENSAGEM( "Tecle algo para continuar" )
   IF INKEY( 0 ) = T_ESC
      RETURN .F.
   ENDIF
   EDITOR( OBS_CLI, "OBS:", .F. )
ELSE
   CURSOR( LIGA )
   READ
   CURSOR( DESLIGA )
   IF LASTKEY() = T_ESC
      RETURN .F.
   ENDIF
ENDIF
RETURN .T.
 
FUNCTION SALVAR01
 CLIENTES->COD_CLI := M->COD_CLI
 CLIENTES->NOM_CLI := M->NOM_CLI
 CLIENTES->DAT_CLI := M->DAT_CLI
 CLIENTES->V_CLI := M->V_CLI
 CLIENTES->OBS_CLI := M->OBS_CLI

FUNCTION ABRECLI
IF USA("CLIENTES",.T.,.F.)
   IF(!FILE("CLIENTE.CDX"))
     _FECHA()
     INDEX ON COD_CLI TAG CLIENT_1 TO CLIENTE
     INDEX ON NOM_CLI TAG CLIENT_2 TO CLIENTE
     _ABRE()
   ENDIF
   DBSETINDEX("CLIENTE")
ELSE
   MENSAGEM( "Troca de n¡vel mal sucedida", 3 )
   RETURN .F.
ENDIF
RETURN .T.

Re: Rotina de codigo automático

Enviado: 15 Ago 2010 02:36
por rochinha

Código: Selecionar todos

LOCAL CONTAR
RE_GISTROS:={}

IF !ABRECLI()
   ALERT("NAO CONSEGUI ABRIR")
ENDIF
M->MOSTRA_RESULTADO := .F.
PRIVATE ME_MO, COD_CLI, NOM_CLI, DAT_CLI, V_CLI, OBS_CLI
WHILE .T.
   MENSAGEM( "Tecle  para retornar" )
      CARREG01( INCLUSAO )
      M->MOSTRA_RESULTADO := .T.
   // -> Carrega tela de cadastro
   IF CARGET01( INCLUSAO )=.F.
      EXIT
   ENDIF
   IF PERG( "Confirma as informa‡”es ?" ) = "N"
      LOOP
   ENDIF
   alert("Numero gerado:" +m->cod_cli)
   M->MOSTRA_RESULTADO := .F.
   IF !ADIREG( 0 )
      MENSAGEM( "Inclus„o n„o foi bem sucedida", 3 )
      LOOP
   ENDIF
   SALVAR01()
   COMMIT
   UNLOCK
ENDDO
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )

FUNCTION CARREG01( TIPO_ACAO )
M->ME_MO := "[memo]"
IF TIPO_ACAO = INCLUSAO
   GOTO BOTT
   SKIP
ENDIF
M->COD_CLI :=  CLIENTES->COD_CLI
M->NOM_CLI :=  CLIENTES->NOM_CLI
M->DAT_CLI :=  CLIENTES->DAT_CLI
M->V_CLI :=  CLIENTES->V_CLI
M->OBS_CLI :=  CLIENTES->OBS_CLI
M->DAT_CLI:=DATE()

IF TIPO_ACAO = INCLUSAO
   ordsetfocus("client_1")
  //
  //
  // *** LOCAL ERRADO *** LOCAL ERRADO *** LOCAL ERRADO ***
  //
  // M->COD_CLI:=alltrim(STRZERO(PSQCONTROLE("clientes"),5))
  ENDIF

FUNCTION CARGET01( TIPO_ACAO )

IF TIPO_ACAO != MOSTRA_PAG_1
   M->AL_TERAR := .F.
ENDIF
JANELA( 3, 3, 16, 63, "CLIENTES" )
COR( "CERCADURAS" )
@  4,  4 TO 15, 62 DOUBL
COR( "GETS" )
@  4, 22 SAY "CADASTRO DE CLIENTES"
*@  6,  7 SAY "CODIGO:" GET M->COD_CLI PICTURE "99999"
@  6, 29 SAY "DATA:" GET M->DAT_CLI
@  9,  7 SAY "NOME..:" GET M->NOM_CLI PICTURE "@!"
@ 12,  7 SAY "VALOR.:" GET M->V_CLI PICTURE "@Z 9,999,999.99"
@ 12, 35 SAY "OBS:" GET ME_MO PICT "9memo]" VALID EDITOR( @OBS_CLI, "OBS:" )
IF TIPO_ACAO = MOSTRA_PAG_1
   CLEAR GETS
   RETURN .F.
ENDIF
IF TIPO_ACAO = CONSULTA .OR. TIPO_ACAO = EXCLUSAO
   CLEAR GETS
   IF TIPO_ACAO = EXCLUSAO
      RETURN .T.
   ENDIF
   MENSAGEM( "Tecle algo para continuar" )
   IF INKEY( 0 ) = T_ESC
      RETURN .F.
   ENDIF
   EDITOR( OBS_CLI, "OBS:", .F. )
ELSE
   CURSOR( LIGA )
   READ
   CURSOR( DESLIGA )
   IF LASTKEY() = T_ESC
      RETURN .F.
   ENDIF
ENDIF
RETURN .T.
 
FUNCTION SALVAR01
 //
 //
 // *** LOCAL CORRETO *** LOCAL CORRETO *** LOCAL CORRETO ***
 //
 M->COD_CLI := alltrim(STRZERO(PSQCONTROLE("clientes"),5))
 CLIENTES->COD_CLI := M->COD_CLI
 CLIENTES->NOM_CLI := M->NOM_CLI
 CLIENTES->DAT_CLI := M->DAT_CLI
 CLIENTES->V_CLI := M->V_CLI
 CLIENTES->OBS_CLI := M->OBS_CLI

FUNCTION ABRECLI
IF USA("CLIENTES",.T.,.F.)
   IF(!FILE("CLIENTE.CDX"))
     _FECHA()
     INDEX ON COD_CLI TAG CLIENT_1 TO CLIENTE
     INDEX ON NOM_CLI TAG CLIENT_2 TO CLIENTE
     _ABRE()
   ENDIF
   DBSETINDEX("CLIENTE")
ELSE
   MENSAGEM( "Troca de n¡vel mal sucedida", 3 )
   RETURN .F.
ENDIF
RETURN .T.

Re: Rotina de codigo automático

Enviado: 15 Ago 2010 17:35
por Josmar dos Santos
Ola Rochinha, fiz o que vc me orientou, mas não funcionou, simplesmente a numeração sequencial não aparece mais !


sem mais obrigado,

Josmar

Re: Rotina de codigo automático

Enviado: 16 Ago 2010 07:28
por Toledo
Josmar, da maneira como o Rochinha colocou vai funcionar sim, mas você terá que concluir todo o cadastro. Naquele alert("Numero gerado:" +m->cod_cli) não vai mostrar o código, vai estar zerado, devido a posição do alert() dentro do seu código. Então, mova esta linha do alert() para o final da função SALVAR01, ai você vai ver o código gerado.

Abraços,

Re: Rotina de codigo automático

Enviado: 16 Ago 2010 15:59
por Josmar dos Santos
É Toledo, vc matou a charada, é isso mesmo ! funcionou. Gerou certinho. Eu so tive um problema na hora..mas consegui resolver. Agora não sei se é da maneira correta ! Explico: Na Manutenção do sistema, onde faço as alterações, exclusões, etc.....No momento em que se fazia alguma alteração no cadastro, o codigo sequencial vontava novamente a pular, ou seja, quando eu aterava por exemplo o numero 250, ele dava a mensagem do alert gerando outro codigo acima. Isso ocorre porque eu uso a função salvar01() também na manutenção. O que eu fiz ? tirei uma cópia dessa função para salva_01() sem essa definição do alert, aí funcionou perfeitamente ! Pergunto a vc...é correto fazer isso dentro de um sistema ?, ou há outro método mais correto ??? Só sei de uma coisa: funcionou !!!!!!!!!
:))

Abraços, Josmar
Todos os horários são UTC-03:00
Página 2 de 2

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB