PC Toledo

Código: Selecionar todos

METHOD setColPos( nColPos ) CLASS TBrowse

   IF ::nConfigure != 0
      ::doConfigure()
   ENDIF

   IF HB_ISNUMERIC( nColPos )
      ::nColPos := nColPos
   ELSE
      ::nColPos := 0
   ENDIF

   RETURN ::nColPos

Código: Selecionar todos

*------------------------------------------------------*
METHOD SetColPos( nColPos ) CLASS TBrowse
*------------------------------------------------------*

   default nColPos to 0

   if ::lNeverDisplayed .OR. (! ::lStable .AND. nColPos <= ::nRightVisible .AND. nColPos >= ::nLeftVisible)
      return ::nColPos := nColPos

   elseif nColPos <> 0 .AND. nColPos <> ::nColPos

      ::Moved()

      // I'm still inside columns currently shown
      if nColPos <= ::nRightVisible  .AND.;
         nColPos >= Max( ::nLeftVisible, ::nFrozenCols )

         ::nColPos := nColpos

      else
         // moving to the right
         if nColPos > ::nColPos

            if nColPos <= ::nColCount

               ::nRightVisible := nColPos
               ::nLeftVisible := ::LeftDetermine()
               ::nColPos := nColPos

            endif

         // moving to the left
         else

            if nColPos >= 1

               // Until the leftmost column has a number higher than the column I want to reach
               while ::nLeftVisible > nColPos

                  ::nRightVisible--
                  ::nLeftVisible := ::LeftDetermine()

               enddo

               ::nColPos := nColPos

            endif

         endif

         ::Invalidate()

      endif

      ::ForceStable()

   endif

Return ::nColPos

Código: Selecionar todos

FOR T=nCOL TO LEN(aDADOS)
   oTBR:COLPOS := T
   // código para preencher os GETs
NEXT

Código: Selecionar todos

/*┌───────────────────────────────────────────┐
  │ WEBSITE     : www.linguagemclipper.com.br │
  │ PROGRAMADOR : ANDERSON CARDOSO SILVA      │
  └───────────────────────────────────────────┘ */
FUNCTION MAIN()
#INCLUDE "INKEY.CH"
LOCAL aWst
LOCAL lExt

SET COLOR TO W+/N
SET SCOREBOARD OFF
SET DATE BRITISH
SET EPOCH TO 1980
SET MESSAGE TO 23
SETMODE(25,80)

*** DEFINIR IDIOMA PORTUGUÊS ***
REQUEST HB_CODEPAGE_PT850 &&& PARA INDEXAR CAMPOS ACENTUADOS
HB_SETCODEPAGE("PT850")   &&& PARA INDEXAR CAMPOS ACENTUADOS
// No Harbour deve compilar com: xhb.hbc
 
CLS
cT1 = "EXEMPLO BÁSICO DE FUNCIONAMENTO DO TBROWSE"
cT2 := "Tecle [ESC] para sair"
cT3 := "www.linguagemclipper.com.br"
@ 00,(80-LEN(cT1))/2 SAY cT1
@ 23,(80-LEN(cT2))/2 SAY cT2
@ 24,(80-LEN(cT3))/2 SAY cT3
 
// CRIACAO DBFs E NTXs.
IF !FILE("PESSOAS.DBF")
   aDBF_EM := {}
   AADD(aDBF_EM, { "NOME",       "C", 35, 0 })
   AADD(aDBF_EM, { "NASC",       "D",  8, 2 })
   AADD(aDBF_EM, { "FONE",       "C", 11, 0 })
   AADD(aDBF_EM, { "CIDADE",     "C", 15, 0 })  
   AADD(aDBF_EM, { "UF",         "C",  2, 0 })
   DBCREATE("PESSOAS", aDBF_EM)
   USE PESSOAS ALIAS PE EXCLUSIVE NEW
   INDEX ON NOME TO PESSOAS
   PE->( DBCLOSEAREA())
