cor no tbrowse

[JoséQuintas]

E já deixa todas as rotinas do browse em fonte separado, pra não ficar confundindo sobre em que parte mexer.
Já está começando misturando fonte, aí vai complicar.

[JoséQuintas]

Use nomes de variáveis decentes.

TestUser dá a impressão de que é um teste qualquer, que nem faz parte da rotina.

Use também um editor decente E ENXERGUE O QUE ESTÁ FAZENDO

Não entende de tbrowse... tá tudo bem... mas entende de nKEY e tecla. Tá testando nKEY antes de obter nkey ?
Porque duplicou a rotina que era no final e colocou no início?
Acabou colocando o resto em lugar errado também.

O Tbrowse estava mesmo funcionando, antes de mexer com rotina de usuário?
Com essa parte duplicada, acho que não estava funcionando direito.

Se não entendeu, vai usar essa rotina pro resto da vida, e pro aplicativo inteiro.
Então dê respeito a ela: leve todo tempo que precisar pra organizar a rotina, escolher nomes de variáveis, etc.
É diferente das rotinas do aplicativo, que vai usar uma vez só.

Nessa duplicação de oBrowse:ApplyKey(), jogou no lixo o que tinha sido mostrado antes, e voltamos à estaca zero, de fazer funcionar o browse direito.
Sim, porque o que era pra fazer depois, passou a fazer antes e depois - duplicado ainda pra piorar mais.

Dê a atenção que a rotina merece.
Use nomes que facilitem. Isso NÃO é pra NÓS, é pra VOCÊ, VOCÊ é que precisa entender os nomes.
Se não entende do browse, e fica usando qualquer nome.... vai entender menos ainda.

Lista de campos: se o nome oTBrowse confunde, chame de aCamposList - array CamposList, que é a lista de campos
o browse, se oTBR confunde, chame de oBrowse - objeto browse
O fonte só vai ficar mais claro, se VOCÊ deixar mais claro, mas VOCÊ é quem sabe como vai ficar melhor pra você.
Rotinas que vão ser usadas em biblioteca precisam muito mais atenção sobre isso, porque uma vez funcionando, não vai mexer tão cedo, e vai ter que lembrar tempo depois pra que serve cada coisa, então faça isso já.

Só de mudar os nomes, já deve entender aonde estão os erros, porque aCamposList:Refresh() vai saber que não existe, que não tem a ver com o browse.

A compilação -w3 -es2 é ótima pra isso, basta alterar um nome de variável de cada vez, e a compilação vai reclamar se esquecer de corrigir em algum lugar.

[JoséQuintas]

Quer ver o que mudou do seu browse anterior para o atual?
Aqui comecei a mexer nos nomes, e cheguei naquela duplicação, mas tudo bem.

passou a receber como parâmetro uma lista de campos, e a rotina de usuário

Código: Selecionar todos

FUNCTION BrowseADO( oRs, aCamposList, bFuncaoUsuario )

Se a lista de campos estiver vazia, usa a criação automática que JÁ EXISTIA.
Senão, cria a lista a partir do que foi recebido no parâmetro

Código: Selecionar todos

   IF aCamposList == Nil
      nLen := oRs:fields():count() - 1
      FOR nCont := 0 TO nLen
         oColumn := TBColumnNew( oRs:fields( nCont ):name(), ADORecordSetFieldBlock( oRs, nCont ) )
         oColumn:width := Max( Min( oRs:Fields( nCont ):definedSize,50), Len( oRs:fields( nCont ):name ) ) + 5
         oBrowse:addColumn( oColumn )
      NEXT
   ELSE
      FOR EACH aItem IN aCamposList
         oColumn := TBColumnNew( aItem[1], aItem[2] )
         IF Len( aItem ) > 2
            oColumn:ColorBlock := aItem[3]
         ENDIF
         oBrowse:AddColumn( oColumn )
      NEXT
   ENDIF

E na checagem de teclas, se existir função de usuário, chama a função de usuário

Código: Selecionar todos

      IF oBrowse:applyKey( nKey ) == TBR_EXIT
         EXIT
      ENDIF
      IF bFuncaoUsuario != NIL
         DO WHILE ! oBrowse:Stable
            oBrowse:Stabilize()
         ENDDO
         Eval( bFuncaoUsuario, oBrowse, oRs, nKey )
         oBrowse:RefreshAll()
      ENDIF

No browse, foi isso acima.

Pra facilitar com o ADO, no que se refere a testar campos, foram adicionadas funções ao ADO.
Mas isso tem a ver com o ADO, que facilita os campos virem prontos, e facilita o browse.

Código: Selecionar todos

FUNCTION SuperADO( oRs )

   __ObjAddMethod( oRs, "TOSTRING", @ADOToString() )
   __ObjAddMethod( oRs, "TONUMBER", @ADOToNumber() )
   __ObjAddMethod( oRs, "TODATE",   @ADOToDate() )
   __ObjAddMethod( oRs, "TOSTR",    @ADOToStr() )

   RETURN Nil

