[ Download da Função | Considerações Iniciais | Chamando a Função | Dissecação do TBrowse | Feedback ]

ATENÇÃO: O Internet Explorer 8 não suporta a exibição das informações com o passar do mouse, mas testamos com o Firefox 3.5.5 e funcionou corretamente.

Alguns sites do governo, tipo o Tribunal de Justiça, só funcionam com o Firefox, portanto sugerimos que você tenha este navegador.

Clique na imagem abaixo para baixar o Firefox agora mesmo!

 

  

 

A função NAVEGAR está na sua versão 2.0, vindo com edição de campos do tipo memo e um exemplo pronto para ser compilado. Clique no link abaixo para o download:

Navegar versão 2010 (5 Kb)

(Correção de alguns bugs, filtro melhorado, opção de ocultar caixa "pesquisa rápida", rolagem de texto fora de vista após 3 segundos)

 

Navegar v2.0 (30 Kb)

(edição de campos do tipo memo e um exemplo pronto para ser compilado)

 

xNavegar v1.0  (8 Kb)

(xNavegar - Nova função que não usa a Visual Lib 2, possui FILTROS e WHEN para os GETs)
 

 

DICNR - Aplicativo exemplo com os fontes:

DICNR  (50 Kb)

 

 

Por favor, respeite minha propriedade intelectual e o dinheiro que você pagou por ele! Não distribua esse material, isto é um privilégio de quem valoriza o conhecimento, como você, não é para qualquer pessoa!!! Ao invés disso, se você gostou, divulgue-o!!! Se não gostou, reclame para que eu saiba onde posso melhorar, ok?!

Considerações Iniciais:

Este trabalho tem o objetivo de subsidiar o entendimento, na prática, do TBrowse e mostrar como ele é utilizado no mundo real.

Para complementação de dados técnicos específicos, ou seja, informação teórica, procure qualquer livro de Clipper.

Um objeto TBrowse é um mecanismo de navegação de propósito geral para uma tabela orientada de dados. 

Objetos TBrowse provisionam uma sofisticada arquitetura para aquisitar, formatar e exibir dados. A manipulação é executada via Code Blocks (Blocos de Código) fornecidos pelo usuário, permitindo um alto grau de flexibilidade e interação entre o mecanismo de navegação e o banco de dados. 

Um objeto TBrowse consiste em um ou mais objetos TBColum. Um objeto TBColumn contém a informação necessária para definir uma simples coluna de navegação dos registros do arquivo.

Vocabulário:

Classe = Função que trabalha com programação orientada a objeto.

Objeto = É um "painel de controle" de uma classe. É também um tipo de dado. Ex.: tipo numérico, caracter, data, lógico etc.

Code Block = É um tipo especial de dado que se refere a um pedaço de código de programa compilado (informação) que é executado quando é avaliado (geralmente com uma função Eval() ou variações desta). 

Array = Uma matriz ou um vetor de informações.

Matriz = Informações organizadas em linhas e colunas.

Vetor = Matriz de uma só coluna.

 

Veja abaixo o programa comentado!

Observe os comentários para explicações rápidas.

Passe o mouse nos links (em vermelho) para ver explicações detalhadas.


***********************

* Exemplo completo de como usar a função NAVEGAR em seus programas

***********************

// INCLUI ARQUIVOS DE CABECALHO DO CLIPPER
#INCLUDE "INKEY.CH"
#INCLUDE "VISUAL2.CH"

PRIVATE aEY
lRED := .F. // DEFINICAO lRED EXIGIDA PELA FUNCAO VAL_PC()

aENV := SAVENV()
SETCOLOR("W/B")
@ 02,00 CLEA TO 22,79
pATUAL := PRG()

DBFCOMUM()

IF !FILE(pDIR+"PLANO.DBF")
   MSGBOX1("Defina, depois, um Plano de Contas!", "Plano de Contas Inexistente")
ENDIF

IF FILE(pDIR+"PLANO.DBF")
   USE (pDIR+"PLANO") ALIAS PC SHARED NEW
   SET INDEX TO (pDIR+"PLANO") //PCCOD,PCNOME
ENDIF

USE AZIENDE ALIAS AZ SHARED NEW
SET INDEX TO AZIENDE

aTITULOS := {"Código", "Nome Fantasia", "Razão Social"}
aCAMPOS := {"AZ->CODIGO", "AZ->FANTASIA", "AZ->RSOCIAL" } // DICA: Clique aqui!
aMASCARAS := { , "@!" ,"@!" }
abROTINA := { {|oTBR,aDADOS,nINDEX,nLKEY| AZ->(ALTERAR(oTBR,aDADOS,nINDEX,nLKEY)) },;
              {|oTBR,aDADOS,nINDEX,nLKEY| AZ->(ALTERAR(oTBR,aDADOS,nINDEX,nLKEY)) },;
              {|oTBR| AZ->(EXCLUIR(oTBR)) } }

NAVEGAR( 03, 03, 20, 75, "Manutenção do Arquivo de Azienda's", , ,;
         aTITULOS, aCAMPOS, aMASCARAS,;
         abROTINA)

Rstenv( aEnv )
** AZ->( DBCLOSEAREA() )
** PC->( DBCLOSEAREA() )

RETURN

