Browse DBF, Array, ADO

[JoséQuintas]

Código: Selecionar todos

#require "hbwin.hbc"
#include "inkey.ch"

PROCEDURE Main

   LOCAL oConsulta, nOpc

   SetColor( "W/B,N/W" )
   SetMode( 40, 100 )
   CLS

   DO WHILE .T.
      CLS
      @ maxrow() - 1, 1  PROMPT "DBF"
      @ maxrow() - 1, 10 PROMPT "Array"
      @ maxrow() - 1, 20 PROMPT "ADO"
      MENU TO nOpc
      DO CASE
      CASE LastKey() == K_ESC
         EXIT
      CASE nOpc == 1
         CreateDBF( "test" )
         USE test
         BrowseGenerico( 5, 3, MaxRow() - 7, MaxCol() - 2 )
         USE
      CASE nOpc == 2
         oConsulta := { ;
            { "ARRAYNOMAAA", "ARRAYENDAAA" }, ;
            { "ARRAYNOMBBB", "ARRAYENDBBB" }, ;
            { "ARRAYNOMCCC", "ARRAYENDCCC" } }
         BrowseGenerico( 5, 3, MaxRow() - 7, MaxCol() - 2, @oConsulta )
      CASE nOpc == 3
         oConsulta := RecordsetADO()
         BrowseGenerico( 5, 3, MaxRow() - 7, MaxCol() - 2, @oConsulta )
         oConsulta:Close()
      ENDCASE
   ENDDO

   RETURN

#include "tbrowse.ch"

FUNCTION BrowseGenerico( nTop, nLeft, nBottom, nRight, oConsulta )

   LOCAL oColumn, nFieldLen, nKey, oTBrowse, nCont, nIndex := 1

   CLS

   oTBrowse := TBrowseDB():new( nTop, nLeft, nBottom, nRight )
   oTBrowse:HeadSep       := Chr(196)
   oTBrowse:ColSep        := Chr(179)
   oTBrowse:FootSep       := ""

   DO CASE

      //--- dbf ---
   CASE oConsulta == NIL
      FOR nCont = 1 TO FCount()
         oColumn := TBColumnNew( FieldName( nCont ), DBFFieldBlock( nCont ) )
         oTBrowse:AddColumn( oColumn )
      NEXT

      //--- array ---
   CASE ValType( oConsulta ) == "A"
      FOR nCont = 1 TO Len( oConsulta[ 1 ] )
         oColumn := TBColumnNew( Str( nCont, 1 ), ArrayFieldBlock( @oConsulta, @nIndex, nCont ) )
         oTBrowse:AddColumn( oColumn )
      NEXT
      oTBrowse:GoTopBlock    := { || nIndex := 1 }
      oTBrowse:GoBottomBlock := { || nIndex := Len( oConsulta ) }
      oTBrowse:SkipBlock     := { | input, temp | temp := nIndex,    ;
         nIndex := Max( 1, Min( Len( oConsulta ), nIndex + input ) ), nIndex - temp }

      // --- ADO ---
   OTHERWISE
      FOR nCont := 1 TO oConsulta:Fields():Count()
         oColumn := TBColumnNew( oConsulta:fields( nCont - 1 ):name(), ADOFieldBlock( oConsulta, nCont - 1 ) )
         IF ValType( oConsulta:Fields( nCont - 1 ):Value ) == "D"
            nFieldLen := Len( Dtoc( Date() ) )
         ELSE
            nFieldLen := Min( oConsulta:Fields( nCont - 1 ):DefinedSize, 50 )
         ENDIF
         oColumn:Width := Max( nFieldLen, Len( oConsulta:fields( nCont - 1 ):name ) )
         oTBrowse:addColumn( oColumn )
      NEXT
      oTBrowse:goTopBlock    := { || oConsulta:moveFirst() }
      oTBrowse:goBottomBlock := { || oConsulta:moveLast() }
      oTBrowse:skipBlock     := { | n | ADOSkipper( oConsulta, n ) }
   ENDCASE

   DO WHILE .T.
      DO WHILE ! oTBrowse:Stable
         oTBrowse:Stabilize()
      ENDDO
      //oTBrowse:refreshCurrent()
      nKey := Inkey(0)
      oTBrowse:ApplyKey( nKey )
      IF nKey == K_ESC .OR. nKey == K_ENTER
         EXIT
      ENDIF
   ENDDO

   RETURN .t.

   // --- ADO ---