Essa parte vai poder usar não apenas no browse, mas em todo aplicativo.
Ao invés de, em todo fonte, ficar testando se o campo é Nil, ou formatando.... já diz exatamente do jeito que quer.
É só trocar :Field( "nome" ):Value por :ToString( "nome" ) ou :ToDate( "nome" ) ou :ToNumber( "nome" ) ou :ToStr( "nome" )
O campo já vém no formato que quiser.
Por exemplo, de adicional, :ToStr( "valor", 15, 2 ),
mais simples no fonte do que Str( :ToNumber( "valor" ), 15, 2 )
e muito mais simples que Str( iif( :Fields("valor") == Nil, 0, :Fields("Valor") ), 15, 2 )
Essa parte é pra reduzir fonte, e evitar esquecer de fazer o teste.
É pro ADO, que ajuda no browse.
NÃO considero defeito do ADO: ele trás o conteúdo, se na base de dados foi gravado NULL, é o que vém.

Então...
Foram essas as mudanças.

Até poderia ter feito na sua própria rotina anterior, se os nomes das variáveis estivessem claros.
E poderia ir removendo as particularidades, conforme for colocando "na parte de fora", na rotina de usuário.

Espero que não, mas o fonte postado deu a impressão de que voce pode estar querendo fazer um browse que chama o outro browse.
Se for assim, vai continuar com complicação do mesmo jeito, só vai trocar a complicação de lugar.

NÃO CONFUNDA um browse que pode ser usado em toda situação, com um browse que contém tudo que é fonte pra tudo que é situação.
Isso NÃO é browse genérico.

[alxsts]

Olá!

...Não sou profissional da área da informática...

Entendi. Isto explica muita coisa.

já foi tempo em que eu cheguei a ler livros desse tamanho num só dia)

Percebo que você escreve bem. Deve ter um bom nível cultural. Características de quem lê bastante.

...Mas o livro tem 334 páginas (...) E não creio que apenas lendo o livro eu vá conseguir entender tudo de code block e tbrowse, a ponto de não precisar mais de ajuda e começar a ajudar os outros nessa área. Até chegar a esse ponto, creio que ainda vou precisar de muita ajuda.

Você tem o livro à disposição, o tempo todo. Num primeiro momento, não precisa ler ele todo. Use o índice. Procure os capítulos relativos ao que tem dúvida no momento e estude apenas o que precisa. Não tem problema se demorar a aprender. Comece. Devagar se vai ao longe...

Tenha a certeza de que alguém sempre vai te ajudar neste fórum. Mas lembre-se de que a maior satisfação de quem transmite algum conhecimento é sentir que aquele que solicita está absorvendo este conhecimento. Aprendendo, evoluindo.

Siga as orientações dadas acima. O código fonte é a alma do teu programa. Capriche nele. Identifique variáveis e rotinas com nomes expressivos. Evite redundâncias de código. Escreva comentários. Depois de um ano, talvez você mesmo terá que dar manutenção. Sem estes cuidados, nem você se lembrará o que faz o código...

Boa sorte.

[JoséQuintas]

Siga as orientações dadas acima. O código fonte é a alma do teu programa. Capriche nele. Identifique variáveis e rotinas com nomes expressivos. Evite redundâncias de código. Escreva comentários. Depois de um ano, talvez você mesmo terá que dar manutenção. Sem estes cuidados, nem você se lembrará o que faz o código...

Isso é com o tempo que vai acostumando, e cada vez vai ficando mais fácil.
Conforme for se convencendo que é vantagem, vai querer fazer cada vez mais.

Mas precisa começar.
Por exemplo, a compilação -w3 -es2 é ótima, mas tenha em mente que pode demorar um ano pra acertar os fontes de um aplicativo grande.
Então.... é fazer sem pressa, um pouquinho daqui, um pouquinho dali, mais um pouco no dia seguinte ou semana seguinte.

Se assumir "não entendo de tbrowse", ou de outra coisa, não vai em frente.

É igual ao ADO, você começou, meteu as caras, não lembro em nenhum momento sobre você dizer "não entendo".
É que começou a usar, gostou do resultado, foi se empolgando cada vez mais, incluindo comandos mais avançados no SQL.
Organizar o fonte vai ser parecido, é que ainda não percebeu a grande vantagem que vai ser fazer isso.

Comece por esse tbrowse.
Altere os nomes de variáveis pra algo mais amigável, o nome é pra identificar do que se trata.
Vai ver que vai começar a ser mais fácil mexer na rotina, só de trocar os nomes.
E devagar vai deixando os outros fontes parecidos.

[cjp]

Troquei, mas continua dando o mesmo erro BASE/1004 Método não exportado: STABLE.
É possível que eu tenha trocado algo errado. Veja, por favor:

Código: Selecionar todos

/*
Exibição das linhas de um Record set ADO usando TBrowseDB()
Alexandre Santos
Compilar: Hbmk2 tbado hbwin.hbc
*/

#pragma -w3
#pragma -es2
#include "tbrowse.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "hbgtinfo.ch"
#include "box.ch"
#include "set.ch"
#include "hbclass.ch"

REQUEST HB_CODEPAGE_PTISO

   
FUNCTION Tbrowseado(cSql)
   LOCAL oRs, aCamposList
   LOCAL oCN :=ConexaoMySQL( "mysql.xxx.com.br", "xxx", "xxx", "xxx" )
   local tela :=savescreen(0,0,maxrow(),maxcol())

   Set( _SET_CODEPAGE, "PTISO" )
   Set( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT - INKEY_MOVE )
   SET DATE BRITISH

*   hb_gtInfo( HB_GTI_WINTITLE , "TBrowse colorBlock() com Acesso ao MySQL via ADO" )
*   hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
   SetColor( "W/B","N/W",,,"W/B" )
   CLS

   oCn:open()

   DO WHILE .T.
      @ 4, MaxRow() SAY Padr( "Obtendo informações...", 22 ) COLOR "W/W"
      oRs := oCn:Execute( cSql )
      SuperADO( oRs )
      IF oRs == NIL .OR. oRs:Eof()
         Hb_Alert( "Não foi possível obter dados para exibição",, "W+/B" )
         EXIT
      ENDIF
      aCamposList := { ;
         { "DATA",       { || oRs:ToDate( "DATA" ) } }, ;
         { "HORA",       { || oRs:ToString( "HORA", 8 ) } }, ;
         { "COMIDA",     { || oRs:ToString( "COMIDA", 30 ) }, { | x | If( At( "TOTAL ", Upper( x ) ) > 0, { 5, 5 }, { 1, 2 } ) } }, ;
         { "QUANTIDADE", { || oRs:ToString( "QUANTIDADE", 20 )  } }, ;
         { "PONTOS",     { || oRs:ToStr( "PONTOS", 6 ) } }, ;
         { "ID",         { || oRs:ToStr( "ID", 6 ) } } }

      tBrowseADO2( oRs, aCamposList, { | aCamposList, nKey | TestUser( oRs, aCamposList, nkey ) } )
*      IF Alert( "Fechar?", { " Não ", " Sim " }, "W+/N" ) == 2
         oRs:Close()
         EXIT
*      ENDIF
*      EXIT
   ENDDO
   oCn:close()

   rest scre from tela
RETURN Nil


FUNCTION tBrowseADO2( oRs, aCamposList, TestUser )
   LOCAL oBrowse, nKey, oColumn, aItem, nLen, I

   oBrowse := TBrowse():new( 02, 3, MaxRow() - 3, MaxCol() - 3 )
   oBrowse:headSep       := Chr(196) + Chr(194) + Chr(196)
   oBrowse:colSep        := " " + Chr(179) + " "
   oBrowse:footSep       := Chr(196) + Chr(193) + Chr(196)
   oBrowse:goTopBlock    := { || oRs:moveFirst() }
   oBrowse:goBottomBlock := { || oRs:moveLast() }
   oBrowse:skipBlock     := { |n| ADORecordSetSkipper( oRs,n ) }
   oBrowse:colorSpec     := "W/B,W+/N,N/W*,W+/R,R+/B,R/W*"

   IF aCamposList == Nil
      // create TBColumn objects and add them to TBrowse object - zero based
      nLen := oRs:fields():count() - 1
      FOR i := 0 TO nLen
         // add code block for individual columns of the record set
         oColumn := TBColumnNew( oRs:fields(i):name(), ADORecordSetFieldBlock( oRs, i ) )
         // Column widths. For some data types, definedSize returns -1...
         oColumn:width := Max( Min( oRs:Fields(i):definedSize,50), Len( oRs:fields(i):name ) ) + 5
         // Add new column to TBrowse
         oBrowse:addColumn( oColumn )
      NEXT
   ELSE
      FOR EACH aItem IN aCamposList
         oColumn := TBColumnNew( aItem[1], aItem[2] )
         IF Len( aItem ) > 2
            oColumn:ColorBlock := aItem[3]
         ENDIF
         oBrowse:AddColumn( oColumn )
      NEXT
   ENDIF

   // border
   DispBox( oBrowse:nTop - 1, oBrowse:nLeft - 1, oBrowse:nBottom + 3, oBrowse:nRight + 1, B_SINGLE )

   DO WHILE .T.

IF oBrowse:applyKey( nKey ) == TBR_EXIT
   EXIT