FUNCTION EXCLUIR(oTBR)
IF !AC->EXCLUIR
   MSGBOX1("Negado", "PermissÆo de ExclusÆo")
 ELSE
   IF (MSGBOX2("CONFIRMA EXCLUSÇO DO REGISTRO")) = 1
      AZ->( LOCKREG())
      AZ->( DBDELETE())
      AZ->( DBUNLOCK())
   ENDIF
ENDIF
RETURN

FUNCTION ALTERAR(oTBR, aDADOS, nINDEX, nLKEY)
aIUS := SAVENV()
nDBF := SELECT()
SETCURSOR(1)

*SET DELIMI ON

IF nLKEY = 13 // ENTER - ALTERAR
   IF !AC->ALTERAR
      MSGBOX1("Negado", "PermissÆo de Altera‡Æo")
      RETURN
   ENDIF

   AZ->( LOCKREG())
   AZ->SIGN++
   AZ->( DBUNLOCK())
   AZ->( DBCOMMIT())
   nSIGN := AZ->SIGN
   cCO := AZ->CODIGO // ALTERAR -> CODIGO EXISTENTE
  ELSE
   IF !AC->INSERIR
      MSGBOX1("Negado", "PermissÆo de InclusÆo")
      RETURN
   ENDIF

   cCO := "Novo"
   AZ->( DBGOTO( LASTREC()+1 )) // CAMPOS DO ARQUIVO VAZIOS NO PONTEIRO ATUAL
ENDIF

cFA := AZ->FANTASIA
cRS := AZ->RSOCIAL
cIR := AZ->IRPJ
cIE := AZ->IESTADUAL
cIM := AZ->IMUNICIPAL
cNIRC := AZ->NIRC
cEN := AZ->ENDERECO
cBA := AZ->BAIRRO
cCI := AZ->CIDADE
cUF := AZ->UF
cCE := AZ->CEP
cME := AZ->MES
nAN := AZ->ANO
cMA := AZ->MASCARA_PC
cCR := AZ->C_RECEITAS
* cDR := AZ->C_DRECEITA
cCD := AZ->C_DESPESAS
cRE := AZ->RESULTADO
cNULL1 := "---"
cNULL2 := "---"
cNULL3 := "---"

IF EMPTY(cME)
   cME := STRZERO( MONTH( DATE()), 2)
ENDIF
IF EMPTY(nAN)
   nAN := YEAR( DATE() )
ENDIF

cT := "Cadastro"
IF nLKEY = 13
   cT := "Edição de Registro"
ENDIF
WIN(05,05,19,71, cT+" de Azienda", "B+*/GR+", "GR+/B")
SETCOLOR("W+/B,W/N,,,W+/B")

@ 23,00 SAY SPACE(80) COLOR "N*/W"
cMSG := "[Esc]Aborta "+CHR(10)+"Salva"
@ 23,(80-LEN(cMSG))/2 SAY cMSG COLOR "R*/W"

nAN_OLD := nAN
@ 06,07 SAY "Código: " + cCO COLOR "W/B"

aDESC := {}
aADD(aDESC, "Nome Fantasia.......:") ; @ MAXROW()+1,MAXCOL()+1 GET cFA PICT "@!"
aADD(aDESC, "Razão Social........:") ; @ MAXROW()+1,MAXCOL()+1 GET cRS PICT "@!"
aADD(aDESC, "C.N.P.J.............:") ; @ MAXROW()+1,MAXCOL()+1 GET cIR PICT "@R 99.999.999/9999-99"
aADD(aDESC, "Insc. Estadual......:") ; @ MAXROW()+1,MAXCOL()+1 GET cIE PICT "@R 999.99999-9"
aADD(aDESC, "Insc. Municipal.....:") ; @ MAXROW()+1,MAXCOL()+1 GET cIM PICT "@R 99.999.999-9"
aADD(aDESC, "Rg. Junta NIRC......:") ; @ MAXROW()+1,MAXCOL()+1 GET cNIRC PICT "@R 999,999999,9"
aADD(aDESC, "---LOCALIZAÇÃO") ; @ MAXROW()+1,MAXCOL()+1 GET cNULL1
aADD(aDESC, "Endereço............:") ; @ MAXROW()+1,MAXCOL()+1 GET cEN PICT "@!"
aADD(aDESC, "Bairro..............:") ; @ MAXROW()+1,MAXCOL()+1 GET cBA PICT "@!"
aADD(aDESC, "Cidade..............:") ; @ MAXROW()+1,MAXCOL()+1 GET cCI PICT "@!"
aADD(aDESC, "UF..................:") ; @ MAXROW()+1,MAXCOL()+1 GET cUF PICT "@!"
aADD(aDESC, "CEP.................:") ; @ MAXROW()+1,MAXCOL()+1 GET cCE PICT "@R 99999-999"

