Codejock Calendar Samples?

[fraxzi]

Frances

The easiest way is to build a class

Let me know what email you use, i will send you a copy of the class i use for my application since quite a while , working like a charm.

Hth

Richard

Dear Mr. Richard,

My email is vichezzz at yahoo dot com.

Thank!

[Richard Chidiak]

Frances Dutch and Norberto

You can download it from www.cbati.com/tcodejock.zip if any one else wants to download he is welcome, of course you will need to have the license from codejock and insert your own license number.

The class was made to fit my needs, i use it for scheduling , version 15.0.2 of the control installed one year ago.

You will find all the elements to get started with, i have joined the resources and images i use also.

If you need help, let me know , codejock is a fantastic product while their support is very bad... unfortunately. Initially the class was set by Reinaldo Crespo and Tim Stone and highly updated by me.
Special thanks also to Daniel Garcia Gil who helped me also getting stated a year ago.

Having more fivewinners using this control is good, we may share more expertise.

Looking forward for your comments,

To Lucas , there is no way to compare the calex class to codejock, there is a lot to do for the same functions. I have joined some images of what can be done with codejock, it is self explaining

Regards

[fraxzi]

Dear Mr. Richard,


Thank you for your positive support. I'm looking forward to start using this class and throw useful feedback for someone to catch..

[dutch]

Thanks Richard,

I will see from your samples and let you know.

Regards,
Dutch

[Massimo Linossi]

Hi Richard.
I'm trying to download your sample but the zip file is not downloadable anymore.
Is it possible to have a new link to test your Codejock example ?
Thanks a lot.
Massimo

[Antonio Linares]

Massimo,

This codejock example has been sent from Richard Chidiak to me, I am copying it here without any licence infos:

Richard, if there is any objection to publish it here, please let me know it and I will remove it, thanks

Code: Select all  Expand view

#INCLUDE "FIVEWIN.CH"
#include "dtpicker.ch"
#INCLUDE "REPORT.CH"

//---------- theme constants
#define xtpCalendarThemeOffice2000  0
#define xtpCalendarThemeOfficeXP        1
#define xtpCalendarThemeOffice2003  2
#define xtpCalendarThemeOffice2007  3

//----------- views
#define xtpCalendarDayView      0
#define xtpCalendarWorkWeekView     1
#define xtpCalendarWeekView     2
#define xtpCalendarMonthView    3
#define xtpCalendarFullWeekView  4
#define xtpCalendarTimeLineView  5

#define xtpCalendarEO_Unknown             0  //Unknown operation value.
#define xtpCalendarEO_DragCopy            1  //Drag copy event.
#define xtpCalendarEO_DragMove            2  //Drag move event.
#define xtpCalendarEO_DragResizeBegin     3  //Drag Resizing event begin.
#define xtpCalendarEO_DragResizeEnd       4  //Drag Resizing event end.
#define xtpCalendarEO_EditSubject_ByF2    5  //In-place edit event by pressing F2 key.
#define xtpCalendarEO_EditSubject_ByMouseClick  6  //In-place edit event by mouse click.
#define xtpCalendarEO_EditSubject_ByTab   7  //In-place edit event tab key.
#define xtpCalendarEO_EditSubject_AfterEventResize 8 //In-place edit event after resizing an event.
#define xtpCalendarEO_Cut                 9  //Cut events.
#define xtpCalendarEO_Copy                10 //Copy events.
#define xtpCalendarEO_Paste               11 //Paste event.
#define xtpCalendarEO_DeleteSelectedEvents 12   //Delete selected events.
#define xtpCalendarEO_DeleteEvent         13 //Delete event. Sent for a single event or for each selected event.
#define xtpCalendarEO_InPlaceCreateEvent  14 //In-place event creation.

REQUEST DBFCDX,DBFFPT
REQUEST DESCEND
REQUEST ORDKeyno, ORDKeycount,ORDKEYGOTO

function Main()
LOCAL TPAR   := {}, ;
      I      := 0, ;
      TSEL   := SELECT(), ;
      DDATE

PUBLIC WDATE,AAMMJJ,JJMMAA

RDDSETDEFAULT("DBFCDX")

SET DATE FRENCH
SET CENTURY ON
SET FIXED ON
SET DELETE ON
SET DBFLOCKSCHEME TO 2   // clp53
SET AUTOPEN ON
SET STRICTREAD OFF  // pour accélérer la réorg dbfcdx

set(_SET_INSERT, .T.)

SET EPOCH TO YEAR(DATE()) - 80

WDATE     := DTOC(DATE())
JJMMAA    := SUBS(WDATE,1,2) + SUBS(WDATE,4,2) + SUBS(WDATE,7,4)
AAMMJJ    := SUBS(WDATE,7,4) + SUBS(WDATE,4,2) + SUBS(WDATE,1,2)

CREPLANTAB(@TPAR)
DDATE := CTOD(TRNDATE(AAMMJJ))

IF ! NETOPEN("PLANPREF")
   RETURN NIL
ENDIF

DEFINE WINDOW OWND FROM 0,0 TO 24,78 ;
       TITLE "I am the main window" ;
       COLORS CLR_WHITE, CLR_WHITE

DEFINE BUTTONBAR OBAR OF  Ownd SIZE 80, 80 2010

DEFINE BUTTON OBTN1 PROMPT "CODEJOCK" of OBAR ;
          ToolTip "CODEJOCK" ;
          ACTION TPLANCJ():New(TPAR,DDATE)

DEFINE BUTTON OBTN2 PROMPT "EXIT" OF OBAR;
       ToolTip "EXIT" ;
       ACTION IF( MSGYESNO( "Want to quit ?","please confirmr" ),(OWND:end ) , ) ;
       MESSAGE "Quit"

ACTIVATE WINDOW OWND MAXIMIZED
return nil

FUNCTION PLANCJ(TPAR,DDATE)
local oApp,hWnd, ;
      TSEL := SELECT()