ELSE
	USE PESSOAS ALIAS PE EXCLUSIVE NEW
	SET INDEX TO PESSOAS
ENDIF
 
cCOLOR = SETCOLOR()
// CRIA OBJETO TBROWSE oTBRX C/ CODEBLOCKS PADRÕES
SET COLOR TO W+/B
@ 04,09 TO 20,71 DOUBLE
oTBRX := TBrowseDB(05,10,20,70)
 
// MONTA COLUNAS DOS DADOS DESEJADOS C/ O OBJETO TBCOLUMN
// ATRIBUI OS TÍTULOS E VALORES DOS CAMPOS DE CADA COLUNA
// Criamos um objeto TBColumnNew() e o inserimos no objeto TBrowse() com addcolumn()
oTBRX:addcolumn( tbcolumnNew( "NOME",     {|| PE->NOME}   ))  // COLUNA 1
oTBRX:addcolumn( tbcolumnNew( "DT. NASC", {|| PE->NASC}   ))  // COLUNA 2
oTBRX:addcolumn( tbcolumnNew( "FONE",     {|| PE->FONE}   ))  // COLUNA 3
oTBRX:addcolumn( tbcolumnNew( "CIDADE",   {|| PE->CIDADE} ))  // COLUNA 4
oTBRX:addcolumn( tbcolumnNew( "UF",       {|| PE->UF}     ))  // COLUNA 5
 
// COMO FORMATAR UMA COLUNA COM UMA MÁSCARA
oTCOL := oTBRX:GETCOLUMN(3)            // PEGA OBJETO DA COLUNA DESEJADA, A 3
oTCOL:PICTURE := "@R (99) 99999-9999"  // FORMATA A COLUNA COM A MÁSCARA 
 