IF FILE(pDIR+"PLANO.DBF")
   aADD(aDESC, "---EXERCÍCIO SOCIAL") 

   @ MAXROW()+1,MAXCOL()+1 GET cNULL2
   aADD(aDESC, "Ano de Trabalho.....:") 

   @ MAXROW()+1,MAXCOL()+1 GET nAN PICT "9999" WHEN MPC("Digite o ano do Exercício Social da empresa que deseja trabalhar",1) VALID MPC("",2)
   aADD(aDESC, "Mês de Trabalho.....:") 

   @ MAXROW()+1,MAXCOL()+1 GET cME PICT "99" VALID {|oGET| VALMES(oGET)}
   aADD(aDESC, "ÄÄÄPLANO DE CONTAS") 

   @ MAXROW()+1,MAXCOL()+1 GET cNULL3
   aADD(aDESC, "M sc. Pl. de Contas.:") 

   @ MAXROW()+1,MAXCOL()+1 GET cMA WHEN MPC("Digite ® 9's e pontos ¯ para definir a m scara da Conta do Plano de Contas",1) VALID MPC("",2)
   aADD(aDESC, "Grupo de Receitas...:") 

   @ MAXROW()+1,MAXCOL()+1 GET cCR PICTURE "@R "+cMA VALID {|oGET| VAL_PC(oGET,.T.,,.T.) }
   aADD(aDESC, "Grupo de Despesas...:") 

   @ MAXROW()+1,MAXCOL()+1 GET cCD PICTURE "@R "+cMA VALID {|oGET| VAL_PC(oGET,.T.,,.T.) }
   aADD(aDESC, "C. Result. Exerc¡cio:") 

   @ MAXROW()+1,MAXCOL()+1 GET cRE PICTURE "@R "+cMA VALID {|oGET| VAL_PC(oGET,.T.,,.T.) }
ENDIF

AZ->( LOCKREG())
AZ->SIGN++
AZ->( DBUNLOCK())
AZ->( DBCOMMIT())
nSIGN := AZ->SIGN

IF !AC->ALTERAR
   MSGBOX1("Qualquer Altera‡Æo nestes dados ser  perdida", "Permissão de Alteração Negada")
ENDIF
lGRAVA := SGETMANY(GETLIST, aDESC, 06,07,19,70 )

IF nSIGN # AZ->SIGN
   nUSER := US->( RECNO())
   US->( DBSEEK( AZ->LAST_USER ))
   MSGBOX1(ALLTRIM(US->USUARIO)+" atualizou os dados que vocˆ editava. Teus dados serÆo perdidos!")
   US->( DBGOTO(nUSER))
   RSTENV(aENV)
   ** AZ->( DBCLOSEAREA())
   RETURN
ENDIF


*SET DELIMI OFF
IF LASTKEY()=27
   SELECT (nDBF)
   VLMouseOff()
   oTBR:FORCESTABLE() // ATUALIZA TBROWSE
   VLMouseOn()
   RSTENV(aIUS)
   RETURN
ENDIF

