| 
    | 
   
    | 
   |
   ![]()  | 
   
   ![]()  | 
   
    | 
  
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)
                
                
                xNavegar v1.0 
                 (8
                Kb)
DICNR - Aplicativo exemplo com os fontes:
                
                
                DICNR 
                 (50
                Kb)
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)
 
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!