Olá!
Veja:
Segue o código. Estude, adapte à tua necessidade e informe se funcionou.
/*
Exibição das linhas de um Record set ADO usando TBrowseDB()
Alexandre Santos
Compilar: Hbmk2 tbado hbwin.hbc
*/
#include "tbrowse.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "hbgtinfo.ch"
#include "box.ch"
#include "set.ch"
#include "ado.ch"
// Default column separator
#define DEF_CSEP " " + chr(179) + " "
// Default heading separator
#define DEF_HSEP chr(196) + chr(194) + chr(196)
// Default footing separator
#define DEF_FSEP chr(196) + chr(193) + chr(196)
FUNCTION Teste()
LOCAL oCn, oRs, oColumn, oTbr As Object
LOCAL i, nLen, nKey, nOldCursor As Numeric
LOCAL cCnString as Character
LOCAL bErr := ErrorBlock( __BreakBlock() ), oErr
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_GT_WIN
HB_CDPSELECT("PTISO")
BEGIN SEQUENCE
SetUp()
/*
Ajuste aqui a connection string conforme o banco
Ou pequise aqui...: https://www.connectionstrings.com/
*/
cCnString := "DRIVER={MariaDB ODBC 3.1 Driver};TCPIP=1;SERVER=localhost;Database=test;UID=root;PWD=root;PORT=3306"
oCn := win_OleCreateObject("ADODB.Connection")
oCn:ConnectionString := cCnString
oCn:CursorLocation := adUseClient
oCn:Mode := adModeReadWrite
oCn:open()
DispOutAt( MaxRow(), 4, PadR( "Obtendo informações... ",22 ), "W/W" )
oRs := oCn:Execute( "SELECT * FROM tbDieta;" )
IF oRs != NIL .And. oRs:state = adStateOpen
oTbr := TBrowse():new( 02, 3, MaxRow() - 3, MaxCol() - 3 )
// Separators
oTbr:headSep := DEF_HSEP
oTbr:colSep := DEF_CSEP
oTbr:footSep := DEF_FSEP
// Navigation code blocks for Record Set
oTbr:goTopBlock := { || oRs:moveFirst() }
oTbr:goBottomBlock := { || oRs:moveLast() }
oTbr:skipBlock := { |n| ADORecordSetSkipper( oRs,n ) }
// Colors
oTbr:colorSpec := "N/W, W+/N,N/W*,W+/R,R/W,R/W*"
// 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
If i==2 // coluna 3
oColumn:width := 25
oColumn:colorBlock := { |x| If( At( "TOTAL ", Upper(x) ) > 0, { 5, 5 }, { 1, 2 } ) }
Endif
// Add new column to TBrowse
oTbr:addColumn( oColumn )
NEXT
// border
DispBox( oTbr:nTop - 1, oTbr:nLeft - 1, oTbr:nBottom + 3, oTbr:nRight + 1, B_SINGLE )
nOldCursor := SetCursor( SC_NONE )
IF ( oRs:eof() )
DispOutAt( Int( ( oTbr:nBottom - oTbr:nTop ) / 2 ), oTbr:nLeft + 2, ;
PadC( "Não há dados disponÃveis para exibição.", Int( oTbr:nRight - oTbr:nLeft ) - 2 ), "W+/RB" )
__Quit()
ENDIF
DO WHILE .T.
oTbr:forceStable()
// Paint TBrowse current line...
oTbr:ColorRect( { oTbr:RowPos, oTbr:LeftVisible, oTbr:RowPos, oTbr:RightVisible }, { 2, 1 } )
// ... and current cell in different colors
If oTbr:colPos == 3 .And. At( "TOTAL ", Upper( Eval( oTBr:getColumn( 3 ):block ) ) ) > 0
oTbr:ColorRect( { oTbr:rowPos, oTbr:colPos, oTbr:rowPos, oTbr:colPos }, { 6, 6 } )
Else
oTbr:ColorRect( { oTbr:rowPos, oTbr:colPos, oTbr:rowPos, oTbr:colPos }, { 3, 2 } )
Endif
oTbr:refreshCurrent()
DispOutAt( MaxRow() - 1, 3, PadR( " Registro " + Ltrim( Str( oRs:AbsolutePosition ) ) + " de " + Ltrim( Str( oRs:recordCount ) ) + " ", 20 ), "N/W" )
nKey := Inkey(0)
IF oTbr:applyKey( nKey ) == TBR_EXIT
If Alert( "Fechar?", { " Não ", " Sim " }, "W+/N" ) == 2
EXIT
Endif
ENDIF
ENDDO
ELSE
Hb_Alert( "Não foi possÃvel obter dados para exibição.",, "W+/B" )
ENDIF
RECOVER USING oErr
hb_Alert( { PadC( "*** Uma exceção não tratada foi encontrada ***", 50 ), ;
Replicate( "_", 50 ), "", ;
PadR( " Erro : " + oErr:description, 50 ), ;
PadR( " Operação : " + oErr:operation, 50 ), ;
PadR( " Subsistema : " + oErr:subsystem, 50 ), ;
PadR( " Subcódigo : " + LTrim( Str( oErr:subcode ) ), 50 ), ;
PadR( " Programa : " + ProcFile(), 50 ), ;
PadR( " Procedure : " + ProcName(), 50 ), ;
PadR( " Linha : " + LTrim( Str( ProcLine() ) ), 50 ), "", "", ;
Replicate( "_", 50 ), "" },, "W+/N" )
ALWAYS
If oRs != NIL .And. oRs:state() = adStateOpen
oRs:close()
Endif
If oCn != NIL .And. oCn:state = adStateOpen
oCn:close()
Endif
oCn := NIL
oRs := NIL
SetCursor( nOldCursor )
ErrorBlock( bErr )
END SEQUENCE
CLS
RETURN NIL
//------------------------------------------------------------------------------
STATIC FUNCTION SetUp()
LOCAL nHeight := 20
LOCAL nWidth := Int( nHeight / 2 )
SetMode(32, 120)
SetBlink( .F. )
Set( _SET_DELETED, .T. )
Set( _SET_EXACT, .T. )
Set( _SET_EPOCH, Year( Date() - 90 ) )
Set( _SET_DATEFORMAT, "DD/MM/YYYY" )
#ifdef _SET_EVENTMASK
Set( _SET_EVENTMASK, INKEY_ALL + HB_INKEY_GTEVENT - INKEY_MOVE )
MSetCursor( .t. )
#endif
hb_gtInfo( HB_GTI_WINTITLE , "Testes TBrowse colorBlock() com Acesso ao MySQL via ADO" )
hb_gtInfo( HB_GTI_ALTENTER, .T. ) // allow <Alt-Enter> for full screen
hb_gtinfo( HB_GTI_SELECTCOPY, .T.)
hb_gtInfo( HB_GTI_CLOSABLE, .F. )
hb_gtinfo( HB_GTI_RESIZABLE, .T.)
Do Case
Case hb_gtinfo( HB_GTI_DESKTOPWIDTH) > 1023
hb_gtinfo( HB_GTI_SCREENWIDTH, 960)
hb_gtinfo( HB_GTI_SCREENHEIGHT, 512)
hb_gtinfo( HB_GTI_FONTWIDTH, 10)
hb_gtinfo( HB_GTI_FONTSIZE, 22)
Case hb_gtinfo( HB_GTI_DESKTOPWIDTH) > 799
hb_gtinfo( HB_GTI_SCREENWIDTH, 640)
hb_gtinfo( HB_GTI_SCREENHEIGHT, 400)
hb_gtinfo( HB_GTI_FONTWIDTH, 12)
hb_gtinfo( HB_GTI_FONTSIZE, 27)
Otherwise
hb_gtinfo( HB_GTI_FONTWIDTH, 8)
hb_gtinfo( HB_GTI_FONTSIZE, 17)
Endcase
hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
hb_gtInfo( HB_GTI_FONTWIDTH, nWidth )
hb_gtInfo( HB_GTI_FONTSIZE , nHeight )
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 Rgb( r, g, b )
RETURN ( r + ( g * 256 ) + ( b * 256 * 256 ) )
//------------------------------------------------------------------------------
Criação e população da tabela:
CREATE TABLE tbDieta ( data date,
hora varchar(8),
comida varchar(30),
quantidade varchar(10),
pontos decimal(6,2),
id int(6)
);
INSERT INTO tbDieta (data, hora, comida, quantidade, pontos, id)
VALUES
('2021-07-20', '09:56:12', 'leite', '1 copo', 5.0, 26692 ),
('2021-07-20', '09:56:42', 'café', '1 xÃcara', 1.0, 26692 ),
('2021-07-20', '11:29:00', 'Total do café da manhã', '', 6.0, 26844 ),
('2021-07-20', '12:56:55', 'arroz', '50g', 10.0, 26692 ),
('2021-07-20', '12:57:15', 'feijão', '30g', 5.0, 26692 ),
('2021-07-20', '12:57:26', 'carne', '50g', 20.0, 26692 ),
('2021-07-20', '13:59:00', 'Total do almoço', '', 35.0, 26844 ),
('2021-07-20', '16:57:34', 'pão', '1', 30.0, 26693 ),
('2021-07-20', '16:58:10', 'leite', '1 copo', 5.0, 26693 ),
('2021-07-20', '19:59:00', 'Total do lanche da tarde', '', 35.0, 26844 ),
('2021-07-20', '21:58:27', 'lasanha', '100g', 100.0, 26693 ),
('2021-07-20', '23:59:00', 'Total da janta', '', 100.0, 26845 ),
('2021-07-20', '23:59:05', 'Total de pontos', '', 176.0, 26845 );
Peguei os dados da imagem postada acima pelo Inácio, usando o
On Line OCR. Interessante...
