Amiguinho Josmar,
Voce não seguiu minhas recomendações nem a sequencia dos códigos que lhe passei.
Voce continua incorrendo em obter falhas na numeração sequencial.
Código: Selecionar todos
FUNCTION SALVAR01( TIPO_ACAO )
LOCAL lRetorno := .F.
IF TIPO_ACAO = INCLUSAO // Nesse local está ocorrendo o erro
CLIENTES->( DbAppend() )
cCOD_CLI := alltrim( STRZERO( PSQCONTROLE( "clientes" ), 5 ) )
CLIENTES->COD_CLI := cCOD_CLI
alert("Numero gerado no arquivo: " +cCOD_CLI)
ELSE
CLIENTES->( Rlock() )
ENDIF
If .Not. NetErr()
CLIENTES->NOM_CLI := M->NOM_CLI
CLIENTES->DAT_CLI := M->DAT_CLI
CLIENTES->V_CLI := M->V_CLI
CLIENTES->OBS_CLI := M->OBS_CLI
CLIENTES->( DbCommit() )
CLIENTES->( DbUnLock() )
Else
Alert( "Falha ao incluir novo cliente." )
Endif
Return .T.
Código: Selecionar todos
FUNCTION SALVAR01( TIPO_ACAO )
LOCAL lRetorno := .F.
IF TIPO_ACAO = INCLUSAO // Nesse local está ocorrendo o erro
A variavel INCLUSAO existe no inicio do .PRG principal e deve conter um numero que a defina, como 1, exemplo.
Código: Selecionar todos
CLIENTES->( DbAppend() )
cCOD_CLI := alltrim( STRZERO( PSQCONTROLE( "clientes" ), 5 ) )
CLIENTES->COD_CLI := cCOD_CLI
alert("Numero gerado no arquivo: " +cCOD_CLI)
Acima voce insiste em manter o erro de numerar o registro sem antes salva-lo.
Código: Selecionar todos
ELSE
CLIENTES->( Rlock() )
ENDIF
If .Not. NetErr()
CLIENTES->NOM_CLI := M->NOM_CLI
CLIENTES->DAT_CLI := M->DAT_CLI
CLIENTES->V_CLI := M->V_CLI
CLIENTES->OBS_CLI := M->OBS_CLI
CLIENTES->( DbCommit() )
CLIENTES->( DbUnLock() )
Else
Alert( "Falha ao incluir novo cliente." )
Endif
Return .T.
Se NetErr() não tiver exito voce tera um furo na numeração de um registro que voce acrescentou e não finalizou.
No trecho abaixo voce incluiu chamadas que nunca serão usadas neste local:
Código: Selecionar todos
@ 19, 04 SAY SUBS( TB_JANELA, 9, 1 ) +;
REPL( SUBS( TB_JANELA, 8, 1 ), 70 ) + SUBS( TB_JANELA, 7, 1 )
ROTI_NAS := { { | X | CARREG01( X ) },;
{ | X | CARGET01( X ) },;
{ || SALVAR01( X ) } }
GRA_VAR := {}
OB_COLUN := {}
AADD( OB_COLUN, TBCOLUMNNEW( "CODIGO:", { || CLIENTES->COD_CLI } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "NOME:", { || CLIENTES->NOM_CLI } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "DATA:", { || CLIENTES->DAT_CLI } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "VALOR:", { || TRAN( CLIENTES->V_CLI, "@Z 9,999,999.99" ) } ) )
BRO_WSE( .T. )
A variavel
ROTI_NAS é na verdade um parametro da função que criei para minimizar a codificação em questão e ela recebe um vetor de codeblock que serão avaliados dentro da função
CADASTRA() e somente nela.
Código: Selecionar todos
CADASTRA( "Inclusao", { { | X | CARREGI1( X ) },;
{ | X | CARGETI1( X ) },;
{ || SALVARI1( X ) } ,;
{ || M->COD_CLI := alltrim( STRZERO( PSQCONTROLE( "clientes" ), 5 ) ) },;
{ || !EMPTY( M->NOM_CLI ) };
} )
A rotina de cadastramento completa esta logo abaixo e funciona perfeitamente pois a coloquei dentro de seu sistema e deixei uma opção no menu para que voce avaliasse.
Código: Selecionar todos
/*
* TITULO : Sistema de Oficina
* DATA : 25/08/2010
* PROGRAMA : OFICI01D.PRG
* COMENTARIO : CADASTRO (Clientes)
*/
#include "OFIC.CH"
// Usando este comando extendido, caso tenha esquecido alguma tabela aberta
// nao acontecera erro de abertura, a nao ser que a mesma esteja aberta em
// modo exclusivo
#command OPEN <(db)> ;
[VIA <rdd>] ;
[ALIAS <a>] ;
[<new: NEW>] ;
[<ex: EXCLUSIVE>] ;
[<sh: SHARED>] ;
[<ro: READONLY>] ;
[INDEX <(index1)> [, <(indexn)>]] ;
=> iif( Select( <(db)> )==0, iif( !File( <(db)>+".CDX" ), ( Alert( "Arquivo "+<(db)>+" esta sem indices. Abrindo sem indices. Reorganiza primeiro" ), dbNetUseArea( <.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.>, 0 ) ), ( dbNetUseArea( <.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.>, 0 ), dbSetIndex( <(db)> ) ) ), ( dbSelectArea( <(db)> ) ) )
MENSAGEM( "Aguarde abertura de arquivos" )
OPEN clientes SHARED NEW
SELECT CLIENTES
SET ORDER TO 1
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Cadastro - Clientes"
M->DU_PLICIDADE := .F. // Testa duplicidade
M->MOSTRA_RESULTADO := .F. // Apresenta dados
M->IN_CLUIR := .T. // Sempre preparado para inclusao
M->AL_TERAR := .F. // Sempre preparado para inclusao
// Privatiza as variaveis de nomes de campos
PRIVATE ME_MO, COD_CLI, NOM_CLI, DAT_CLI, V_CLI, OBS_CLI
SET DELETED ON
SET KEY 22 TO
// Usando esta funcao customizada voce diminui o tempo de programacao
// bastando apenas focar a codificacao nas funcoes de CARREGamento, GETamento
// SALVARmento e criticas
CADASTRA( "Inclusao", { { | X | CARREGI1( X ) },;
{ | X | CARGETI1( X ) },;
{ || SALVARI1( X ) } ,;
{ || M->COD_CLI := alltrim( STRZERO( PSQCONTROLE( "clientes" ), 5 ) ) },;
{ || !EMPTY( M->NOM_CLI ) };
} )
STATIC ; // Coloquei estas funcoes como STATIC para que sejam visualizadas somente aqui neste PRG
FUNCTION VERI0I1( TIPO_ACAO )
//
// -> Funcao que verifica duplicidade no arquivo
LOCAL REGISTRO := RECN(), ORDEM := INDEXORD()
SET ORDER TO 2
SEEK M->NOM_CLI
IF !EOF()
IF REGISTRO = RECN()
SET ORDER TO ORDEM
RETURN .T.
ENDIF
IF TIPO_ACAO = INCLUSAO
BEEP(); MENSAGEM( "Registro ja cadastrado", 3 )
GOTO REGISTRO
RETURN .F.
ELSE
M->AL_TERAR := .T.
CLEAR GETS
SET ORDER TO ORDEM
RETURN .T.
ENDIF
ELSE
ENDIF
SET ORDER TO ORDEM
GOTO REGISTRO
RETURN .T. // Uma coisa muito feia na programacao com MIRO e a falta desta finalizacao
STATIC ; // Coloquei estas funcoes como STATIC para que sejam visualizadas somente aqui neste PRG
FUNCTION CARREGI1( TIPO_ACAO )
//
// -> Carrega variaveis para entrada ou alteracao de dados
IF TIPO_ACAO = INCLUSAO
GOTO BOTTOM
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
IF TIPO_ACAO = INCLUSAO
M->DAT_CLI := DATE()
ENDIF
STATIC ; // Coloquei estas funcoes como STATIC para que sejam visualizadas somente aqui neste PRG
FUNCTION CARGETI1( TIPO_ACAO )
//
// -> Formata a tela para entrada ou alteracao de dados
IF TIPO_ACAO != ALTERACAO
M->AL_TERAR := .F.
ENDIF
JANELA( 3, 5, 8, 66, "Registro" )
COR( "GETS" )
//
// -> Monta tela de cadastro
@ 4, 7 SAY "DATA..:" GET M->DAT_CLI
@ 5, 7 SAY "NOME..:" GET M->NOM_CLI PICTURE "@!" VALID VERI0I1( TIPO_ACAO )
@ 6, 7 SAY "VALOR.:" GET M->V_CLI PICTURE "@Z 9,999,999.99"
@ 7, 7 SAY "OBS...:" GET ME_MO PICT "9memo]" VALID EDITOR( @OBS_CLI, "OBS:" )
IF TIPO_ACAO = ALTERACAO
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 LASTKEY() = T_ESC
RETURN .F.
ENDIF
ELSE
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF M->AL_TERAR
RETURN .F.
ENDIF
IF LASTKEY() = T_ESC
RETURN .F.
ENDIF
ENDIF
RETURN .T. // Uma coisa muito feia na programacao com MIRO e a falta desta finalizacao
STATIC ; // Coloquei estas funcoes como STATIC para que sejam visualizadas somente aqui neste PRG
FUNCTION SALVARI1( TIPO_ACAO )
// -> Salva o conteudo das variaveis de entrada no arquivo
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
CLIENTES->( DbCommit() )
CLIENTES->( DbUnLock() )
RETURN .T. // Uma coisa muito feia na programacao com MIRO e a falta desta finalizacao
/* Final do programa OFICII01R.PRG */
/*
* TITULO : Funcoes de Cadastro Customizada
* DATA : 25/08/2010
* PROGRAMA : NFWLIB.PRG
* COMENTARIO : Funcoes de cadastramento customizadas pelo usuario
*/
FUNCTION CADASTRA( TI_TULO, ROTI_NAS, OR_DER, DBF_ON )
PUBLIC RE_GISTRO
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Cadastro ³ "+TI_TULO
SAVE SCREEN TO CA_DASTRO
FUNDO(15)
IF DBF_ON = NIL
DO WHILE .T.
MENSAGEM( "Tecle <ESC> para retornar" )
IF !( M->DU_PLICIDADE )
SET ORDER TO IIF(OR_DER=NIL,2,OR_DER)
//
// -> Inicializa variaveis
EVAL( ROTI_NAS[ 1 ], INCLUSAO )
ELSE
M->MOSTRA_RESULTADO := .T.
ENDIF
//
// -> Carrega tela de cadastro
IF EVAL( ROTI_NAS[ 2 ], IIF( M->AL_TERAR, ALTERACAO, INCLUSAO ) ) = .F.
IF M->AL_TERAR
EVAL( ROTI_NAS[ 1 ], ALTERACAO )
M->MOSTRA_RESULTADO = .T.
EVAL( ROTI_NAS[ 2 ], MOSTRA_PAG_1 )
BEEP()
IF PERG( "Registro j cadastrado. Deseja alterar ?" ) = "S"
M->IN_CLUIR := .F.; M->DU_PLICIDADE := .T.
RE_GISTRO := RECN() // REGLOCK
ELSE
M->AL_TERAR := .F.
ENDIF
LOOP
ENDIF
EXIT
ENDIF
IF PERG( "Confirma as informa‡”es ?" ) = "N"
//
// -> Faz reedicao
M->DU_PLICIDADE := .T.
LOOP
ENDIF
M->DU_PLICIDADE := .F.
M->MOSTRA_RESULTADO := .F.
IF M->IN_CLUIR
EVAL( ROTI_NAS[ 4 ] )
IF EVAL( ROTI_NAS[ 5 ] ) = .T.
APPEND BLANK
ELSE
BEEP(); BEEP()
MENSAGEM('Registro deve possuir informa‡”es corretas.',5)
ENDIF
ELSE
GO RE_GISTRO
M->IN_CLUIR := .T.
RLOCK()
ENDIF
//
// -> Atualiza o banco de dados
EVAL( ROTI_NAS[ 3 ] )
ENDDO
CLOSE DATABASES
ELSE
EVAL( ROTI_NAS[ 1 ], INCLUSAO )
EVAL( ROTI_NAS[ 2 ], INCLUSAO )
IF PERG( "Confirma as informa‡”es ?" ) = "N"
//
// -> Faz reedicao
RETURN
ENDIF
EVAL( ROTI_NAS[ 4 ] )
IF EVAL( ROTI_NAS[ 5 ] ) = .T.
APPEND BLANK
ELSE
BEEP(); BEEP()
MENSAGEM('Registro deve possuir informa‡”es corretas.',5)
ENDIF
//
// -> Atualiza o banco de dados
EVAL( ROTI_NAS[ 3 ] )
ENDIF
REST SCREEN FROM CA_DASTRO
RETURN .T.
A formatação deste código é do tipo recorta-e-cola, ou seja, é um protótipo para que voce use o mesmo corpo para vários outros .DBFs modificando somente os trecho que compreendem a abertura das tabelas, os GETs na função CARGETXX() e os campos e variaveis nas funções CARREGXX() e SALVARXX().
Com certeza a outra recomendação de alteração fique por conta da eliminação das linhas que contém
EVAL( ROTI_NAS[ 4 ] ) dentro da função CADASTRA() e a alteração do seguintes trechos:
Código: Selecionar todos
...
//
// -> Atualiza o banco de dados
EVAL( ROTI_NAS[ 3 ] )
...
//
// -> Atualiza o banco de dados
EVAL( ROTI_NAS[ 3 ] )
...
Para:
Código: Selecionar todos
...
//
// -> Atualiza o banco de dados
If .Not. NetErr()
IF M->IN_CLUIR // Se for INCLUSAO pega novo codigo
EVAL( ROTI_NAS[ 4 ] )
Endif
EVAL( ROTI_NAS[ 3 ] )
Endif
...
//
// -> Atualiza o banco de dados
If .Not. NetErr()
IF M->IN_CLUIR // Se for INCLUSAO pega novo codigo
EVAL( ROTI_NAS[ 4 ] )
Endif
EVAL( ROTI_NAS[ 3 ] )
Endif
...
Desta forma, se não houver problema com NetErr() o código não saltará.
