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!