Dear Mr. Richard,Richard Chidiak wrote: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
Code: Select all
#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
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.Antonio Linares wrote: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.
So, the technical reasons do exist. Yes, I use it to let the system refresh some wait animations. This is the syntax:Antonio Linares wrote: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 ?
Code: Select all
HB_BackGroundAdd( <bAction>, [<nMillisecs>], [<lActive>] ) --> nTaskHandle