FUNCTION ADOFieldBlock( oConsulta, nCont )

   RETURN { || oConsulta:Fields( nCont ):Value }

   // --- ADO ---

FUNCTION ADOSkipper( oConsulta, nSkip )

   LOCAL nPos := oConsulta:AbsolutePosition()

   IF ! oConsulta:Eof()
      oConsulta:Move( nSkip )
      IF oConsulta:Eof()
         oConsulta:MoveLast()
      ENDIF
      IF oConsulta:Bof()
         oConsulta:MoveFirst()
      ENDIF
   ENDIF

   RETURN oConsulta:AbsolutePosition() - nPos

   // --- DBF ---

FUNCTION DBFFieldBlock( nCont )

   RETURN { || FieldGet( nCont ) }

   // --- Array ---

FUNCTION ArrayFieldBlock( oConsulta, nIndex, nCont )

   RETURN { || oConsulta[ nIndex, nCont ] }

   // --- Recordset ADO ---

#define AD_VARCHAR                      200

FUNCTION RecordsetADO()

   LOCAL nCont, cChar := "A"
   LOCAL oConsulta := win_OleCreateObject( "ADODB.Recordset" )

   WITH OBJECT oConsulta
      :Fields:Append( "NOME", AD_VARCHAR, 30 )
      :Fields:Append( "ENDERECO", AD_VARCHAR, 30 )
      :Open()
      FOR nCont = 1 TO 10000
         :AddNew()
         :Fields( "NOME" ):Value := "ADONOM" + Replicate( cChar, 10 ) + Str( nCont, 6 )
         :Fields( "ENDERECO" ):Value := "ADOEND" + Replicate( cChar, 10 ) + Str( nCont, 6 )
         :Update()
         cChar := iif( cChar == "Z", "A", Chr( Asc( cChar ) + 1 ) )
      NEXT
      :MoveFirst()
   ENDWITH

   RETURN oConsulta

// --- DBF ---
FUNCTION CreateDbf( cName )

   dbCreate( cName, { ;
      { "NOME", "C", 20, 0 }, ;
      { "ENDERECO", "C", 30, 0 } } )
   USE ( cName )
   APPEND BLANK
   REPLACE test->nome WITH "DBFAAAA", test->Endereco WITH "DBFAAAA"
   APPEND BLANK
   REPLACE test->nome WITH "DBFBBBB", test->Endereco WITH "DBFBBBB"
   APPEND BLANK
   REPLACE test->Nome WITH "DBFCCCC", test->Endereco WITH "DBFDDDD"
   USE

   RETURN NIL

Nota:
ADO com 10.000 registros, apesar de não fazer diferença.
Mostra bem como o browse ADO não depende de ficar consultando servidor, e basta QUALQUER recordset ADO, não importa nem se existe servidor, e nem qual é o banco de dados (MySQL, Access, Excel, Firebird, SQL Server, só ADO, etc ).

[JoséQuintas]

É só um exemplo.
Seja qual for o tipo de browse, o ideal é NÃO deixar automático.
O ideal é passar um array com as colunas do tbrowse, com formatação mais adequada dos campos

Algo do tipo:

Código: Selecionar todos

aLista := { ;
   { "codigo", { || Str( codigo, 10 ) }, ;
   { "nome", { || Pad( nome, 30 ) } }

Mas pra isso, já não seria a mesma rotina, lógico.

No caso do ADO, também dá pra tirar proveito de recursos.

Filtrar enquanto digita, pra qualquer campo/posição, usando :Filter( "nome like '%jose%'" or endereco like '%jose%' )
usar outros tipos de filtro: :Filter( "valor > 5000 and data > '2020-06-01'" )
Ordenar, usando :Sort = "nome, codigo"
Posicionar, usando :Find ou :Seek
E tudo local, sem precisar consultar novamente servidor/banco de dados

Fica lento... com 1 milhão de registros, por exemplo, mas... aí seria o caso de pensar em filtros adicionais.