ENDIF
IF TestUser != NIL
   DO WHILE ! aCamposList:Stable
      aCamposList:Stabilize()
   ENDDO
   Eval( TestUser, aCamposList, oRs, nKey )
   aCamposList:RefreshAll()
ENDIF
*nKey := 0 
      oBrowse:refreshCurrent()
      DO WHILE ! oBrowse:Stable()
         oBrowse:Stabilize()
      ENDDO
      // Paint TBrowse current line...
      //oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:LeftVisible, oBrowse:RowPos, oBrowse:RightVisible }, { 2, 1 } )

      @ MaxRow() - 1, 3 SAY Padr( " Registro " + Ltrim( Str( oRs:AbsolutePosition ) ) + " de " + Ltrim( Str( oRs:recordCount ) ) + " ", 20 ) COLOR "N/W"

      nKey := Inkey(0)

      IF oBrowse:applyKey( nKey ) == TBR_EXIT
         EXIT
      ENDIF
   ENDDO

RETURN Nil

STATIC FUNCTION ADORecordSetFieldBlock( oRs, i, xVal )
   LOCAL bRet

   IF xVal == NIL
      IF oRs:Eof()
         bRet := { || Space( Max( oRs:Fields( i ):DefinedSize , Len( oRs:Fields( i ):name ) ) ) }
      ELSE
         bRet := { || oRs:Fields( i ):value }
      ENDIF
   ELSE
      bRet := { |xVal| oRs:Fields( i ):Value := xVal }
   ENDIF

RETURN bRet

STATIC FUNCTION ADORecordSetSkipper(oRecordSet,nSkip)
   LOCAL nRec := oRecordSet:AbsolutePosition

   IF ! ( oRecordSet:eof )
      oRecordSet:Move( nSkip )

      IF oRecordSet:eof
         oRecordSet:moveLast()
      ENDIF

      IF oRecordSet:bof
         oRecordSet:moveFirst()
      ENDIF
   ENDIF

RETURN (oRecordSet:AbsolutePosition - nRec)

   
STATIC FUNCTION ConexaoMySQL( cServer, cDatabase, cUser, cPassword )

   LOCAL oCn := win_OleCreateObject("ADODB.Connection")

   oCn:ConnectionString := "DRIVER={MariaDB ODBC 3.1 Driver};TCPIP=1;SERVER=" + ;
      cServer + ";Database=" + cDatabase + ";UID=" + cUser + ";PWD=" + cPassword + ";PORT=3306"
   oCn:CursorLocation   := 3

RETURN oCn


FUNCTION SuperADO( oRs )

   __ObjAddMethod( oRs, "TOSTRING", @ADOToString() )
   __ObjAddMethod( oRs, "TONUMBER", @ADOToNumber() )
   __ObjAddMethod( oRs, "TODATE",   @ADOToDate() )
   __ObjAddMethod( oRs, "TOSTR",    @ADOToStr() )

RETURN Nil

STATIC FUNCTION ADOToDate( cField )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "D"
      x := Ctod("")
   ENDIF
RETURN x

STATIC FUNCTION ADOToString( cField, nLen )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "C"
      x := ""
   ENDIF
   IF nLen != Nil
      x := Pad( x, nLen )
   ENDIF
RETURN x

STATIC FUNCTION ADOToNumber( cField )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "N"
      x := 0
   ENDIF

RETURN x

STATIC FUNCTION ADOToStr( cField, nLen, nDec )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "N"
      x := 0
   ENDIF
   IF nLen == Nil
      x := Str( x )
   ELSEIF nDec == Nil
      x := Str( x, nLen )
   ELSE
      x := Str( x, nLen, nDec )
   ENDIF

RETURN x

STATIC FUNCTION TestUser( oRs, aCamposList, nKey )
   IF nKey == K_F5
      Alert( "Foi teclado F5" )
      Alert( oRs:ToString( "COMIDA" ) )
      aCamposList:RefreshAll()
   ENDIF

RETURN 1

[JoséQuintas]

Deu erro no STABLE, olhe a linha do erro, procure no fonte a palavra STABLE.

Precisa dizer mais alguma coisa?

Eu até comentei: altere os nomes pra ficar mais fácil de localizar os erros, porque já tinha visto isso.
E não é só nesse lugar que tem variável trocada, vai ver nos próximos erros.

E na explicação detalhada sobre o que mudou: aCamposList é apenas a lista de campos, pra criar o browse.
Só usa pra criar e em nenhum outro lugar.

[JoséQuintas]

Usando o próprio fórum pra pesquisar.

Comentário:

Isso é coisa que JÁ FUNCIONAVA.
Ao adicionar a lista de campos, saiu mexendo aonde não deveria, e usando o nome da lista de campos nos outros lugares.

A lista de campos é apenas pra criar a lista de campos do browse, e nada mais.
Deve aparecer só no início da rotina, durante a criação.

Já a variável do browse... essa vai usar em toda rotina, e até nas subrotinas.