hWnd := FINDWINDOW( 0, "Planning Visuel") // 1 seule instance acceptée
IF hWnd != 0
   BringWindowToTop( hWnd )
   CLOSEWINDOW(hWnd)              // fermer instance pour bien initialiser
   SENDMESSAGE( hWnd, 16 )        // Fais quitter
   RETURN NIL
ENDIF

oApp := TPLANCJ():New(TPAR,DDATE,TSEL)

return nil

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

CLASS TPLANCJ

   DATA oWndPL
   DATA oBar
   DATA oDtPick
   DATA oCalex
   DATA oPanelCalex
   DATA oPanelDtp
   DATA oCalexStdDlgs
   DATA oGlbSettings
   DATA OCATEG            // Table désignation libellés catégories pour assigner les couleurs
   DATA ORAPMIN           // Table rappel minutes
   DATA MENOUTILS         // MENU OUTILS
   DATA MENPRINT          // MENU IMPRESSION
   DATA TPAR              // TABLE DEPANNAGES
   DATA Oclientid         // client's id unique set from ini file , 1 per client
   DATA lDoInsert         // Flag for inserting new events : .F. for repeat objects
   DATA lviewafterinsert  // Flag for allowing view appdetails when inserted default True
   DATA ONOTIFIED         // ARRAY FOR ID EVENTS ADDED BY ANOTHER CLIENT AND ALREADY NOTIFIED SO WE DON'T ADD TWICE THE SAME EVENTS
   DATA lNOTIFy           // TRUE (default) for notifications, false when called from notification updates (recursivity)
   DATA lCut              // set when cut   is asked at context menu
   DATA lPaste            // set when Paste is asked at context menu
   DATA lCutcopyID        // set when cut or Copy is asked at context menu id of the CUT event in order to allow database delete
   DATA lPastedid         // New ID after Paste
   DATA lnbPers           // Nombre de personnes à afficher
   DATA ltSel             // SELECT FICHIER

   METHOD New()

   METHOD ApptDetail( oEvent )
   METHOD BuildCalex()
   METHOD BuildDatePicker()
   METHOD BuildPanels()
   METHOD build1Schedule()
   METHOD build1grSchedule()
   METHOD buildMultiSchedule()
   METHOD BuildStdDialogs( )
   METHOD DeleteEvent( oEvent, cId )
   METHOD EditEvent( oEvent )
   METHOD GETENDTIME(OTIME)
   METHOD GetUniqueId
   METHOD handleEvent( Event, aParms, pParams )
   METHOD Histrecur(OEVENT,DREPETER,DREPOK,DMSG,OSAY)
   METHOD InsertEvent( oEvent )
   METHOD NotifyClients(lCodenotify)
   METHOD PLANMENU()
   METHOD PREFCALEX()
   METHOD RECURRAPPT()
   METHOD RetrieveDayEvents( dtDate, oEvents )
   METHOD RetrieveDocinit( dtDate, oEvents )
   METHOD SetSize( nType, nWidth, nHeight )
   METHOD UpdatefromEvent( oEvent )
   METHOD UpdatetoEvent( oEvent)
   METHOD Updatetpar()
ENDCLASS

//---------------------------------------------------//
METHOD New(TPAR,DDATE,TSEL) CLASS TPLANCJ
local oSelf := Self, ;
      n     := 0, ;
      cId   := SPACE(12), ;
      oMenu,oEvent,FICO

::lTsel := TSEL

::lDoInsert        := .t.                // Add event flag
::lviewafterinsert := .t.
::lNotify          := .t.
::lcut             := .f.
::lPaste           := .f.
::lcutcopyid       := SPACE(12)
::lPastedid        := SPACE(12)
::OCATEG           := {}
::Oclientid        := 01  // VAL(GETUSERNUM())  // Retreive the client userid from ini file , each terminal has a different id
::ONOTIFIED        := {}                 // IniTIALIZE array for Notified events

IF ! NETOPEN("PLANPREF")
   RETURN NIL
ENDIF

IF DTOS(TPAR[04]) = SPACE(8)
   TPAR[04] := CTOD(WDATE)
ENDIF

TPAR[31] := .F. // Initialize
::TPAR   := TPAR

IF LEN(ALLTRIM(::TPAR[17])) = 0
   ::TPAR[17] := ::TPAR[05] // Nom du client
ENDIF

::ORAPMIN  := { "0", "5", "10", "15", "30", "45", "60", "90", "120", "180", "240" }  // Minutes reminder

MENU oMenu
ENDMENU

DEFINE WINDOW ::oWndPL MDI MENU oMenu Title "Planning Visuel" VSCROLL HSCROLL FROM 0,0 TO 800, 1150 PIXEL

IF ! isActiveX("Codejock.CalendarControl.15.0.2" )  // fichier pas enregistré
   RegisterServer( "Codejock.Calendar.v15.0.2.ocx" )
   SYSREFRESH()
   MSGINFO("Composant enregistré sur cet ordinateur")
ENDIF

TRY
 ::oGlbSettings := CreateObject( "Codejock.CalendarGlobalSettings.15.0.2" )
 ::oGlbSettings:License = "Calendar Control Copyright (c) 2003-2011 Codejock Software" + CRLF + ;
               "PRODUCT-ID: Codejock.Calendar.ActiveX.v15.0" + CRLF +"VALIDATE-CODE: 000-000-000-000"
  CATCH oErr
    MsgStop( "Section globalSettings inaccessible ! " )
END

::oGlbSettings:ResourceFile = "Calendar.ResourceFr.dll"

DEFINE BUTTONBAR ::oBar OF ::oWndPL SIZE 50,60 2010

DEFINE BUTTON PROMPT "PREF" OF ::oBar MENU ::PLANMENU() ToolTip "Préférences"

