Problem with Tplan : Cargo Error

[James Bott]

Well, I don't have much to work with, but it looks like you may have added the class data ::oData and there are lots of oData's in the program too. I would first suggest making a backup, then removing all the double colons from in front of ::oData, then trying it again.

James

[Silvio.Falconi]

there are not ::odata data class in my source
Please see it ( where are these DATA ::odata?)

Code: Select all  Expand view  RUN

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




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



    // 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


       Data cDbfPath
       Data cTipoElemento

       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 oSelf := Self
       local cInifile := TakeOffExt( GetModuleFileName( GetInstance() ) ) + ".ini"

       ::cDbfPath    := GetIni( cIniFile, "Config", "DbfPath")

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


        ::BuildDbf()

        ::cTipoElemento   := "01" //for filter

        ::oWnd:=oApp():oPanelBook



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




       ::oWnd:oClient = ::oPlann



    RETURN Self

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



    METHOD BuildDbf() CLASS SamplePlan

       field ID, ROOMS_ID, CHECK_IN

       local aStructure
       local i
       local cDir     := ::cDbfPath

       if ! File( cDir+"rooms.dbf" )

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

          DBCreate( cDir+"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

           USE  &(cDir+"ROOMS"+".dbf")  VIA "DBFCDX" NEW
          ROOMS->( Dbzap() )
          ROOMS->( DbPack() )
           CLOSE ROOMS


       if ! File( cDir+"reserva.dbf" )

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

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

       ENDIF

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

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



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

       //save struttura to Rooms
       //I must load all rooms from spiaggia.dbf
        LoadToRoom(cDir,::oRooms)


       ::oReserva := TDatabase():Open( nil, cDir+"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
       Local nCella,cTipo,cText,nResno


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


       cTipo := ::cTipoElemento               //type of the room
       nCella  :=  RIGHT(oPlan:GetRowID(),3)  // number of room



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


       if ! lNew
           ::oReserva:SetOrder( "room_in" )
           ::oReserva:GoTop()
           ::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:TYPE      = cTipo
          ::oReserva:Save()
          ::oReserva:Commit()

          ::LoadData()
          oPlan:Refresh()

       ENDIF

    RETURN nil

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

    METHOD BuildPlanning() CLASS SamplePlan
       Local oSelf := Self
       Local oPopupCalPlan
       Local oDate1,oDate2,oBtnCalenda
       Local oBtn[4]
       Local aBtnfw :={ FW_BmpPlus(), FW_BmpMinus() }
       Local nIcoElemento  := 1
       Local oCbx
       Local oScrollHor
       Local aBmpCombo := {   ".\temp\TempEl_1.Jpg.bmp",;
                              ".\temp\TempEl_2.Jpg.bmp"   ,;
                              ".\temp\TempEl_3.Jpg.bmp" ,;
                              ".\temp\TempEl_4.Jpg.bmp"}



   MENU oPopupCalPlan POPUP 2015
    MENUITEM "Oggi"        ACTION ( oSelf:dStart:=date(),oSelf:dEnd:=date()+5,oDate1:refresh(),oDate2:refresh(),;
                                   EVAL( oDate1:bchange),EVAL( oDate2:bchange) )
    MENUITEM "Domani"      ACTION ( oSelf:dStart:=date()+1,oSelf:dEnd:=date()+6,oDate1:refresh(),oDate2:refresh(),;
                            EVAL( oDate1:bchange),EVAL( oDate2:bchange) )
    MENUITEM "DopoDomani"  ACTION ( oSelf:dStart:=date()+2,oSelf:dEnd:=date()+7,oDate1:refresh(),oDate2:refresh(),;
                            EVAL( oDate1:bchange),EVAL( oDate2:bchange) )

   SEPARATOR

   MENUITEM "Mese Corrente"  ACTION (oSelf:dStart:=bom(date()),;
                                       oSelf:dEnd:= eom(date()),;
                                       oDate1:refresh(),oDate2:refresh(),;
                                       EVAL( oDate1:bchange),EVAL( oDate2:bchange))

   MENUITEM "Mese Prossimo"  ACTION (oSelf:dStart:=AddMonth(bom(date()),1),;
                                       oSelf:dEnd:= AddMonth(eom(date()),1),;
                                       oDate1:refresh(),oDate2:refresh(),;
                                       EVAL( oDate1:bchange),EVAL( oDate2:bchange))

   SEPARATOR

     MENUITEM "Giugno"  ACTION (oSelf:dStart:=AddMonth( BOY( DATE() ), 5 ),;
                                oSelf:dEnd:=EoM(AddMonth( BOY( DATE() ), 5 )),;
                                oDate1:refresh(),oDate2:refresh(),;
                                EVAL( oDate1:bchange),EVAL( oDate2:bchange))

     MENUITEM "Luglio"  ACTION (oSelf:dStart:=AddMonth( BOY( DATE() ), 6 ),;
                                oSelf:dEnd:=EoM(AddMonth( BOY( DATE() ), 6 )),;
                                oDate1:refresh(),oDate2:refresh(),;
                                EVAL( oDate1:bchange),EVAL( oDate2:bchange))

      MENUITEM "Agosto"  ACTION (oSelf:dStart:=AddMonth( BOY( DATE() ), 7 ),;
                                oSelf:dEnd:=EoM(AddMonth( BOY( DATE() ), 7 )),;
                                oDate1:refresh(),oDate2:refresh(),;
                                EVAL( oDate1:bchange),EVAL( oDate2:bchange))

      MENUITEM "Settembre"  ACTION (oSelf:dStart:=AddMonth( BOY( DATE() ), 8 ),;
                                oSelf:dEnd:=EoM(AddMonth( BOY( DATE() ), 8 )),;
                                oDate1:refresh(),oDate2:refresh(),;
                                EVAL( oDate1:bchange),EVAL( oDate2:bchange))

    ENDMENU





       DEFINE PLANNING ::oPlann OF ::oWnd;
              HEADER "Elementi / Giorni";
              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

   ::oPlann:nTopMargin:= 0
   ::oPlann:nLeftLabelWidth  := 108



     // I check there is a dialog on Ribbonbar  oApp():oReBar
     // if there is allready I erased it and end all objects
     // then create the dialog oGrPlanning and create all object

    IF  oApp:oGrPlanning != nil
           For n= 1 to Len( oApp:oGrPlanning:aControls)
                 oApp:oGrPlanning:aControls[n]:end()
           next
             oApp:oGrPlanning:end()
            oApp:oGrPlanning := oApp():oReBar:AddGroup( 780,  "Periodo da visualizzare", 2,,, )
        else
      Endif




       @ 5,0   ADD BUTTON oBtnCalenda PROMPT "Calendario" ;
                  BITMAP "TOOLBAR_CALENDAR"         ;
                 OF oApp:oGrPlanning ROUND SIZE 68,72 ;
                 SPLITPOPUP MENU oPopupCalPlan



        @ 0.9,12 DTPICKER oDate1 VAR  oSelf:dStart OF oApp:oGrPlanning  SIZE 145,25 picture "ddd dd mmm yyyy";
                ON CHANGE ( if( oSelf:dStart != oSelf:oPlann:dStart,;
                            ( oSelf:oPlann:SetDates( oSelf:dStart ), oSelf:LoadData() ), ) ) ;
                    VALID ValidareData(oSelf:dStart, oSelf:dEnd )

       @ 0.9,40 DTPICKER oDate2 VAR  oSelf:dEnd OF oApp:oGrPlanning  SIZE 145,25 picture "ddd dd mmm yyyy";
                ON CHANGE ( if( oSelf:dEnd != oSelf:oPlann:dEnd,;
                ( oSelf:oPlann:SetDates( , oSelf:dEnd ), oSelf:LoadData() ), ) )  ;
                       VALID ValidareData(oSelf:dStart, oSelf:dEnd )

         @ 45,72   ADD BUTTON oBtn[1]  ;
                  BITMAP aBtnfw[2] ; //"BTN_PNG_MINUS"         ;
                  OF oApp:oGrPlanning SIZE 28,25;// 60,25  ;
                      ACTION   ( oSelf:dStart--,oDate1:REFRESH(),EVAL( oDate1:bchange)) BORDER

           @ 45,188   ADD BUTTON oBtn[2] ;
              BITMAP  aBtnfw[1] ; //"BTN_PNG_PLUS"         ;
                  OF oApp:oGrPlanning   SIZE 28,25; // 60,25    ;
        ACTION   (IF( oSelf:dStart<oSelf:dEnd,oSelf:dStart++,(oSelf:dStart++,oSelf:dEnd++)),;
                           oDate1:REFRESH(),oDate2:REFRESH(),EVAL( oDate1:bchange),EVAL( oDate2:bchange)) BORDER


    @ 45,241   ADD BUTTON oBtn[3] ;
              BITMAP aBtnfw[2] ; //"BTN_PNG_MINUS"         ;
                  OF oApp:oGrPlanning  SIZE 28,25; // 60,25  ;
                      ACTION   ( IF( oSelf:dEnd=oSelf:dStart,,oSelf:dEnd--),;
                                 oDate2:REFRESH(),EVAL( oDate1:bchange),EVAL( oDate2:bchange)) BORDER

    @ 45,356   ADD BUTTON oBtn[4] ;
               BITMAP  aBtnfw[1] ; //"BTN_PNG_PLUS"         ;
                  OF oApp:oGrPlanning  SIZE 28,25; // 60,25    ;
                           ACTION   ( oSelf:dEnd++,oDate2:REFRESH(),EVAL( oDate1:bchange),EVAL( oDate2:bchange)) BORDER




    @ 9,400 COMBOBOX oCbx VAR nIcoElemento Items { " ", " ", " ", " "  } ;
      BITMAPS aBmpCombo  SIZE 90,120 PIXEL  OF oApp:oGrPlanning     HEIGHTGET 60 ;
      ON CHANGE ( oSelf:cTipoElemento  := GiveElemento(nIcoElemento),;
      oSelf:oPlann:Reset()                       ,;
      oSelf:LoadRooms()                          ,;
      oSelf:LoadData()                          ,;
      oSelf:oPlann:Refresh() )

    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 ) ;
             .AND. ::oReserva:TYPE== AllTrim( ::cTipoElemento )

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

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

          cTooltip  = "Elemento     : " + ::oRooms:NAME + CRLF
          cTooltip += "Numero       : " + ::oRooms:ID + CRLF
          cTooltip += "Ospite       : " + ::oReserva:GUEST + CRLF
          cTooltip += "Arrivo       : " + DToC( ::oReserva:CHECK_IN ) + CRLF
          cTooltip += "Partenza     : " + 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()
       ::oPlann:hRows := {=>}

       DO WHILE ! ::oRooms:Eof()
          If AllTrim(::oRooms:TYPE ) == AllTrim( ::cTipoElemento )
             ::oPlann:AddRow( ::oRooms:ID, ::oRooms:NAME)
       Endif
          ::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  = "Elemento     : " + ::oRooms:NAME + CRLF
          cTooltip += "Numero       : " + ::oRooms:ID + CRLF
          cTooltip += "Ospite       : " + ::oReserva:GUEST + CRLF
          cTooltip += "Arrivo       : " + DToC( ::oReserva:CHECK_IN ) + CRLF
          cTooltip += "Partenza     : " + 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  = "Elemento     : " + ::oRooms:NAME + CRLF
          cTooltip += "Numero       : " + ::oRooms:ID + CRLF
          cTooltip += "Ospite       : " + ::oReserva:GUEST + CRLF
          cTooltip += "Arrivo       : " + DToC( ::oReserva:CHECK_IN ) + CRLF
          cTooltip += "Partenza     : " + 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



Static function LoadToRoom(cDbfPath,oRooms)
   Local aElementi := LoadElementi(cDbfPath)
   Local n
   local cDir     := cDbfPath
   Local cCodice
   Local oBeach
   local nArea    := Select()


       oBeach   := TDatabase():Open( nil, cDir+"SPIAGGIA",   "DBFCDX", .t. )
       oBeach:SetOrder( 1 )
       oBeach:GoTop()

        for n= 1 to Len(aElementi)
           IF aElementi[n][6] //attivo
               cCodice:=  aElementi[n][3]
                oBeach:gotop()
                Do While .not. oBeach:eof()
                   IF  oBeach:Elemento == cCodice
                     oRooms:Append()
                     oRooms:ID   := Left(oBeach:Desc,1)+Strzero(oBeach:Cella,3)
                     oRooms:Name := alltrim(oBeach:Desc)+" "+Ltrim(str( oBeach:Cella))
                     oRooms:Type := oBeach:Elemento
                     oRooms:Save()
                     oRooms:Commit()
                    EndIF
                   oBeach:Skip()
                  EndDo
               Endif
            Next



            oBeach:close()
         Select (nArea)

     return nil
//-----------------------------------------------------------------//
Function LoadElementi(cDbfPath)
   Local oElementi
   Local nId,;
         cImage  ,;
         cCodice ,;
         cDesc   ,;
         cColor  ,;
         lAttivo ,;
         nOrdine ,;
         cImgfree,;
         cImgOcc ,;
         cImgalt ,;
         lLock

   Local aDataProduct:={}
   local cDir     := cDbfPath
   local nArea    := Select()

            oElementi:=TDatabase():Open( , cDir+"Elementi", "DBFCDX", .T. )
            oElementi:setorder(2)
            oElementi:gotop()

              DO WHILE .not. oElementi:EOF()
                     nId     := oElementi:ELNUMERO
                     cCodice := Strzero(val(nId),2)
                     cDesc   := alltrim(oElementi:ELNOME)
                     cColor  := GetBackColor(alltrim(oElementi:ELCOLORE))
                     lAttivo := oElementi:ELATTIVO
                     nOrdine := oElementi:ELORDINE
                     cImgfree:= oElementi:ELIMGLIB
                     cImgOcc := oElementi:ELIMGOCC
                     cImgalt := oElementi:ELIMGALT
                     lLock   := oElementi:ELLOCK
                     cImage  := IF(oElementi:ELATTIVO, cImgalt,cImgfree)


                 AaDd(aDataProduct,{ nId,;
                                 cImage  ,;
                                 cCodice ,;
                                 cDesc   ,;
                                 cColor  ,;
                                 lAttivo ,;
                                 nOrdine ,;
                                 cImgfree,;
                                 cImgOcc ,;
                                 cImgalt ,;
                                 lLock,0})


          oElementi:SKIP()

    ENDDO
    oElementi:close()
    Select (nArea)
    RETURN aDataProduct
//------------------------------------------------------------------//

       Function GiveElemento(nIcoElemento)
      Local cElemento

         do case
            case  nIcoElemento= 1
               cElemento:="01"
            case  nIcoElemento= 2
               cElemento:="02"
            case  nIcoElemento= 3
               cElemento:="03"
            case  nIcoElemento= 4
               cElemento:="04"
            endcase

            return cElemento

 static Function ValidareData( dFechaIni, dFechaFin )
   LOCAL lValid := .T.

   IF ( dFechaIni > dFechaFin )
      alert( "La data finale deve essere  maggiore di quella finale " )
      lValid := .F.
   ENDIF
   RETURN  lValid
 

on private email a reserva.dbf demo with many records to try

[James Bott]

Silvio,

In my copy in the method MoveReservation() oData is ::oData. I see your copy doesn't have that so ignore my suggestion.

James

[Silvio.Falconi]

Wait
I 'm searching my oldest sources from daniel 's messages on google gmail

[Silvio.Falconi]

I checked it this is the last release created by daniel garcia Gill on 18.03.2013



Class Tplan

Tplann.prg

Code: Select all  Expand view  RUN

//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  Expand view  RUN

#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]

this is the sample sent me on 18.03.2013 by Daniel

Sample03.prg

Code: Select all  Expand view  RUN

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

   
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

   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
   

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
      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

RETURN nil

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

METHOD BuildPlanning() CLASS SamplePlan 

   LOCAL oSelf := Self

   DEFINE PLANNING ::oPlann OF ::oWnd;
          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 )
   
   ::oPlann:bOnCapture = { | oData, nRowId, oPlann | ::MoveReservation(oData, nRowId, oPlann) }
   ::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 RESERVA->( DBSeek( oPlan:GetRowID() + DToS( dCheckIn ) ) )
       RESERVA->( DBDelete() )
       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
   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() )
 
   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