oTBRX:HeadSep := CHR(205) + CHR(203) + CHR(205)    // ═╦═ SEPARADOR DE CABECALHO
oTBRX:ColSep  := " "+chr(186)+" "                  //  ║  SEPARADOR DE COLUNAS
oTBRX:FootSep := CHR(205) + CHR(202) + CHR(205)    // ═╩═ SEPARADOR DE RODAPE
 
 
// NAVEGACAO E CONTROLE DA TABELA
lExt := .F.
DO WHILE !lExt
 
      IF !oTBRX:STABLE
         *** ATUALIZACAO DO TBROWSE
         IF INDEXORD() = 0 
            // BANCO DE DADOS NÃO ESTÁ INDEXADO
            oTBRX:REFRESHCURRENT()    
         ELSE
            // BANCO DE DADOS ESTÁ INDEXADO
            oTBRX:REFRESHALL()        
         ENDIF
         DO WHILE !oTBRX:STABILIZE()
         ENDDO
      ENDIF
 
	  aWSt := INKEY(0) // ESPERA UMA TECLA
 
      DO CASE       // manipulação padrão de teclas de navegação
         CASE aWst == K_DOWN          ; oTBRX:down()
         CASE aWst == K_UP            ; oTBRX:up()
         CASE aWst == K_PGDN          ; oTBRX:pageDown()
         CASE aWst == K_PGUP          ; oTBRX:pageUp()
         CASE aWst == K_CTRL_PGUP     ; oTBRX:goTop()
         CASE aWst == K_CTRL_PGDN     ; oTBRX:goBottom()
         CASE aWst == K_RIGHT         ; oTBRX:right()
         CASE aWst == K_LEFT          ; oTBRX:left()
         CASE aWst == K_HOME          ; oTBRX:home()
         CASE aWst == K_END           ; oTBRX:end()
         CASE aWst == K_CTRL_LEFT     ; oTBRX:panLeft()
         CASE aWst == K_CTRL_RIGHT    ; oTBRX:panRight()
         CASE aWst == K_CTRL_HOME     ; oTBRX:panHome()
         CASE aWst == K_CTRL_END      ; oTBRX:panEnd()
         CASE aWst == K_ESC           ; lExt := .T. // SAIR
         CASE aWst == K_INS          
				// Teclou [Insert]
				// Rotina para inserir registros
				PE->(DBAPPEND())
				FOR T=1 TO oTBRX:colCount
					oTBRX:COLPOS := T
					oTBRX:REFRESHALL()            
					IF !oTBRX:STABLE
						DO WHILE !oTBRX:STABILIZE()
						ENDDO
					ENDIF
					xVAR := oTBRX:getColumn( oTBRX:COLPOS )
					bCB  := xVAR:BLOCK                      // CODEBLOCK da coluna TBrowse
					xVAL := EVAL( bCB )                     // RESULTADO DO CODEBLOCK
					nROW := ROW()
					nCOL := COL()
					@ ROW(),COL() GET xVAL
					READ    // READ estava mudando a posição do cursor! 
							// Provavelmente por conta de um eventual MESSAGE
					SETPOS(nROW,nCOL)  // AQUI RESOLVEU
					// OBS: AS 2 LINHAS ABAIXO FUNCIONAM PORQUE A ORDEM DOS CAMPOS NO DBF
					// É IGUAL À ORDEM DOS CAMPOS NO TBROWSE, OU SEJA, oTBRX:COLPOS = FIELDNUM().
					xFIELD   := "PE->" + FIELDNAME( oTBRX:COLPOS )					
					&xFIELD. := xVAL
				NEXT

         CASE aWst == K_ENTER        
              // Teclou [Enter]
              // Rotina para editar registros
			  		xVAR := oTBRX:getColumn( oTBRX:COLPOS ) // PEGA O OBJETO TBCOLUMN
					bCB  := xVAR:BLOCK                      // CODEBLOCK da coluna TBrowse
					xVAL := EVAL( bCB )                     // RESULTADO DO CODEBLOCK
					
					nROW := ROW()
					nCOL := COL()					
					@ ROW(),COL() GET xVAL
					READ    // READ estava mudando a posição do cursor! 
							// Provavelmente por conta de um eventual MESSAGE
					SETPOS(nROW,nCOL) // RESOLVE ASSIM
					// OBS: AS 2 LINHAS ABAIXO FUNCIONAM PORQUE A ORDEM DOS CAMPOS NO DBF
					// É IGUAL À ORDEM DOS CAMPOS NO TBROWSE, OU SEJA, oTBRX:COLPOS = FIELDNUM().
					xFIELD   := "PE->" + FIELDNAME( oTBRX:COLPOS )
					&xFIELD. := xVAL					
         CASE aWst == K_DEL          
              // Teclou [Delete]
              // Rotina para deletar registros
				PE->(DBDELETE())
				PACK
			  	oTBRX:REFRESHALL()            
				IF !oTBRX:STABLE
					DO WHILE !oTBRX:STABILIZE()
					ENDDO
				ENDIF
         OTHERWISE
              // QUALQUER OUTRA TECLA
         ENDCASE
ENDDO
SET COLOR TO
CLS
RETURN

Código: Selecionar todos

   IF Empty( GetList )
      SetPos( MaxRow() - 1, 0 )
      RETURN .F.
   ENDIF

Código: Selecionar todos

FOR T=nCOL TO LEN(aDADOS)
       oTBR:COLPOS := T
// [...]
       // NECESSÁRIO NO HARBOUR PARA ATUALIZAR O :COLPOS
       oTBR:REFRESHCURRENT() // SOLICITA ATUALIZACAO TBROWSE
       oTBR:FORCESTABLE()    // ATUALIZA TBROWSE
// [...]

Código: Selecionar todos

               nROW := ROW()
               nCOL := COL()               
               @ ROW(),COL() GET xVAL
               READ    // READ estava mudando a posição do cursor! 
                     // Provavelmente por conta de um eventual MESSAGE
               SETPOS(nROW,nCOL) // RESOLVE ASSIM