Dois registros em uma linha no TBrowse

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

alxsts
Colaborador
Colaborador
Mensagens: 3092
Registrado em: 12 Ago 2008 15:50
Localização: São Paulo-SP-Brasil

Dois registros em uma linha no TBrowse

Mensagem por alxsts »

Olá!

Você testou isto? Funcionou?

DbSkip (1) move o ponteiro adiante. E se o usuário teclar seta para cima, page up ou control page up?
[]´s
Alexandre Santos (AlxSts)
Avatar do usuário
mauricioportela
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 29 Jul 2016 04:22
Localização: Vitoria da Conquista/Bahia

Dois registros em uma linha no TBrowse

Mensagem por mauricioportela »

Boa noite!

Sim! Veja:
Anexos
TBrowse - 2 registros em linha
TBrowse - 2 registros em linha
Avatar do usuário
mauricioportela
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 29 Jul 2016 04:22
Localização: Vitoria da Conquista/Bahia

Dois registros em uma linha no TBrowse

Mensagem por mauricioportela »

DbSkip (1) move o ponteiro adiante. E se o usuário teclar seta para cima, page up ou control page up?
faça um ajuste com os controles de teclas:

Código: Selecionar todos

// ...
            CASE nTecla == K_DOWN       ;  oTbr:down() ; dbskip(-1)
// ...
Avatar do usuário
mauricioportela
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 29 Jul 2016 04:22
Localização: Vitoria da Conquista/Bahia

Dois registros em uma linha no TBrowse

Mensagem por mauricioportela »

Pensando nisso (movimentacao pelo teclado), pode-se alterar a classe:

Código: Selecionar todos

METHOD down() CLASS TBrowse
    ::setUnstable()
    ::nMoveOffset++
RETURN Self

METHOD up() CLASS TBrowse
    ::setUnstable()
    ::nMoveOffset--
RETURN Self
Algo parecido:

Código: Selecionar todos

METHOD down2() CLASS TBrowse
    ::setUnstable()
    ::nMoveOffset += 2
RETURN Self

METHOD up2() CLASS TBrowse
    ::setUnstable()
    ::nMoveOffset -= 2
RETURN Self
Att.

Mauricio Portela
Avatar do usuário
mauricioportela
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 29 Jul 2016 04:22
Localização: Vitoria da Conquista/Bahia

Dois registros em uma linha no TBrowse

Mensagem por mauricioportela »

Boa noite!

Quanto a colocar 2 registros na mesma linha, esse codigo faz.

Porem o alxsts chamou minha atenção quando a mudanca de linha, utilizando as teclas (cima,baixo,...).

Fiz uma alteração no codigo mas, existe uma "duplicidade" do segundo registo...

Segue o codigo:

Código: Selecionar todos

// USUARIOS

#include "inkey.ch"

#define COR_BARRA_TITULO    "W+/B"
#define COR_BARRA_MENU_H    "B/W"
#define COR_TELA_FUNDO      "N/W"
#define COR_JANELA          "B/W+*"
#define COR_BOTAO           "W+/B+"
#define COR_BOTAO_ATIVO     "GR+/R"
#define COR_GET             "B+/W,GR+/R"
#define COR_GET_ATIVO       "GR+/R"

#define DEF_SEP     chr(32)  + chr(179) + chr(32)
#define DEF_HSEP    chr(196) + chr(194) + chr(196)
#define DEF_FSEP    chr(196) + chr(193) + chr(196)

FUNCTION Main()
    FIELD id, nivel, nome, login, senha
    LOCAL nTecla, lSaida, cRodaPe, aOpcoesUsuario, cTela, cCor
    LOCAL oTbr  := TBrowseDB( 04, 01, 21, 78 )
    LOCAL oTbc1 := TBColumnNew("#"   , { || id            } ), ;
          oTbc2 := TBColumnNew("Nome", { || nome          } ), ;
          oTbc3 := TBColumnNew("#"   , { || dbSkip(1), id } ), ;
          oTbc4 := TBColumnNew("Nome", { || nome          } ), ;
          oTbc5 := TBColumnNew("Nome", { || dbSkip(-1)    } )

    cTela := SAVESCREEN( 00, 00, 24, 79 )
    cCor  := SETCOLOR()
    
    Tabela()

    aOpcoesUsuario := {{"F2" , "Incluir"},;
                       {"F4" , "Editar" },;
                       {"ESC", "Sair"   }}
    Rodape( 24, 00, aOpcoesUsuario )

    janela( 03, 00, 22, 79, "Usuarios" )

    USE usuarios NEW
    INDEX ON id TO usuarios

    dbGoTop()

    oTbr:colorSpec := "B/W+*,W+/R,R/W+*,GR+/R,N+/W+*,N+/W+*"

    oTbr:addColumn( oTbc1 )
    oTbr:addColumn( oTbc2 )
    oTbr:addColumn( oTbc3 )
    oTbr:addColumn( oTbc4 )
    oTbr:addColumn( oTbc5 ) // Gambiarra

    oTbr:colSep  := DEF_SEP
    oTbr:headSep := DEF_HSEP
    oTbr:footSep := DEF_FSEP
    
    oTbc1:width  := 03
    oTbc2:width  := 30
    oTbc3:width  := 03
    oTbc4:width  := 30
    oTbc5:width  := 1

    lSaida := .F.
    WHILE !lSaida
        oTbr:refreshall()
        WHILE !oTbr:stabilize()
        ENDDO
        nTecla := INKEY(0)
        DO CASE
            CASE nTecla == K_DOWN       ;  oTbr:down()
            CASE nTecla == K_UP         ;  oTbr:up()
            CASE nTecla == K_PGDN       ;  oTbr:pageDown()
            CASE nTecla == K_PGUP       ;  oTbr:pageUp()
            CASE nTecla == K_CTRL_PGDN  ;  oTbr:goBottom()
            CASE nTecla == K_CTRL_PGUP  ;  oTbr:goTop()
            CASE nTecla == K_RIGHT      ;  oTbr:right()
            CASE nTecla == K_LEFT       ;  oTbr:left()
            CASE nTecla == K_HOME       ;  oTbr:home()
            CASE nTecla == K_END        ;  oTbr:end()
            CASE nTecla == K_CTRL_LEFT  ;  oTbr:panLeft()
            CASE nTecla == K_CTRL_RIGHT ;  oTbr:panRight()
            CASE nTecla == K_CTRL_HOME  ;  oTbr:panHome()
            CASE nTecla == K_CTRL_END   ;  oTbr:panEnd()
            CASE nTecla == K_ESC        ;  lSaida := .T.
        ENDCASE
    ENDDO
    SET KEY K_F3 TO
    CLOSE DATA
    SETCOLOR(cCor)
    RESTSCREEN(00, 00, 24, 79, cTela)