return NIL


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

METHOD LoadRooms() CLASS SamplePlan

   local n
   local cRowName, cRowText
   local oData
   
   ROOMS->( DbGoTop() )
   
   DO WHILE ! ROOMS->( Eof() )
      ::oPlann:AddRow( ROOMS->ID, ROOMS->NAME )
      ROOMS->( DbSkip() )
   ENDDO  

   
RETURN nil

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

METHOD MoveReservation( oData, nRowId, oPlann ) CLASS SamplePlan

   local oItem := oData
   local cDescribe, cTooltip, nStatus

   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


RETURN nil

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

function HB_COMPILEFROMBUF()
return nil

function curdrive()
return nil

[Silvio.Falconi]

I tried to talk with Daniel but he seem vanished and I haven't heard for two years since we met in Sillian in Otto's hotel
Only Daniel could help us
then I think id oData is a Data class perhaps it not change my error

[James Bott]

Silvio,

Correct, oData is not a database object. It appears to be a very simple object that just contains some data and a GetNewID() method.

Also, I notice in the newest version that oData is declared as class data but not used anywhere. Perhaps you should try that version.

James

[Silvio.Falconi]

James,
I recompiling the original of Daniel and it not make errors
On Release with Tdatabase on Methods MoveReservation and ResizeReservation there are errors because
on method MoveReservation the procedure must change only the number of ROOMS_ID

