Converting sample test of Tplan

[Silvio.Falconi]

I cannot open a dbf
the dbf is on the root of the test




the error

Code: Select all

Application
===========
   Path and name: C:\Work\Errori\plan_tdata\sample03.Exe (32 bits)
   Size: 3,492,864 bytes
   Compiler version: Harbour 3.2.0dev (r1904111533)
   FiveWin  version: FWH 19.05
   C compiler version: Borland/Embarcadero C++ 7.0 (32-bit)
   Windows version: 6.2, Build 9200 

   Time from start: 0 hours 0 mins 0 secs 
   Error occurred at: 06/20/2019, 13:19:55
   Error description: Error BASE/1002  Alias inesistente: ROOMS

Stack Calls
===========
   Called from:  => DBUSEAREA( 0 )
   Called from: .\source\classes\DATABASE.PRG => (b)TDATABASE_USE( 424 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:TD_EXECLOOP( 2085 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:USE( 424 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:OPEN( 352 )
   Called from: sample03.prg => SAMPLEPLAN:OPENDATA( 685 )
   Called from: sample03.prg => SAMPLEPLAN:NEW( 86 )
   Called from: sample03.prg => MAIN( 32 )

openData method

Code: Select all

METHOD OpenData() CLASS SamplePlan

   oRooms:= TDatabase():Open( nil, "Rooms", "DBFCDX", .t. )
   oRooms:setorder(1)
   oRooms:gotop()

   oReserva:=TDatabase():Open( nil, "Reserva", "DBFCDX", .T. )
   oReserva:setorder(1)
   oReserva:gotop()

 return nil

where is the error ?

[nageswaragunupudi]

You can not get this error if you use unmodified TDatabase.
There can never be alias names like ROOMS with TDatabase.
Please post a self contained sample to reproduce the error.

[Silvio.Falconi]

this is the sample03 for Tplan of Daniel I 'm trying to use tdatabase of fwh ( fw 19.05) no modified

Code: Select all

#include "fivewin.ch"
#include "ord.ch"
#include "planning.ch"
#include "dtpicker.ch"

REQUEST DBFCDX
REQUEST HB_Lang_IT
REQUEST HB_CODEPAGE_ITWIN

#define PLANNING_RESERVED   1
#define PLANNING_CONFIRMED  2
#define PLANNING_OCCUPIED   3
#define PLANNING_CANCELED   4
#define PLANNING_EMPTY      5


// TEST WITH TDATABASE



Static oRooms,oReserva   //oDbf

function Main()

   SET DATE FORMAT "MM/DD/YYYY"
   SET DELETE ON

   HB_LangSelect("IT")
   HB_CDPSELECT("ITWIN")


   SamplePlan():New()

return nil

// status 01 reserved
// status 02 confirmed
// status 03 occupied
// status 04 canceled

//---------------------------------------------------//

CLASS SamplePlan

   DATA oPlann
   DATA oWnd
   DATA aStatus
   DATA dStart, dEnd
   DATA oData

   METHOD New()

   METHOD BuildDbf()
   METHOD BuildDialog()
   METHOD BuildPlanning()
   METHOD BuildPop()

   METHOD DeleteData( oPlan, dCheckIn )

   METHOD ColorData( oData )

   METHOD LoadData()
   METHOD LoadRooms()
   METHOD MoveReservation( nRow, nCol, nType )
   METHOD ResizeReservation( oData, nRowId, oPlann )
   METHOD OpenData()
ENDCLASS

//---------------------------------------------------//

METHOD New() CLASS SamplePlan

   local oMenu, oBrush
   local oSelf := Self

   ::aStatus = { "Reserved", "Confirmed", "Occupied", "Canceled", "Empty" }


   MENU oMenu
   ENDMENU

   DEFINE BRUSH oBrush COLOR CLR_WHITE

   ::BuildDbf()

   ::OpenData()

   DEFINE WINDOW ::oWnd BRUSH obrush ;
   TITLE "test con Tdatabase"

   ::BuildPlanning()
   ::LoadRooms()
   ::LoadData()

   ::oWnd:oClient = ::oPlann

   ACTIVATE WINDOW ::oWnd

   oBrush:End()


RETURN Self

//---------------------------------------------------//


METHOD BuildDbf() CLASS SamplePlan

   local aStructure
   local i


   if ! File( "rooms.dbf" )

      aStructure = { { "id"   , "C",   4, 0 },;
                      { "name" , "C",  30, 0 },;
                      { "type" , "C",   2, 0 } }

      DBCreate( "rooms", aStructure, "DBFCDX" )

   endif

   if ! File( "reserva.dbf" )

      aStructure = { { "date"     , "D",   8, 0 },;
                      { "rooms_id" , "C",   4, 0 },;
                      { "check_in" , "D",   8, 0 },;
                      { "check_out", "D",   8, 0 },;
                      { "status"   , "C",   2, 0 },;
                      { "guest"    , "C",  30, 0 } }

      DBCreate( "reserva", aStructure, "DBFCDX" )

   ENDIF

   USE ROOMS ALIAS ROOMS VIA "DBFCDX" NEW
   INDEX ON ROOMS->ID TAG rooms_id TO rooms

   USE RESERVA ALIAS RESERVA VIA "DBFCDX" NEW
   INDEX ON RESERVA->ROOMS_ID + DToS( RESERVA->CHECK_IN ) TAG room_in TO reserva

   if ROOMS->( LastRec() ) == 0
      for i = 1 to 30
         ROOMS->( DbAppend() )
         ROOMS->ID   = StrZero( i, 2 )
         ROOMS->NAME = "Room " + StrZero( i, 2 )
         ROOMS->TYPE = StrZero( i % 5, 2 )
      next
   endif
   Rooms->(dbclosearea())
   RESERVA->(dbclosearea())




RETURN nil

//---------------------------------------------------//

METHOD BuildDialog( oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oDlg, oCbx
   local lSave := .F.
   local lNew := .T.
   local cVar, cName := Space( 30 )
   local nAt := 1
   local adata

   Local nCella,cTipo,cText,nResno


   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif




 /*
   DEFINE DIALOG oDlg TITLE "Adding Data" SIZE 350, 370

   if ! lNew
      RESERVA->( DBSeek( oPlan:GetRowID() + DToS( dCheckIn ) ) )
      cName    := RESERVA->GUEST
      nAt      := Val( RESERVA->STATUS )

   endif


   //cCheckIn = oPlan:aSelected[ 1 ]

   @ 10, 10 SAY "Room: " + oPlan:GetRowText()  OF oDlg PIXEL
   @ 25, 10 SAY "Check In: " + DToC( dCheckIn ) OF oDlg PIXEL
   @ 40, 10 SAY "Check Out:" + DToC( dCheckOut ) OF oDlg PIXEL
   @ 55, 10 SAY "Status:" OF oDlg PIXEL
   @ 55, 55 COMBOBOX oCbx VAR cVar;
             ITEMS ::aStatus;
             STYLE CBS_DROPDOWN PIXEL
   @ 70, 10 SAY "Guest Name:" OF oDlg PIXEL
   @ 70, 55 GET cName OF oDlg PIXEL

   @ 170, 10 BUTTON "OK" PIXEL ACTION ( lSave := .T., oDlg:End() )
   @ 170, 100 BUTTON "CANCEL" PIXEL ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED;
            ON INIT oCbx:Select( nAt )

   IF lSave
      if lNew
         RESERVA->( DBAppend() )
      else
         RESERVA->( DBSeek( oPlan:GetRowID() + DToS( dCheckIn ) ) )
      endif

      RESERVA->DATE      = Date()
      RESERVA->ROOMS_ID  = oPlan:GetRowID()
      RESERVA->CHECK_IN  = dCheckIn
      RESERVA->CHECK_OUT = dCheckOut
      RESERVA->STATUS    = StrZero( oCbx:nAt, 2 )
      RESERVA->GUEST     = cName
      RESERVA->( DbCommitAll() )

      ::LoadData()
      oPlan:Refresh()

   ENDIF
  */


  * DEFINE DIALOG oDlg SIZE 1120,650 ;
        *         PIXEL TRUEPIXEL RESIZABLE FONT oFont ;
          *       TITLE "Prenotazione numero : "+ nInvoice

  DEFINE DIALOG oDlg TITLE "Adding Data" SIZE 350, 370

    if ! lNew
      oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
      cName    := oReserva:GUEST
      nAt      := Val( oReserva:STATUS )

   endif

        oDlg:settext("Prenotazione n."+ nResno)

   //cCheckIn = oPlan:aSelected[ 1 ]

   @ 10, 10 SAY "Room: " + oPlan:GetRowText()  OF oDlg PIXEL
   @ 25, 10 SAY "Check In: " + DToC( dCheckIn ) OF oDlg PIXEL
   @ 40, 10 SAY "Check Out:" + DToC( dCheckOut ) OF oDlg PIXEL
   @ 55, 10 SAY "Status:" OF oDlg PIXEL
   @ 55, 55 COMBOBOX oCbx VAR cVar;
             ITEMS ::aStatus;
             STYLE CBS_DROPDOWN PIXEL
   @ 70, 10 SAY "Guest Name:" OF oDlg PIXEL
   @ 70, 55 GET cName OF oDlg PIXEL

   @ 170, 10 BUTTON "OK" PIXEL ACTION ( lSave := .T., oDlg:End() )
   @ 170, 100 BUTTON "CANCEL" PIXEL ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED;
            ON INIT oCbx:Select( nAt )

   IF lSave
      if lNew
         *oReserva:Append()
         oRec:=oReserva:record(.t.)
      else
         oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
          oRec:=oReserva:record()
      endif

      oRec:DATE      := Date()
      oRec:ROOMS_ID  := oPlan:GetRowID()
      oRec:CHECK_IN  := dCheckIn
      oRec:CHECK_OUT := dCheckOut
      oRec:STATUS    := StrZero( oCbx:nAt, 2 )
      oRec:GUEST     := cName


     // RESERVA->( DbCommitAll() )

      //new fields add by silvio
      oRec:Resno     := nResNo
      oRec:Type_Room := cTipo


      oRec:save()


      ::LoadData()

      oPlan:Refresh()

   ENDIF

  oRec:End()

RETURN nil

//---------------------------------------------------//

METHOD BuildPlanning() CLASS SamplePlan

   LOCAL oSelf := Self



   DEFINE PLANNING ::oPlann OF ::oWnd;
          HEADER "Stanze/Giorni";
          COLOR HEADER ( If( Dow( dDate ) == 1 .OR.  Dow( dDate ) == 7, CLR_WHITE, oSelf:oPlann:nClrText )  );
          COLOR CELL ::ColorData( oData ) ;
          START DAY Date() - 5;
          END DAY Date() + 5;
          ON RIGHT SELECT oSelf:BuildPop( nRow, nCol, oSelf:oPlann, dCheckIn, dCheckOut );
          ON CAPTURE oSelf:MoveReservation(oSelf:oData, nRowId, oSelf:oPlann);
          ON RESIZE DATA  oSelf:ResizeReservation(oSelf:oData, nRowId, Self)

           ::oPlann:lNoHalfDay    := .T. // also  one day
           ::oPlann:nLeftLabelWidth := 160

           ::dStart = ::oPlann:dStart
          ::dEnd = ::oPlann:dEnd

          @ 10, 10 DTPICKER ::dStart OF ::oPlann pixel ;
            ON CHANGE ( if( oSelf:dStart != oSelf:oPlann:dStart, ( oSelf:oPlann:SetDates( oSelf:dStart ), oSelf:LoadData() ), ) )

   @ 10, 120 DTPICKER ::dEnd OF ::oPlann pixel;
            ON CHANGE ( if( oSelf:dEnd != oSelf:oPlann:dEnd, ( oSelf:oPlann:SetDates( , oSelf:dEnd ), oSelf:LoadData() ), ) )


RETURN nil


//---------------------------------------------------//

METHOD BuildPop( nRow, nCol, oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oMenu
   local oSelf := Self
   local lNew := .T.

   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif

   MENU oMenu POPUP
      MENUITEM If( lNew, "New Reserve",;
                         "Modify Reserve" ) ACTION oSelf:BuildDialog( oPlan, dCheckIn, dCheckOut )
      if ! lNew
         MENUITEM "Delete Reserve"  ACTION If( MsgYesNo( "Are you sure?" ), oSelf:DeleteData( oPlan, dCheckIn ) , )
      endif

   ENDMENU


   ACTIVATE POPUP oMenu OF oPlan AT nRow, nCol

RETURN nil

//---------------------------------------------------//

METHOD DeleteData( oPlan, dCheckIn ) CLASS SamplePlan

   if oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
       oReserva:Delete()
       oPlan:DeleteData( oPlan:oLastData )
   endif


RETURN nil


//---------------------------------------------------//

METHOD ColorData( oData ) CLASS SamplePlan
   local aGrad

   //"Reserved", "Confirmed", "Occupied", "Calceled", "Empty"
   switch oData:Cargo['STATUS']
      case PLANNING_RESERVED
         aGrad = { { 1, RGB(0x9a,0xcd,0x32), RGB(0x9a,0xcd,0x32) } }
         exit
      case PLANNING_CONFIRMED
         aGrad = { { 1, RGB(0x00,0x80,0xff) , RGB(0x00,0x80,0xff) } }
         exit
      case PLANNING_OCCUPIED
         aGrad = { { 1, RGB(0xff,0xff,0x80), RGB(0xff,0xff,0x80) } }
         exit
      case PLANNING_CANCELED
         aGrad = { { 1, RGB(0xff,0x00,0x00), RGB(0xff,0x00,0x00) } }
         exit
      case PLANNING_EMPTY
         aGrad = { { 1, RGB(0xc0,0xc0,0xc0), RGB(0xc0,0xc0,0xc0) } }

   endswitch

return aGrad

//---------------------------------------------------//

METHOD LoadData() CLASS SamplePlan

   local cDescribe
   local nStatus
   local cTooltip

   //Clear scopes
  /*

   RESERVA->( OrdSetFocus( "room_in" ) )
   RESERVA->( OrdScope( TOPSCOPE, NIL ) )
   RESERVA->( OrdScope( BOTTOMSCOPE, NIL ) )
   RESERVA->(  DBGoTop() )
   RESERVA->( OrdScope( TOPSCOPE, Month( ::oPlann:dStart ) ) )
   RESERVA->( OrdScope( BOTTOMSCOPE, Month( ::oPlann:dEnd ) ) )
   RESERVA->(  DBGoTop() )

   */


   oReserva:OrdSetFocus( "room_in" )
   oReserva:OrdScope( TOPSCOPE, NIL )
   oReserva:OrdScope( BOTTOMSCOPE, NIL )
   oReserva:GoTop()
   oReserva:OrdScope( TOPSCOPE, Month( ::oPlann:dStart ) )
   oReserva:OrdScope( BOTTOMSCOPE, Month( ::oPlann:dEnd ) )
   oReserva:GoTop()



   /*
   DO WHILE ! RESERVA->( Eof() )
      if DToS( RESERVA->CHECK_OUT ) > DToS( ::oPlann:dStart ) .AND. DToS( RESERVA->CHECK_IN ) < DToS( ::oPlann:dEnd )

         cDescribe = "Empty..."
         nStatus = Val( RESERVA->STATUS )
         if nStatus > 0 .and. nStatus < 5
            cDescribe = ::aStatus[ nStatus ]
         endif


         ROOMS->( DbSeek( RESERVA->ROOMS_ID ) )

         cTooltip  = "Room     : " + ROOMS->NAME + CRLF
         cTooltip += "Guest    : " + RESERVA->GUEST + CRLF
         cTooltip += "Check In : " + DToC( RESERVA->CHECK_IN ) + CRLF
         cTooltip += "Check Out: " + DToC( RESERVA->CHECK_OUT )
         oData = ::oPlann:AddData( RESERVA->ROOMS_ID,;
                           RESERVA->CHECK_IN,;
                           RESERVA->CHECK_OUT,;
                           cDescribe, cToolTip )
         if oData != NIL
            oData:Cargo = {=>}
            oData:Cargo["STATUS"] = nStatus
            oData:Cargo["INDICE"] = RESERVA->ROOMS_ID + DToS(RESERVA->CHECK_IN)
         endif
      endif

      RESERVA->( DbSkip() )

   ENDDO
     */



 DO WHILE ! oReserva:Eof()
      if DToS( oReserva:CHECK_OUT ) > DToS( ::oPlann:dStart ) .AND. DToS( oReserva:CHECK_IN ) < DToS( ::oPlann:dEnd )

         cDescribe = "Empty..."
         nStatus = Val( oReserva:STATUS )
         if nStatus > 0 .and. nStatus < 5
            cDescribe = ::aStatus[ nStatus ]
         endif


         oRooms:Seek( oReserva:ROOMS_ID )

         cTooltip  = "Room     : " + oRooms:NAME + CRLF
         cTooltip += "Guest    : " + oReserva:GUEST + CRLF
         cTooltip += "Check In : " + DToC( oReserva:CHECK_IN ) + CRLF
         cTooltip += "Check Out: " + DToC( oReserva:CHECK_OUT )
         ::oData = ::oPlann:AddData( oReserva:ROOMS_ID,;
                           oReserva:CHECK_IN,;
                           oReserva:CHECK_OUT,;
                           cDescribe, cToolTip )

         if ::oData != NIL
            ::oData:Cargo = {=>}
            ::oData:Cargo["STATUS"] = nStatus
            ::oData:Cargo["INDICE"] = oReserva:ROOMS_ID + DToS(oReserva:CHECK_IN)
         endif
      endif

      oReserva:Skip()

   ENDDO

   return NIL


//---------------------------------------------------//

METHOD LoadRooms() CLASS SamplePlan

   local n
   local cRowName, cRowText


  /*
  ROOMS->( DbGoTop() )

   DO WHILE ! ROOMS->( Eof() )
      ::oPlann:AddRow( ROOMS->ID, alltrim(ROOMS->NAME)+"-"+ROOMS->TYPE)
      ROOMS->( DbSkip() )
   ENDDO

  */

   oRooms:GoTop()

   DO WHILE ! oRooms:Eof()
      ::oPlann:AddRow( oRooms:ID, alltrim(oRooms:NAME)+"-"+oRooms:TYPE)
      oRooms:Skip()
   ENDDO
RETURN nil

//---------------------------------------------------//

METHOD MoveReservation( oData, nRowId, oPlann ) CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus
   Local oRec

 /*
   RESERVA->( DBSeek( oItem:Cargo['INDICE'] ) )

   if oPlann:nDaysOffset != 0 .OR. oPlann:nRoomsOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      RESERVA->CHECK_IN += oPlann:nDaysOffset //determina cuantos dias nos movimos
      RESERVA->CHECK_OUT += oPlann:nDaysOffset //determina cuantos dias nos movimos
      RESERVA->ROOMS_ID = nRowId
      RESERVA->( DbCommitAll() )
      ROOMS->( DBSeek( nRowId ) )
      cTooltip  = "Room     : " + ROOMS->NAME + CRLF
      cTooltip += "Guest    : " + RESERVA->GUEST + CRLF
      cTooltip += "Check In : " + DToC( RESERVA->CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( RESERVA->CHECK_OUT )

      oData = oPlann:AddData( RESERVA->ROOMS_ID,;
                          RESERVA->CHECK_IN,;
                          RESERVA->CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = RESERVA->ROOMS_ID + DToS(RESERVA->CHECK_IN)
      oPlann:oLastData = NIL
   endif
   */

 oReserva:setorder(1)
 oReserva:Seek( oItem:Cargo['INDICE'] )
 oRec := oReserva:record()

   if oPlann:nDaysOffset != 0 .OR. oPlann:nRoomsOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

    /*  oReserva:CHECK_IN += oPlann:nDaysOffset //determina cuantos dias nos movimos
      oReserva:CHECK_OUT += oPlann:nDaysOffset //determina cuantos dias nos movimos
      oReserva:ROOMS_ID = nRowId
      * oReserva:DbCommitAll()
      */

             oRec:CHECK_IN += oPlann:nDaysOffset
             oRec:CHECK_OUT += oPlann:nDaysOffset
             oRec:ROOMS_ID = nRowId
             oRec:save()

      oRooms:Seek( nRowId )
      cTooltip  = "Room     : " + oRooms:NAME + CRLF
      cTooltip += "Guest    : " + oRec:GUEST + CRLF
      cTooltip += "Check In : " + DToC( oRec:CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( oRec:CHECK_OUT )

      ::oData = oPlann:AddData( oRec:ROOMS_ID,;
                          oRec:CHECK_IN,;
                          oRec:CHECK_OUT,;
                          cDescribe, cToolTip )
      ::oData:Cargo = {=>}
      ::oData:Cargo['STATUS'] = nStatus
      ::oData:Cargo['INDICE'] = oRec:ROOMS_ID + DToS(oRec:CHECK_IN)
      oPlann:oLastData = NIL
   endif

   oRec:end()

   RETURN nil
//---------------------------------------------------------------------//

METHOD ResizeReservation( oData, nRowId, oPlann )  CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus
   * Local oRec := TReservation():New(oReserva)
   Local oRec
  // SELECT RE
   oReserva:SetOrder( 1 )
   oReserva:Seek( oItem:Cargo['INDICE'] )
   oRec := oReserva:record()


   if oPlann:nDaysOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      oRec:CHECK_IN += If( oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      oRec:CHECK_OUT += If( ! oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      oRec:ROOMS_ID = nRowId
      //RE->( DbCommitAll() )
      oRec:save()

      //SELECT RO
      oRooms:Seek( nRowId )

      cTooltip  = "Room          : " + oRooms:NAME + CRLF
      cTooltip += "Tipologia     : " + oRooms:TYPE + CRLF
      cTooltip += "Guest         : " + oRec:GUEST + CRLF
      cTooltip += "Check In      : " + DToC( oRec:CHECK_IN ) + CRLF
      cTooltip += "Check Out     : " + DToC( oRec:CHECK_OUT )

      oData = oPlann:AddData( oRec:ROOMS_ID,;
                          oRec:CHECK_IN,;
                          oRec:CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = oRec:ROOMS_ID + DToS(oRec:CHECK_IN)
      oPlann:oLastData = NIL
   endif

    oRec:end()

RETURN nil

//----------------------------------------------------------------------------------//





















//---------------------------------------------------//

function HB_COMPILEFROMBUF()
return nil

function curdrive()
   return nil

//------------------------------------------------------------------//

METHOD OpenData() CLASS SamplePlan

   oRooms:= TDatabase():Open( nil, "Rooms", "DBFCDX", .t. )
   oRooms:setorder(1)
   oRooms:gotop()

   oReserva:=TDatabase():Open( nil, "Reserva", "DBFCDX", .T. )
   oReserva:setorder(1)
   oReserva:gotop()

 return nil


 

[TimStone]

You call ::OpenData() but I do not see the method in your code

[Silvio.Falconi]

Tim
the method ::OPenData there is at bottom

METHOD OpenData() CLASS SamplePlan

[Silvio.Falconi]

this evening I have allready that error



As U can see I not compile a new tdatabase ( modified) or tdata

and I have this error

Code: Select all

Application
===========
   Path and name: C:\Work\Errori\plan_tdata\sample03.Exe (32 bits)
   Size: 3,492,864 bytes
   Compiler version: Harbour 3.2.0dev (r1904111533)
   FiveWin  version: FWH 19.05
   C compiler version: Borland/Embarcadero C++ 7.0 (32-bit)
   Windows version: 6.2, Build 9200 

   Time from start: 0 hours 0 mins 0 secs 
   Error occurred at: 06/20/2019, 14:16:45
   Error description: Error BASE/1002  Alias inesistente: ROOMS

Stack Calls
===========
   Called from:  => DBUSEAREA( 0 )
   Called from: .\source\classes\DATABASE.PRG => (b)TDATABASE_USE( 424 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:TD_EXECLOOP( 2085 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:USE( 424 )
   Called from: .\source\classes\DATABASE.PRG => TDATABASE:OPEN( 352 )
   Called from: sample03.prg => SAMPLEPLAN:OPENDATA( 73 )
   Called from: sample03.prg => SAMPLEPLAN:NEW( 101 )
   Called from: sample03.prg => MAIN( 32 )

Now I insert the method OpenData on init ( I Hope Tim see it )

Code: Select all

#include "fivewin.ch"
#include "ord.ch"
#include "planning.ch"
#include "dtpicker.ch"

REQUEST DBFCDX
REQUEST HB_Lang_IT
REQUEST HB_CODEPAGE_ITWIN

#define PLANNING_RESERVED   1
#define PLANNING_CONFIRMED  2
#define PLANNING_OCCUPIED   3
#define PLANNING_CANCELED   4
#define PLANNING_EMPTY      5


// TEST WITH TDATABASE



Static oRooms,oReserva   //oDbf

function Main()

   SET DATE FORMAT "MM/DD/YYYY"
   SET DELETE ON

   HB_LangSelect("IT")
   HB_CDPSELECT("ITWIN")


   SamplePlan():New()

return nil

// status 01 reserved
// status 02 confirmed
// status 03 occupied
// status 04 canceled

//---------------------------------------------------//

CLASS SamplePlan

   DATA oPlann
   DATA oWnd
   DATA aStatus
   DATA dStart, dEnd
   DATA oData

   METHOD New()

   METHOD BuildDbf()
   METHOD BuildDialog()
   METHOD BuildPlanning()
   METHOD BuildPop()

   METHOD DeleteData( oPlan, dCheckIn )

   METHOD ColorData( oData )

   METHOD LoadData()
   METHOD LoadRooms()
   METHOD MoveReservation( nRow, nCol, nType )
   METHOD ResizeReservation( oData, nRowId, oPlann )
   METHOD OpenData()
ENDCLASS

//---------------------------------------------------//

METHOD OpenData() CLASS SamplePlan

   oRooms:= TDatabase():Open( nil, "Rooms", "DBFCDX", .t. )
   oRooms:setorder(1)
   oRooms:gotop()

   oReserva:=TDatabase():Open( nil, "Reserva", "DBFCDX", .T. )
   oReserva:setorder(1)
   oReserva:gotop()

 return nil




METHOD New() CLASS SamplePlan

   local oMenu, oBrush
   local oSelf := Self

   ::aStatus = { "Reserved", "Confirmed", "Occupied", "Canceled", "Empty" }


   MENU oMenu
   ENDMENU

   DEFINE BRUSH oBrush COLOR CLR_WHITE

   ::BuildDbf()

   ::OpenData()

   DEFINE WINDOW ::oWnd BRUSH obrush ;
   TITLE "test con Tdatabase"

   ::BuildPlanning()
   ::LoadRooms()
   ::LoadData()

   ::oWnd:oClient = ::oPlann

   ACTIVATE WINDOW ::oWnd

   oBrush:End()


RETURN Self

//---------------------------------------------------//


METHOD BuildDbf() CLASS SamplePlan

   local aStructure
   local i


   if ! File( "rooms.dbf" )

      aStructure = { { "id"   , "C",   4, 0 },;
                      { "name" , "C",  30, 0 },;
                      { "type" , "C",   2, 0 } }

      DBCreate( "rooms", aStructure, "DBFCDX" )

   endif

   if ! File( "reserva.dbf" )

      aStructure = { { "date"     , "D",   8, 0 },;
                      { "rooms_id" , "C",   4, 0 },;
                      { "check_in" , "D",   8, 0 },;
                      { "check_out", "D",   8, 0 },;
                      { "status"   , "C",   2, 0 },;
                      { "guest"    , "C",  30, 0 } }

      DBCreate( "reserva", aStructure, "DBFCDX" )

   ENDIF

   USE ROOMS ALIAS ROOMS VIA "DBFCDX" NEW
   INDEX ON ROOMS->ID TAG rooms_id TO rooms

   USE RESERVA ALIAS RESERVA VIA "DBFCDX" NEW
   INDEX ON RESERVA->ROOMS_ID + DToS( RESERVA->CHECK_IN ) TAG room_in TO reserva

   if ROOMS->( LastRec() ) == 0
      for i = 1 to 30
         ROOMS->( DbAppend() )
         ROOMS->ID   = StrZero( i, 2 )
         ROOMS->NAME = "Room " + StrZero( i, 2 )
         ROOMS->TYPE = StrZero( i % 5, 2 )
      next
   endif
   Rooms->(dbclosearea())
   RESERVA->(dbclosearea())




RETURN nil

//---------------------------------------------------//

METHOD BuildDialog( oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oDlg, oCbx
   local lSave := .F.
   local lNew := .T.
   local cVar, cName := Space( 30 )
   local nAt := 1
   local adata

   Local nCella,cTipo,cText,nResno


   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif




 /*
   DEFINE DIALOG oDlg TITLE "Adding Data" SIZE 350, 370

   if ! lNew
      RESERVA->( DBSeek( oPlan:GetRowID() + DToS( dCheckIn ) ) )
      cName    := RESERVA->GUEST
      nAt      := Val( RESERVA->STATUS )

   endif


   //cCheckIn = oPlan:aSelected[ 1 ]

   @ 10, 10 SAY "Room: " + oPlan:GetRowText()  OF oDlg PIXEL
   @ 25, 10 SAY "Check In: " + DToC( dCheckIn ) OF oDlg PIXEL
   @ 40, 10 SAY "Check Out:" + DToC( dCheckOut ) OF oDlg PIXEL
   @ 55, 10 SAY "Status:" OF oDlg PIXEL
   @ 55, 55 COMBOBOX oCbx VAR cVar;
             ITEMS ::aStatus;
             STYLE CBS_DROPDOWN PIXEL
   @ 70, 10 SAY "Guest Name:" OF oDlg PIXEL
   @ 70, 55 GET cName OF oDlg PIXEL

   @ 170, 10 BUTTON "OK" PIXEL ACTION ( lSave := .T., oDlg:End() )
   @ 170, 100 BUTTON "CANCEL" PIXEL ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED;
            ON INIT oCbx:Select( nAt )

   IF lSave
      if lNew
         RESERVA->( DBAppend() )
      else
         RESERVA->( DBSeek( oPlan:GetRowID() + DToS( dCheckIn ) ) )
      endif

      RESERVA->DATE      = Date()
      RESERVA->ROOMS_ID  = oPlan:GetRowID()
      RESERVA->CHECK_IN  = dCheckIn
      RESERVA->CHECK_OUT = dCheckOut
      RESERVA->STATUS    = StrZero( oCbx:nAt, 2 )
      RESERVA->GUEST     = cName
      RESERVA->( DbCommitAll() )

      ::LoadData()
      oPlan:Refresh()

   ENDIF
  */


  * DEFINE DIALOG oDlg SIZE 1120,650 ;
        *         PIXEL TRUEPIXEL RESIZABLE FONT oFont ;
          *       TITLE "Prenotazione numero : "+ nInvoice

  DEFINE DIALOG oDlg TITLE "Adding Data" SIZE 350, 370

    if ! lNew
      oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
      cName    := oReserva:GUEST
      nAt      := Val( oReserva:STATUS )

   endif

        oDlg:settext("Prenotazione n."+ nResno)

   //cCheckIn = oPlan:aSelected[ 1 ]

   @ 10, 10 SAY "Room: " + oPlan:GetRowText()  OF oDlg PIXEL
   @ 25, 10 SAY "Check In: " + DToC( dCheckIn ) OF oDlg PIXEL
   @ 40, 10 SAY "Check Out:" + DToC( dCheckOut ) OF oDlg PIXEL
   @ 55, 10 SAY "Status:" OF oDlg PIXEL
   @ 55, 55 COMBOBOX oCbx VAR cVar;
             ITEMS ::aStatus;
             STYLE CBS_DROPDOWN PIXEL
   @ 70, 10 SAY "Guest Name:" OF oDlg PIXEL
   @ 70, 55 GET cName OF oDlg PIXEL

   @ 170, 10 BUTTON "OK" PIXEL ACTION ( lSave := .T., oDlg:End() )
   @ 170, 100 BUTTON "CANCEL" PIXEL ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED;
            ON INIT oCbx:Select( nAt )

   IF lSave
      if lNew
         *oReserva:Append()
         oRec:=oReserva:record(.t.)
      else
         oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
          oRec:=oReserva:record()
      endif

      oRec:DATE      := Date()
      oRec:ROOMS_ID  := oPlan:GetRowID()
      oRec:CHECK_IN  := dCheckIn
      oRec:CHECK_OUT := dCheckOut
      oRec:STATUS    := StrZero( oCbx:nAt, 2 )
      oRec:GUEST     := cName


     // RESERVA->( DbCommitAll() )

      //new fields add by silvio
      oRec:Resno     := nResNo
      oRec:Type_Room := cTipo


      oRec:save()


      ::LoadData()

      oPlan:Refresh()

   ENDIF

  oRec:End()

RETURN nil

//---------------------------------------------------//

METHOD BuildPlanning() CLASS SamplePlan

   LOCAL oSelf := Self



   DEFINE PLANNING ::oPlann OF ::oWnd;
          HEADER "Stanze/Giorni";
          COLOR HEADER ( If( Dow( dDate ) == 1 .OR.  Dow( dDate ) == 7, CLR_WHITE, oSelf:oPlann:nClrText )  );
          COLOR CELL ::ColorData( oData ) ;
          START DAY Date() - 5;
          END DAY Date() + 5;
          ON RIGHT SELECT oSelf:BuildPop( nRow, nCol, oSelf:oPlann, dCheckIn, dCheckOut );
          ON CAPTURE oSelf:MoveReservation(oSelf:oData, nRowId, oSelf:oPlann);
          ON RESIZE DATA  oSelf:ResizeReservation(oSelf:oData, nRowId, Self)

           ::oPlann:lNoHalfDay    := .T. // also  one day
           ::oPlann:nLeftLabelWidth := 160

           ::dStart = ::oPlann:dStart
          ::dEnd = ::oPlann:dEnd

          @ 10, 10 DTPICKER ::dStart OF ::oPlann pixel ;
            ON CHANGE ( if( oSelf:dStart != oSelf:oPlann:dStart, ( oSelf:oPlann:SetDates( oSelf:dStart ), oSelf:LoadData() ), ) )

   @ 10, 120 DTPICKER ::dEnd OF ::oPlann pixel;
            ON CHANGE ( if( oSelf:dEnd != oSelf:oPlann:dEnd, ( oSelf:oPlann:SetDates( , oSelf:dEnd ), oSelf:LoadData() ), ) )


RETURN nil


//---------------------------------------------------//

METHOD BuildPop( nRow, nCol, oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oMenu
   local oSelf := Self
   local lNew := .T.

   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif

   MENU oMenu POPUP
      MENUITEM If( lNew, "New Reserve",;
                         "Modify Reserve" ) ACTION oSelf:BuildDialog( oPlan, dCheckIn, dCheckOut )
      if ! lNew
         MENUITEM "Delete Reserve"  ACTION If( MsgYesNo( "Are you sure?" ), oSelf:DeleteData( oPlan, dCheckIn ) , )
      endif

   ENDMENU


   ACTIVATE POPUP oMenu OF oPlan AT nRow, nCol

RETURN nil

//---------------------------------------------------//

METHOD DeleteData( oPlan, dCheckIn ) CLASS SamplePlan

   if oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
       oReserva:Delete()
       oPlan:DeleteData( oPlan:oLastData )
   endif


RETURN nil


//---------------------------------------------------//

METHOD ColorData( oData ) CLASS SamplePlan
   local aGrad

   //"Reserved", "Confirmed", "Occupied", "Calceled", "Empty"
   switch oData:Cargo['STATUS']
      case PLANNING_RESERVED
         aGrad = { { 1, RGB(0x9a,0xcd,0x32), RGB(0x9a,0xcd,0x32) } }
         exit
      case PLANNING_CONFIRMED
         aGrad = { { 1, RGB(0x00,0x80,0xff) , RGB(0x00,0x80,0xff) } }
         exit
      case PLANNING_OCCUPIED
         aGrad = { { 1, RGB(0xff,0xff,0x80), RGB(0xff,0xff,0x80) } }
         exit
      case PLANNING_CANCELED
         aGrad = { { 1, RGB(0xff,0x00,0x00), RGB(0xff,0x00,0x00) } }
         exit
      case PLANNING_EMPTY
         aGrad = { { 1, RGB(0xc0,0xc0,0xc0), RGB(0xc0,0xc0,0xc0) } }

   endswitch

return aGrad

//---------------------------------------------------//

METHOD LoadData() CLASS SamplePlan

   local cDescribe
   local nStatus
   local cTooltip

   //Clear scopes
  /*

   RESERVA->( OrdSetFocus( "room_in" ) )
   RESERVA->( OrdScope( TOPSCOPE, NIL ) )
   RESERVA->( OrdScope( BOTTOMSCOPE, NIL ) )
   RESERVA->(  DBGoTop() )
   RESERVA->( OrdScope( TOPSCOPE, Month( ::oPlann:dStart ) ) )
   RESERVA->( OrdScope( BOTTOMSCOPE, Month( ::oPlann:dEnd ) ) )
   RESERVA->(  DBGoTop() )

   */


   oReserva:OrdSetFocus( "room_in" )
   oReserva:OrdScope( TOPSCOPE, NIL )
   oReserva:OrdScope( BOTTOMSCOPE, NIL )
   oReserva:GoTop()
   oReserva:OrdScope( TOPSCOPE, Month( ::oPlann:dStart ) )
   oReserva:OrdScope( BOTTOMSCOPE, Month( ::oPlann:dEnd ) )
   oReserva:GoTop()



   /*
   DO WHILE ! RESERVA->( Eof() )
      if DToS( RESERVA->CHECK_OUT ) > DToS( ::oPlann:dStart ) .AND. DToS( RESERVA->CHECK_IN ) < DToS( ::oPlann:dEnd )

         cDescribe = "Empty..."
         nStatus = Val( RESERVA->STATUS )
         if nStatus > 0 .and. nStatus < 5
            cDescribe = ::aStatus[ nStatus ]
         endif


         ROOMS->( DbSeek( RESERVA->ROOMS_ID ) )

         cTooltip  = "Room     : " + ROOMS->NAME + CRLF
         cTooltip += "Guest    : " + RESERVA->GUEST + CRLF
         cTooltip += "Check In : " + DToC( RESERVA->CHECK_IN ) + CRLF
         cTooltip += "Check Out: " + DToC( RESERVA->CHECK_OUT )
         oData = ::oPlann:AddData( RESERVA->ROOMS_ID,;
                           RESERVA->CHECK_IN,;
                           RESERVA->CHECK_OUT,;
                           cDescribe, cToolTip )
         if oData != NIL
            oData:Cargo = {=>}
            oData:Cargo["STATUS"] = nStatus
            oData:Cargo["INDICE"] = RESERVA->ROOMS_ID + DToS(RESERVA->CHECK_IN)
         endif
      endif

      RESERVA->( DbSkip() )

   ENDDO
     */



 DO WHILE ! oReserva:Eof()
      if DToS( oReserva:CHECK_OUT ) > DToS( ::oPlann:dStart ) .AND. DToS( oReserva:CHECK_IN ) < DToS( ::oPlann:dEnd )

         cDescribe = "Empty..."
         nStatus = Val( oReserva:STATUS )
         if nStatus > 0 .and. nStatus < 5
            cDescribe = ::aStatus[ nStatus ]
         endif


         oRooms:Seek( oReserva:ROOMS_ID )

         cTooltip  = "Room     : " + oRooms:NAME + CRLF
         cTooltip += "Guest    : " + oReserva:GUEST + CRLF
         cTooltip += "Check In : " + DToC( oReserva:CHECK_IN ) + CRLF
         cTooltip += "Check Out: " + DToC( oReserva:CHECK_OUT )
         ::oData = ::oPlann:AddData( oReserva:ROOMS_ID,;
                           oReserva:CHECK_IN,;
                           oReserva:CHECK_OUT,;
                           cDescribe, cToolTip )

         if ::oData != NIL
            ::oData:Cargo = {=>}
            ::oData:Cargo["STATUS"] = nStatus
            ::oData:Cargo["INDICE"] = oReserva:ROOMS_ID + DToS(oReserva:CHECK_IN)
         endif
      endif

      oReserva:Skip()

   ENDDO

   return NIL


//---------------------------------------------------//

METHOD LoadRooms() CLASS SamplePlan

   local n
   local cRowName, cRowText


  /*
  ROOMS->( DbGoTop() )

   DO WHILE ! ROOMS->( Eof() )
      ::oPlann:AddRow( ROOMS->ID, alltrim(ROOMS->NAME)+"-"+ROOMS->TYPE)
      ROOMS->( DbSkip() )
   ENDDO

  */

   oRooms:GoTop()

   DO WHILE ! oRooms:Eof()
      ::oPlann:AddRow( oRooms:ID, alltrim(oRooms:NAME)+"-"+oRooms:TYPE)
      oRooms:Skip()
   ENDDO
RETURN nil

//---------------------------------------------------//

METHOD MoveReservation( oData, nRowId, oPlann ) CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus
   Local oRec

 /*
   RESERVA->( DBSeek( oItem:Cargo['INDICE'] ) )

   if oPlann:nDaysOffset != 0 .OR. oPlann:nRoomsOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      RESERVA->CHECK_IN += oPlann:nDaysOffset //determina cuantos dias nos movimos
      RESERVA->CHECK_OUT += oPlann:nDaysOffset //determina cuantos dias nos movimos
      RESERVA->ROOMS_ID = nRowId
      RESERVA->( DbCommitAll() )
      ROOMS->( DBSeek( nRowId ) )
      cTooltip  = "Room     : " + ROOMS->NAME + CRLF
      cTooltip += "Guest    : " + RESERVA->GUEST + CRLF
      cTooltip += "Check In : " + DToC( RESERVA->CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( RESERVA->CHECK_OUT )

      oData = oPlann:AddData( RESERVA->ROOMS_ID,;
                          RESERVA->CHECK_IN,;
                          RESERVA->CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = RESERVA->ROOMS_ID + DToS(RESERVA->CHECK_IN)
      oPlann:oLastData = NIL
   endif
   */

 oReserva:setorder(1)
 oReserva:Seek( oItem:Cargo['INDICE'] )
 oRec := oReserva:record()

   if oPlann:nDaysOffset != 0 .OR. oPlann:nRoomsOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

    /*  oReserva:CHECK_IN += oPlann:nDaysOffset //determina cuantos dias nos movimos
      oReserva:CHECK_OUT += oPlann:nDaysOffset //determina cuantos dias nos movimos
      oReserva:ROOMS_ID = nRowId
      * oReserva:DbCommitAll()
      */

             oRec:CHECK_IN += oPlann:nDaysOffset
             oRec:CHECK_OUT += oPlann:nDaysOffset
             oRec:ROOMS_ID = nRowId
             oRec:save()

      oRooms:Seek( nRowId )
      cTooltip  = "Room     : " + oRooms:NAME + CRLF
      cTooltip += "Guest    : " + oRec:GUEST + CRLF
      cTooltip += "Check In : " + DToC( oRec:CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( oRec:CHECK_OUT )

      ::oData = oPlann:AddData( oRec:ROOMS_ID,;
                          oRec:CHECK_IN,;
                          oRec:CHECK_OUT,;
                          cDescribe, cToolTip )
      ::oData:Cargo = {=>}
      ::oData:Cargo['STATUS'] = nStatus
      ::oData:Cargo['INDICE'] = oRec:ROOMS_ID + DToS(oRec:CHECK_IN)
      oPlann:oLastData = NIL
   endif

   oRec:end()

   RETURN nil
//---------------------------------------------------------------------//

METHOD ResizeReservation( oData, nRowId, oPlann )  CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus
   * Local oRec := TReservation():New(oReserva)
   Local oRec
  // SELECT RE
   oReserva:SetOrder( 1 )
   oReserva:Seek( oItem:Cargo['INDICE'] )
   oRec := oReserva:record()


   if oPlann:nDaysOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      oRec:CHECK_IN += If( oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      oRec:CHECK_OUT += If( ! oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      oRec:ROOMS_ID = nRowId
      //RE->( DbCommitAll() )
      oRec:save()

      //SELECT RO
      oRooms:Seek( nRowId )

      cTooltip  = "Room          : " + oRooms:NAME + CRLF
      cTooltip += "Tipologia     : " + oRooms:TYPE + CRLF
      cTooltip += "Guest         : " + oRec:GUEST + CRLF
      cTooltip += "Check In      : " + DToC( oRec:CHECK_IN ) + CRLF
      cTooltip += "Check Out     : " + DToC( oRec:CHECK_OUT )

      oData = oPlann:AddData( oRec:ROOMS_ID,;
                          oRec:CHECK_IN,;
                          oRec:CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = oRec:ROOMS_ID + DToS(oRec:CHECK_IN)
      oPlann:oLastData = NIL
   endif

    oRec:end()

RETURN nil

//----------------------------------------------------------------------------------//


function HB_COMPILEFROMBUF()
return nil

function curdrive()
   return nil

//------------------------------------------------------------------//


 

[Otto]

Hello Silvio,
where can we download the dbf - files for testing.
Best regards
Otto

[nageswaragunupudi]

I am unable to test this program, because I do not have planning.ch and I can not see the original of sample in fwh\samples folder.

Where is the original program of Mr. Daniel using only DBF?
Where is the planning.dbf?

Provide us with any sample program which we can test at our end.

[nageswaragunupudi]

I just downloaded.
We will test and get back.

[nageswaragunupudi]

Here lies the problem:

Indexes are created with index expression including the current alias name.

Code: Select all

   INDEX ON ROOMS->ID TAG rooms_id TO rooms
   INDEX ON RESERVA->ROOMS_ID + DToS( RESERVA->CHECK_IN ) TAG room_in TO reserva
 

Indexes should not be created using current alias name.
In such cases, trying to open the DBF with a different alias name fails with the same error.

For example, try opening rooms.dbf with a different alias like this:

Code: Select all

   USE ROOMS ALIAS ROOM2 VIA "DBFCDX" NEW
 

This results in the error that alias ROOMS not found.

Whether using TDatabase or using direct DBF, this error is bound to occur, if an attempt is made to open these DBFs with different alias names.

I downloaded TPlan zip. I have only sample01.prg in the zip. I modified sample01.prg to use TDatabase. I also modified the creation of indexes without using alias names. This is the right way to create indexes. I have also changed "Super:" to "::Super:" in Tplan.prg. With these changes, sample01.prg with tplan.prg is working well.

Note: Before running this program, please delete the existing ROOMS.DBF, ROOMS.CDX, RESERVA.DBF and RESERVA.CDX.


sample01.prg

Code: Select all

#include "fivewin.ch"
#include "ord.ch"
#include "planning.ch"
#include "dtpicker.ch"

REQUEST DBFCDX
REQUEST HB_Lang_ES
REQUEST HB_CODEPAGE_ESWIN

#define PLANNING_RESERVED   1
#define PLANNING_CONFIRMED  2
#define PLANNING_OCCUPIED   3
#define PLANNING_CANCELED   4
#define PLANNING_EMPTY      5

function Main()

   SET DATE FORMAT "MM/DD/YYYY"
   SET DELETE ON

   HB_LangSelect("ES")
   HB_CDPSELECT("ESWIN")

   SamplePlan():New()

return nil

// status 01 reserved
// status 02 confirmed
// status 03 occupied
// status 04 canceled

//---------------------------------------------------//

CLASS SamplePlan

   DATA oRooms, oReserva

   DATA oPlann
   DATA oWnd
   DATA aStatus
   DATA dStart, dEnd

   METHOD New()

   METHOD BuildDbf()
   METHOD BuildDialog()
   METHOD BuildPlanning()
   METHOD BuildPop()

   METHOD DeleteData( oPlan, dCheckIn )

   METHOD ColorData( oData )

   METHOD LoadData()
   METHOD LoadRooms()
   METHOD MoveReservation( nRow, nCol, nType )
   METHOD ResizeReservation( oData, nRowId, oPlann )

ENDCLASS

//---------------------------------------------------//

METHOD New() CLASS SamplePlan

   local oMenu, oBrush
   local oSelf := Self

   ::aStatus = { "Reserved", "Confirmed", "Occupied", "Canceled", "Empty" }

   MENU oMenu
   ENDMENU

   DEFINE BRUSH oBrush COLOR CLR_WHITE

   ::BuildDbf()

   DEFINE WINDOW ::oWnd BRUSH obrush

   ::BuildPlanning()
   ::LoadRooms()
   ::LoadData()

   ::oWnd:oClient = ::oPlann

   ACTIVATE WINDOW ::oWnd

   oBrush:End()

RETURN Self

//---------------------------------------------------//

METHOD BuildDbf() CLASS SamplePlan

   field ID, ROOMS_ID, CHECK_IN

   local aStructure
   local i

   if ! File( "rooms.dbf" )

      aStructure = { { "id"   , "C",   4, 0 },;
                      { "name" , "C",  30, 0 },;
                      { "type" , "C",   2, 0 } }

      DBCreate( "rooms", aStructure, "DBFCDX", .T., "ROOMS" )

      for i = 1 to 30
         ROOMS->( DbAppend() )
         ROOMS->ID   = StrZero( i, 2 )
         ROOMS->NAME = "Room " + StrZero( i, 2 )
         ROOMS->TYPE = StrZero( i % 5, 2 )
      next

      CLOSE ROOMS

   endif

   if ! File( "reserva.dbf" )

      aStructure = { { "date"     , "D",   8, 0 },;
                      { "rooms_id" , "C",   4, 0 },;
                      { "check_in" , "D",   8, 0 },;
                      { "check_out", "D",   8, 0 },;
                      { "status"   , "C",   2, 0 },;
                      { "guest"    , "C",  30, 0 } }

      DBCreate( "reserva", aStructure, "DBFCDX" )

   ENDIF

   if !File( "rooms.cdx" )
      USE ROOMS ALIAS ROOMS VIA "DBFCDX" NEW
      INDEX ON ID TAG rooms_id
      CLOSE ROOMS
   endif

   if !File( "reserva.cdx" )
      USE RESERVA ALIAS RESERVA VIA "DBFCDX" NEW
      INDEX ON ROOMS_ID + DToS( CHECK_IN ) TAG room_in TO reserva
      CLOSE RESERVA
   endif

   ::oRooms   := TDatabase():Open( nil, "ROOMS",   "DBFCDX", .t. )
   ::oRooms:SetOrder( "rooms_id" )
   ::oRooms:GoTop()

   ::oReserva := TDatabase():Open( nil, "RESERVA", "DBFCDX", .t. )
   ::oReserva:SetOrder( "room_in" )
   ::oReserva:GoTop()

RETURN nil

//---------------------------------------------------//

METHOD BuildDialog( oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oDlg, oCbx
   local lSave := .F.
   local lNew := .T.
   local cVar, cName := Space( 30 )
   local nAt := 1

   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif

   DEFINE DIALOG oDlg TITLE "Adding Data" SIZE 350, 370

   if ! lNew

      ::oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
      cName    := ::oReserva:GUEST
      nAt      := Val( ::oReserva:STATUS )

   endif

   //cCheckIn = oPlan:aSelected[ 1 ]

   @ 10, 10 SAY "Room: " + oPlan:GetRowText()  OF oDlg PIXEL
   @ 25, 10 SAY "Check In: " + DToC( dCheckIn ) OF oDlg PIXEL
   @ 40, 10 SAY "Check Out:" + DToC( dCheckOut ) OF oDlg PIXEL
   @ 55, 10 SAY "Status:" OF oDlg PIXEL
   @ 55, 55 COMBOBOX oCbx VAR cVar;
             ITEMS ::aStatus;
             STYLE CBS_DROPDOWN PIXEL
   @ 70, 10 SAY "Guest Name:" OF oDlg PIXEL
   @ 70, 55 GET cName OF oDlg PIXEL

   @ 170, 10 BUTTON "OK" PIXEL ACTION ( lSave := .T., oDlg:End() )
   @ 170, 100 BUTTON "CANCEL" PIXEL ACTION ( oDlg:End() )

   ACTIVATE DIALOG oDlg CENTERED;
            ON INIT oCbx:Select( nAt )

   IF lSave
      if lNew
         ::oReserva:Append()
      else
         ::oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
      endif

      ::oReserva:DATE      = Date()
      ::oReserva:ROOMS_ID  = oPlan:GetRowID()
      ::oReserva:CHECK_IN  = dCheckIn
      ::oReserva:CHECK_OUT = dCheckOut
      ::oReserva:STATUS    = StrZero( oCbx:nAt, 2 )
      ::oReserva:GUEST     = cName
      ::oReserva:Save()
      ::oReserva:Commit()

      ::LoadData()
      oPlan:Refresh()

   ENDIF

RETURN nil

//---------------------------------------------------//

METHOD BuildPlanning() CLASS SamplePlan

   LOCAL oSelf := Self

   DEFINE PLANNING ::oPlann OF ::oWnd;
          HEADER "Hab/Dias";
          COLOR HEADER ( If( Dow( dDate ) == 1 .OR.  Dow( dDate ) == 7, CLR_WHITE, ::oPlann:nClrText )  );
          COLOR CELL ::ColorData( oData ) ;
          START DAY Date() - 5;
          END DAY Date() + 5;
          ON RIGHT SELECT oSelf:BuildPop( nRow, nCol, Self, dCheckIn, dCheckOut );
          ON CAPTURE oSelf:MoveReservation(oData, nRowId, Self);
          ON RESIZE DATA  oSelf:ResizeReservation(oData, nRowId, Self) NOHALFDAY

   ::dStart = ::oPlann:dStart
   ::dEnd = ::oPlann:dEnd

   @ 10, 10 DTPICKER ::dStart OF ::oPlann pixel ;
            ON CHANGE ( if( oSelf:dStart != oSelf:oPlann:dStart, ( oSelf:oPlann:SetDates( oSelf:dStart ), oSelf:LoadData() ), ) )

   @ 10, 120 DTPICKER ::dEnd OF ::oPlann pixel;
            ON CHANGE ( if( oSelf:dEnd != oSelf:oPlann:dEnd, ( oSelf:oPlann:SetDates( , oSelf:dEnd ), oSelf:LoadData() ), ) )

RETURN nil

//---------------------------------------------------//

METHOD BuildPop( nRow, nCol, oPlan, dCheckIn, dCheckOut ) CLASS SamplePlan

   local oMenu
   local oSelf := Self
   local lNew := .T.

   if oPlan:oLastData != NIL
      lNew = ! oPlan:oLastData:lSelected
   endif

   MENU oMenu POPUP
      MENUITEM If( lNew, "New Reserve",;
                         "Modify Reserve" ) ACTION oSelf:BuildDialog( oPlan, dCheckIn, dCheckOut )
      if ! lNew
         MENUITEM "Delete Reserve"  ACTION If( MsgYesNo( "Are you sure?" ), oSelf:DeleteData( oPlan, dCheckIn ) , )
      endif

   ENDMENU

   ACTIVATE POPUP oMenu OF oPlan AT nRow, nCol

RETURN nil

//---------------------------------------------------//

METHOD DeleteData( oPlan, dCheckIn ) CLASS SamplePlan

   if ::oReserva:Seek( oPlan:GetRowID() + DToS( dCheckIn ) )
       ::oReserva:Delete()
       oPlan:DeleteData( oPlan:oLastData )
   endif

RETURN nil

//---------------------------------------------------//

METHOD ColorData( oData ) CLASS SamplePlan
   local aGrad

   //"Reserved", "Confirmed", "Occupied", "Calceled", "Empty"
   switch oData:Cargo['STATUS']
      case PLANNING_RESERVED
         aGrad = { { 1, RGB(0x9a,0xcd,0x32), RGB(0x9a,0xcd,0x32) } }
         exit
      case PLANNING_CONFIRMED
         aGrad = { { 1, RGB(0x00,0x80,0xff) , RGB(0x00,0x80,0xff) } }
         exit
      case PLANNING_OCCUPIED
         aGrad = { { 1, RGB(0xff,0xff,0x80), RGB(0xff,0xff,0x80) } }
         exit
      case PLANNING_CANCELED
         aGrad = { { 1, RGB(0xff,0x00,0x00), RGB(0xff,0x00,0x00) } }
         exit
      case PLANNING_EMPTY
         aGrad = { { 1, RGB(0xc0,0xc0,0xc0), RGB(0xc0,0xc0,0xc0) } }

   endswitch

return aGrad

//---------------------------------------------------//

METHOD LoadData() CLASS SamplePlan

   local cDescribe
   local nStatus
   local cTooltip, oData

   //Clear scopes

   ::oReserva:SetOrder( "room_in" )
   ::oReserva:OrdScope( TOPSCOPE, NIL )
   ::oReserva:OrdScope( BOTTOMSCOPE, NIL )
   ::oReserva:GoTop()
   ::oReserva:OrdScope( TOPSCOPE, Month( ::oPlann:dStart ) )
   ::oReserva:OrdScope( BOTTOMSCOPE, Month( ::oPlann:dEnd ) )
   ::oReserva:GoTop()

   DO WHILE ! ::oReserva:Eof()
      if DToS( ::oReserva:CHECK_OUT ) > DToS( ::oPlann:dStart ) .AND. DToS( ::oReserva:CHECK_IN ) < DToS( ::oPlann:dEnd )

         cDescribe = "Empty..."
         nStatus = Val( ::oReserva:STATUS )
         if nStatus > 0 .and. nStatus < 5
            cDescribe = ::aStatus[ nStatus ]
         endif

         ::oRooms:Seek( ::oReserva:ROOMS_ID )

         cTooltip  = "Room     : " + ::oRooms:NAME + CRLF
         cTooltip += "Guest    : " + ::oReserva:GUEST + CRLF
         cTooltip += "Check In : " + DToC( ::oReserva:CHECK_IN ) + CRLF
         cTooltip += "Check Out: " + DToC( ::oReserva:CHECK_OUT )
         oData = ::oPlann:AddData( ::oReserva:ROOMS_ID,;
                           ::oReserva:CHECK_IN,;
                           ::oReserva:CHECK_OUT,;
                           cDescribe, cToolTip )
         if oData != NIL
            oData:Cargo = {=>}
            oData:Cargo["STATUS"] = nStatus
            oData:Cargo["INDICE"] = ::oReserva:ROOMS_ID + DToS(::oReserva:CHECK_IN)
         endif
      endif

      ::oReserva:Skip()

   ENDDO

return NIL

//---------------------------------------------------//

METHOD LoadRooms() CLASS SamplePlan

   local n
   local cRowName, cRowText
   local oData

   ::oRooms:GoTop()

   DO WHILE ! ::oRooms:Eof()
      ::oPlann:AddRow( ::oRooms:ID, ::oRooms:NAME )
      ::oRooms:Skip( 1 )
   ENDDO

RETURN nil

//---------------------------------------------------//

METHOD MoveReservation( oData, nRowId, oPlann ) CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus

   ::oReserva:Seek( oItem:Cargo['INDICE'] )

   if oPlann:nDaysOffset != 0 .OR. oPlann:nRoomsOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      ::oReserva:CHECK_IN += oPlann:nDaysOffset //determina cuantos dias nos movimos
      ::oReserva:CHECK_OUT += oPlann:nDaysOffset //determina cuantos dias nos movimos
      ::oReserva:ROOMS_ID = nRowId
      ::oReserva:Save()
      ::oReserva:Commit()
      ::oRooms:Seek( nRowId )

      cTooltip  = "Room     : " + ::oRooms:NAME + CRLF
      cTooltip += "Guest    : " + ::oReserva:GUEST + CRLF
      cTooltip += "Check In : " + DToC( ::oReserva:CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( ::oReserva:CHECK_OUT )

      oData = oPlann:AddData( ::oReserva:ROOMS_ID,;
                          ::oReserva:CHECK_IN,;
                          ::oReserva:CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = ::oReserva:ROOMS_ID + DToS(::oReserva:CHECK_IN)
      oPlann:oLastData = NIL
   endif

RETURN nil

//---------------------------------------------------//

METHOD ResizeReservation( oData, nRowId, oPlann ) CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus

   ::oReserva:Seek( oItem:Cargo['INDICE'] )

   if oPlann:nDaysOffset != 0
      cDescribe = oItem:cDescribe
      nStatus = oItem:Cargo['STATUS']
      oPlann:DeleteData( oItem, .F. )

      ::oReserva:CHECK_IN += If( oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      ::oReserva:CHECK_OUT += If( ! oData:lRFromStart, oPlann:nDaysOffset, 0 ) //determina cuantos dias nos movimos
      ::oReserva:ROOMS_ID = nRowId
      ::oReserva:Save()
      ::oReserva:Commit()
      ::oRooms:Seek( nRowId )
      cTooltip  = "Room     : " + ::oRooms:NAME + CRLF
      cTooltip += "Guest    : " + ::oReserva:GUEST + CRLF
      cTooltip += "Check In : " + DToC( ::oReserva:CHECK_IN ) + CRLF
      cTooltip += "Check Out: " + DToC( ::oReserva:CHECK_OUT )

      oData = oPlann:AddData( ::oReserva:ROOMS_ID,;
                          ::oReserva:CHECK_IN,;
                          ::oReserva:CHECK_OUT,;
                          cDescribe, cToolTip )
      oData:Cargo = {=>}
      oData:Cargo['STATUS'] = nStatus
      oData:Cargo['INDICE'] = ::oReserva:ROOMS_ID + DToS(::oReserva:CHECK_IN)
      oPlann:oLastData = NIL
   endif

RETURN nil

//---------------------------------------------------//

function HB_COMPILEFROMBUF()
return nil

function curdrive()
return nil
 

For those who want to test:

planning.ch

Code: Select all

#ifndef _PLANNING_H_
#define _PLANNING_H_

#define PLANNING_MOVE_NONE  0
#define PLANNING_MOVE_RIGTH 1
#define PLANNING_MOVE_LEFT  2
#define PLANNING_MOVE_UP    3
#define PLANNING_MOVE_DOWN  4

#xcommand DEFINE PLANNING <oPlann>;
          [ <of: OF, WINDOW, DIALOG, PANEL> <oWnd> ];
          [ HEADER <cHeader> ];
          [ START DAY <dStart> ];
          [ END DAY <dEnd> ];
          [ LABEL WIDTH <nLabelWidth> ];
          [ TOP MARGIN <nTopMargin> ];
          [ FONT <oFont> ];
          [ FONT DATA <oDataFont> ];
          [ FONT HEADER <oHeaderFont> ];
          [ COLOR HEADER <bClrLabelHeader> ];
          [ COLOR CELL <bClrData>] ;
          [ COLOR TEXT <bClrTextData> ];
          [ ON RIGHT SELECT <bRSelected> ] ;
          [ ON CAPTURE <bOncapture> ];
          [ ON RESIZE DATA <bOnResize> ];
          [ <lNoHalfDay: NOHALFDAY> ] ;
       => ;
           <oPlann> := TPlanning():New( <oWnd>, <oFont>, <oDataFont>, <oHeaderFont>, <dStart>, <dEnd>,  <cHeader>, <.lNoHalfDay.> );;
           WITH OBJECT <oPlann>;;
              [ :bClrLabelHeader := \{ | dDate | <bClrLabelHeader> \} ] ;;
              [ :bClrData := \{ | oData | <bClrData> \} ] ;;
              [ :bClrTextData := \{ | oData | <bClrTextData> \} ] ;;
              [ :bRSelected := \{ | nRow, nCol, Self, dCheckIn, dCheckOut | <bRSelected> \} ] ;;
              [ :bOnCapture := \{ | oData, nRowId, Self | <bOncapture> \ } ];;
              [ :bOnResizedData := \{ | oData, nRowId, Self | <bOnResize> \ } ];;
          END <oPlann>

#endif

So, the problem is not with TDatabase, but the way the DBFs are indexed.

[nageswaragunupudi]

tplan.prg

Code: Select all

//TPlanning.prg

#include "fivewin.ch"
#include "planning.ch"

#ifdef __XHARBOUR__
#include "hbcompat.ch"
#endif

#define DEFAULT_GUI_FONT    17
#define SM_CXVSCROLL         2



#define TME_LEAVE           2
#define WM_MOUSELEAVE     675

#define PLANN_MONTH   1
#define PLANN_WEEK    2
#define PLANN_DAY     3
#define PLANN_CUSTOM  4

#define DT_CENTER     1
#define DT_VCENTER    4
#define DT_SINGLELINE 32

#define PLANN_ROW_HASH    1
#define PLANN_ROW_TEXTO   2

#define PLANN_HT_BODY     1
#define PLANN_HT_HEADER   2
#define PLANN_HT_NONE     3

#define PLANN_ATROW       1
#define PLANN_ATCOL       2


static nID := 0

CLASS TPlanning FROM TControl

   CLASSDATA lRegistered AS LOGICAL

   //ARRAYS
   DATA aLabelHeader
   DATA aGradHeaderCel
   DATA aGradLabel
   DATA aSelected

   //CODEBLOCK
   DATA bClrLabelHeader
   DATA bClrData
   DATA bClrTextData
   DATA bRSelected
   DATA bOnCapture
   DATA bOnResizedData

   //CHARACTER
   DATA cHeader

   //DATES
   DATA dStart, dEnd, dDate AS DATE

   // HASH
   DATA hRows

   //HANDLES
   DATA hConRight
   DATA hConLeft
   DATA pHitTest

   //LOGICAL
   DATA lSBVisible
   DATA lVertGrad
   DATA lCaptured                     //check if a empty cell is captured
   DATA lNoHalfDay
   DATA lCatched

   //NUMERIC
   DATA nColorGrid                    // Grid line color
   DATA nColorGrid2                   // Grid internal line color
   DATA nColorCellSelected            // Color of border in cell selected
   DATA nDNameHeight                  // Day Name header size
   DATA nLeftLabelWidth               // Left label width size
   DATA nLeftMargin                   // Left Margin
   DATA nRightMargin                  // Right Margin
   DATA nTopMargin                    // Top Margin
   DATA nVirtualHeight
   DATA nVirtualTop
   DATA nTypePlann                    // Planning type
                                      // 1 Month
                                      // 2 week
                                      // 3 day
                                      // 4 custom
                                      // 2 = MONDAY
   DATA nRowHeight
   DATA nHeaderHeight
   DATA nVScroll
   DATA nColDown, nRowDown, nLastColDown

   //OBJECTS
   DATA oCursorCatch
   DATA oHeaderFont
   DATA oDataFont
   DATA oLastData, oDataOver
   DATA oHeaderFont_aux   HIDDEN
   DATA oFont_aux         HIDDEN

   DATA nDaysOffset, nRoomsOffset


   METHOD New( oWnd, nClrText ) CONSTRUCTOR


   METHOD AddRow( cName, cTexto )
   METHOD AddData( cRow, dStart, dEnd, cDescribe )

   METHOD CheckScroll()

   METHOD ColWidth()        INLINE Int( ( ::GridWidth() - ::nLeftLabelWidth ) / Len( ::aLabelHeader ) )

   METHOD EraseBkGnd( hDC ) INLINE 0

   METHOD DataDropAvailable( uRowId, dFecha1, dFecha2 )

   METHOD DeleteData( oData )
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD Destroy()

   METHOD FirstVisibleRow() INLINE Int( ::nVirtualTop / ::nRowHeight ) + 1

   METHOD GetAtRow( nRow )
   METHOD GetAtCol( nCol )
   METHOD GetData( nAtRow, nCol )
   METHOD GetRow( nAtRow )
   METHOD GetCol( nAtCol )
   METHOD GetCoorFromPos( nAtRow, nAtCol )
   METHOD GetLastRow()   INLINE Len( ::hRows ) * ::nRowHeight + ::nTopMargin + ::nHeaderHeight
   METHOD GetRowText()
   METHOD GetRowID()
   METHOD GridWidth()    INLINE ::nWidth - ::nRightMargin - ::nLeftMargin - ::nVScroll
   METHOD GridHeight()   INLINE ::nHeight - 4 - ::nTopMargin

   METHOD HandleEvent()

   METHOD HitTest( nRow, nCol )

   METHOD LButtonDown( nRow, nCol )
   METHOD LButtonUp( nRow, nCol )

   METHOD LastVisibleRow()  INLINE  Min( Len( ::hRows ), ::FirstVisibleRow() + ::TotalVisibleRow() )
   METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor )

   METHOD ModCol()          INLINE ( ::GridWidth() - ::nLeftLabelWidth ) % Len( ::aLabelHeader )
   METHOD MouseLeave()
   METHOD MouseMove( nRow, nCol, nFlags )
   METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos )

   METHOD Paint()
   METHOD PaintData( hDC )
   METHOD PaintDates( hDC )


   METHOD RButtonUp( nRow, nCol, nKeyFlags )
   METHOD Resize( nType, nWidth, nHeight ) INLINE ::CheckScroll(), ::Super:Resize( nType, nWidth, nHeight )
   METHOD Reset()

   METHOD SelectCell( )
   METHOD SetDates( dStart, dEnd )
   METHOD SetLabelHeader()
   METHOD SetScroll()

   METHOD ToTalVisibleRow() INLINE ( ::GridHeight() / ::nRowHeight ) + 1

   METHOD UpdateData( cRow, dStart, dEnd, cDescribe, cToolTip )

   METHOD VScrollSetPos( nPos )
   METHOD VScrollSkip( nSkip )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( oWnd, oFont, oDataFont, oHeaderFont, dStart, dEnd, cHeader, lNoHalfDay ) CLASS TPlanning

   local nMod, aFontInfo, n

   DEFAULT oWnd     := GetWndDefault()
   DEFAULT cHeader  := "Rooms/Days"
   DEFAULT lNoHalfDay := .T.

   ::nTop       = 0
   ::nLeft      = 0
   ::nBottom    = 600
   ::nRight     = 800
   ::oWnd       = oWnd
   ::lNoHalfDay = lNoHalfDay

   ::nClrText    = 0
   ::nStyle      = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER, WS_CLIPCHILDREN )


   //Array
   ::aGradHeaderCel     = { { 1, nRGB( 165, 191, 225 ), nRGB( 165, 191, 225 ) } }
   ::aGradLabel         = { { 1, nRGB( 165, 191, 225 ), nRGB( 165, 191, 225 ) } }
   ::aSelected          = {}

   //Numeric
   ::nColorGrid       = nRGB( 141, 174, 217 )
   ::nColorGrid2      = nRGB( 230, 237, 247 )
   ::nColorCellSelected = nRGB(0xe6,0xe6,0xfa)
   ::nLeftLabelWidth  = 100
   ::nLeftMargin      = 2
   ::nRightMargin     = 2
   ::nTopMargin       = 60
   ::nVirtualHeight   = ::nHeight
   ::nRowHeight       = 24
   ::nHeaderHeight    = 30
   ::nVirtualTop      = 0
   ::nVScroll         = 0
   ::nColDown         = 0
   ::nRowDown         = 0
   ::nLastColDown     = 0

   ::nDaysOffset      = 0
   ::nRoomsOffset     = 0

   //CodeBlocks

   ::bClrLabelHeader = {|| ::nClrText }
   ::bClrData        = {|| { { 1, nRGB( 225, 234, 247 ), nRGB( 181, 202, 230 ) } } }
   ::bClrTextData    = {|| ::nClrText }

   //Character
   ::cHeader         = cHeader

   //Hash
   ::hRows := {=>}

   //Handles
   ::hConLeft  = HConLeft()
   ::hConRight = HConRight()

   ::lVertGrad = .F.
   ::lCaptured = .F.

   if ::oFont != NIL
      ::oFont:End()
   endif

   if oFont != NIl
      aFontInfo = GetFontInfo( oFont:hFont )
   else
      aFontInfo = GetFontInfo( GetStockObject( DEFAULT_GUI_FONT ) )
   endif

   DEFINE FONT ::oFont NAME aFontInfo[ 4 ] SIZE aFontInfo[ 2 ], aFontInfo[ 1 ]
   DEFINE FONT ::oFont_aux NAME aFontInfo[ 4 ] SIZE aFontInfo[ 2 ], aFontInfo[ 1 ] BOLD

   if oDataFont != NIl
      aFontInfo = GetFontInfo( oDataFont:hFont )
   else
      aFontInfo = GetFontInfo( GetStockObject( DEFAULT_GUI_FONT ) )
   endif

   DEFINE FONT ::oDataFont NAME aFontInfo[ 4 ] SIZE aFontInfo[ 2 ], aFontInfo[ 1 ]

   if oHeaderFont != NIL
      aFontInfo = GetFontInfo( oHeaderFont:hFont )
   else
      aFontInfo = GetFontInfo( GetStockObject( DEFAULT_GUI_FONT ) )
   endif

   DEFINE FONT ::oHeaderFont NAME aFontInfo[ 4 ] SIZE aFontInfo[ 2 ] - 1, aFontInfo[ 1 ] - 1
   DEFINE FONT ::oHeaderFont_aux NAME aFontInfo[ 4 ] SIZE aFontInfo[ 2 ] - 1, aFontInfo[ 1 ] - 1 BOLD


   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

  ::SetBrush( ::oWnd:oBrush )

   ::Register()

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

   DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self
   ::SetScroll()
   ::lSBVisible = .F.

   ::nTypePlann = PLANN_MONTH
   ::dDate = Date()

   DEFAULT dStart := SToD( StrZero( Year( ::dDate ), 4 ) + StrZero( Month( ::dDate ), 2 ) + "01" )
   DEFAULT dEnd   := P_GetLastDayMonth( ::dDate )

   ::dStart = dStart
   ::dEnd   = dEnd
   ::SetLabelHeader()


return Self

//----------------------------------------------------------------------------//

METHOD AddRow( cName, cTexto ) CLASS TPlanning

   if cName != NIL .and. ValType( cName ) == "C"
      if cTexto == NIL
         cTexto = StrTran( cName, " ", "" )
      endif
      hb_HSET( ::hRows, cName, { {=>}, cTexto } )
   endif

return NIL

//----------------------------------------------------------------------------//

METHOD AddData( cRow, dStart, dEnd, cDescribe, cToolTip ) CLASS TPlanning

   local oData
   local hDatas
   local aDatas

   if dEnd < ::dStart
      return nil
   endif

   if cRow != NIL
      if ValType( cRow ) == "C"
         if ! hb_HHASKEY( ::hRows, cRow )
            ::AddRow( cRow )
         endif
         aDatas = hb_HGET( ::hRows, cRow )
         hDatas  = aDatas[ PLANN_ROW_HASH ]
         oData  = TPData():New( Self, cRow, dStart, dEnd, cDescribe, cToolTip )
         hb_HSET( hDatas, oData:cName, oData )
         aDatas[ PLANN_ROW_HASH ] = hDatas
         hb_HSET( ::hRows, cRow, aDatas )
      endif
   endif

return oData

//----------------------------------------------------------------------------//

METHOD CheckScroll() CLASS TPlanning

   local nLastRow
   local nPos

   if ! ::lActive
      RETURN nil
   endif

   nLastRow := ::GetLastRow()
   if nLastRow > ::nHeight
      ::nVirtualHeight = nLastRow
      SetScrollRangeX( ::hWnd, 1, 0, ::nVirtualHeight - 1)

      if  (::nVirtualHeight - ::nVirtualTop) < ::nHeight
         ::nVirtualTop := ::nVirtualHeight - ::nHeight
      endif

      ::oVScroll:SetPage( ::nHeight, .F. )
      ::oVScroll:SetPos( ::nVirtualTop )
      ::lSBVisible = .T.
      ::nVScroll = GetSysMetrics( SM_CXVSCROLL )

   else
      ::nVirtualTop = 0
      ::nVirtualHeight = ::nHeight
      SetScrollRangeX( ::hWnd, 1, 0, 0 )
      ::lSBVisible = .F.
      ::nVScroll = 0
   endif

   ::SetFocus()

RETURN nil

//----------------------------------------------------------------------------//

//USED INTERNALLY ONLY
METHOD DataDropAvailable( uRowId, oData ) CLASS TPlanning

   local lOk := .T.
   local hDatas, oItem
   local n, days, bits
   local n2, days2, bits2

   if ( lOk := ! Empty( uRowId ) )
      hDatas = hb_HGET( ::hRows, uRowId )[ PLANN_ROW_HASH ]
      for each oItem in hDatas
   #ifdef __XHARBOUR__
         oItem = oItem:Value
   #endif
         if oItem:nId != oData:nId
            n = max(0, min(oItem:nColEnd,oData:nNewColEnd) - max(oItem:nColStart,oData:nNewColStart))
            lOk = lOk .AND. (n==0)
         endif
         if ! lOk
            exit
         endif
      next
   endif
return lOk


//----------------------------------------------------------------------------//

METHOD DeleteData( oData, lRefresh ) CLASS TPlanning

   local hData

   DEFAULT lRefresh := .T.

   if oData != nil
      if hb_HHASKEY( ::hRows, oData:cRow )
         hData = ::hRows[ oData:cRow ][ PLANN_ROW_HASH ]
         if hb_HHASKEY( hData, oData:cName )
            hb_HDEL( hData, oData:cName )
            if lRefresh
               ::Refresh()
            endif
         endif
      endif
   endif

RETURN NIL

//----------------------------------------------------------------------------//

METHOD Destroy() CLASS TPlanning

   ::oHeaderFont:End()
   ::oDataFont:End()
   ::oFont_aux:End()
   ::oHeaderFont_aux:End()
   if ::oCursorCatch != NIL
      ::oCursorCatch:end()
   endif
   DeleteObject( ::hConRight )
   DeleteObject( ::HConLeft )

return ::Super:Destroy()

//----------------------------------------------------------------------------//

METHOD GetAtCol( nCol ) CLASS TPlanning

   local nAtCol := 0

   if nCol > ::nLeftLabelWidth .and. ::pHitTest:nRow > ::nTopMargin
      nAtCol = AScan( ::aLabelHeader, {|x| x["LEFT"] < nCol .AND. x["RIGHT"] >= nCol } )
   endif

return nAtCol

//----------------------------------------------------------------------------//

METHOD GetAtRow( nRow ) CLASS TPlanning

   local nAtRow

   nAtRow := Int( ( nRow + ::nVirtualTop - ::nTopMargin - ::nHeaderHeight ) / ::nRowHeight ) + 1

   if nAtRow > Len( ::hRows ) .OR. nRow < ( ::nTopMargin + ::nHeaderHeight )
      nAtRow = 0
   endif

return nAtRow

//----------------------------------------------------------------------------//

METHOD GetCol( nAtCol ) CLASS TPlanning

   local nCol
   local nModCol   := ::ModCol()
   local nColWidth := ::ColWidth()
   local nAux      := ( nColWidth + 1 ) * nModCol

   if nAtCol > nModCol
      nCol = nAux + ( ( nAtCol - nModCol - 1 ) * nColWidth ) + ::nLeftLabelWidth
   else
      nCol = ( nAtCol - 1 ) * ( nColWidth + 1 ) + ::nLeftLabelWidth
   endif

   nCol := Max( ::nLeftLabelWidth - 1, nCol )

return nCol

//----------------------------------------------------------------------------//

METHOD GetCoorFromPos( nAtRow, nAtCol ) CLASS TPlanning

   local aCoor := Array( 4 )
   local nCol

   aCoor[ 1 ] = ::GetRow( nAtRow ) + 1
   aCoor[ 2 ] = ::GetCol( nAtCol ) + 1
   aCoor[ 3 ] = aCoor[ 1 ] + ::nRowHeight - 1
   aCoor[ 4 ] = ::GetCol( nAtCol + 1 )

return aCoor

//----------------------------------------------------------------------------//

METHOD GetData( nAtRow, nCol ) CLASS TPlanning
   local oData, oRet
   local hDatas
   local nAtCol := ::GetAtCol( nCol )
   local nColDataEnd, nColDataStart
   local nColWidth

   if ::lNoHalfDay
      nColWidth = 0
   else
      nColWidth = ( ::ColWidth() / 2 )
   endif

   if nAtRow < 1 .Or. nAtCol < 1
      return nil
   endif

   hDatas = hb_HGET( ::hRows, hb_HKEYAT( ::hRows, nAtRow ) )[ PLANN_ROW_HASH ]
   for each oData in hDatas
#ifdef __XHARBOUR__
      oData = oData:Value
#endif
      if oData != NIL .and. ( oData:nColStart != NIL .OR.  oData:nColEnd != nil )
         if oData:nColStart <= nCol .AND. oData:nColEnd >= nCol
            oRet = oData
            exit
         endif
      endif
   next


return oRet

//----------------------------------------------------------------------------//


METHOD GetRow( nAtRow ) CLASS TPlanning

   local nRow

   nRow = ( nAtRow - 1 ) * ::nRowHeight - ::nVirtualTop + ::nTopMargin + ::nHeaderHeight

return nRow

//----------------------------------------------------------------------------//

METHOD GetRowText( nAtRow ) CLASS TPlanning

   local cText := ""

   DEFAULT nAtRow := 0

   if ::oLastData != NIL
      cText = ::hRows[ ::oLastData:cRow ][ PLANN_ROW_TEXTO ]
   else
      if Len( ::aSelected ) > 0
         nAtRow = ::aSelected[ 1 ][ PLANN_ATROW ]
      endif
   endif

   if nAtRow > 0
      cText = ::hRows[ hb_HKEYAT( ::hRows, nAtRow ) ][ PLANN_ROW_TEXTO ]
   endif

return cText

//----------------------------------------------------------------------------//

METHOD GetRowID( nAtRow ) CLASS TPlanning

   local uID

   if nAtRow == NIL
      if ::oLastData != NIL .and. ::oLastData:lSelected
         uID = ::oLastData:cRow
      else
         if nAtRow == NIL
            if Len( ::aSelected ) > 0
               nAtRow = ::aSelected[ 1 ][ PLANN_ATROW ]
            else
               nAtRow = 0
            endif
         endif
         if nAtRow > 0
             uID = hb_HKEYAT( ::hRows, nAtRow )
         endif
      endif
   else
      if nAtRow > 0
         uID = hb_HKEYAT( ::hRows, nAtRow )
      endif
   endif

return uID

//----------------------------------------------------------------------------//

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TPlanning

   do case
      case nMsg == WM_MOUSELEAVE
         return ::MouseLeave( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
  endcase

RETURN ::Super:HandleEvent( nMsg, nWParam, nLParam )

//----------------------------------------------------------------------------//

METHOD HitTest( nRow, nCol ) CLASS TPlanning

   local pHitTest := TStruct():New()
   local nAtRow, nAtCol
   local pLast

   pHitTest:Addmember( "nType",  _INT )
   pHitTest:Addmember( "nAtRow", LONG )
   pHitTest:Addmember( "nAtCol", LONG )
   pHitTest:Addmember( "nRow", LONG )
   pHitTest:Addmember( "nCol", LONG )
   pHitTest:Addmember( "nMoveType", _INT )

   pHitTest:nAtRow = 0
   pHitTest:nAtCol = 0
   pHitTest:nRow = nRow
   pHitTest:nCol = nCol

   pLast = ::pHitTest
   ::pHitTest = pHitTest

   if nRow < ::nTopMargin
      pHitTest:nType  = PLANN_HT_NONE
      ::nDaysOffset     = 0
      ::nRoomsOffset     = 0
   elseif nRow > ::nTopMargin .and. nRow < ::nTopMargin + ::nHeaderHeight
      pHitTest:nType  = PLANN_HT_HEADER
      ::nDaysOffset     = 0
      ::nRoomsOffset     = 0
   else
      pHitTest:nType  = PLANN_HT_BODY
      nAtRow = ::GetAtRow( nRow )
      nAtCol = ::GetAtCol( nCol )

      if pLast != NIL
         pHitTest:nMoveType = PLANNING_MOVE_NONE
         if nAtRow > pLast:nAtRow
            pHitTest:nMoveType = PLANNING_MOVE_DOWN
         elseif nAtRow <  pLast:nAtRow
            pHitTest:nMoveType = PLANNING_MOVE_UP
         endif
         ::nRoomsOffset += ( nAtRow - pLast:nAtRow )
         if nAtCol > pLast:nAtCol
            pHitTest:nMoveType = PLANNING_MOVE_RIGTH
         elseif nAtCol <  pLast:nAtCol
            pHitTest:nMoveType = PLANNING_MOVE_LEFT
         endif
         ::nDaysOffset += ( nAtCol - pLast:nAtCol )
      endif
      pHitTest:nAtRow = nAtRow
      pHitTest:nAtCol = nAtCol
   endif

return pHitTest

//----------------------------------------------------------------------------//

METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TPlanning

   ::SelectCell( nRow, nCol, nKeyFlags )
   ::nDaysOffset     = 0
   ::nRoomsOffset     = 0

return ::Super:LButtonDown( nRow, nCol, nKeyFlags )

//----------------------------------------------------------------------------//

METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPlanning

   local uId
   local nAt
   ::lCaptured = .F.
   if ::oLastData != NIL
      if ::oLastData:lCatched
         ::oLastData:lCatched = .F.
         if hb_isBlock( ::bOnCapture )
            if ( nAt := ::GetAtRow( nRow ) ) > 0
               uId = ::GetRowId( nAt )
               if ::DataDropAvailable( uId, ::oLastData )
                  Eval( ::bOnCapture, ::oLastData, uId, self )
               endif
            endif
         endif
      endif
      if ::oLastData != NIL
         if ::oLastData:lResized
            ::oLastData:lResized = .F.
            if hb_isBlock( ::bOnResizedData )
               if ( nAt := ::GetAtRow( nRow ) ) > 0
                  uId = ::GetRowId( nAt )
                  if ::DataDropAvailable( uId, ::oLastData )
                     if ::oLastData:lRFromStart
                        if ::oLastData:dStart + ::nDaysOffset >= ::oLastData:dEnd
                           ::nDaysOffset = ::oLastData:dEnd - ::oLastData:dStart - 1
                        endif
                     else
                        if ::oLastData:dEnd + ::nDaysOffset <= ::oLastData:dStart
                           ::nDaysOffset = ::oLastData:dStart - ::oLastData:dEnd + 1
                        endif
                     endif
                     Eval( ::bOnResizedData, ::oLastData, uId, self )
                  endif
               endif
            endif
         endif
      endif
   endif
   ::nDaysOffset     = 0
   ::nRoomsOffset     = 0
   CursorArrow()
   ::Refresh()

return ::Super:LButtonUp( nRow, nCol, nKeyFlags )

//----------------------------------------------------------------------------//

METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor ) CLASS TPlanning

   local hPen, hOldPen

   DEFAULT nColor := 0

   hPen = CreatePen( PS_SOLID, 1, nColor )
   hOldPen = SelectObject( hDC, hPen )
   MoveTo( hDC, nLeft, nTop )
   LineTo( hDC, nRight, nBottom )
   SelectObject( hDC, hOldPen )
   DeleteObject( hPen )


return nil

//-----------------------------------------------------------------//

METHOD MouseLeave( nRow, nCol, nFlags ) CLASS TPlanning

   ::nDaysOffset     = 0
   ::nRoomsOffset     = 0
   if ::oLastData != NIL
      ::oLastData:lCatched = .F.
      ::oLastData:lResized = .F.
   endif
   ::Refresh()
return 0

//-----------------------------------------------------------------//

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPlanning

   local pHitTest
   local nColWidth := ::ColWidth()
   local oData
   local nEastSize
   local nWestSize

   TrackMouseEvent( ::hWnd, TME_LEAVE )

   pHitTest = ::HitTest( nRow, nCol )

   oData = ::GetData( pHitTest:nAtRow, nCol )

   if ::oLastData == NIL .OR. ( ! ::oLastData:lCatched .AND. ! ::oLastData:lResized )
      if oData != NIL
         if ::oDataOver != NIL
            if ::oDataOver:nID == oData:nID
               if ::cToolTip == NIL
                  ::DestroyToolTip()
                  ::cToolTip = oData:cToolTip
               endif
            else
               ::DestroyToolTip()
               ::cToolTip = NIL
            endif
         endif
      else
         ::DestroyToolTip()
         ::cToolTip = NIL
      endif

      ::oDataOver = oData

      if oData != NIL
         if ( ( oData:nColStart <= nCol .AND. oData:nColStart + 2 >= nCol ) .OR. ;
           ( oData:nColEnd >= nCol .AND. oData:nColEnd - 2 <= nCol ) )
            CursorWE()
            return 0
         endif
      endif

      if pHitTest:nType == PLANN_HT_BODY
         ::Refresh()
      endif

   else
      if ::oLastData != NIL
         if pHitTest:nAtCol == 0 .OR. pHitTest:nAtRow == 0
            ::oLastData:lResized = .f.
            ::oLastData:lCatched = .f.
            ::Refresh()
         endif
         if ::oLastData:lCatched
            if ::oCursorCatch != NIL
               SetCursor( ::oCursorCatch:hCursor )
            else
               CursorCatch()
            endif
            if pHitTest:nMoveType > 0
               ::Refresh()
            endif
            return 0
         endif

         if ::oLastData:lResized
            CursorWE()
            if pHitTest:nMoveType > 0
               ::Refresh()
            endif
            return 0
         endif
      endif

   endif

return ::Super:MouseMove( nRow, nCol, nKeyFlags )

//----------------------------------------------------------------------------//

METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos ) CLASS TPlanning

   local aPos := { nYPos, nXPos }

   if ::lSBVisible
      if nDelta < 0
         ::VScrollSkip( 40 )
      else
         ::VScrollSkip( -40 )
      endif
   endif

return nil

//----------------------------------------------------------------------------//

METHOD Paint() CLASS TPlanning

   local aInfo       := ::DispBegin()
   local aRect
   local hDC         := ::hDC
   local nGridWidth  := ::GridWidth()
   local nGridHeight := ::GridHeight() + ::nTopMargin

   aRect = GetClientRect( ::hWnd )

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   WndBox2007( hDC, ::nTopMargin,;
               ::nLeftMargin, ;
               nGridHeight, ;
               nGridWidth , ;
               ::nColorGrid )

   ::PaintDates( hDC )

   ::DispEnd( aInfo )

return 0

//----------------------------------------------------------------------------//

STATIC function CalPos( oData, Self, nDaysOffset )

   local u := {=>}
   local nTotDays :=  Len(::aLabelHeader)
   local nColWidth_2
   local nColWidth

   DEFAULT nDaysOffset := 0

   nColWidth = ::ColWidth()

   nColWidth_2 = 0// Int( nColWidth / 2 )


   u["lPrev"] = .F.
   u["lNext"] = .F.
   if oData:lResized
      if oData:lRFromStart
         u["nColStart"] = Max( 1, oData:dStart - ::dStart + 1 + nDaysOffset )
         u["nColEnd"]   = Min( nTotDays, max( 1, oData:dEnd - ::dStart + If( ::lNoHalfDay, 0, 1 ) ) )
         if u["nColStart"] >= u["nColEnd"]
            u["nColStart"] = u["nColEnd"] - If( ::lNoHalfDay, 0, 1 )
         endif
      else
         u["nColStart"] = Max( 1, oData:dStart - ::dStart + 1 )
         u["nColEnd"]   = Min( nTotDays, max( 1, oData:dEnd - ::dStart + If( ::lNoHalfDay, 0, 1 ) + nDaysOffset ) )
         if u["nColStart"] >= u["nColEnd"]
            u["nColEnd"] = u["nColStart"]  + If( ::lNoHalfDay, 0, 1 )
         endif
      endif
      if ! ::lNoHalfDay
         nColWidth_2 = ( ::aLabelHeader[u["nColStart"]]["RIGHT"] - ::aLabelHeader[u["nColStart"]]["LEFT"] ) / 2
      endif
      if oData:lRFromStart
         u["nCol1"] = ::aLabelHeader[u["nColStart"]]["LEFT"] + nColWidth_2
         if oData:dEnd > ::dEnd
            u["nCol2"] = ::aLabelHeader[u["nColEnd"]]["RIGHT"]
            u["lNext"] = .T.
         else
            u["nCol2"] = ::aLabelHeader[u["nColEnd"]]["RIGHT"] - nColWidth_2
         endif
      else
         u["nCol2"] = ::aLabelHeader[u["nColEnd"]]["RIGHT"] - nColWidth_2
         if oData:dStart < ::dStart
            u["nCol1"] = ::aLabelHeader[u["nColStart"]]["LEFT"]
            u["lPrev"] = .T.
         else
            u["nCol1"] = ::aLabelHeader[u["nColStart"]]["LEFT"] + nColWidth_2
         endif
      endif
   else
      u["nColStart"] = Max( 1, oData:dStart - ::dStart + 1 + nDaysOffset )
      u["nColEnd"]   = Min( nTotDays, max( 1, oData:dEnd - ::dStart + If( ::lNoHalfDay, 0, 1 ) + nDaysOffset ) )
   endif

   if ! ::lNoHalfDay
      nColWidth_2 = ( ::aLabelHeader[u["nColStart"]]["RIGHT"] - ::aLabelHeader[u["nColStart"]]["LEFT"] ) / 2
   endif

   if ! oData:lResized
      if oData:dStart + nDaysOffset < ::dStart
         u["lPrev"] = .T.
         u["nCol1"] = ::aLabelHeader[u["nColStart"]]["LEFT"]
      else
         u["nCol1"] = ::aLabelHeader[u["nColStart"]]["LEFT"] + nColWidth_2
      endif
      if oData:dEnd + nDaysOffset > ::dEnd
         u["lNext"] = .T.
         u["nCol2"] = ::aLabelHeader[u["nColEnd"]]["RIGHT"]
      else
         u["nCol2"] = ::aLabelHeader[u["nColEnd"]]["RIGHT"] - nColWidth_2
      endif
   endif

return u

//----------------------------------------------------------------------------//

METHOD PaintData( hDC ) CLASS TPlanning

   local oData, hDatas
   local Row, hPen, hPenRed
   local nStartRow, nEndRow
   local n, j
   local nRow, nColStart, nColEnd
   local nModCol, nColWidth, nAux
   local nCol1, nCol2
   local aClrData
   local nClrTextData
   local lPrev := .F., lNext := .F.
   local hCatched := NIL
   local nColWidth_2 := 0
   local nTotDays :=  Len(::aLabelHeader)
   local u

   nColWidth = ::ColWidth()

   nStartRow = ::FirstVisibleRow()
   nEndRow   = ::LastVisibleRow()



   for n = nStartRow to nEndRow
      hDatas = hb_HGET( ::hRows, hb_HKEYAT( ::hRows, n ) )[ PLANN_ROW_HASH ]
      nRow = ::GetRow( n )
      for each oData in hDatas
#ifdef __XHARBOUR__
         oData = oData:Value
#endif

         u = CalPos(oData, self)

         lPrev = u["lPrev"]
         lNext = u["lNext"]
         nCol1 = u["nCol1"]
         nCol2 = u["nCol2"]

         oData:nColStart = nCol1
         oData:nColEnd = nCol2

         aClrData = Eval( ::bClrData, oData )

         GradientFill( hDC, nRow + 1, nCol1 + 1, nRow + ::nRowHeight - If( ::lVertGrad, 1, 0 ), nCol2 - 1, aClrData, ::lVertGrad )

         if lPrev
            if nCol1 > nBmpWidth( ::hConLeft )
               DrawTransparent( hDC, ::hConLeft, nRow + ( ::nRowHeight / 2 - nBmpHeight( ::hConLeft ) / 2  ), ;
                                      ::nLeftLabelWidth - 1 + 3 )
            endif
         endif

         if lNext := ( ::GridWidth()  < nCol2 + 1 )
            if nColWidth > nBmpWidth( ::hConRight )
               DrawTransparent( hDC, ::hConRight, nRow + ( ::nRowHeight / 2 - nBmpHeight( ::hConRight ) / 2  ), ;
                                     ::GridWidth() - nBmpWidth( ::hConRight ) - 1 )
            endif
         endif

         nClrTextData = Eval( ::bClrTextData, oData )

         P_Say( hDC, oData:cDescribe, ;
                    { nRow ,;
                      nCol1 + 7 + If( lPrev,  nBmpWidth( ::hConLeft ) + 2, 0 ), ;
                      nRow + ::nRowHeight, ;
                      nCol2 - 7 - If( lNext,  nBmpWidth( ::hConLeft ) + 2, 0 ) }, nOr( DT_SINGLELINE, DT_VCENTER ), ::oDataFont, nClrTextData, 0 )

         WndBox2007( hDC, nRow ,;
               nCol1 + 1, ;
               nRow + ::nRowHeight, ;
               nCol2 - 1, ;
               0 )
         if oData:lSelected
            WndBox2007( hDC, nRow + 1,;
                  nCol1 + 2, ;
                  nRow + ::nRowHeight - 1, ;
                  nCol2 - 2, ;
                  0 )
         endif
         if oData:lCatched .OR. oData:lResized
            hCatched = {=>}
            hCatched["DATA"] = oData
            hCatched["COL1"] = nCol1
            hCatched["COL2"] = nCol2
            hCatched["ROW"]  = nRow
            hCatched["ATROW"] = n
         endif
      next
   next
   if hCatched != NIL
      nRow = hCatched["ROW"]

      u = CalPos( hCatched["DATA"], self, ::nDaysOffset )

      nColStart = u["nColStart"]
      nColEnd   = u["nColEnd"]

      nCol1 = u["nCol1"]
      nCol2 = u["nCol2"]

      if u["lPrev"]
         DrawTransparent( hDC, ::hConLeft, nRow + ( ::nRowHeight / 2 - nBmpHeight( ::hConLeft ) / 2  )  + (::nRoomsOffset*::nRowHeight), ;
                                ::nLeftLabelWidth + 2 )
      endif

      if u["lNext"]
         DrawTransparent( hDC, ::hConRight, nRow + ( ::nRowHeight / 2 - nBmpHeight( ::hConRight ) / 2  )  + (::nRoomsOffset*::nRowHeight), ;
                               ::GridWidth() - nBmpWidth( ::hConRight ) - 1 )
      endif

      hCatched["DATA"]:nNewColStart = nCol1 + 1
      hCatched["DATA"]:nNewColEnd = nCol2 - 1

      if ::DataDropAvailable( ::GetRowId( hCatched["ATROW"] + ::nRoomsOffset ), hCatched["DATA"])
         hPen = CreatePen( PS_DOT, 1, 0 )
      else
         hPen = CreatePen( PS_DOT, 1, nRGB(255,0,0) )
      endif

      WNDBOXCLR( hDC, nRow + 2 + (::nRoomsOffset*::nRowHeight),;
                  nCol1 + 2, ;
                  nRow + ::nRowHeight - 2 +  (::nRoomsOffset*::nRowHeight), ;
                  nCol2 - 2, hPen, hpen)

      DeleteObject( hPen )
   endif

return nil

//----------------------------------------------------------------------------//

METHOD PaintDates( hDC ) CLASS TPlanning

   local nTotDays := Len( ::aLabelHeader )
   local n, hSel
   local nMod
   local nColWidth
   local nColOffSet
   local aRect
   local nClr
   local cRowText
   local nRowOffSet
   local nStartRow, nEndRow
   local aSelected, aCell
   local nFrom, nTo, head

   nColWidth  = ::ColWidth()
   nMod       = ::ModCol()
   nColOffSet = ::nLeftLabelWidth

   nMod      = ::ModCol()
   nColOffSet   = ::nLeftLabelWidth

   for n = 1 to nTotDays
      nColOffSet += ( nColWidth + If( nMod > 0, ( nMod--, 1 ), 0 ) )
      if n == 1
         ::aLabelHeader[n]["LEFT"] = ::nLeftLabelWidth
         ::aLabelHeader[n]["RIGHT"] = nColOffSet
      else
         ::aLabelHeader[n]["LEFT"] = ::aLabelHeader[n-1]["RIGHT"]
         ::aLabelHeader[n]["RIGHT"] = nColOffSet
      endif
      if n == nTotDays
         ::aLabelHeader[n]["LEFT"] = ::aLabelHeader[n-1]["RIGHT"]
         ::aLabelHeader[n]["RIGHT"] = ::GridWidth()
      endif
      ::Line( hDC, ::nTopMargin , nColOffSet, ::nHeight - 3 , nColOffSet, ::nColorGrid )
   next

   GradientFill( hDC, ::nTopMargin + 1, ::nLeftMargin + 1, ::nHeight - 5 , ::nLeftLabelWidth, ::aGradLabel )


   // visibles rows
   nStartRow = ::FirstVisibleRow()
   nEndRow   = ::LastVisibleRow()

   for n = nStartRow to nEndRow
      cRowText = hb_HGET( ::hRows, hb_HKEYAT( ::hRows, n ) )[ PLANN_ROW_TEXTO ]
      nRowOffSet = ::nTopMargin + ::nHeaderHeight + ( ::nRowHeight * ( n - 1 ) )
      if ::pHitTest != NIL
         if ::pHitTest:nAtRow == n
            P_Say( hDC, cRowText, { nRowOffSet - ::nVirtualTop, ::nLeftMargin + 1, nRowOffSet + ::nRowHeight - ::nVirtualTop, ::nLeftLabelWidth },;
          nOR( DT_VCENTER, DT_SINGLELINE ), ::oFont_aux, nClr, 0 )
         else
            P_Say( hDC, cRowText, { nRowOffSet - ::nVirtualTop, ::nLeftMargin + 1, nRowOffSet + ::nRowHeight - ::nVirtualTop, ::nLeftLabelWidth },;
          nOR( DT_VCENTER, DT_SINGLELINE ), ::oFont, nClr, 0 )
         endif
      else
         P_Say( hDC, cRowText, { nRowOffSet - ::nVirtualTop, ::nLeftMargin + 1, nRowOffSet + ::nRowHeight - ::nVirtualTop, ::nLeftLabelWidth },;
          nOR( DT_VCENTER, DT_SINGLELINE ), ::oFont, nClr, 0 )
      endif

      ::Line( hDC, nRowOffSet + ::nRowHeight - ::nVirtualTop, ::nLeftMargin, nRowOffSet + ::nRowHeight - ::nVirtualTop, ::nWidth - ::nRightMargin - 1 - ::nVScroll, ::nColorGrid )
   next


   //Detail column (header)
   hSel = CreateSolidBrush( ::nColorCellSelected )

   if ::lCaptured
      if ::pHitTest:nAtCol < ::nColDown
         nFrom = ::pHitTest:nAtCol
         nTo   = ::nColDown
      elseif ::pHitTest:nAtCol > ::nColDown
         nFrom = ::nColDown
         nTo   = ::pHitTest:nAtCol
      else
         nFrom = ::nColDown
         nTo   = ::nColDown
      endif
      ::aSelected = {}
      for n = nFrom to nTo
         aCell = ::GetCoorFromPos( ::nRowDown, n )
         FillRect( hDC, aCell, hSel )
         AAdd( ::aSelected, { ::nRowDown, n } )
      next
   else
      for each aSelected in ::aSelected
         aCell = ::GetCoorFromPos( aSelected [ PLANN_ATROW ], aSelected [ PLANN_ATCOL ] )
         FillRect( hDC, aCell, hSel )
      next
   endif

   DeleteObject( hSel )
   //Paint datas
   ::PaintData( hDC )

   GradientFill( hDC, ::nTopMargin , ;
                     ::nLeftLabelWidth + 1, ;
                     ::nTopMargin + ::nHeaderHeight - 1, ;
                     ::GridWidth(), ::aGradHeaderCel )



   //Header Horizontal Line
   ::Line( hDC, ::nTopMargin + ::nHeaderHeight-1, ::nLeftMargin, ::nTopMargin + ::nHeaderHeight-1, ::GridWidth(), ::nColorGrid )


   for each head in ::aLabelHeader
      aRect = { ::nTopMargin + 2, head["LEFT"],;
                ::nTopMargin + ::nHeaderHeight - 2, head["RIGHT"] }

#ifdef __XHARBOUR__
         n = HB_EnumIndex()
#else
         n = head:__enumIndex()
#endif

      if ::bClrLabelHeader != NIL
         nClr = Eval( ::bClrLabelHeader, ::dStart + n - 1 )
      else
         nClr = ::nClrText
      endif

      if ::pHitTest != NIL
         if ::pHitTest:nAtCol == n
            P_Say( hDC, head['LABEL'], aRect, DT_CENTER, ::oHeaderFont_aux, nClr, 0 )
         else
            P_Say( hDC, head['LABEL'], aRect, DT_CENTER, ::oHeaderFont, nClr, 0 )
         endif
      else
         P_Say( hDC, head['LABEL'], aRect, DT_CENTER, ::oHeaderFont, nClr, 0 )
      endif

   next

   GradientFill( hDC, ::nTopMargin, ;
                     ::nLeftMargin + 1, ;
                     ::nTopMargin + ::nHeaderHeight - 1, ;
                     ::nLeftLabelWidth - 1, ::aGradHeaderCel )



   P_Say( hDC, ::cHeader, { ::nTopMargin + 2, ::nLeftMargin + 1, ::nTopMargin + ::nHeaderHeight - 1, ::nLeftLabelWidth },;
          nOR( DT_VCENTER, DT_CENTER, DT_SINGLELINE ), ::oHeaderFont, nClr, 0 )

   FillRect( hDC, { 0, ;
                      0,;
                      ::nTopMargin,;
                      ::GridWidth() }, ::oBrush:hBrush )

   WndBox2007( hDC, ::nTopMargin,;
               ::nLeftMargin, ;
               ::nHeaderHeight + ::nTopMargin -1, ;
               ::nLeftLabelWidth , ;
               ::nColorGrid )


   for each head in ::aLabelHeader
      ::Line( hDC, ::nTopMargin , head["LEFT"], ::nTopMargin + ::nHeaderHeight , head["LEFT"], ::nColorGrid )
   next

return NIL

//----------------------------------------------------------------------------//

METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TPlanning

   local nInit := 0, nEnd := 0
   local lOK := .F.

    if nRow < ::nTopMargin+30  .OR. nCol < ::nLeftLabelWidth .OR. ::GetAtRow( nRow ) < 1
       return nil                              // agregado para evitar el click derecho en cabecera
    endif                                     //


   if ::oLastData != NIL
      if ::oDataOver != NIL
         if ::oDataOver:nID != ::oLastData:nID
            ::oLastData:lSelected = .F.
            ::oLastData = ::oDataOver
            ::oLastData:lSelected = .T.
            ::Refresh()
         endif
         if ( lOK := ::oLastData:lSelected )
            nInit = ::oLastData:dStart - ::dStart
            nEnd  = ::oLastData:dEnd - ::dStart
         endif
      endif
   endif

   if ! lOK
      if ::oDataOver != NIL
         ::oLastData = ::oDataOver
         ::oLastData:lSelected = .T.
         nInit = ::oLastData:dStart - ::dStart
         nEnd  = ::oLastData:dEnd - ::dStart
         lOK = .T.
         ::Refresh()
      endif
      if ! lOK
         if Len( ::aSelected ) > 0
            if ::pHitTest:nAtRow == ::aSelected[ 1 ][ PLANN_ATROW ]
               if ::pHitTest:nAtCol >= ::aSelected[ 1 ][ PLANN_ATCOL ] .and. ;
                  ::pHitTest:nAtCol <= Atail( ::aSelected )[ PLANN_ATCOL ]
               else
                  ::SelectCell( nRow, nCol )
               endif
            else
               ::SelectCell( nRow, nCol )
            endif
         else
            ::SelectCell( nRow, nCol )
         endif
         if ! lOK
            nInit = ::aSelected[ 1 ][ PLANN_ATCOL ] - 1
            nEnd  = Atail( ::aSelected )[ PLANN_ATCOL ]
         endif
      endif
   endif

   ::lCaptured = .F.

   if ::bRSelected != NIL
      Eval( ::bRSelected, nRow, nCol, Self, ;
                          ::dStart + nInit, ;
                          ::dStart + nEnd  )
   endif

return ::Super:RButtonUp( nRow, nCol, nKeyFlags )

//----------------------------------------------------------------------------//

METHOD Reset() CLASS TPlanning

   local aRow
   local n
   local cKey

   for n = 1 to Len( ::hRows )
      cKey = hb_HKEYAT( ::hRows, n )
      hb_HSET( ::hRows, cKey, { {=>}, hb_HGET( ::hRows, cKey )[ PLANN_ROW_TEXTO ] } )
   next

return NIL

//----------------------------------------------------------------------------//

METHOD SelectCell( nRow, nCol ) CLASS TPlanning

   local nAtRow := ::GetAtRow( nRow )
   local nAtCol := ::GetAtCol( nCol )
   local oData

   ::nRowDown  = nAtRow
   ::nColDown  = nAtCol
   ::aSelected = {}

   if ::oLastData != NIL
      ::oLastData:lSelected = .F.
   endif

   oData = ::GetData( nAtRow, nCol )

   if oData == NIL
      ::lCaptured = .T.
      AAdd( ::aSelected, { nAtRow, nAtCol } )
   else
      oData:lSelected = .T.
      if ( ( oData:nColStart <= nCol .AND. oData:nColStart + 2 >= nCol ) .OR. ;
           ( oData:nColEnd >= nCol .AND. oData:nColEnd - 2 <= nCol ) )
         oData:lResized = .T.
         oData:lRFromStart = oData:nColStart <= nCol .AND. oData:nColStart + 2 >= nCol
      else
         oData:lCatched = .T.
      endif
      ::oLastData = oData
      ::cToolTip = NIL
   endif

   ::Refresh()

return NIL

//----------------------------------------------------------------------------//

METHOD SetLabelHeader() CLASS TPlanning

   local n, dDate, cLabel
   local nTotDays := ::dEnd - ::dStart + 1
   local hHead

   ::aLabelHeader = {}

   for n = 1 to nTotDays
      hHead := {=>}
      dDate = ::dStart + ( n - 1 )
      cLabel = SubStr( CDoW( dDate ), 1, 3 ) + CRLF + StrZero( Day( dDate ), 2 ) + "-" + SubStr( CMonth( dDate ), 1, 3 )
      hHead["LABEL"] = cLabel
      hHead["DATE"]  = DToS(dDate)
      hHead["LEFT"]  = 0
      hHead["RIGHT"] = 0
      AAdd( ::aLabelHeader, hHead )
   next

return nil

//----------------------------------------------------------------------------//

METHOD SetScroll() CLASS TPlanning

   ::oVScroll:bGoUp     = {|| ::VScrollSkip( - ::nRowHeight ) }
   ::oVScroll:bGoDown   = {|| ::VScrollSkip( ::nRowHeight ) }
   ::oVScroll:bPageUp   = {|| ::VScrollSkip( - ::oVScroll:nPgStep ) }
   ::oVScroll:bPageDown = {|| ::VScrollSkip( ::oVScroll:nPgStep ) }
   ::oVScroll:bPos      = {|nPos| ::VScrollSetPos( nPos ) }
   ::oVScroll:bTrack    = {|nPos| ::VScrollSetPos( nPos ) }

return nil

//----------------------------------------------------------------------------//

METHOD SetDates( dStart, dEnd ) CLASS TPlanning

   DEFAULT dStart := ::dStart
   DEFAULT dEnd   := ::dEnd

   if dStart >= dEnd
      return nil
   endif

   ::dStart = dStart
   ::dEnd   = dEnd
   ::Reset()
   ::SetLabelHeader()
   ::Refresh()

return nil

//----------------------------------------------------------------------------//

METHOD UpdateData( cRow, dStart, dEnd, cDescribe, cToolTip ) CLASS TPlanning


return nil

//----------------------------------------------------------------------------//

METHOD VScrollSetPos( nPos ) CLASS TPlanning

   local nSkip := nPos - ::nVirtualTop

   ::nVirtualTop := nPos
   ::oVScroll:SetPos( nPos )

   ::Refresh()


RETURN nil

//----------------------------------------------------------------------------//

METHOD VScrollSkip( nSkip ) CLASS TPlanning

   local nHeight := ( ::nVirtualHeight - ::nHeight )
   local nAux

   IF (::nVirtualTop == 0 .And. nSkip < 0) .Or. ;
      (::nVirtualTop == nHeight .And. nSkip > 0)
      RETURN nil
   ENDIF

   nAux = ::nVirtualTop
   ::nVirtualTop += nSkip

   ::nVirtualTop = Min( ::nVirtualHeight - ::nHeight, ::nVirtualTop )

   IF ::nVirtualTop < 0
      ::nVirtualTop := 0
   ELSEIF ::nVirtualTop > nHeight
      ::nVirtualTop := nHeight
   ENDIF
   ::oVScroll:SetPos( ::nVirtualTop )

   ::Refresh()

   if nAux - ::nVirtualTop != -nSkip
      nSkip = -( nAux - ::nVirtualTop )
   endif


RETURN nil

//----------------------------------------------------------------------------//

FUNCTION P_GetLastDayMonth( dDate )

   local nMonth, cDay, nYear
   local dAux

   nMonth = Month( dDate )
   cDay   = "01"
   nYear  = Year( dDate )
   if nMonth == 12
      nMonth = 1
      nYear++
   else
      nMonth++
   endif

   dAux = ( SToD( StrZero( nYear, 4 ) + StrZero( nMonth, 2 ) + cDay ) ) - 1

return dAux


//----------------------------------------------------------------------------//
//****************************************************************************//
//----------------------------------------------------------------------------//


CLASS TPData

   DATA oPlanning
   DATA cRow
   DATA cName
   DATA dStart
   DATA dEnd
   DATA Cargo
   DATA cDescribe
   DATA cToolTip
   DATA nID
   DATA nColStart, nColEnd
   DATA nNewColStart, nNewColEnd

   DATA lSelected
   DATA lCatched
   DATA lResized, lRFromStart, lRFromEnd

   METHOD New()

   METHOD GetNewId()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( oPlanning, cRow, dStart, dEnd, cDescribe, cToolTip ) CLASS TPData

   DEFAULT dStart := Date(),;
           dEnd   := Date()

   ::oPlanning = oPlanning
   ::cRow      = cRow
   ::cName     = DToS( dStart )
   ::dStart    = dStart
   ::dEnd      = dEnd
   ::cDescribe = cDescribe
   ::cToolTip  = cToolTip

   ::lSelected = .F.
   ::lCatched = .F.
   ::lResized = .F.
   ::lRFromStart = .F.
   ::lRFromEnd = .F.
   ::nID = ::GetNewId()

return Self

//----------------------------------------------------------------------------//

METHOD GetNewId() CLASS TPData

   nID++

   if nID > 10000
      nID = 1
   endif

return nID


//----------------------------------------------------------------------------//
//****************************************************************************//
//----------------------------------------------------------------------------//


#define TRANSPARENT         0x1   //1
//----------------------------------------------------------------------------//

static function DrawTransparent( hDC, hBmp, nRow, nCol )

   local hDCMem
   local hBmpOld
   local nZeroZeroClr

   hDCMem = CreateCompatibleDC( hDC )

   // we can not get nZeroZeroClr from hDC is possible hDC are locked by other SelectObject
   // An application cannot select a bitmap into more than one device context at a time.
   hBmpOld      = SelectObject( hDCMem, hBmp )
   nZeroZeroClr = GetPixel( hDCMem, 0, 0 )

   SelectObject( hDCMem, hBmpOld )
   DeleteDC( hDCMem )

   TransBmp( hBmp, nBmpWidth( hBmp ), nBmpHeight( hBmp ),;
             nZeroZeroClr, hDC, nCol, nRow, nBmpWidth( hBmp ), nBmpHeight( hBmp ) )

return nil

//----------------------------------------------------------------------------//

static FUNCTION P_Say( hDC, cText, aRect, nStyle, oFont, nClrText, nClrBack )

   local nOldMode := SetBkMode( hDC, 1 )
   local nOldClr  := SetTextColor( hDC, nClrText )
   local hOldFont

   if oFont != NIL
      hOldFont = SelectObject( hDC, oFont:hFont )
   endif

   DrawText( hDC, cText, aRect, nStyle )
   SetBkMode( hDC, nOldMode )
   SetTextColor( hDC, nOldClr )
   if oFont != NIL
      SelectObject( hDC, hOldFont )
   endif

return nil

plan.c

Code: Select all

#include <hbapi.h> 
#include <windows.h>

HBITMAP CreateMemBitmap( HDC, LPSTR );

static far BYTE nextitem [] = {
0x42, 0x4D, 0x40, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x36, 0x00, 0x00, 0x00,
0x28, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x0B, 0x00, 0x00, 0x00, 0x01, 0x00, 0x18, 0x00,
0x00, 0x00, 0x00, 0x00, 0x0A, 0x01, 0x00, 0x00, 0x12, 0x0B, 0x00, 0x00, 0x12, 0x0B, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA,
0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA,
0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA,
0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA,
0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA,
0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA };                      

static far BYTE previtem [] = {
0x42, 0x4D, 0x40, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x36, 0x00, 0x00, 0x00, 0x28, 0x00,
0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x0B, 0x00, 0x00, 0x00, 0x01, 0x00, 0x18, 0x00, 0x00, 0x00,
0x00, 0x00, 0x0A, 0x01, 0x00, 0x00, 0x12, 0x0B, 0x00, 0x00, 0x12, 0x0B, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00,
0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6,
0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA, 0xE6, 0x00, 0xFA } ;   

//----------------------------------------------------------------------------// 

HB_FUNC( HCONRIGHT )
{
   hb_retnl( ( LONG ) CreateMemBitmap( 0, ( LPSTR ) nextitem ) );
}  

//----------------------------------------------------------------------------// 

HB_FUNC( HCONLEFT )
{
   hb_retnl( ( LONG ) CreateMemBitmap( 0, ( LPSTR ) previtem ) );
}  

[Silvio.Falconi]

Hello Silvio,
where can we download the dbf - files for testing.
Best regards
Otto

Otto,
the sample create the dbf you need

[Silvio.Falconi]

I am unable to test this program, because I do not have planning.ch and I can not see the original of sample in fwh\samples folder.

Where is the original program of Mr. Daniel using only DBF?
Where is the planning.dbf?

Provide us with any sample program which we can test at our end.

I'm sorry but I had internet connection problems and had to restore windows 10 on my laptop as I wrote to you privately

[Silvio.Falconi]

Note: Before running this program, please delete the existing ROOMS.DBF, ROOMS.CDX, RESERVA.DBF and RESERVA.CDX.

But if I use this sample on my application I must erase allway this dbfs ?

[Silvio.Falconi]

So, the problem is not with TDatabase, but the way the DBFs are indexed.

I never said that there are problems in the tdatabase class, I just said that when I compiled and executed it gave me problems opening the dbf with the class Tdatabase