RETURN Nil

FUNCTION janela( nLin1, nCol1, nLin2, nCol2, cTitulo )
    LOCAL cCorOld, cBarra
    cCorOld := SETCOLOR()
    SETCOLOR(COR_JANELA)
    @ nLin1, nCol1, nLin2, nCol2 BOX SPACE(9)
    HB_Shadow(nLin1, nCol1, nLin2, nCol2)
    cBarra := (nCol2 - nCol1)+1
    @ nLin1, nCol1    SAY space(cBarra) COLOR COR_BARRA_TITULO
    @ nLin1, nCol1 +1 SAY cTitulo       COLOR COR_BARRA_TITULO
    SETCOLOR(cCorOld)
RETURN Nil

FUNCTION Rodape( nLin, nCol, aOpc )
    LOCAL i
    @ nLin, nCol SAY SPACE(80) COLOR "N/W+*"
    nCol += 1
    FOR i := 1 TO LEN(aOpc)
        @ nLin, nCol SAY aOpc[i,1] COLOR "R+/W+*" ; nCol += LEN(aOpc[i,1]) ; nCol += 1
        @ nLin, nCol SAY aOpc[i,2] COLOR "N/W+*"  ; nCol += LEN(aOpc[i,2]) ; nCol += 1
    NEXT
RETURN Nil

FUNCTION Tabela()
    aUsuario2 := { { "ID"        , "N", 03, 00 }, ;
                   { "NIVEL"     , "N", 01, 00 }, ;
                   { "NOME"      , "C", 30, 00 }, ;
                   { "LOGIN"     , "C", 30, 00 }, ;
                   { "SENHA"     , "C", 32, 00 }, ;
                   { "GENERO"    , "C", 01, 00 }, ;
                   { "NASCIMENTO", "D", 08, 00 }, ;
                   { "CPF"       , "C", 11, 00 }, ;
                   { "CRIADO_EM" , "D", 08, 00 }, ;
                   { "MODIFI_EM" , "D", 08, 00 }, ;
                   { "USU_ID"    , "N", 03, 00 } }

    Cria_ArqDados("usuarios.dbf", aUsuario2)

    USE usuarios ALIAS usuarios SHARED NEW
    INDEX ON id TO usuarios
    IF (LASTREC() == 0)
        IF NetErr()
            ? "Falha na abertura do arquivo. (usuarios.dbf)"
            BREAK
        ENDIF
        aUsuarios := { {1, "Administrador", "admin"   , "nimda" }, ;
                       {2, "Mauricio"     , "mauricio", "teste" }, ;
                       {3, "Ana"          , "ana"     , "teste" }, ;
                       {4, "Jamile"       , "jamile"  , "teste" }, ;
                       {5, "Antonio"      , "antonio" , "teste" }, ;
                       {6, "Maria"        , "maria"   , "teste" }, ;
                       {7, "Simone"       , "simone"  , "teste" }, ;
                       {8, "Julio"        , "julio"   , "teste" } }
        FOR i := 1 TO LEN(aUsuarios)
            APPEND BLANK
            dbrlock(recno())
            usuarios->ID         := aUsuarios[i,1]
            usuarios->NOME       := UPPER(aUsuarios[i,2])
            usuarios->LOGIN      := aUsuarios[i,3]
            usuarios->SENHA      := aUsuarios[i,4]
            usuarios->CRIADO_EM  := DATE()
            usuarios->USU_ID     := 1
            dbrunlock(recno())
        NEXT
    ENDIF
    CLOSE DATA
RETURN Nil

FUNCTION Cria_ArqDados(cDBF, aCampos)
    IF !FILE(cDBF)
        DBCreate(cDBF,aCampos)
    ENDIF
RETURN Nil

Att.

Mauricio Portela
Anexos
tbrowse_2_regs_em_linha_02.png
tbrowse_2_regs_em_linha_02.png (10.58 KiB) Exibido 1104 vezes
Responder