Então.... isso é assim desde o início, desde o primeiro browse.
Tudo causado por não ter padronizado os nomes, e confundir sobre o que é cada coisa.
Agora vai saber que oBrowse contém TUDO referente ao browse.

[cjp]

De fato vc tem razão, corrigi este erro, mas continua dando erro. Fiz assim porque ainda não entendi como funciona este browse.
Duas dúvidas iniciais para eu tentar entender:
1) posso estar errado, mas me parece que tem duas variáveis que contém o browse nesta função: a oRs e a oBrowse; é assim mesmo?
2) vc disse que a aCamposList só usa no início para criar a lista de campos do browse, mais nada; mas então vamos criar ela e não vamos usar em lugar nenhum? Nem é pra passar como parâmetro?

[JoséQuintas]

1) posso estar errado, mas me parece que tem duas variáveis que contém o browse nesta função: a oRs e a oBrowse; é assim mesmo?

oRs é o recordset ADO que vém do banco de dados, ela não contém o browse, ela contém as informações.

2) vc disse que a aCamposList só usa no início para criar a lista de campos do browse, mais nada; mas então vamos criar ela e não vamos usar em lugar nenhum? Nem é pra passar como parâmetro?

Eu já disse: é usada pra criar as colunas do browse.
Antes era somente automático, pegando a estrutura retornada pelo SELECT no Rs.
Agora tem a opção de escolher o que vai querer, passando a estrutura pronta do browse.
Nos dois casos, é criada a configuração do browse, e a partir daí o browse funciona sozinho com a configuração e com o recordset/base de dados.

Browse:

a) usa informações de uma tabela

Tá usando o oRs do ADO, poderia ser um DBF ou um array

b) Cria a configuração sobre como mostrar as informações

Antes estava no modo semi-automático, pegando as informações direto de a)
Agora, além do semi-automático, pode receber a lista de campos contendo formatação, cores, etc.

c) Faz o processamento, e conforme a tecla, faz algo diferente

Antes era só o processamento de teclas padrão.
Agora permite receber a função de usuário, contendo ações pra cada tecla "diferente"

O browse continua o mesmo de antes, apenas foram acrescentadas opções.
Se não passar aCamposList, ele vai criar isso sozinho, que nem sempre é do jeito que você quer
Se não passar rotina de usuário, ele vai fazer só a parte padrão.
Ou seja, se não passar nada, vai ser igual antes.

[JoséQuintas]

Uma visão mais clara do que mudou com relação à rotina original.

[cjp]

Vamos ver se eu entendi o que vc disse:

oRs é o recordset ADO que vém do banco de dados, ela não contém o browse, ela contém as informações.

- entendi que a variável oRs é para o resultado do ADO; e a variável oBrowse é para o resultado do tbrowse; então, respondendo à minha pergunta 1 da última resposta, sim, precisa das duas variáveis, são diferentes, ok?

Eu já disse: é usada pra criar as colunas do browse.
Antes era somente automático, pegando a estrutura retornada pelo SELECT no Rs.
Agora tem a opção de escolher o que vai querer, passando a estrutura pronta do browse.
Nos dois casos, é criada a configuração do browse, e a partir daí o browse funciona sozinho com a configuração e com o recordset/base de dados.

- entendi que precisa sim passar a variável aCamposList, ok?

Só não entendi bem ainda onde e como fazer isso. Ainda estou confuso de como usar exatamente essas variáveis.

Browse:

a) usa informações de uma tabela

Tá usando o oRs do ADO, poderia ser um DBF ou um array

b) Cria a configuração sobre como mostrar as informações

Antes estava no modo semi-automático, pegando as informações direto de a)
Agora, além do semi-automático, pode receber a lista de campos contendo formatação, cores, etc.

c) Faz o processamento, e conforme a tecla, faz algo diferente

Antes era só o processamento de teclas padrão.
Agora permite receber a função de usuário, contendo ações pra cada tecla "diferente"

O browse continua o mesmo de antes, apenas foram acrescentadas opções.
Se não passar aCamposList, ele vai criar isso sozinho, que nem sempre é do jeito que você quer
Se não passar rotina de usuário, ele vai fazer só a parte padrão.
Ou seja, se não passar nada, vai ser igual antes.

Aqui eu acho que entendi mais ou menos como funciona o Browse.


Fiz as seguintes correções, mas ainda está dando erro, o que indica que eu não fiz certo:

Código: Selecionar todos

/*
Exibição das linhas de um Record set ADO usando TBrowseDB()
Alexandre Santos
Compilar: Hbmk2 tbado hbwin.hbc
*/

#pragma -w3
#pragma -es2
#include "tbrowse.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "hbgtinfo.ch"
#include "box.ch"
#include "set.ch"
#include "hbclass.ch"