when there is the cargo error it saved only the number of room but not the other data



then oData posizioned on new Room not found the data info and make error

[James Bott]

What is the error? And what is the line that is generating the error (not the line number, just the code)?

[Silvio.Falconi]

James,
Nages,

I sent all sources on private mails

perhaps it happened when there are many records on RESERVA.DBF
( but on oldest application without tdatabase but with normal use it run ok)
I sent you also the reserva.dbf with some records to make tests

Code: Select all  Expand view  RUN

Application
===========
   Path and name: C:\Users\silvio\Desktop\Release_TPlan\Normal_window\tplan_TdataBase\Main.Exe (32 bits)
   Size: 5,965,312 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 3 secs
   Error occurred at: 07/04/2019, 09:22:40
   Error description: Error BASE/1005  Variabile non disponibile: CARGO
   Args:
     [   1] = U  
     [   2] = H   {=>}

Stack Calls
===========
   Called from:  => _CARGO( 0 )
   Called from: Source\sample01.prg => SAMPLEPLAN:MOVERESERVATION( 591 )
   Called from: Source\sample01.prg => (b)SAMPLEPLAN_BUILDPLANNING( 357 )
   Called from: Source\tplann.prg => TPLANNING:LBUTTONUP( 702 )
   Called from: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT( 1791 )
   Called from: Source\tplann.prg => TPLANNING:HANDLEEVENT( 619 )
   Called from: .\source\classes\WINDOW.PRG => _FWH( 3546 )
   Called from:  => WINRUN( 0 )
   Called from: .\source\classes\WINDOW.PRG => TWINDOW:ACTIVATE( 1078 )
   Called from: Source\sample01.prg => SAMPLEPLAN:NEW( 110 )
   Called from: Source\sample01.prg => MAIN( 28 )

[Silvio.Falconi]

But where is is Daniel Garcia Gill?