DEFINE BUTTON PROMPT "EXIT" OF ::oBar  ;
       Action IF(::oWndPL # nil,::oWndPL:end( ), ) ToolTip "Quitter"

::BuildPanels()          //two panels -left and right
::BuildCalex()           //CodeJock calendar on the right
::BuildDatePicker()      //CodeJock DatePicker on the left
::BuildStdDialogs( )

WNDCENTER( ::oWndPL:hWnd )

ACTIVATE WINDOW ::oWndPL MAXIMIZED ;
         ON RESIZE oSelf:SetSize( nSizeType, nWidth, nHeight ) ;
         VALID        ( ::oWndPL   := nil    ,;
                        ::TPAR[31] := .T.    ,;
                        .T. )

StopUntil( { || ::TPAR[31] } )
RETURN NIL

METHOD PLANMENU() CLASS TPLANCJ
MENU ::MENOUTILS POPUP 2010
   MENUITEM "Préférences Générales" ;
      ACTION ::PREFCALEX()
ENDMENU
RETURN ::MENOUTILS


//-----------------------------------------------------------------------------------------------------//
//-----------------------------------------------------------------------------------------------------//
METHOD handleEvent( Event, aParms, pParams ) CLASS TPLANCJ
LOCAL opParms,oRes,oTime,cId,OEVENT
if valType( Event ) == "C"

   Do Case

        Case Event == "DoRetrieveDayEvents"
           ::lDoInsert := .f.
           ::RetrieveDayEvents( aParms[ 1 ], aParms[2] )
           ::lDoInsert := .T.    // Bypass the InsertEvent Method because we put the data in here.

        Case Event == "DblClick"
        if ::oCalex:ViewType() < xtpCalendarMonthView .OR. ::oCalex:ViewType() = xtpCalendarFullWeekView //day or week view only
           IF ( oEvent := ::oCalex:ActiveView():HitTest():ViewEvent() ) != nil  // EVENEMENT EXISTANT
               oEvent := oEvent:Event()
               ::EditEvent( oEvent)
            Else   // new EVENt
              // oday   := ::oCalex:ActiveView():HitTest():Viewday():date // EX 31/03/2011  type = date
              oTIME  := ::oCalex:ActiveView():HitTest():HitDateTime() // DATE time EX 31/03/2011 12.30.00.00
              ::lDoInsert := .T.    // Bypass the InsertEvent Method because we put the data in here.
              cid    := ::getuniqueid()
              oEvent := ::oCalex:DataProvider:CreateEventex(CID)
              oevent:customproperties:_Property("id",CID)

              oevent:StartTime  := oTIME
              oevent:EndTime    := ::GETENDTIME(oTIME)

              IF PLANPREF->MULTIPERS
                 ORES = ::oCalex:MultipleResources:Item(::oCalex:ActiveView():Selection:GroupIndex)
                 IF ORES:SCHEDULEIDS():COUNT() = 1 // scheduleid for 1 person else it will be a group of persons and we need to add a function to retreive the id wanted
                    oEvent:Scheduleid := ORES:SCHEDULEIDS():item(0)
                 ENDIF
              ENDIF
              ::InsertEvent( oEvent)
              ::lDoInsert := .f.
              ::oCalex:DataProvider:AddEvent( oEvent )
              ::lDoInsert := .f.
           ENDIF
         endif

         case Event == "BeforeEditOperation"  // occurs before insertevent
            OpParms := aParms[ 1 ]
            //  OpParms:EventViews:ViewEvent( 0 ) = oevent

            //       aparms[ 1 ] holds a pointer to CalendarEditOperationParameters object.
            //          This object is referred to as opParms on documentation.
            //          OpParms:Operation is the edit operation taking place from Enumeration list
            //          OpParms:EventViews is an Object acting as an array with all event objects
            //                   marked for editing on the calendar control.
            //          OpParms:EventViews:Count() length of the array
            //          OpParms:EventViews:ViewEvent( n ) returns the nth event in EventViews.
            //       aparms[ 2 ] sent by ref to inform .t. to cancel the operation of .f. to allow it.

            if OpParms:Operation() == xtpCalendarEO_EditSubject_ByF2
               aParms[ 2 ] := .T.

               if OpParms:EventViews:Count() > 0
                  ::EditEvent( OpParms:EventViews:ViewEvent( 0 ) )
               endif

            endif

            IF OpParms:Operation() == xtpCalendarEO_DeleteEvent  // Intercepté avant delete !!! pouvoir inverser delete, comment ???
//               msginfo("DELETE")
            ENDIF
       case Event == "DoCreateEvent" // "EventAddedEx"
         IF ::lDoInsert
            ::InsertEvent( aParms[ 1 ], @aParms[2], @aParms[3] )    // oEvent, nId, lResult
         ENDIF
       case Event == "DoUpdateEvent" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            ::UpdatefromEvent( aParms[ 1 ] )
       case Event == "DoDeleteEvent" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            // ::oCalex:ActiveView():UNDO()
       case Event == "EventDeletedEx" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            // ::DeleteEvent( aParms[ 1 ] ) // delete from ::appdetail and prompt for delete more secure
       Case Event == "MouseMove" .OR. Event == "MouseDown" // aParms[ 3] = x , aParms[ 4] = y
            IF aParms[ 1 ] = 2 //  1 = left click , 2 = right click
               IF ::oCalex:ViewType() < xtpCalendarMonthView .OR. ::oCalex:ViewType() = xtpCalendarFullWeekView //day or week view only
                  cId    := SPACE(12)
                  oEvent := ::oCalex:ActiveView():HitTest():ViewEvent()
                  IF oEvent # nil
                     oEvent := oEvent:Event()
                     CID    := oEvent:CustomProperties:Property( "id" )
                  ENDIF
               ENDIF
            ENDIF
       Case Event == "MouseDown"
       case Event == "KeyDown"
       case Event == "IsEditOperationDisabled"
       case Event == "IsEditOperationDisabledV"
       case Event == "SelectionChanged"
       case Event == "PrePopulate"
       case Event == "PrePopulateDay"
       case Event == "ViewChanged"
       case Event == "OptionsChanged"
   End
endif
Return nil

METHOD GETENDTIME(OTIME) CLASS TPLANCJ // DATE time EX 31/03/2011 12.30.00.00
LOCAL ONEWTIME,CDATE, ;
      CTIME := SPACE(6), ;
      CMIN  := "  ", ;
      CHRS  := "  " , ;
      CWORK := 0

cDate      := StoD( SUBSTR( TtoS( OTime ), 1, 8 ))
cTime      := SubStr( TtoS( OTime ), 9, 6 )
CMIN       := STRTRAN(SubStr( cTime, 3, 2 )," ","0")
CHRS       := SubStr( cTime, 1, 2 )
CWORK      := VAL(CMIN)  + PLANPREF->MINUTES

IF CWORK >= 60
   CWORK -= 60
   CMIN  := STR(CWORK,2)
   CWORK := VAL(CHRS) + 1
   CHRS  := STR((VAL(CHRS) + 1),2)
 ELSE
   CMIN  := STRTRAN(SubStr( cTime, 3, 2 )," ","0")
ENDIF
cTime := cHRS + CMIN + "00"
Onewtime := StoT( DTOS(cDate) + cTime )
RETURN ONEWTIME

//-----------------------------------------------------------------------------------------------------//
METHOD InsertEvent( oEvent, nId, lResult ) CLASS TPLANCJ
LOCAL CID := ::GetUniqueId()

Return oEvent

METHOD EditEvent( oEvent ) CLASS TPLANCJ
Local cid     := oEvent:CustomProperties:Property( "id" )

return nil

METHOD UpdatetoEvent( oEvent) CLASS TPLANCJ
return nil

//-----------------------------------------------------------------------------------------------------//
METHOD UpdatefromEvent( oEvent ) CLASS TPLANCJ

return oEvent

//-----------------------------------------------------------------------------------------------------//
METHOD DeleteEvent( oEvent,LId ) CLASS TPLANCJ
return oEvent

//-----------------------------------------------------------------------------------------------------//
METHOD retrieveDayEvents( dtDate, oEvents) CLASS TPLANCJ
Retur Nil

//---------------------------------------------------------------------------------------------------//
METHOD BuildCalex() CLASS TPLANCJ
local oErr
LOCAL objResource, pRCDesc, n
Local cfile

TRY
    ::oCalex := tActiveX():New( ::oPanelCalex, "Codejock.CalendarControl.15.0.2" )
 CATCH oErr
    MsgStop( "Installation Composant OCX manquante", "Abandon" )
    Quit
END

with object ::oCalex

     :VisualTheme = ( xtpCalendarThemeOffice2007 )
     :bOnEvent = { | event, aParms, pParams | ::handleEvent( Event, aParms, pParams ) }
     :SetDataProvider( "Provider=custom" )

     if ! :DataProvider:open()
        :DataProvider:Create()
     endif

     :ShowCaptionBar = ( .t. )
     :ShowCaptionBarSwitchViewButtons = ( .t. ) //switch from day, week, month view on capbar
     :ShowTimelineButton = ( .t. )
     :TimeLineView:BackgroundColor := ( RGB(176, 216, 255) )
     :TimeLineView:SeparateGroup := ( .t. )
     :MarkupEnabled := ( .T. )

     :ShowCaptionBarDateLabel = ( .t. )
     :ShowCaptionBarScrollDateButtons = ( .t. )

     :DayView:TimeScaleMinTime := ( SUBS(PLANPREF->HDEBUT,1,2) + ":" + SUBS(PLANPREF->HDEBUT,3,2) + ":00" )
     :DayView:TimeScaleMaxTime := ( SUBS(PLANPREF->HFIN,1,2)   + ":" + SUBS(PLANPREF->HFIN,3,2) + ":00" )
     :DayView:TimeScale := ( PLANPREF->MINUTES )
     :DayView:Showday(::TPAR[04])
     :Options:DayViewTimeScaleShowMinutes = ( .t. )

     :OneLineCaptionBar := (.t.)          //captionbar defaults to two lines eating up too much space.
     :EnableToolTips( .t. )

     :MonthView:DayHeaderFormatShort := ( "d" )
     :MonthView:DayHeaderFormatMiddle := ( "ddd, dd MMM yy" )
     :MonthView:DayHeaderFormatLong := ( "ddd, dd MMMM yyyy" )
     :MonthView:DayHeaderFormatShortest := ( "d" )
     :SetLongDayHeaderFormat("ddd, dd MMMM")
     :WeekView:DayHeaderFormatLong = ( "ddd, dd MMMM" )

     :Options:MonthViewShowEndDate := ( .t. )
     :Options:MonthViewShowTimeAsClocks := ( .t. )
     :Options:MonthViewCompressWeekendDays := ( .t.)
     :SwitchToDayViewIfPickedSingleDay := ( .t. )
     :EnableReminders( .t. )
     :Options:EnableInPlaceCreateEvent := (.f.)
     :Options:EnableInPlaceEditEventSubject_ByMouseClick := (.f.)

     IF SUBS(PLANPREF->PARAM,3,1) = "O"
       ::OCALEX:printoptions:PrintDateHeader = (.T.)
      ELSE
       ::OCALEX:printoptions:PrintDateHeader = (.F.)
     ENDIF

     IF  VAL(SUBS(PLANPREF->PARAM,4,5))  > 0   // NOMBRE DE PIXELS MINIMUM PAR CELLULE
         :DayView:MinColumnWidth = (VAL(SUBS(PLANPREF->PARAM,4,5)))
     ENDIF
     :UseMultiColumnWeekMode = ( .t. )

     :ViewType = (PLANPREF->VUEDEBUT)
end

::oPanelCalex:oClient = ::oCalex

::buildMultiSchedule()
RETURN NIL

METHOD buildMultiSchedule() CLASS TPLANCJ
local objResources, oSchedules ,oRes1, ;
      oRes := {} , ;
      n    := 0

RETURN NIL
return nil

METHOD build1Schedule() CLASS TPLANCJ
return nil

METHOD build1grSchedule() CLASS TPLANCJ
return nil

//---------------------------------------------------//
METHOD BuildDatePicker() CLASS TPLANCJ
local oErr
TRY
   ::oDtPick := tActiveX():New( ::oPaneldtp,"Codejock.DatePicker.15.0.2" )

   With Object ::oDtPick
        :Enabled = ( .t. )
        :ShowWeekNumbers := ( .t. )
        :MaxSelectionCount :=  7
        :VisualTheme := ( xtpCalendarThemeOffice2007 )
        :AttachToCalendar( TOleAuto():New( ::oCalex:oOleAuto:__hObj ))
        //:ShowTodayButton(.f.)
        :ShowNoneButton := (.f.)
        :TextTodayButton := "Aujourd'hui"
        //CalendarControl.CaptionButtonTitle 6, "Hello"
  End
  ::oPaneldtp:oClient := ::oDtPick
 CATCH oErr
END
RETURN nil

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

METHOD BuildPanels() CLASS TPLANCJ
local nHeight := ::oWndPL:nHeight, ;
      nDepl   := 0

IF ::OWNDPL:nHorzRes() > 1600
   ndepl := 30
ENDIF

::oPanelCalex  = TPanel():New( 0, 175 + ndepl, nHeight, ::oWndPL:nWidth, ::oWndPL:oWndClient )
::oPaneldtp    = TPanel():New( 0, 0, (nHeight), ::oPanelCalex:nLeft, ::oWndPL:oWndClient )

RETURN nil

//---------------------------------------------------//
METHOD BuildStdDialogs() CLASS TPLANCJ
local oErr
TRY
   ::oCalexStdDlgs := CreateObject( "Codejock.CalendarDialogs.15.0.2" )
   ::oCalexStdDlgs:Calendar = TOleAuto():New( ::oCalex:oOleAuto:__hObj )

   ::oCalexStdDlgs:RemindersWindowShowInTaskBar = .t.
   ::oCalexStdDlgs:CreateRemindersWindow()
 CATCH oErr
   MsgInfo( "Manque composants dialogues Standard")
END
RETURN nil

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

METHOD SetSize( nType, nWidth, nHeight ) CLASS TPLANCJ
if nWidth != nil
   nHeight -= 60
   ::oPaneldtp:Move( , , , nHeight )
   ::oPanelCalex:Move( , , nWidth - ::oPaneldtp:nRight, nHeight )
endif
RETURN nil

*-------------------------------------------------------------------------------------------------------------------------------
METHOD GetUniqueId CLASS TPLANCJ
LOCAL CID  := SPACE(12) , ;
      NUID := 0, ;
      TSEL := SELECT()

LOCKENR("PLANPREF")
PLANPREF->SEQID++
PLANPREF->(DBUNLOCK())
NUID := PLANPREF->SEQID

cId := SUBSTR( STR( 1000000000000 + NUID , 13), 2, 12 )
SELECT(TSEL)
Return ( cId )

METHOD UpDATETPAR() CLASS TPLANCJ
RETURN nil

METHOD NotifyClients(lCodenotify) CLASS TPLANCJ
RETURN nil

METHOD ApptDetail( oEvent ) CLASS TPLANCJ
RETURN NIL

STATIC FUNCTION GETCOLORTACHE(ITACHE,TOBJ,DCOLOR,ICOLOR)
RETURN NIL

METHOD RetrieveDocinit() CLASS TPLANCJ
RETURN NIL

METHOD RECURRAPPT() CLASS TPLANCJ
RETURN NIL

METHOD HISTRECUR(OEVENT,DREPETER,DREPOK,DMSG,OSAY) CLASS TPLANCJ
RETURN NIL

METHOD PREFCALEX() CLASS TPLANCJ
LOCAL LSAVE     := .F., ;
      DHDEB     := SPACE(04), ;
      DHFIN     := SPACE(04), ;
      DMINUTES  := 0, ;
      DHDEBI    := SPACE(04), ;
      DIMAGE    := SPACE(04), ;
      DHFINI    := SPACE(04), ;
      DMINUTESI := 0, ;
      DPIXELS   := 0, ;
      OITEM     := 0, ;
      OITEMI    := 0, ;
      DMULTI    := .F., ;
      OCHK1     := .F., ;
      OCHK2     := .F., ;
      OCHK3     := .F., ;
      DGROUPE   := .F., ;
      DENC      := .F. , ;
      TABIMAGE  := {}, ;
      DHIMP     := 0, ;
      DLIMP     := 0, ;
      ADRBMP1   := 0, ;
      ODLG,OBJ1,OBJ2,ORAD,OSAY

::Oclientid := 01  // VAL(GETUSERNUM())  // Retreive the client userid from ini file , each terminal has a different id

IF ! NETOPEN("PLANPREF")
   RETURN NIL
ENDIF
DHDEB     := PLANPREF->HDEBUT
DHFIN     := PLANPREF->HFIN
DMINUTES  := PLANPREF->MINUTES
DHDEBI    := PLANPREF->HDEBUT
DHFINI    := PLANPREF->HFIN
DMINUTESI := PLANPREF->MINUTES
DMULTI    := PLANPREF->MULTIPERS
DGROUPE   := PLANPREF->GROUPPERS     // Regrouper le personnel en groupes
OITEM     := PLANPREF->VUEDEBUT + 1  // Vue démarre de 0 à 3
OITEMI    := OITEM

OCHK1     := TRNLOG(SUBS(PLANPREF->PARAM,1,1))     // Reporter la désignation de la tache Planning dans fiche Intervention
OCHK2     := TRNLOG(SUBS(PLANPREF->PARAM,2,1))     // Reporter la désignation de la tache Planning dans la Case Commentaires
OCHK3     := TRNLOG(SUBS(PLANPREF->PARAM,3,1))     // Ne pas imprimer calendrier avec les documents
DPIXELS   := VAL(SUBS(PLANPREF->PARAM,4,5))        // NOMBRE DE PIXELS MINIMUM PAR CELLULE
DHIMP     := VAL(SUBS(PLANPREF->PARAM,9,4)) / 100  // Hauteur Impression logo
DLIMP     := VAL(SUBS(PLANPREF->PARAM,13,4)) / 100 // Largeur Impression logo
DENC      := TRNLOG(SUBS(PLANPREF->PARAM,17,1))    // Encadrer Fiche impression
ADRBMP1   := VAL(SUBS(PLANPREF->PARAM,18,6))       // Adresse image logo

/*
IF ! NETOPEN("DEVIMAGE",,5,"IMA")
   RETURN NIL
ENDIF
SET INDEX TO DEVIMAGE

INITIMAGE(@TABIMAGE)
TABIMAGE[01] := ADRBMP1
TABIMAGE[10] := .T.
LOADTIMA(@TABIMAGE)
*/

DEFINE DIALOG ODLG RESOURCE "PREFPLAN" COLOR CLR_BLACK,COULDLG("TD") //  TRANSPARENT

REDEFINE GET DHDEB            ID 201 OF ODLG
REDEFINE GET DHFIN            ID 202 OF ODLG
REDEFINE GET DMINUTES         ID 203 OF ODLG PICTURE "@Z 999" VALID(DMINUTES > 0 .AND. DMINUTES < 240)
REDEFINE CHECKBOX DMULTI      ID 204 OF ODLG                      // Planning MULTI PERSONNEL
REDEFINE RADIO ORAD VAR OITEM ID 205,206,207,208 OF ODLG

REDEFINE CHECKBOX OBJ1 VAR OCHK1  ID 209 OF ODLG                  // reporter désignation tache planning dans fiche intervention
REDEFINE CHECKBOX OBJ2 VAR OCHK2  ID 210 OF ODLG                  // reporter tache planning dans commentaires

REDEFINE GET ::Oclientid      ID 211 OF ODLG PICTURE "@Z 999" READONLY COLOR CLR_GREEN,COULDLG("TD")
REDEFINE CHECKBOX DGROUPE     ID 212 OF ODLG COLOR CLR_GREEN WHEN DMULTI UPDATE // Regrouper le personnel en groupes

REDEFINE CHECKBOX OCHK3       ID 213 OF ODLG                                    // Imprimer calendrier sur documents imprimés
REDEFINE GET      DPIXELS     ID 214 OF ODLG PICTURE "99999"                    // Nombre de pixels minimum

REDEFINE GET      DIMAGE       ID 215 OF ODLG READONLY UPDATE COLOR CLR_GREEN,CLR_WHITE
REDEFINE CHECKBOX DENC         ID 216 OF ODLG
REDEFINE GET      DHIMP        ID 217 OF ODLG PICTURE "@Z 99.99"
REDEFINE GET      DLIMP        ID 218 OF ODLG PICTURE "@Z 99.99"

REDEFINE BUTTONBMP BITMAP "IMAGE.BMP" ID 03 OF ODLG ;
         ToolTip "Associer une image" ;
         ACTION (1 = 1)  // VISUIMAGE(@TABIMAGE,"Logo Haut de page"),ODLG:UPDATE()

REDEFINE BUTTON ID 01 OF ODLG ACTION (LSAVE := .T., ODLG:END())
REDEFINE BUTTON ID 02 OF ODLG ACTION (LSAVE := .F., ODLG:END())

DEFSAY(ODLG,401,408)
REDEFINE SAY OSAY             ID 409 OF ODLG COLOR CLR_HRED,CLR_WHITE
REDEFINE SAY OSAY             ID 410 OF ODLG COLOR CLR_HRED,CLR_WHITE

DEFSAY(ODLG,411,414)
ACTIVATE DIALOG ODLG CENTERED

IF ! LSAVE
   RETURN NIL
ENDIF

// CLOSEFIC("IMA","DEVIMAGE")

IF VAL(SUBS(DHDEB,1,2)) > 24  .OR. VAL(SUBS(DHDEB,3,4)) > 60
   MSGSTOP("Heure début Erronée " + DHDEB + " , valeur 0800 par défaut ")
   DHDEB := "0800"
ENDIF

IF VAL(SUBS(DHFIN,1,2)) > 24 .OR. VAL(SUBS(DHFIN,3,4)) > 60
   MSGSTOP("Heure Fin Erronée " + DHDEB + " , valeur 1800 par défaut ")
   DHFIN := "1800"
ENDIF

LOCKENR("PLANPREF")
PLANPREF->HDEBUT    := DHDEB
PLANPREF->HFIN      := DHFIN
PLANPREF->MINUTES   := DMINUTES
PLANPREF->MULTIPERS := DMULTI
PLANPREF->GROUPPERS := DGROUPE
PLANPREF->VUEDEBUT  := OITEM -1
PLANPREF->PARAM     := LOGTRN(OCHK1) + LOGTRN(OCHK2) + LOGTRN(OCHK3) + STR(DPIXELS,5) + STR((DHIMP * 100),4) + STR((DLIMP * 100),4) + LOGTRN(DENC) + ;
                       SUBS(PLANPREF->PARAM,23,78)
PLANPREF->(DBUNLOCK())

IF DHDEB = DHDEBI .AND. DHFIN = DHFINI .AND. DMINUTES = DMINUTESI .AND. OITEM = OITEMI
 ELSE
   with object ::oCalex
      :ViewType := PLANPREF->VUEDEBUT    //:ViewType( xtpCalendarDayView )
      :DayView:TimeScaleMinTime := ( SUBS(PLANPREF->HDEBUT,1,2) + ":" + SUBS(PLANPREF->HDEBUT,3,2) + ":00" )
      :DayView:TimeScaleMaxTime := ( SUBS(PLANPREF->HFIN,1,2)   + ":" + SUBS(PLANPREF->HFIN,3,2) + ":00" )
      :DayView:TimeScale := ( PLANPREF->MINUTES )
      ::oCalex:redrawcontrol()
   end
ENDIF

IF SUBS(PLANPREF->PARAM,3,1) = "O"
   ::OCALEX:printoptions:PrintDateHeader = (.T.)
 ELSE
   ::OCALEX:printoptions:PrintDateHeader = (.F.)
ENDIF
RETURN NIL

STATIC FUNCTION RECHCLIPL(DREFCLI,DNOM,ODLG,TOBJ)
RETURN NIL

FUNCTION CREPLANTAB(TPAR)
TPAR := {}
AADD(TPAR,0)           // 01 = DREFCLI  ID CLIENT
AADD(TPAR,0)           // 02 = Tache    ID TACHE
AADD(TPAR,SPACE(6))    // 03 = HEURE RDV
AADD(TPAR,CTOD(WDATE)) // 04 = DATE RDV
AADD(TPAR,SPACE(60) )  // 05 = NOM DU CLIENT
AADD(TPAR,0)           // 06 = ID (AGPERS) OUVRIER->AGPERSID
AADD(TPAR,SPACE(30))   // 07 = LIBELLE TACHE
AADD(TPAR,0)           // 08 = NUMERO CONTRAT ID
AADD(TPAR,0)           // 09 = NUMERO SITE ID
AADD(TPAR,0)           // 10 = NUMERO FEUILLE DEPANNAGE
AADD(TPAR,.F.)         // 11 = si TRUE quitte le planning dès selection cellule (APPEL PAR CTRDEPAN)
AADD(TPAR,0)           // 12 = ADRSITE
AADD(TPAR,0)           // 13 = NUMPRO
AADD(TPAR,0)           // 14 = ID DEPANNAGE SAVDEPAN
AADD(TPAR,SPACE(13))   // 15 = CONTRAT
AADD(TPAR,0)           // 16 = ID SAVPVIS
AADD(TPAR,SPACE(80) )  // 17 = AFFICHAGE NOM CLIENT + VILLE
AADD(TPAR,.F.)         // 18 = TRUE = Nouveau dépannage, évite retour au dépannage (récursivité)
AADD(TPAR, {})         // 19 = TABSEC
AADD(TPAR,.F.)         // 20 = TRUE = Reporter libellé tache dépannage dans feuille intervention
AADD(TPAR,.F.)         // 21 = TRUE = Reporter libellé tache dépannage dans CASE COMMENTAIRES
AADD(TPAR,NIL)         // 22 = OBJ DTPICKER SAISIE AMONT PLANNING
AADD(TPAR,NIL)         // 23 = OBJ GET HEURE SAISIE AMONT PLANNING
AADD(TPAR,NIL)         // 24 = OBJ GET TEXTE DEPANNAGE SAISIE AMONT PLANNING
AADD(TPAR,NIL)         // 25 = OBJ combobox ouvrier DEPANNAGE SAISIE AMONT PLANNING
AADD(TPAR,NIL)         // 26 = OBJ combobox tache DEPANNAGE SAISIE AMONT PLANNING
AADD(TPAR,SPACE(01) )  // 27 = texte depannage
AADD(TPAR,1)           // 28 = INDICE COMBO OUVRIERS
AADD(TPAR,1)           // 29 = INDICE COMBO TACHES
AADD(TPAR,SPACE(12) )  // 30 = ID PLANPERS
AADD(TPAR,.F.)         // 31 = TRUE = on Quitte le planning
AADD(TPAR,SPACE(05) )  // 32 = Masque heure affichée dans dépannages ex 09:30

IF FILE("PLANPREF.DBF")
   IF ! NETOPEN("PLANPREF")
      RETURN NIL
   ENDIF
   TPAR[20] := TRNLOG(SUBS(PLANPREF->PARAM,1,1)) // Reporter la désignation de la tache Planning dans fiche Intervention
   TPAR[21] := TRNLOG(SUBS(PLANPREF->PARAM,2,1)) // Reporter la désignation de la tache Planning dans la Case Commentaires
ENDIF
RETURN NIL

FUNCTION NETOPEN( cFile, lMode, nSeconds, cAlias, lNewArea,cDriver, lReadOnly )
local nWaitTime, ;
      lContinue := .t., ;
      lSuccess  := .f., ;
      TSEL      := 0

DEFAULT lMode     :=  .f.                     // shared mode
DEFAULT nSeconds  :=  3
DEFAULT cAlias    := cFile
DEFAULT lNewArea  :=  .t.
DEFAULT cDriver   := "DBFCDX"
DEFAULT lReadOnly :=  .f.
nWaitTime := nSeconds

IF ! FILE(CFILE)
   IF ! FILE( cFile + ".DBF" )
      MSGSTOP("Fichier " + CFILE + ".DBF Absent")
      lContinue := .f.
      RETURN (.F.)
   ENDIF
ENDIF

IF CALIAS == nil    // harbour bug
   CALIAS := ALLTRIM(CFILE)
ENDIF

// Verifier que fichier pas deja ouvert
// Alors ouvrir dans meme zone

IF SELECT(cAlias) # 0
   TSEL := SELECT(cAlias)
   SELECT(TSEL)
   lContinue := .t.
   lNewArea  := .f.
ENDIF
// verify driver is valid

if ascan( RddList(), cDriver ) == 0
   MSGSTOP("Driver " + Cdriver + "  Absent")
   lContinue := .f.
endif
// while continuing to attempt open
while lContinue
  // while .not. timed-out
  while nSeconds > 0 .and. lContinue
     dbUseArea( lNewArea, Cdriver, cFile, cAlias, ( .not. lMode ), lReadOnly )
     // check for success/failure
     IF neterr()
       nSeconds--
       lSuccess  := .F.
      else
       // open successful
       nSeconds  := 0
       lSuccess  := .t.
       lContinue := .f.
     ENDIF
  ENDDO
  IF ! lSuccess
      nSeconds  := nWaitTime
      MSGSTOP("Fichier " + CFILE + " Ouvert par un autre utilisateur" + CRLF + CRLF + ;
             "Veuillez impérativement refermer tous vos postes" + CRLF + ;
                       "avant de continuer")
      lSuccess   := .F.
      lContinue  := .T.
      lNewArea   := .T.
  ENDIF
ENDDO
return lSuccess

FUNCTION AJENR(FALIAS)
DBSELECTAREA(FALIAS)
WHILE .T.
   (FALIAS)->(DBAPPEND(.F.))
   IF ! (FALIAS)->(NETERR())
      EXIT
   ENDIF
ENDDO
LOCKENR(FALIAS)
RETURN NIL

FUNCTION LOCKENR(FALIAS)
DBSELECTAREA(FALIAS)
WHILE .T.
   IF (FALIAS)->(DBRLOCK( (FALIAS)->(RECNO()) ))
      EXIT
    ELSE
      MSGSTOP("Fichier " + (FALIAS) + "Verrouillé" + CRLF + "Attente déverrouillage")
      IF MSGYESNO("Voulez-vous forcer le fichier à être déverouillé ?")
         (FALIAS)->(DBUNLOCK())
      ENDIF
   ENDIF
ENDDO
RETURN NIL

FUNCTION LOCKFIC(FALIAS)
DBSELECTAREA(FALIAS)
(FALIAS)->(DBGOTOP())
DO WHILE .T.
   IF (FALIAS)->(FLOCK())
      EXIT
    ELSE
      MSGSTOP("Fichier " + (FALIAS) + "Verrouillé" + CRLF + "Attente déverrouillage")
   ENDIF
ENDDO
RETURN NIL

FUNCTION TRNLOG(DVAL)
IF DVAL = "O"
   RETURN .T.
 ELSE
   RETURN .F.
ENDIF
RETURN .F.

FUNCTION LOGTRN(DVAL) // Transformation valeur logique en "O" ou "N"
IF DVAL
   RETURN "O"
 ELSE
   RETURN "N"
ENDIF
RETURN " "

FUNCTION TRNDATE(DDATE,DSEP)
IF DSEP == NIL
   DSEP := "."
ENDIF
IF DDATE # SPACE(08)
   RETURN SUBS(DDATE,7,2) + DSEP + SUBS(DDATE,5,2) + DSEP + SUBS(DDATE,1,4)
 ELSE
   RETURN SPACE(10)
ENDIF
RETURN NIL

FUNCTION COULDLG(DTYPE)
LOCAL DCOUL    := 0

DTYPE := UPPER(DTYPE)

//DCOUL := VAL(GetPvProfString("COULEUR",DTYPE,,INILOGI() ) )
//IF DCOUL = 0 .AND. SUBS(DTYPE,2,1) = "D"   // Uniquement pour les boites de dialogue
   DCOUL := nRgb(215,235,255)
//ENDIF
RETURN(DCOUL)

FUNCTION DEFSAY(ODLG,IDSDEB,IDSFIN,DFONT,DCOLOR)
LOCAL I      := 0, ;
      TABSAY := {}

IF DCOLOR == NIL
   DCOLOR := CLR_WHITE
ENDIF

IF IDSFIN == NIL
   IDSFIN := IDSDEB
ENDIF

I      := 0
WHILE IDSDEB <= IDSFIN   // Statics  500
    I++
    AADD(TABSAY,NIL)
       IF DFONT # NIL
         try
           REDEFINE SAY TABSAY[I] ID IDSDEB OF ODLG FONT DFONT COLOR CLR_HBLUE,DCOLOR // TRANSPARENT ADJUST
         catch
         end
       ELSE
         try
           REDEFINE SAY TABSAY[I] ID IDSDEB OF ODLG COLOR CLR_HBLUE,DCOLOR // TRANSPARENT ADJUST
         catch
         end
       ENDIF
    IDSDEB++
ENDDO
RETURN NIL

 

[Massimo Linossi]

Hi Antonio.
I have an error linking on this function RegisterServer( "Codejock.Calendar.v15.0.2.ocx" ) and there is no "Calendar.ResourceFr.dll" file on any Codejock folder.
I temporary deleted it and now I'm trying to build the files, because there is no function that creates them.
Thanks a lot.
Massimo.

[Antonio Linares]

RegisterServer() and UnRegisterServer() are in FWH/source/winapi/ocx.c so you should have them in your FWH

Comment out the line about the DLL, I think it is just for French language support.

[Massimo Linossi]

Hello again Antonio.
I give up the tests.

:VisualTheme = ( xtpCalendarThemeOffice2007 ) Error in runtime
:bOnEvent = { | event, aParms, pParams | ::handleEvent( Event, aParms, pParams ) }
:SetDataProvider( "Provider=custom" ) Error in runtime

I don't know if is a problem with Xharbour commercial, but in few days I'll start to convert all the enormous
application to your harbour. It's not possible that there is always something that is not working, and your
examples with your compiler are perfect.

Thanks a lot
Massimo

[Antonio Linares]

Massimo,

Thats a very clever desition

Harbour is simply great. xHarbour was usefull for pushing Harbour to evolve and improve.

But now there is no technical reason to continue using it.

[Enrico Maria Giordano]

Massimo,

Thats a very clever desition

Harbour is simply great. xHarbour was usefull for pushing Harbour to evolve and improve.

But now there is no technical reason to continue using it.

I tried to use Harbour, you know. But I gave up due to the incompatibilities. As an example, HB_BACKGROUNDADD() function is not available in Harbour. So, the technical reasons do exist.

EMG

[Antonio Linares]

Enrico,

Are there any examples of use of function HB_BACKGROUNDADD() ? It looks to me as a threads manager.

Do you use it on your apps ?

[Enrico Maria Giordano]

Enrico,

Are there any examples of use of function HB_BACKGROUNDADD() ? It looks to me as a threads manager.

Do you use it on your apps ?

Yes, I use it to let the system refresh some wait animations. This is the syntax:

Code: Select all  Expand view

HB_BackGroundAdd( <bAction>, [<nMillisecs>], [<lActive>] ) --> nTaskHandle

EMG

[Antonio Linares]

Enrico,

Could you provide a small self contained example ? thanks

[Massimo Linossi]

Hi Antonio.
I procedure I want to convert, I'm frequently using come functions that in Xharbour commercial are really fast,
like cmfilter(), cmfiltcount, cmxkeycount(), because they are using the Rushmore technology. Do you think that is possible
to use something similar ? I've tried with dbfilter(), but is really slow on big tables.
Thanks.
P.S. When I'll start to convert all the application, maybe I'll request you some help.