/*
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 Teste()

   LOCAL oRs, oTBrowse
   LOCAL oCN := ConexaoMySQL( "serverjpa", "tatu", "tatu", "tatu" )

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

   hb_gtInfo( HB_GTI_WINTITLE , "Testes TBrowse colorBlock() com Acesso ao MySQL via ADO" )
   hb_gtInfo( HB_GTI_FONTNAME , "Lucida Console" )
   SetMode( 20, 80 )
   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( "SELECT * FROM tbDieta;" )
      SuperADO( oRs )
      IF oRs == NIL .OR. oRs:Eof()
         Hb_Alert( "Não foi possível obter dados para exibição.",, "W+/B" )
         EXIT
      ENDIF
      oTBrowse := { ;
         { "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 ) } } }

      BrowseADO( oRs, oTBrowse )
      IF Alert( "Fechar?", { " Não ", " Sim " }, "W+/N" ) == 2
         oRs:Close()
         EXIT
      ENDIF
      EXIT
   ENDDO
   oCn:close()

   RETURN Nil

FUNCTION BrowseADO( oRs, oTBrowse )

   LOCAL oTbr, nKey, oColumn, aItem, nLen, I

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

   IF oTBrowse == 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
         oTbr:addColumn( oColumn )
      NEXT
   ELSE
      FOR EACH aItem IN oTBrowse
         oColumn := TBColumnNew( aItem[1], aItem[2] )
         IF Len( aItem ) > 2
            oColumn:ColorBlock := aItem[3]
         ENDIF
         oTbr:AddColumn( oColumn )
      NEXT
   ENDIF

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

   DO WHILE .T.

      oTbr:refreshCurrent()
      DO WHILE ! oTbr:Stable()
         oTbr:Stabilize()
      ENDDO
      // Paint TBrowse current line...
      //oTbr:ColorRect( { oTbr:RowPos, oTbr:LeftVisible, oTbr:RowPos, oTbr: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 oTbr: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")

   /*
   Ajuste aqui a connection string conforme o banco
   Ou pequise aqui...: https://www.connectionstrings.com/
   */
   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