* GRAVA NOVO VALOR NO ARQUIVO
* CASO TENHA PERMISSAO
IF lGRAVA .AND. AC->ALTERAR
   IF nLKEY = 13 // ALTERAR
      IF nAN_OLD # nAN
         * ALTERA EXERCICIO SOCIAL
         aEE := SAVENV()
         MSGRODA("Vocˆ estar  alterando o Exerc¡cio Social cont bil corrente desta azienda")
         nCNF := MSGBOX2("Confirma altera‡Æo de Exerc¡cio Social de ®"+;
         STR(nAN_OLD, 4)+"¯ para ®"+ STR(nAN, 4)+"¯ ?")

         IF nCNF = 1 // SIM
            cDIR1 := "BASE\"+"AZI"+cCO+"\ANO"+ALLTRIM( STR(nAN, 4))
            IF !DIREXIST(cDIR1)
               MSGBOX1("Exerc¡cio Social de ®"+STR(nAN, 4)+"¯, desta azienda, nÆo existe")
            ELSE
               AZ->( LOCKREG())
               AZ->ANO := nAN
               AZ->( DBUNLOCK())
               AZ->( DBCOMMIT())
            ENDIF
         ENDIF
         RSTENV(aEE)
      ENDIF

      IF nSIGN # AZ->SIGN
         nUSER := US->( RECNO())
         US->( DBSEEK( AZ->LAST_USER ))
         MSGBOX1(ALLTRIM(US->USUARIO)+" atualizou os dados que vocˆ editava. Teus dados serÆo perdidos!")
         US->( DBGOTO(nUSER))
         RSTENV(aIUS)
         ** AZ->( DBCLOSEAREA())
         RETURN
      ENDIF
   ENDIF

   IF nLKEY = 22 // LASTKEY = INSERT
      AZ->( INSERE())
      cCO := STRZERO( NOVOCOD("AZIENDE.DAT"), 4 ) // INSERT -> NOVO CODIGO
      *** CRIA DIRETORIO DE TRABALHO
      IF !DIREXIST("BASE")
         nERRO := DIRCREATE("BASE")
      ENDIF
      cDIR := "AZI"+cCO
      cDIR1 := cDIR+"\ANO"+STR(nAN, 4)
      cDIR3 := cDIR1+"\PENDENC"
      IF !DIREXIST("BASE\"+cDIR)
         nERRO := DIRCREATE( "BASE\"+cDIR ) // CRIA DIRETORIO P/ AZIENDA
      ENDIF
      nERRO := DIRCREATE( "BASE\"+cDIR1 ) // CRIA DIRETORIO P/ ANO/EXERCICIO SOCIAL

      AZ->( LOCKREG())
      AZ->ANO := nAN
      AZ->( DBUNLOCK())
      AZ->( DBCOMMIT())

   ENDIF

   AZ->(LOCKREG())
   AZ->CODIGO := cCO
   AZ->FANTASIA := cFA
   AZ->RSOCIAL := cRS
   AZ->IRPJ := cIR
   AZ->IESTADUAL := cIE
   AZ->IMUNICIPAL := cIM
   AZ->NIRC := cNIRC
   AZ->ENDERECO := cEN
   AZ->BAIRRO := cBA
   AZ->CIDADE := cCI
   AZ->UF := cUF
   AZ->CEP := cCE
   AZ->MES := cME
   AZ->MASCARA_PC := cMA
   AZ->C_RECEITAS := cCR
   * AZ->C_DRECEITA := cDR
   AZ->C_DESPESAS := cCD
   AZ->RESULTADO := cRE
   AZ->SIGN := 0
   AZ->(DBUNLOCK())
   AZ->(DBCOMMIT())
   lUPDATE := .T.

   XCIDADE := AZ->CIDADE
   XUF := AZ->UF

   VLMouseOff()
   oTBR:REFRESHCURRENT() // NOTIFICA INFORMACAO A ATUALIZAR
   oTBR:FORCESTABLE() // ATUALIZA TBROWSE
   VLMouseOn()

ENDIF

SELECT (nDBF)
RSTENV(aIUS)
RETURN


FUNCTION VALMES(oGET)
cB := oGET:BUFFER
oGET:VARPUT( STRZERO(VAL(cB), 2) )
IF VAL(cB) >= 1 .AND. VAL(cB) <= 12
   RETURN (.T.)
ELSE
   RETURN (.F.)
ENDIF

FUNCTION MPC(cMSG, nWV)
IF nWV=1 // WHEN
   aEY := SAVENV()
   MSGRODA(cMSG)
ELSE // VALID
   RSTENV(aEY)
ENDIF
RETURN (.T.)


 

**********************************************

* PROGRAMA....: NAVEGAR.PRG 
* FUNÇÃO......: FACILITAR MANUTENÇÃO DBFs 
* PROGRAMADOR : ANDERSON CARDOSO SILVA 
**********************************************

 

#INCLUDE "DEFAULT.CH"

FUNCTION NAVEGAR(nL1,nC1,nL2,nC2 , cTITULO, cCOR1, cCOR2,;
                 aTITULOS, aCAMPOS_, aMASCARAS,;
                 abROTINA_)

// INCLUI ARQUIVOS DE CABECALHO DO CLIPPER
#INCLUDE "INKEY.CH"
#INCLUDE "VISUAL2.CH"


PRIVATE cPSQ := "", YPOS, aJANELA
PRIVATE abROTINA := abROTINA_, aCAMPOS := aCAMPOS_

aJANELA := {nL1, nC1, nL2, nC2}

sAMB := SAVENV()
IF EMPTY(cCOR1)
   cCOR1 := "B*/W"
ENDIF
IF EMPTY(cCOR2)
   cCOR2 := "W+/W"
ENDIF

*** FERRAMENTAS DE MULTI-PESQUISA AUTOMATICA
aCHAVES := {}
nORD := INDEXORD()
nCNT := 1
nMAXLEN := 0
DO WHILE .T.
   IF !EMPTY( INDEXKEY(nCNT) )
      aADD(aCHAVES, " "+INDEXKEY(nCNT)+" ")
      nCNT++
   ELSE
      EXIT
   ENDIF
ENDDO
aEVAL(aCHAVES, {|cV,nV| IF( LEN( aCHAVES[nV] ) > nMAXLEN,;
nMAXLEN := LEN( aCHAVES[nV] ), NIL ) })
DBSETORDER(nORD)

// MONTA TELA NAVEGACAO
WIN(nL1,nC1,nL2,nC2, cTITULO, cCOR1, cCOR2)
SETCOLOR(cCOR2+","+cCOR1)
cFDCOR1 := "N/"+SUBSTR(cCOR2, (AT("/",cCOR2))+1)
cFDCOR2 := SUBSTR(cCOR2, (AT("/",cCOR2))+1) + "+/" + SUBSTR(cCOR2, (AT("/",cCOR2))+1)
DESKBOXCOR(nL1+1,nC1+2,nL2-4,nC2-2, cFDCOR1, cFDCOR2)
FRAMECOR(nL2-3,nC1+1,nL2-1,nC2-1, "Busca R pida", 3, cFDCOR1, cFDCOR2)

@ 23, 00 SAY PADL( "[Esc] Sa¡da ", 80 ) COLOR "R*/W" // sair pelo mouse
@ 23, 24 SAY "[" + CHR( 27 ) + "]" COLOR "R*/W" // Esq. pelo mouse
@ 23, 28 SAY "[" + CHR( 26 ) + "]" COLOR "R*/W" // Dir. pelo mouse
@ 23, 35 SAY CHR(4) COLOR "R+*/W"
@ 23, 36 SAY "Ordem" COLOR "R*/W"
@ 23, 43 SAY CHR(5) COLOR "R+*/W"
@ 23, 44 SAY "Congela/Desc." COLOR "R*/W"

*** CRIA OBJETO TBROWSE
IF !EMPTY( INDEXKEY() )
   oTBRX := TBrowseDB( nL1+2,nC1+3,nL2-5,nC2-4 )
ELSE
   oTBRX := TBrowseDB( nL1+2,nC1+3,nL2-2,nC2-4 )
ENDIF
 

*** MONTA COLUNAS DE CAMPOS NUM TAPA CONFORME ARRAYs
aEVAL(aCAMPOS,;
     {|cVAL,nIND| oTBRX:addcolumn(;
     tbcolumnNew( aTITULOS[nIND], &( "{||"+aCAMPOS[nIND]+"}" );
     ) );
     })
 

oTBRX:COLSEP := " | "

*** ATRIBUI MASCARAS AS COLUNAS TBROWSE
FOR T=1 TO oTBRX:COLCOUNT
    oTCOL := "oTCOL" + ALLTRIM(STR(T))
    &oTCOL. := oTBRX:GETCOLUMN(T)
    &oTCOL.:PICTURE := aMASCARAS[T]
NEXT

* ATRIBUI FERRAMENTAS POSICIONADORAS DA BARRA DE ROLAGEM
nELEMENT := 1
oTBRX:SKIPBLOCK := {|n| SKIPTB(n, @nElement, oTBRX) }
oTBRX:gobottomblock := {|| nElement := LASTREC() }
oTBRX:gotopblock := {|| nElement := 1 }

// NAVEGACAO E CONTROLE DA TABELA
lExt := .F.
DO WHILE !lExt
   IF !oTBRX:STABLE
      *** ATUALIZACAO DO TBROWSE
      VLMouseOff()
      oTBRX:FORCESTABLE()
      VLMouseOn()
   ENDIF
   ROLAGEM(nL1+2, nC1+4, nL2-5, nC2-1, oTBRX:COLPOS, nELEMENT, LASTREC(), .T.)

   *** FERRAMENTAS DA PESQUISA RAPIDA
   vFIELD := &(INDEXKEY())
   IF ALLTRIM(vFIELD) # ALLTRIM(cPSQ)
      cPSQ := ""
      @ nL2-2,nC1+3 SAY SPACE( LEN(vFIELD)+1 )
   ENDIF

   aWSt := WaitState() // substitui o INKEY(), função da Visual Lib

   DO CASE
      CASE aWSt:wsType == WAIT_KEYPRESS // o evento foi uma tecla
           DO CASE // manipulacao padrao de teclas
              CASE aWst:wsKey == K_DOWN ;       oTBRX:down()
              CASE aWst:wsKey == K_UP ;         oTBRX:up()
              CASE aWst:wsKey == K_PGDN ;       oTBRX:pageDown()
              CASE aWst:wsKey == K_PGUP ;       oTBRX:pageUp()
              CASE aWst:wsKey == K_CTRL_PGUP ;  oTBRX:goTop()
              CASE aWst:wsKey == K_CTRL_PGDN ;  oTBRX:goBottom()
              CASE aWst:wsKey == K_RIGHT ;      oTBRX:right()
              CASE aWst:wsKey == K_LEFT ;       oTBRX:left()
              CASE aWst:wsKey == K_HOME ;       oTBRX:home()
              CASE aWst:wsKey == K_END ;        oTBRX:end()
              CASE aWst:wsKey == K_CTRL_LEFT ;  oTBRX:panLeft()
              CASE aWst:wsKey == K_CTRL_RIGHT ; oTBRX:panRight()
              CASE aWst:wsKey == K_CTRL_HOME ;  oTBRX:panHome()
              CASE aWst:wsKey == K_CTRL_END ;   oTBRX:panEnd()
 

              CASE aWst:wsKey == K_F5
                   IF oTBRX:FREEZE = 0
                      nCOL := oTBRX:COLPOS   // As colunas à esquerda desta serão congeladas
                      oTBRX:COLPOS ++        // Muda a coluna atual para a próxima coluna, que receberá o foco
                      oTBRX:REFRESHCURRENT() // Atualiza mudança do foco na tela
                      VLMouseOff()
                      oTBRX:FORCESTABLE()
                      VLMouseOn()
 
                      *** CONGELA COLUNAS A ESQUERDA ***
                      aRect := {1, nCOL, oTBRX:RowCount, nCOL}
                      oTBRX:ColorRect( aRect, {2, 1} )
                      oTBRX:FREEZE := nCOL // Congela as <nCOL> colunas à esquerda  
                    ELSE
                      *** DESCONGELA COLUNAS ***
                      oTBRX:FREEZE := 0  // Número de colunas congeladas = zero .::. Descongela todas as colunas
                      oTBRX:PANHOME()    // Posiciona o cursor na primeira coluna do Tbrowse
                      oTBRX:REFRESHALL()
                    ENDIF
              CASE aWst:wsKey == K_F4
                   *** MUDAR ORDEM DE PESQUISA ***
                   aEEE := SAVENV()
                   nCHAVES := LEN(aCHAVES)
                   IF nCHAVES <= 1
                      MSGBOX1("Nao ha outras chaves/ordens de pesquisa para este arquivo")
                   ELSE
                      WIN(10,45,10+nCHAVES+1,45+nMAXLEN+2, "Ordens", "W+/G","G*/W")
                      SETCOLOR("G*/W,GR+/R")
                      nOLD := INDEXORD()
                      nORDEM := aCHOICE(11,46,10+nCHAVES,45+nMAXLEN, aCHAVES,,, INDEXORD())
                      IF nORDEM > 0 .AND. nOLD # nORDEM
                         DBSETORDER(nORDEM)
                         ROLAGEM(nL1+2, nC1+4, nL2-5, nC2-1, oTBRX:COLPOS, oTBRX:ROWPOS, LASTREC(), .F.)
                      ENDIF
                   ENDIF
                    RSTENV(aEEE)
                    oTBRX:REFRESHALL()
              CASE aWst:wsKey == K_ESC ; lExt := .T.
              CASE aWst:wsKey == 237 ; lExt := .T. // í
              CASE aWst:wsKey == K_INS // TECLA INSERT
                   IF !EMPTY(abROTINA)
                      IF abROTINA[1] # NIL
                         EVAL(abROTINA[1], oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                      ELSE
                         INSERIR(oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                      ENDIF
                   ENDIF
                   IF EMPTY(abROTINA)
                      // PORQUE PODE HAVER abROTINA, MAS NAO abROTINA[1]
                      INSERIR(oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                   ENDIF
                   oTBRX:CONFIGURE()
               CASE aWst:wsKey == K_ENTER // ALTERA VALOR
                    MEMO := .F.
                    vCAMPO_N := ALIAS() +"->"+ aCAMPOS[ oTBRX:COLPOS ]
                    IF VALTYPE( &vCAMPO_N ) = "M"
                       * CAMPO DO TIPO MEMO
                       MEMO := .T.
                    ENDIF

                    IF !EMPTY(abROTINA)
                       IF MEMO
                          * EDITA CAMPO MEMO
                          IF LEN(abROTINA) >= 4
                             IF abROTINA[4] # NIL
                                // CHAMA FUNCAO DEFINIDA PELO PROGRAMADOR
                                EVAL(abROTINA[4], oTBRX, aCAMPOS, aTITULOS, oTBRX:COLPOS, aWst:wsKey)
                             ENDIF
                          ELSE
                             // CHAMA FUNCAO PADRAO
                             EDITARMEMO( oTBRX, aCAMPOS, aTITULOS, oTBRX:COLPOS, aWst:wsKey )
                          ENDIF
                       ELSE
                          * EDITA CAMPO NORMAL
                          IF LEN(abROTINA) >= 2
                             IF abROTINA[2] # NIL
                                // CHAMA FUNCAO DEFINIDA PELO PROGRAMADOR
                                EVAL(abROTINA[2], oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                             ENDIF
                          ELSE
                             // CHAMA FUNCAO PADRAO
                             EDITAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
                          ENDIF
                       ENDIF
                    ELSE
                       * abROTINA NAO EXISTE/DEFINIDA PELO USUÁRIO
                       IF MEMO
                          // CHAMA FUNCAO PADRAO - MEMO
                          EDITARMEMO( oTBRX, aCAMPOS, aTITULOS, oTBRX:COLPOS, aWst:wsKey )
                       ELSE
                          // CHAMA FUNCAO PADRAO - NORMAL
                          EDITAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
                       ENDIF
                    ENDIF
                    oTBRX:REFRESHCURRENT()
               CASE aWst:wsKey == K_DEL
                    IF !EMPTY(abROTINA)
                       IF LEN(abROTINA) >= 3
                          IF abROTINA[3] # NIL
                             EVAL(abROTINA[3], oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                          ENDIF
                       ELSE
                          // CHAMA FUNCAO PADRAO
                          APAGAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
                       ENDIF
                    ELSE
                       // CHAMA FUNCAO PADRAO
                       APAGAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
                    ENDIF

                    oTBRX:CONFIGURE()
                    oTBRX:REFRESHALL()

               OTHERWISE
                    *** PESQUISA RAPIDA ***
                    IF aWst:wsKey = 8 // TECLOU BS (BACK SPACE / <- )
                       cPSQ := LEFT(cPSQ, LEN(cPSQ)-1)
                       DBSEEK( cPSQ )
                    ENDIF
                    // BUSCAR
                    IF (aWst:wsKey >= 46 .AND. aWst:wsKey <= 57) .OR.;
                       (aWst:wsKey >= 65 .AND. aWst:wsKey <= 122)
                       IF LEN(cPSQ) < LEN(vFIELD)
                          cPSQ += CHR(aWst:wsKey)
                       ENDIF
                    ENDIF
                    DBSEEK( cPSQ )
                    oTBRX:REFRESHALL()
                    vFIELD := &(INDEXKEY())
                    IF ALLTRIM(vFIELD) # cPSQ
                       cPSQ := ""
                    ENDIF
                    @ nL2-2,nC1+3 SAY SPACE( LEN(vFIELD)+1 )
                    @ nL2-2,nC1+3 SAY cPSQ
               ENDCASE

               // abaixo - evento MOUSEDOWN - o usu rio clicou com o mouse

               CASE aWst:wsType == WAIT_MOUSEDOWN
                    DO CASE
                       CASE aWst:wsCol >= 68 .AND. aWst:wsCol <= 78 .AND. aWST:WSROW = 23 // clicou em "[Esc] Sa¡da"
                            lExt := .T.
                       CASE aWst:wsCol = (nC2-1) .AND. aWst:wsROW = (nL1+2) // clicou em "Sobe"
                            oTBRX:up()
                       CASE aWst:wsCol = (nC2-1) .AND. aWst:wsROW = (nL2-5) // clicou em "Desce"
                            oTBRX:down()
                       CASE aWst:wsCol = (nC2-1) .AND.;
                            ( aWst:wsROW < YPOS .AND. aWst:wsROW > (nL1+2) ) // clicou em "[PgUp]"
                            oTBRX:pageUp()
                       CASE aWst:wsCol = (nC2-1) .AND.;
                            ( aWst:wsROW > YPOS .AND. aWST:WSROW < (nL2-5) ) // clicou em "[PgDn]"
                            oTBRX:pageDown()
                       CASE aWst:wsCol >= 24 .AND. aWst:wsCol <= 26 // clicou em "Esquerda"
                            oTBRX:left()
                       CASE aWst:wsCol >= 28 .AND. aWst:wsCol <= 30 // clicou em "Direita"
                            oTBRX:right()
                       CASE aWSt:wsRow >= nL1+2 .AND. aWSt:wsRow <= nL2-5 .AND.;
                            aWSt:wsCol >= nC1+3 .AND. aWSt:wsCol <= nC2-3
                            // c¢digo para habilitar cliques nas c‚lulas do tbrowse
                            nLin := aWSt:wsRow
                            nCol := aWSt:wsCol
                            nTbrLin := oTBRX:rowPos
                            nTbrCol := oTBRX:colPos
                            oTBRX:deHilite()
                            oTBRX:rowPos := nTbrLin + nLin - ROW() // Acerta linha

                            VLMouseOff()
                            FOR nInd = oTBRX:rightVisible TO oTBRX:leftVisible STEP -1
                                oTBRX:colPos := nInd
                                oTBRX:Hilite()
                                IF COL() - 1 <= nCol
                                   oTBRX:Hilite()
                                   EXIT
                                ENDIF
                            NEXT
                            IF nTbrLin == oTBRX:rowPos .AND. nTbrCol == oTBRX:colPos // clicou 2X na mesma c‚lula
                               // CLIQUE DUPLO
                               VLMouseOn()
                               IF !EMPTY(abROTINA)
                                  IF abROTINA[2] # NIL
                                     EVAL(abROTINA[2], oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
                                  ENDIF
                               ENDIF
                               IF LASTKEY()=27
                                  // CASO A FUNCAO CHAMADA RETORNE A TECLA Esc
                                  // PARA FORCAR UMA SAIDA
                                  lEXT := .T.
                               ENDIF
                               oTBRX:REFRESHCURRENT()
                               VLMouseOff()
                            ENDIF
                            oTBRX:refreshCurrent()
                            VLMouseOn()
                    ENDCASE
   ENDCASE
ENDDO

RSTENV(sAMB)
RETURN

******************************************************
******************************************************

FUNCTION ROLAGEM(nY1,nX1, nY2, nX2, nXPOS, nYPOS, nALL, lROW)
IF nALL > (nY2-nY1) // VERIFICA NECESSIDADE DA BARRA DE ROLAGEM VERTICAL
   nROW := ROW()
   nCOL := COL()
   DISPBEGIN()
       @ nY1+1,nX2, nY2-1,nX2 BOX " " COLOR "W*/N"
       @ nY1,nX2 SAY CHR(30) COLOR "N*/W"
       @ nY2,nX2 SAY CHR(31) COLOR "N*/W"
       nH := (nY2-1) - (nY1+1)
       nYY := ROUND( (nYPOS*nH)/nALL, 0)
       IF nYPOS-1 <= 0 .OR. BOF()
          nYY := 0
       ENDIF
       @ (nY1+1)+nYY,nX2 SAY "²" COLOR "N+*/W"
   DISPEND()
   YPOS := (nY1+1)+nYY
   SETPOS(nROW, nCOL)
ENDIF
RETURN

FUNCTION EDITAR(oTBR, aDADOS, nINDEX, nLKEY)
sC := SETCURSOR()
nROW := ROW()
nCOL := COL()
vNOME := ALIAS() + "->" + aDADOS[nINDEX] // SE NAO "->", MEMORIA, MAS NAO ARQUIVO
vVALOR := EVAL ( { || &vNOME } )
SETCURSOR(1)
@ nROW,nCOL GET vVALOR COLOR "W/N, W/N"
VLREAD
SETCURSOR(sC)
LOCKREG()
&vNOME. := vVALOR
DBUNLOCK()
DBCOMMIT()
RETURN

*
*
*

FUNCTION INSERIR(oTBR, aDADOS, nINDEX, nLKEY)
// MOVE ULTIMA LINHA
oTBR:ROWPOS := oTBR:nBOTTOM
oTBR:REFRESHCURRENT() // SOLICITA ATUALIZACAO TBROWSE
oTBR:FORCESTABLE() // ATUALIZA TBROWSE

oTBR:REFRESHCURRENT() // SOLICITA ATUALIZACAO TBROWSE
oTBR:FORCESTABLE() // ATUALIZA TBROWSE
oTBR:COLPOS := 1 // POSICIONA NO PRIMEIRO CAMPO - A DATA
oTBR:CONFIGURE() // SOLICITA ATUALIZACAO TBROWSE
oTBR:REFRESHCURRENT() // SOLICITA ATUALIZACAO TBROWSE
oTBR:FORCESTABLE() // ATUALIZA TBROWSE

// INSERE REGISTRO EM BRANCO
INSERE()

FOR T=1 TO LEN(aDADOS)
    oTBR:COLPOS := T
    oTBR:REFRESHCURRENT() // SOLICITA ATUALIZACAO TBROWSE
    oTBR:FORCESTABLE() // ATUALIZA TBROWSE
    IF !EMPTY(abROTINA)
       vCAMPO_N := ALIAS() +"->"+ aCAMPOS[ oTBRX:COLPOS ]
       IF VALTYPE( &vCAMPO_N ) = "M"
          * CAMPO DO TIPO MEMO
          IF LEN(abROTINA) >= 4
             IF abROTINA[4] # NIL
                // CHAMA FUNCAO DEFINIDA PELO PROGRAMADOR
                EVAL(abROTINA[4], oTBRX, aCAMPOS, aTITULOS, oTBRX:COLPOS, aWst:wsKey)
             ENDIF
          ELSE
             // CHAMA FUNCAO PADRAO
             EDITARMEMO( oTBRX, aCAMPOS, aTITULOS, oTBRX:COLPOS, aWst:wsKey )
          ENDIF
       ELSE
          IF LEN(abROTINA) >= 2
             IF abROTINA[2] # NIL
                // CHAMA FUNCAO DEFINIDA PELO PROGRAMADOR
                EVAL(abROTINA[2], oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey)
             ENDIF
          ELSE
             // CHAMA FUNCAO PADRAO
             EDITAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
          ENDIF
       ENDIF
    ELSE
       // CHAMA FUNCAO PADRAO
       EDITAR( oTBRX, aCAMPOS, oTBRX:COLPOS, aWst:wsKey )
    ENDIF
    oTBRX:REFRESHCURRENT()

    IF LASTKEY() = 27
       // PRESSIONOU [ESC]
       EXIT
    ENDIF
NEXT
RETURN

*
*
*

FUNCTION APAGAR(oTBR, aDADOS, nINDEX, nLKEY)
IF MSGBOX2("Remover este registro do arquivo?") = 1
   LOCKREG()
   DBDELETE()
   DBUNLOCK()
   DBCOMMIT()
ENDIF
DBSKIP()
RETURN

*
*
*

FUNCTION EDITARMEMO( oTBRX, aCAMPOS, aTITULOS, nINDEX, nLKEY )
SAVE SCREEN TO tMEMO

@ aJANELA[1]+1, aJANELA[2]+1 CLEA TO aJANELA[3]-1, aJANELA[4]-1

FRAME(aJANELA[1]+1, aJANELA[2]+1, aJANELA[1]+3, aJANELA[4]-1, aTITULOS[1])
xNOME := aCAMPOS[1]
@ aJANELA[1]+2, aJANELA[2]+2 SAY &xNOME

FRAME(aJANELA[1]+4, aJANELA[2]+1, aJANELA[3]-1, aJANELA[4]-1, aTITULOS[ nINDEX ])
vCAMPO_N := ALIAS() +"->"+ aCAMPOS[ nINDEX ]
lCURSOR := SETCURSOR()
SETCURSOR(1)

mOBS := MEMOEDIT(&vCAMPO_N, aJANELA[1]+5, aJANELA[2]+2, aJANELA[3]-2, aJANELA[4]-2, .T.)

SETCURSOR(lCURSOR)

// GRAVA CAMPO MEMO NO DBF
LOCKREG()
&vCAMPO_N. := mOBS
DBUNLOCK()
DBCOMMIT()
RESTORE SCREEN FROM tMEMO
RETURN

 

*

*

*

 

FUNCTION SkipTB( nSKIPS, nPOS, oTB )
LOCAL nSKIPPED := 0
DO CASE
   CASE nSKIPS == 0
        DBSKIP(0)
   CASE nSKIPS > 0
        DO WHILE nSKIPPED < nSKIPS .AND. !EOF()
           SKIP
           nPOS++
           nSKIPPED++
        ENDDO
   CASE nSKIPS < 0
        DO WHILE nSKIPPED > nSKIPS .AND. !BOF()
           SKIP -1
           nPOS--
           nSKIPPED--
        ENDDO
   ENDCASE
IF BOF()
   nPOS := 1
   nSKIPPED++
   oTB:REFRESHCURRENT()
ENDIF
IF EOF()
   nPOS := LASTREC()
   nSKIPPED--
   SKIP -1
   oTB:REFRESHCURRENT()
ENDIF
RETURN (nSKIPPED)

 


Gostou do trabalho?!

Esta publicação é para um mero fim didático...

Um exemplo prático para compilar e ver o resultado da função acompanha o download da mesma.

Mande seus comentários ou dúvidas restantes no formulário abaixo.

Seu Feedback é muito importante!

 

 

Nome

*

Email

*

Assunto

*Campos obrigatórios.

 

NOTA: Apresentamos nossas apologias por não informar nosso endereço de email, não queremos continuar sendo vítimas de spam. Mais de 90% de emails que recebemos estão com vírus ou propaganda indesejada. Isto nos atrapalha muito.  Apreciamos vossa compreensão!