#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 ).