FiveTech Software tech support forums

by **Silvio.Falconi** » Thu Jun 20, 2019 11:22 am

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

the error

Code: Select all Expand view: 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 Expand view: 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 ?

by **nageswaragunupudi** » Thu Jun 20, 2019 12:34 pm

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.

by **Silvio.Falconi** » Thu Jun 20, 2019 1:12 pm

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

Code: Select all Expand view: #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

by **TimStone** » Thu Jun 20, 2019 4:33 pm

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

by **Silvio.Falconi** » Thu Jun 20, 2019 7:55 pm

Tim
the method ::OPenData there is at bottom

METHOD OpenData() CLASS SamplePlan

by **Silvio.Falconi** » Thu Jun 20, 2019 9:18 pm

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 Expand view: 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 Expand view: #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 //------------------------------------------------------------------//

by **Otto** » Thu Jun 20, 2019 9:42 pm

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

by **nageswaragunupudi** » Thu Jun 20, 2019 11:57 pm

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.

by **nageswaragunupudi** » Fri Jun 21, 2019 3:13 am

I just downloaded.
We will test and get back.

by **nageswaragunupudi** » Fri Jun 21, 2019 4:11 am

Here lies the problem:

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

Code: Select all Expand view: 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 Expand view: 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 Expand view: #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 Expand view: #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.

by **nageswaragunupudi** » Fri Jun 21, 2019 4:13 am

tplan.prg

Code: Select all Expand view: //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: #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 ) ); }

by **Silvio.Falconi** » Fri Jun 21, 2019 7:20 am

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

Otto,
the sample create the dbf you need

by **Silvio.Falconi** » Fri Jun 21, 2019 7:21 am

nageswaragunupudi wrote: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

by **Silvio.Falconi** » Fri Jun 21, 2019 7:25 am

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 ?

by **Silvio.Falconi** » Fri Jun 21, 2019 7:30 am

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

FiveTech Software tech support forums

Converting sample test of Tplan

Converting sample test of Tplan

Re: Problem to open a tdatabase

Re: Problem to open a tdatabase

Re: Problem to open a tdatabase

Re: Problem to open a tdatabase

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Re: Converting sample test of Tplan

Who is online