REQUEST HB_CODEPAGE_PTISO

   
FUNCTION Tbrowseado(cSql)
   LOCAL oRs, aCamposList
   LOCAL oCN :=ConexaoMySQL( "mysql.xxx.com.br", "xxx", "xxx", "xxx" )
   local tela :=savescreen(0,0,maxrow(),maxcol())

   Set( _SET_CODEPAGE, "PTISO" )
   Set( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT - INKEY_MOVE )
   SET DATE BRITISH

*   hb_gtInfo( HB_GTI_WINTITLE , "TBrowse colorBlock() com Acesso ao MySQL via ADO" )
*   hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
   SetColor( "W/B","N/W",,,"W/B" )
   CLS

   oCn:open()

   DO WHILE .T.
      @ 4, MaxRow() SAY Padr( "Obtendo informações...", 22 ) COLOR "W/W"
      oRs := oCn:Execute( cSql )
      SuperADO( oRs )
      IF oRs == NIL .OR. oRs:Eof()
         Hb_Alert( "Não foi possível obter dados para exibição",, "W+/B" )
         EXIT
      ENDIF
      aCamposList := { ;
         { "DATA",       { || oRs:ToDate( "DATA" ) } }, ;
         { "HORA",       { || oRs:ToString( "HORA", 8 ) } }, ;
         { "COMIDA",     { || oRs:ToString( "COMIDA", 30 ) }, { | x | If( At( "TOTAL ", Upper( x ) ) > 0, { 5, 5 }, { 1, 2 } ) } }, ;
         { "QUANTIDADE", { || oRs:ToString( "QUANTIDADE", 20 )  } }, ;
         { "PONTOS",     { || oRs:ToStr( "PONTOS", 6 ) } }, ;
         { "ID",         { || oRs:ToStr( "ID", 6 ) } } }

      tBrowseADO2( oRs, aCamposList, { | aCamposList, nKey | TestUser( oRs, aCamposList, nkey ) } )
*      IF Alert( "Fechar?", { " Não ", " Sim " }, "W+/N" ) == 2
         oRs:Close()
         EXIT
*      ENDIF
*      EXIT
   ENDDO
   oCn:close()

   rest scre from tela
RETURN Nil


FUNCTION tBrowseADO2( oRs, aCamposList, TestUser )
   LOCAL oBrowse, nKey, oColumn, aItem, nLen, I

   oBrowse := TBrowse():new( 02, 3, MaxRow() - 3, MaxCol() - 3 )
   oBrowse:headSep       := Chr(196) + Chr(194) + Chr(196)
   oBrowse:colSep        := " " + Chr(179) + " "
   oBrowse:footSep       := Chr(196) + Chr(193) + Chr(196)
   oBrowse:goTopBlock    := { || oRs:moveFirst() }
   oBrowse:goBottomBlock := { || oRs:moveLast() }
   oBrowse:skipBlock     := { |n| ADORecordSetSkipper( oRs,n ) }
   oBrowse:colorSpec     := "W/B,W+/N,N/W*,W+/R,R+/B,R/W*"

   IF aCamposList == Nil
      // create TBColumn objects and add them to TBrowse object - zero based
      nLen := oRs:fields():count() - 1
      FOR i := 0 TO nLen
         // add code block for individual columns of the record set
         oColumn := TBColumnNew( oRs:fields(i):name(), ADORecordSetFieldBlock( oRs, i ) )
         // Column widths. For some data types, definedSize returns -1...
         oColumn:width := Max( Min( oRs:Fields(i):definedSize,50), Len( oRs:fields(i):name ) ) + 5
         // Add new column to TBrowse
         oBrowse:addColumn( oColumn )
      NEXT
   ELSE
      FOR EACH aItem IN aCamposList
         oColumn := TBColumnNew( aItem[1], aItem[2] )
         IF Len( aItem ) > 2
            oColumn:ColorBlock := aItem[3]
         ENDIF
         oBrowse:AddColumn( oColumn )
      NEXT
   ENDIF

   // border
   DispBox( oBrowse:nTop - 1, oBrowse:nLeft - 1, oBrowse:nBottom + 3, oBrowse:nRight + 1, B_SINGLE )

   DO WHILE .T.

IF oBrowse:applyKey( nKey ) == TBR_EXIT
   EXIT
ENDIF
IF TestUser != NIL
   DO WHILE ! oBrowse:Stable
      oBrowse:Stabilize()
   ENDDO
   Eval( TestUser, aCamposList, oRs, nKey )
   aCamposList:RefreshAll()
ENDIF
*nKey := 0 
      oBrowse:refreshCurrent()
      DO WHILE ! oBrowse:Stable()
         oBrowse:Stabilize()
      ENDDO
      // Paint TBrowse current line...
      //oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:LeftVisible, oBrowse:RowPos, oBrowse:RightVisible }, { 2, 1 } )

      @ MaxRow() - 1, 3 SAY Padr( " Registro " + Ltrim( Str( oRs:AbsolutePosition ) ) + " de " + Ltrim( Str( oRs:recordCount ) ) + " ", 20 ) COLOR "N/W"

      nKey := Inkey(0)

      IF oBrowse:applyKey( nKey ) == TBR_EXIT
         EXIT
      ENDIF
   ENDDO

RETURN Nil

STATIC FUNCTION ADORecordSetFieldBlock( oRs, i, xVal )
   LOCAL bRet

   IF xVal == NIL
      IF oRs:Eof()
         bRet := { || Space( Max( oRs:Fields( i ):DefinedSize , Len( oRs:Fields( i ):name ) ) ) }
      ELSE
         bRet := { || oRs:Fields( i ):value }
      ENDIF
   ELSE
      bRet := { |xVal| oRs:Fields( i ):Value := xVal }
   ENDIF

RETURN bRet

STATIC FUNCTION ADORecordSetSkipper(oRecordSet,nSkip)
   LOCAL nRec := oRecordSet:AbsolutePosition

   IF ! ( oRecordSet:eof )
      oRecordSet:Move( nSkip )

      IF oRecordSet:eof
         oRecordSet:moveLast()
      ENDIF

      IF oRecordSet:bof
         oRecordSet:moveFirst()
      ENDIF
   ENDIF

RETURN (oRecordSet:AbsolutePosition - nRec)

   
STATIC FUNCTION ConexaoMySQL( cServer, cDatabase, cUser, cPassword )

   LOCAL oCn := win_OleCreateObject("ADODB.Connection")

   oCn:ConnectionString := "DRIVER={MariaDB ODBC 3.1 Driver};TCPIP=1;SERVER=" + ;
      cServer + ";Database=" + cDatabase + ";UID=" + cUser + ";PWD=" + cPassword + ";PORT=3306"
   oCn:CursorLocation   := 3

RETURN oCn


FUNCTION SuperADO( oRs )

   __ObjAddMethod( oRs, "TOSTRING", @ADOToString() )
   __ObjAddMethod( oRs, "TONUMBER", @ADOToNumber() )
   __ObjAddMethod( oRs, "TODATE",   @ADOToDate() )
   __ObjAddMethod( oRs, "TOSTR",    @ADOToStr() )

RETURN Nil

STATIC FUNCTION ADOToDate( cField )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "D"
      x := Ctod("")
   ENDIF
RETURN x

STATIC FUNCTION ADOToString( cField, nLen )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "C"
      x := ""
   ENDIF
   IF nLen != Nil
      x := Pad( x, nLen )
   ENDIF
RETURN x

STATIC FUNCTION ADOToNumber( cField )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "N"
      x := 0
   ENDIF

RETURN x

STATIC FUNCTION ADOToStr( cField, nLen, nDec )
   LOCAL x, Self := QSelf()

   x := ::Fields( cField ):Value
   IF ValType( x ) != "N"
      x := 0
   ENDIF
   IF nLen == Nil
      x := Str( x )
   ELSEIF nDec == Nil
      x := Str( x, nLen )
   ELSE
      x := Str( x, nLen, nDec )
   ENDIF

RETURN x

STATIC FUNCTION TestUser( oBrowse, aCamposList, nKey )
   IF nKey == K_F5
      Alert( "Foi teclado F5" )
      Alert( oBrowse:ToString( "COMIDA" ) )
      aCamposList:RefreshAll()
   ENDIF

RETURN 1

[JoséQuintas]

Vamos separar mais ainda:

Código: Selecionar todos

FUNCTION BrowseADO( oRs, aCamposList, bRotinaUsuario )

   LOCAL oBrowse, nKey

   oBrowse := CriaBrowse( oRs, aCamposList )

   DispBox( oBrowse:nTop - 1, oBrowse:nLeft - 1, oBrowse:nBottom + 3, oBrowse:nRight + 1, B_SINGLE )

   DO WHILE .T.

      oBrowse:refreshCurrent()
      DO WHILE ! oBrowse:Stable()
         oBrowse:Stabilize()
      ENDDO
      // Paint TBrowse current line...
      //oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:LeftVisible, oBrowse:RowPos, oBrowse:RightVisible }, { 2, 1 } )

      @ MaxRow() - 1, 3 SAY Padr( " Registro " + Ltrim( Str( oRs:AbsolutePosition ) ) + " de " + Ltrim( Str( oRs:recordCount ) ) + " ", 20 ) COLOR "N/W"

      nKey := Inkey(0)
      IF oBrowse:applyKey( nKey ) == TBR_EXIT
         EXIT
      ENDIF
      IF bRotinaUsuario != NIL
         DO WHILE ! oBrowse:Stable
            oBrowse:Stabilize()
         ENDDO
         Eval( bRotinaUsuario, oBrowse, oRs, nKey )
         oBrowse:RefreshAll()
      ENDIF

   ENDDO

   RETURN Nil

STATIC FUNCTION CriaBrowse( oRs, aCamposList )

   LOCAL oBrowse, oColumn, aItem, nLen, nCont

   oBrowse := TBrowse():new( 02, 3, MaxRow() - 3, MaxCol() - 3 )
   oBrowse:headSep       := Chr(196) + Chr(194) + Chr(196)
   oBrowse:colSep        := " " + Chr(179) + " "
   oBrowse:footSep       := Chr(196) + Chr(193) + Chr(196)
   oBrowse:goTopBlock    := { || oRs:moveFirst() }
   oBrowse:goBottomBlock := { || oRs:moveLast() }
   oBrowse:skipBlock     := { |n| ADORecordSetSkipper( oRs,n ) }
   oBrowse:colorSpec     := "W/B,W+/N,N/W*,W+/R,R+/B,R/W*"

   IF aCamposList == Nil
      nLen := oRs:fields():count() - 1
      FOR nCont := 0 TO nLen
         oColumn := TBColumnNew( oRs:fields( nCont ):name(), ADORecordSetFieldBlock( oRs, nCont ) )
         oColumn:width := Max( Min( oRs:Fields( nCont ):definedSize,50), Len( oRs:fields( nCont ):name ) ) + 5
         oBrowse:addColumn( oColumn )
      NEXT
   ELSE
      FOR EACH aItem IN aCamposList
         oColumn := TBColumnNew( aItem[1], aItem[2] )
         IF Len( aItem ) > 2
            oColumn:ColorBlock := aItem[3]
         ENDIF
         oBrowse:AddColumn( oColumn )
      NEXT
   ENDIF

   RETURN oBrowse

[JoséQuintas]

Se aquele oBrowse:ApplyKey( nKey ), que é interno do Harbour, não funcionar direito, sempre pode fazer manual, pra ter mais controle sobre as teclas.
Isto substituiria o oBrowse:AppyKey( nKey )

Código: Selecionar todos

DO CASE
CASE nkey == K_CTRL_PGDN ;  nKey := 0; oBrowse:GoBottom() ; LOOP
CASE nkey == K_CTRL_PGUP ;  nKey := 0; oBrowse:GoTop() ;    LOOP
CASE nkey == K_DOWN ;       nKey := 0; oBrowse:Down()    ;  LOOP
CASE nkey == K_HOME ;       nKey := 0; oBrowse:GoTop() ;    LOOP
CASE nkey == K_END ;        nKey := 0; oBrowse:GoBottom() ; LOOP
CASE nkey == K_LEFT ;       nKey := 0; oBrowse:Left() ;     LOOP
CASE nkey == K_RIGHT ;      nKey := 0; oBrowse:Right() ;    LOOP
CASE nkey == K_PGDN ;       nKey := 0; oBrowse:PageDown() ; LOOP
CASE nkey == K_PGUP ;       nKey := 0; oBrowse:PageUp() ;   LOOP
CASE nkey == K_UP ;         nKey := 0; oBrowse:Up() ;       LOOP
CASE nKey == K_ESC ;   EXIT
ENDCASE
IF bRotinaUsuario != NIL
   DO WHILE ! oBrowse:Stable
      oBrowse:Stabilize()
   ENDDO
   Eval( bRotinaUsuario, oBrowse, Rs, nKey )
   oBrowse:RefreshAll()
ENDIF

Pra testar pode fazer:

1) Chame passando apenas Rs, vai fazer tudo como era antes, a parte nova não vai entrar
2) Chame passando Rs e lista de colunas, vai entrar a parte de escolher o que mostrar
3) Chame passando os 3 parâmetros, vai entrar a parte da rotina pra teclas "diferentes".

Talvez seja interessante a do ENTER pra quando não tem função de usuário:
Poderia ser no ELSE do teste de função de usuário

Código: Selecionar todos

IF bRotinaUsuario != Nil
...
ELSEIF nKey == K_ENTER
   DO WHILE ! oBrowse:Stable
      oBrowse:Stabilize()
   ENDDO
   EXIT
ENDIF

Assim, se não fizer nada diferente, sai no ENTER ou no ESC.
Se criar função de usuário, aí sua função de usuário vai dizer o que fazer no ENTER.

Não é pra complicar, é que se precisar depois já sabe aonde mexer.
Pode deixar esta parte pra depois, pra quando precisar.
Apenas deixe anotado.

[JoséQuintas]

Apenas comentário:

Pra quem não percebeu, serviria também pra DBF, basta retirar a parte de do ADO (oRs).
Pra array já teria que ajustar um pouco mais, talvez aproveitando o estilo do ADO (oRs) e mais um número/variável pra ser usado como índice.

No caso de DBF, usar tbrowseDB() ao invés de tbrowse(), assim já vém os codeblocks pra dbf.