{********************************************************************} { } { Developer Express Visual Component Library } { ExpressScheduler } { } { Copyright (c) 2003-2009 Developer Express Inc. } { ALL RIGHTS RESERVED } { } { The entire contents of this file is protected by U.S. and } { International Copyright Laws. Unauthorized reproduction, } { reverse-engineering, and distribution of all or any portion of } { the code contained in this file is strictly prohibited and may } { result in severe civil and criminal penalties and will be } { prosecuted to the maximum extent possible under the law. } { } { RESTRICTIONS } { } { THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES } { (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE } { SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS } { LICENSED TO DISTRIBUTE THE EXPRESSSCHEDULER AND ALL ACCOMPANYING } { VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. } { } { THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED } { FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE } { COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE } { AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT } { AND PERMISSION FROM DEVELOPER EXPRESS INC. } { } { CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON } { ADDITIONAL RESTRICTIONS. } { } {********************************************************************} unit cxSchedulerStorage; {$I cxVer.inc} interface uses {$IFDEF DELPHI6} Variants, DateUtils, {$ENDIF} Classes, SysUtils, Windows, Forms, Math, Graphics, Contnrs, cxClasses, cxCustomData, cxDataStorage, cxDateUtils, cxDataUtils, cxSchedulerUtils, cxVariants, cxStorage, ExtCtrls, cxLookAndFeels, Controls, ImgList, cxFormats, cxSchedulerHolidays, cxDataConsts, dxCore; const // Options flag masks omAllDayEvent = $0001; omEnabled = $0002; omReminder = $0004; omCollapsed = $0008; // Time line state tlsFree = 0; tlsTentative = 1; tlsBusy = 2; tlsOutOfOffice = 3; cxDefaultEventDuration: TDateTime = 0.0034722222222; cxMaxDate = 767010; //Dec 31 3999 cxInvalidRecordIndex = -MaxInt; ReminderRefreshInterval: Double = MinuteToTime / 2; type TcxSchedulerControlEventID = class; TcxCustomSchedulerStorage = class; TcxSchedulerStorage = class; TcxSchedulerEvent = class; TcxSchedulerEventRecurrenceInfo = class; TcxSchedulerControlEvent = class; TcxSchedulerCachedEventList = class; TcxSchedulerOccurrenceCalculator = class; TcxSchedulerEventList = class; TcxSchedulerFilteredEventList = class; TcxSchedulerStorageResources = class; TcxSchedulerStorageResourceItem = class; TcxCustomSchedulerStorageClass = class of TcxCustomSchedulerStorage; TcxSchedulerCachedEventListClass = class of TcxSchedulerCachedEventList; TcxSchedulerStorageResourcesClass = class of TcxSchedulerStorageResources; TcxSchedulerStorageResourceItemClass = class of TcxSchedulerStorageResourceItem; //reminders TcxSchedulerReminders = class; TcxSchedulerReminder = class; TcxSchedulerReminderClass = class of TcxSchedulerReminder; TcxSchedulerEventConflictsInfo = class; TcxEventType = (etNone, etPattern, etOccurrence, etException, etCustom); TcxRecurrence = (cxreDaily, cxreWeekly, cxreMonthly, cxreYearly); TcxRecurrenceValidStatus = (rvsValid, rvsReplaceOccurrenceDate, rvsInvalidPattern, rvsInvalidDuration); TcxDayType = (cxdtDay, cxdtEveryDay, cxdtWeekDay, cxdtWeekEndDay, cxdtSunday, cxdtMonday, cxdtTuesday, cxdtWednesday, cxdtThursday, cxdtFriday, cxdtSaturday); TcxCompareEventsProc = function(AEvent1, AEvent2: TcxSchedulerEvent): Integer; TcxGetRecurrenceDescriptionStringProc = function( ARecurrenceInfo: TcxSchedulerEventRecurrenceInfo; AFullDescription: Boolean = False): string; TcxSchedulerReminderDueTimeElement = (dteMinute, dteHour, dteDay, dteWeek); TcxSchedulerReminderDueTimeKind = (dtkNow, dtkOverdue, dtkActual); TcxSchedulerReminderDueTimeInfo = record DueKind: TcxSchedulerReminderDueTimeKind; Element: TcxSchedulerReminderDueTimeElement; ElementValue: Integer; Minutes: Integer; end; TcxSchedulerReminderResource = packed record DismissDate: TDateTime; ResourceID: Variant; ReminderDate: TDateTime; end; TcxSchedulerReminderResources = array of TcxSchedulerReminderResource; TcxSchedulerReminderResourcesData = packed record Version: Byte; Resources: TcxSchedulerReminderResources; end; TcxDueTimeInfoToTextProc = function ( const AInfo: TcxSchedulerReminderDueTimeInfo): string; { IcxSchedulerStorageListener } IcxSchedulerStorageListener = interface ['{87E0EBF3-F68A-4A51-8EA3-850D3819FBAB}'] procedure StorageChanged(Sender: TObject); procedure StorageRemoved(Sender: TObject); end; { IcxSchedulerSelectionAdapter } IcxSchedulerSelectionAdapter = interface ['{68B007E5-1057-40DE-BDA4-0D72F3780CC7}'] procedure Add(AEvent: TcxSchedulerControlEvent; Shift: TShiftState); procedure Clear; function IsSelected(AEvent: TcxSchedulerControlEvent): Boolean; procedure Update; end; { TcxSchedulerStorageDataController } TcxSchedulerStorageDataController = class(TcxCustomDataController) private function GetStorage: TcxCustomSchedulerStorage; protected procedure UpdateControl(AInfo: TcxUpdateControlInfo); override; function UseRecordID: Boolean; override; property Storage: TcxCustomSchedulerStorage read GetStorage; public function GetItem(Index: Integer): TObject; override; function GetItemValueSource(AItemIndex: Integer): TcxDataEditValueSource; override; function GetItemID(AItem: TObject): Integer; override; procedure UpdateData; override; procedure UpdateItemIndexes; override; end; TcxSchedulerStorageDataControllerClass = class of TcxCustomDataController; { TcxCustomSchedulerStorageField } TcxCustomSchedulerStorageField = class(TCollectionItem) private FIndex: Integer; FIsUnique: Boolean; FName: string; function IsValueTypeStored: Boolean; function GetDataController: TcxCustomDataController; function GetStorage: TcxCustomSchedulerStorage; function GetValue(AIndex: Integer): Variant; function GetValueCount: Integer; function GetValueType: string; function GetValueTypeClass: TcxValueTypeClass; procedure SetName(const AValue: string); procedure SetValue(AIndex: Integer; const AValue: Variant); procedure SetValueType(const AValue: string); procedure SetValueTypeClass(AValue: TcxValueTypeClass); virtual; protected function GetDisplayName: string; override; function GetIsActive: Boolean; virtual; function GetIsBlob: Boolean; virtual; property DataController: TcxCustomDataController read GetDataController; property IsBlob: Boolean read GetIsBlob; property IsUnique: Boolean read FIsUnique; property Name: string read FName write SetName; property Storage: TcxCustomSchedulerStorage read GetStorage; property ValueCount: Integer read GetValueCount; property Values[ARecordIndex: Integer]: Variant read GetValue write SetValue; property ValueType: string read GetValueType write SetValueType stored IsValueTypeStored; property ValueTypeClass: TcxValueTypeClass read GetValueTypeClass write SetValueTypeClass; public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; property Index: Integer read FIndex; end; TcxSchedulerStorageFieldClass = class of TcxCustomSchedulerStorageField; { TcxSchedulerStorageField } TcxSchedulerStorageField = class(TcxCustomSchedulerStorageField) public procedure Assign(Source: TPersistent); override; property ValueCount; property Values; property ValueTypeClass; published property Index; property Name; property ValueType; end; { TcxCustomSchedulerStorageFields } TcxCustomSchedulerStorageFields = class(TCollection) private FOwner: TPersistent; function GetStorage: TcxCustomSchedulerStorage; protected function FindFieldByName(const AName: string): TcxCustomSchedulerStorageField; virtual; function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; public property Storage: TcxCustomSchedulerStorage read GetStorage; end; TcxSchedulerStorageFieldsClass = class of TcxCustomSchedulerStorageFields; { TcxSchedulerStorageFields } TcxSchedulerStorageFields = class(TcxCustomSchedulerStorageFields) private function GetItem(AIndex: Integer): TcxSchedulerStorageField; procedure SetItem(AIndex: Integer; AValue: TcxSchedulerStorageField); public function Add: TcxSchedulerStorageField; function ItemByName(const AName: string): TcxSchedulerStorageField; property Items[Index: Integer]: TcxSchedulerStorageField read GetItem write SetItem; property Storage; end; { TcxSchedulerEventRecurrenceInfo } TcxSchedulerEventRecurrenceInfoData = packed record Count: Integer; DayNumber: Integer; DayType: TcxDayType; Finish: TDateTime; OccurDays: TDays; Periodicity: Integer; Recurrence: TcxRecurrence; Start: TDateTime; YearPeriodicity: Integer; Reserved1: Byte; DismissDate: Integer; end; TcxSchedulerEventRecurrenceInfo = class(TPersistent) private FOwner: TcxSchedulerEvent; function GetCount: Integer; function GetDayNumber: Integer; function GetDayType: TcxDayType; function GetDismissDate: TDateTime; function GetFinish: TDateTime; function GetIsInfinity: Boolean; function GetOccurDays: TDays; function GetPeriodicity: Integer; function GetRecurrence: TcxRecurrence; function GetStart: TDateTime; function GetStorage: TcxCustomSchedulerStorage; function GetYearPeriodicity: Integer; procedure SetCount(const AValue: Integer); procedure SetDayNumber(const AValue: Integer); procedure SetDayType(const AValue: TcxDayType); procedure SetDismissDate(const AValue: TDateTime); procedure SetFinish(AValue: TDateTime); procedure SetOccurDays(const AValue: TDays); procedure SetPeriodicity(const AValue: Integer); procedure SetRecurrence(const AValue: TcxRecurrence); procedure SetStart(const AValue: TDateTime); procedure SetYearPeriodicity(const AValue: Integer); protected procedure AssignDefaultValues; virtual; function GetData: TcxSchedulerEventRecurrenceInfoData; function GetOccurrences(AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime): Boolean; function GetOwner: TPersistent; override; function GetValue(var AValue: AnsiString): Boolean; procedure SetDataItem(AOffset: Pointer; ASize: Integer; const AValue); procedure SetValue(const AValue: AnsiString); // validate function GetDailyPatternStatus: TcxRecurrenceValidStatus; function GetMonthlyPatternStatus: TcxRecurrenceValidStatus; function GetWeeklyPatternStatus: TcxRecurrenceValidStatus; function GetYearlyPatternStatus: TcxRecurrenceValidStatus; property Storage: TcxCustomSchedulerStorage read GetStorage; public constructor Create(AOwner: TcxSchedulerEvent); virtual; procedure Assign(Source: TPersistent); override; function GetEndDate: TDateTime; function GetValidStatus: TcxRecurrenceValidStatus; procedure Validate; property Count: Integer read GetCount write SetCount; property DayNumber: Integer read GetDayNumber write SetDayNumber; property DayType: TcxDayType read GetDayType write SetDayType; property DismissDate: TDateTime read GetDismissDate write SetDismissDate; property Event: TcxSchedulerEvent read FOwner; property Finish: TDateTime read GetFinish write SetFinish; property IsInfinity: Boolean read GetIsInfinity; property OccurDays: TDays read GetOccurDays write SetOccurDays; property Periodicity: Integer read GetPeriodicity write SetPeriodicity; property Recurrence: TcxRecurrence read GetRecurrence write SetRecurrence; property Start: TDateTime read GetStart write SetStart; property YearPeriodicity: Integer read GetYearPeriodicity write SetYearPeriodicity; end; TcxSchedulerEventRecurrenceInfoClass = class of TcxSchedulerEventRecurrenceInfo; { TcxSchedulerEventItemLink } TcxSchedulerEventRelation = (trFinishToStart, trStartToStart, trFinishToFinish, trStartToFinish); TcxSchedulerEventItemLink = class(TCollectionItem) private FLink: TcxSchedulerEvent; FLinkRecurrenceIndex: Integer; FRelation: TcxSchedulerEventRelation; function GetEvent: TcxSchedulerEvent; function GetStorage: TcxCustomSchedulerStorage; procedure SetLink(AValue: TcxSchedulerEvent); procedure SetRelation(AValue: TcxSchedulerEventRelation); protected function CheckLinked(AEvent: TcxSchedulerEvent): Boolean; overload; function CheckLinked(const ID: Variant; ARecurrenceIndex: Integer): Boolean; overload; function GetData: Variant; virtual; procedure SetData(const AData: Variant); virtual; procedure UpdateLink; virtual; property Storage: TcxCustomSchedulerStorage read GetStorage; public constructor Create(Collection: TCollection); override; function GetRelationAsText: string; property Event: TcxSchedulerEvent read GetEvent; property Link: TcxSchedulerEvent read FLink write SetLink; property LinkRecurrenceIndex: Integer read FLinkRecurrenceIndex; property Relation: TcxSchedulerEventRelation read FRelation write SetRelation; end; { TcxSchedulerEventLinks } TcxSchedulerEventLinks = class(TCollection) private FEvent: TcxSchedulerEvent; function GetExpanded: Boolean; function GetItemLink(AIndex: Integer): TcxSchedulerEventItemLink; procedure SetExpanded(AValue: Boolean); procedure SetItemLink(AIndex: Integer; AValue: TcxSchedulerEventItemLink); protected function GetDisplayText: string; virtual; function GetOwner: TPersistent; override; procedure RemoveLink(ALink: TcxSchedulerEvent); virtual; procedure Update(Item: TCollectionItem); override; public function Add(AEvent: TcxSchedulerEvent; ARelation: TcxSchedulerEventRelation = trStartToFinish): TcxSchedulerEventItemLink; overload; function IsEventLinked(AEvent: TcxSchedulerEvent): Boolean; property DisplayText: string read GetDisplayText; property Event: TcxSchedulerEvent read FEvent; property Expanded: Boolean read GetExpanded write SetExpanded; property ItemLinks[Index: Integer]: TcxSchedulerEventItemLink read GetItemLink write SetItemLink; default; end; TcxSchedulerEventTaskStatus = (tsNotStarted, tsInProgress, tsComplete, tsWaiting, tsDeferred); { TcxSchedulerEvent } TcxSchedulerEvent = class(TPersistent) private FIsModified: Boolean; FLink: TcxSchedulerEvent; FSkipExceptions: Boolean; FStorage: TcxCustomSchedulerStorage; FPrevTaskComplete: Integer; FRecurrenceInfo: TcxSchedulerEventRecurrenceInfo; function GetActualFinish: Integer; function GetActualStart: Integer; function GetAllDayEvent: Boolean; function GetCaption: string; function GetDuration: TDateTime; function GetEditValue(AIndex: Integer): Variant; function GetEnabled: Boolean; function GetEventType: TcxEventType; function GetFinish: TDateTime; function GetID: Variant; function GetIsEditing: Boolean; function GetIsNewEvent: Boolean; function GetLabelColor: Integer; function GetLocation: string; function Getmessage: string; {GetMessage conflicts with C++ macro} function GetOptionsFlag: Integer; function GetReadOnly: Boolean; function GetRecurrenceIndex: Integer; function GetReminder: Boolean; function GetReminderDate: TDateTime; function GetReminderMinutesBeforeStart: Integer; function GetReminderResourcesData: TcxSchedulerReminderResourcesData; function GetResourceID: Variant; function GetResourceIDCount: Integer; function GetResourceIDs(Index: Integer): Variant; function GetShared: Boolean; function GetStart: TDateTime; function GetState: Integer; function GetTaskComplete: Integer; function GetTaskIndex: Integer; function GetTaskStatus: TcxSchedulerEventTaskStatus; function GetValueCount: Integer; procedure InternalSetTaskComplete(const AValue: Integer; AUpdateTaskStatus: Boolean = True); procedure InternalSetTaskStatus(AValue: TcxSchedulerEventTaskStatus; AUpdateTaskComplete: Boolean = True); procedure SetAllDayEvent(const AValue: Boolean); procedure SetCaption(const AValue: string); procedure SetDuration(const AValue: TDateTime); procedure SetEditValue(AIndex: Integer; const AValue: Variant); procedure SetEnabled(const AValue: Boolean); procedure SetEventType(AValue: TcxEventType); procedure SetFinish(const AValue: TDateTime); procedure SetLabelColor(const AValue: Integer); procedure SetLocation(const AValue: string); procedure SetMessage(const AValue: string); function SetOptionsFlag(const AMask: Integer; AValue: Boolean): Boolean; procedure SetParentID(const AValue: Variant); procedure SetRecurrenceIndex(const AValue: Integer); procedure SetRecurrenceInfo(AValue: TcxSchedulerEventRecurrenceInfo); procedure SetReminder(const AValue: Boolean); procedure SetReminderDate(AValue: TDateTime); procedure SetReminderMinutesBeforeStart(const AValue: Integer); procedure SetReminderResourcesData(const AValue: TcxSchedulerReminderResourcesData); procedure SetResourceID(const AValue: Variant); procedure SetStart(const AValue: TDateTime); procedure SetState(const AValue: Integer); procedure SetTaskComplete(const AValue: Integer); procedure SetTaskIndex(const AValue: Integer); procedure SetTaskStatus(AValue: TcxSchedulerEventTaskStatus); protected FEditCount: Integer; FEditValues: array of Variant; FPattern: TcxSchedulerEvent; FRecordIndex: Integer; FIndex: Integer; FIsDataValid: Boolean; FIsDeletion: Boolean; FFinish, FStart: Double; FStartDate: Integer; FOptions: Integer; FSavedID: Variant; FTaskLinks: TcxSchedulerEventLinks; FTaskLinkOwners: TcxSchedulerEventList; procedure AssignDefaultValues; virtual; procedure CalculateActualTimeRange; procedure CalculateActualTimeRangePost; function CanMoveTo(ANewTime: TDateTime): Boolean; virtual; procedure CheckLinksOnChangeEventType(ANewEventType: TcxEventType); virtual; procedure CheckRecurrenceLink(AEvent: TcxSchedulerEvent); procedure CheckRecurrenceLinkEx(AEvent: TcxSchedulerEvent); function CheckTimeRange(const AStartDate, AFinishDate: Integer): Boolean; function CreateRecurrenceInfo: TcxSchedulerEventRecurrenceInfo; virtual; function CreateReminderResourcesData: TcxSchedulerReminderResourcesData; function CreateTaskLinks: TcxSchedulerEventLinks; virtual; function CreateTaskLinkOwners: TcxSchedulerEventList; virtual; function GetIsFreeState: Boolean; virtual; function GetOccurrenceByIndex(AIndex: Integer; var AOccurrence: TcxSchedulerEvent): Boolean; function GetOwner: TPersistent; override; function GetParentID: Variant; virtual; function GetRecurrenceInfoValue(var AValue: AnsiString): Boolean; virtual; procedure GetStartFinishTime(var AStart, AFinish: TDateTime); function GetTaskLinks: TcxSchedulerEventLinks; virtual; function GetTaskLinkOwners: TcxSchedulerEventList; virtual; function GetTaskCompleteDuration: TDateTime; virtual; function GetValueByIndex(AIndex: Integer): Variant; virtual; function GetValueDef(AField: TcxCustomSchedulerStorageField; const ADefValue: Variant): Variant; procedure InitTaskLinks; virtual; procedure InternalMoveTo(const AStartTime: TDateTime); virtual; procedure Modified; procedure PostEditingData; procedure RefreshTaskLinks; procedure RemoveTaskLink(ALink: TcxSchedulerEvent); virtual; procedure ResetReminderResourcesData; procedure SetActualTimeRange(const ActualStart, ActualFinish: TDateTime); procedure SetRecordIndex(const AIndex: Integer); procedure SetRecurrenceInfoValue(const AValue: AnsiString); virtual; procedure SetValue(AField: TcxCustomSchedulerStorageField; const AValue: Variant); virtual; procedure SetValueByIndex(AIndex: Integer; const AValue: Variant); virtual; procedure TaskLinksChanged(Sender: TcxSchedulerEventLinks); virtual; function TimeBias: Double; virtual; procedure UpdateTemporaryData; property IsFreeState: Boolean read GetIsFreeState; property IsModified: Boolean read FIsModified write FIsModified; property IsNewEvent: Boolean read GetIsNewEvent; property Link: TcxSchedulerEvent read FLink; property ReminderResourcesData: TcxSchedulerReminderResourcesData read GetReminderResourcesData write SetReminderResourcesData; public constructor Create(AStorage: TcxCustomSchedulerStorage); overload; virtual; constructor Create(AStorage: TcxCustomSchedulerStorage; ARecordIndex: Integer); overload; virtual; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure AssignAttributes(ASource: TcxSchedulerEvent; AUseSourceTime: Boolean = True); virtual; procedure BeginEditing; virtual; procedure Cancel; function CanLink(AEvent: TcxSchedulerEvent): Boolean; virtual; function Conflicts(AExceptEventsWithoutResources: Boolean): Boolean; function CreateConflictsInfo(AExceptEventsWithoutResources: Boolean): TcxSchedulerEventConflictsInfo; procedure Delete; virtual; procedure DeleteExceptions; virtual; procedure EndEditing; virtual; function GetOccurrence(ADate: TDateTime): TcxSchedulerEvent; function GetOriginalDate: TDateTime; function GetResourceItem: TcxSchedulerStorageResourceItem; function GetRecurrenceChain: TcxSchedulerEventList; function GetTaskLinkOwnerRelation(ATaskLinkOwner: TcxSchedulerEvent; var ARelation: TcxSchedulerEventRelation): Boolean; virtual; procedure GetValidTaskTimeRange(var AStart, AFinish: TDateTime); virtual; procedure GetValidTaskTimeRangeByRelation(const ARelation: TcxSchedulerEventRelation; AEvent: TcxSchedulerEvent; var AStart, AFinish: TDateTime); virtual; function HasExceptions: Boolean; function HasReminderForResourceID(const AResourceID: Variant): Boolean; function IsDayEvent(ADate: Integer): Boolean; overload; function IsDayEvent(const ADate: TDateTime): Boolean; overload; function IsRecurring: Boolean; function IsResourceEvent(AResource: TcxSchedulerStorageResourceItem; AllowUnassigned: Boolean): Boolean; procedure MoveTo(const AStartTime: TDateTime); procedure Post; procedure RemoveRecurrence; virtual; procedure UpdateTaskTime; virtual; procedure UpdateTaskLinks; virtual; // resource sharing procedure ShareWithResource(AResourceItem: TcxSchedulerStorageResourceItem); overload; procedure ShareWithResource(AResourceID: Variant); overload; function IsSharedWithResource(AResourceItem: TcxSchedulerStorageResourceItem): Boolean; overload; function IsSharedWithResource(AResourceID: Variant): Boolean; overload; procedure UnshareWithResource(AResourceItem: TcxSchedulerStorageResourceItem); overload; procedure UnshareWithResource(AResourceID: Variant); overload; procedure ReplaceResourceID(AResourceID: Variant); //custom fields routines function GetCustomFieldValueByIndex(AIndex: Integer): Variant; function GetCustomFieldValueByName(const AName: string): Variant; function GetCustomFieldValue(ACustomField: TcxCustomSchedulerStorageField): Variant; procedure SetCustomFieldValueByIndex(AIndex: Integer; const AValue: Variant); procedure SetCustomFieldValueByName(const AName: string; const AValue: Variant); procedure SetCustomFieldValue(ACustomField: TcxCustomSchedulerStorageField; const AValue: Variant); property ActualStart: Integer read GetActualStart; property ActualFinish: Integer read GetActualFinish; property AllDayEvent: Boolean read GetAllDayEvent write SetAllDayEvent; property Caption: string read GetCaption write SetCaption; property Duration: TDateTime read GetDuration write SetDuration; property EditValues[Index: Integer]: Variant read GetEditValue write SetEditValue; property Enabled: Boolean read GetEnabled write SetEnabled; property EventType: TcxEventType read GetEventType write SetEventType; property Finish: TDateTime read GetFinish write SetFinish; property ID: Variant read GetID; property IsEditing: Boolean read GetIsEditing; property LabelColor: Integer read GetLabelColor write SetLabelColor; property Location: string read GetLocation write SetLocation; property Message: string read Getmessage write SetMessage; property ParentID: Variant read GetParentID write SetParentID; property Pattern: TcxSchedulerEvent read FPattern; property ReadOnly: Boolean read GetReadOnly; property RecordIndex: Integer read FRecordIndex; property RecurrenceIndex: Integer read GetRecurrenceIndex write SetRecurrenceIndex; property RecurrenceInfo: TcxSchedulerEventRecurrenceInfo read FRecurrenceInfo write SetRecurrenceInfo; property Reminder: Boolean read GetReminder write SetReminder; property ReminderDate: TDateTime read GetReminderDate write SetReminderDate; property ReminderMinutesBeforeStart: Integer read GetReminderMinutesBeforeStart write SetReminderMinutesBeforeStart; property ResourceID: Variant read GetResourceID write SetResourceID; property ResourceIDCount: Integer read GetResourceIDCount; property ResourceIDs[Index: Integer]: Variant read GetResourceIDs; property Shared: Boolean read GetShared; property SkipExceptions: Boolean read FSkipExceptions write FSkipExceptions; property Start: TDateTime read GetStart write SetStart; property State: Integer read GetState write SetState; property Storage: TcxCustomSchedulerStorage read FStorage; property TaskComplete: Integer read GetTaskComplete write SetTaskComplete; property TaskIndex: Integer read GetTaskIndex write SetTaskIndex; property TaskLinks: TcxSchedulerEventLinks read GetTaskLinks; property TaskLinkOwners: TcxSchedulerEventList read GetTaskLinkOwners; property TaskStatus: TcxSchedulerEventTaskStatus read GetTaskStatus write SetTaskStatus; property ValueCount: Integer read GetValueCount; property Values[Index: Integer]: Variant read GetValueByIndex write SetValueByIndex; end; { TcxSchedulerControlEvent } TcxSchedulerControlEvent = class(TcxSchedulerEvent) private FIsClone: Boolean; FIsEditing: Boolean; FIsSource: Boolean; FLineStart: Integer; FLockedResource: Variant; FSelectionAdapter: IcxSchedulerSelectionAdapter; FSource: TcxSchedulerEvent; FTimeBias: Double; FValues: array of Variant; function GetNonExceptionLinkCount: Integer; function GetSelected: Boolean; procedure SetSelected(AValue: Boolean); protected function CanMoveTo(ANewTime: TDateTime): Boolean; override; procedure CheckLinksOnChangeEventType(ANewEventType: TcxEventType); override; procedure ClearValues; function CreateTaskLinks: TcxSchedulerEventLinks; override; function GetTaskLinks: TcxSchedulerEventLinks; override; function GetTaskLinkOwners: TcxSchedulerEventList; override; function GetValueByIndex(AIndex: Integer): Variant; override; procedure SetValueByIndex(AIndex: Integer; const AValue: Variant); override; function TimeBias: Double; override; property LineStart: Integer read FLineStart write FLineStart; property SelectionAdapter: IcxSchedulerSelectionAdapter read FSelectionAdapter write FSelectionAdapter; public constructor Create(AStorage: TcxCustomSchedulerStorage); overload; override; constructor Create(ASource: TcxSchedulerEvent); reintroduce; overload; constructor Create(ASource: TcxSchedulerEvent; const AStart, AFinish: TDateTime); reintroduce; overload; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BeginEditing; override; procedure Delete; override; procedure EndEditing; override; function GetTaskLinkOwnerRelation(ATaskLinkOwner: TcxSchedulerEvent; var ARelation: TcxSchedulerEventRelation): Boolean; override; procedure GetValidTaskTimeRange(var AStart, AFinish: TDateTime); override; function IsOrigin(AEvent: TcxSchedulerEvent): Boolean; virtual; procedure lockResource(const ALockedResource: Variant); procedure unlockResource; procedure UpdateTaskTime; override; procedure UpdateTaskLinks; override; property IsClone: Boolean read FIsClone; property IsDataValid: Boolean read FIsDataValid write FIsDataValid; property IsEditing: Boolean read FIsEditing; property IsSource: Boolean read FIsSource; property NonExceptionLinkCount: Integer read GetNonExceptionLinkCount; property Pattern: TcxSchedulerEvent read FPattern write FPattern; property Selected: Boolean read GetSelected write SetSelected; property Source: TcxSchedulerEvent read FSource; end; TcxSchedulerEventClass = class of TcxSchedulerEvent; TcxSchedulerGetResourceNameEvent = procedure(Sender: TObject; AResource: TcxSchedulerStorageResourceItem; var AResourceName: string) of object; TcxSchedulerGetResourceImageIndexEvent = procedure(Sender: TObject; AResource: TcxSchedulerStorageResourceItem; var AImageIndex: TImageIndex) of object; { TcxSchedulerStorageResourceItems } TcxSchedulerStorageResourceItems = class(TCollection) private FOwner: TcxSchedulerStorageResources; function GetItem(AIndex: Integer): TcxSchedulerStorageResourceItem; function GetStorage: TcxCustomSchedulerStorage; procedure SetItem(AIndex: Integer; AValue: TcxSchedulerStorageResourceItem); function GetVisibleResource(AIndex: Integer): TcxSchedulerStorageResourceItem; function GetVisibleResourceCount: Integer; protected function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; property Resources: TcxSchedulerStorageResources read FOwner; property Storage: TcxCustomSchedulerStorage read GetStorage; public constructor Create(AOwner: TcxSchedulerStorageResources; AItemClass: TcxSchedulerStorageResourceItemClass); virtual; function Add: TcxSchedulerStorageResourceItem; property Items[Index: Integer]: TcxSchedulerStorageResourceItem read GetItem write SetItem; default; property VisibleResourceCount: Integer read GetVisibleResourceCount; property VisibleResources[Index: Integer]: TcxSchedulerStorageResourceItem read GetVisibleResource; end; { TcxSchedulerStorageResourceItem } TcxSchedulerStorageResourceItem = class(TCollectionItem) private FColor: TColor; FImageIndex: TImageIndex; FName: string; FReadOnly: Boolean; FResourceID: Variant; FVisible: Boolean; FWorkDays: TDays; FWorkFinish: TTime; FWorkFinishAssigned: Boolean; FWorkStart: TTime; FWorkStartAssigned: Boolean; function GetActualImageIndex: TImageIndex; function GetResources: TcxSchedulerStorageResources; function IsWorkDaysStored: Boolean; procedure ReadWorkFinish(AReader: TReader); procedure ReadWorkStart(AReader: TReader); procedure WriteWorkFinish(AWriter: TWriter); procedure WriteWorkStart(AWriter: TWriter); protected procedure DefineProperties(Filer: TFiler); override; // methods TList.Sort function GetDisplayName: string; override; procedure SetColor(const AValue: TColor); virtual; procedure SetImageIndex(const AValue: TImageIndex); virtual; procedure SetName(const AValue: string); virtual; procedure SetResourceID(const AValue: Variant); virtual; procedure SetVisible(const AValue: Boolean); virtual; procedure SetWorkDays(AValue: TDays); virtual; procedure SetWorkFinish(const AValue: TTime); virtual; procedure SetWorkStart(const AValue: TTime); virtual; public constructor Create(Collection: TCollection); override; procedure Assign(Source: TPersistent); override; property ActualImageIndex: TImageIndex read GetActualImageIndex; property Resources: TcxSchedulerStorageResources read GetResources; published property Color: TColor read FColor write SetColor default clDefault; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; property Name: string read FName write SetName; property ReadOnly: Boolean read FReadOnly write FReadOnly default False; property ResourceID: Variant read FResourceID write SetResourceID; property Visible: Boolean read FVisible write SetVisible default True; property WorkFinish: TTime read FWorkFinish write SetWorkFinish stored False; property WorkStart: TTime read FWorkStart write SetWorkStart stored False; property WorkDays: TDays read FWorkDays write SetWorkDays stored IsWorkDaysStored; end; { TcxSchedulerStorageResources } TcxSchedulerStorageResources = class(TcxInterfacedPersistent, IcxStoredObject) private FImages: TCustomImageList; FItems: TcxSchedulerStorageResourceItems; FOwner: TcxCustomSchedulerStorage; FRestoringItems: TList; FOnGetResourceImageIndex: TcxSchedulerGetResourceImageIndexEvent; FOnGetResourceName: TcxSchedulerGetResourceNameEvent; function GetAreImagesUsed: Boolean; procedure SetImages(AValue: TCustomImageList); procedure SetItems(AValue: TcxSchedulerStorageResourceItems); protected function DecodePropertyName(const AName: string; var ASubValue: string): Integer; // IcxStoredObject function GetObjectName: string; function GetProperties(AProperties: TStrings): Boolean; procedure GetPropertyValue(const AName: string; var AValue: Variant); procedure SetPropertyValue(const AName: string; const AValue: Variant); // methods procedure Changed; virtual; function CreateItems: TcxSchedulerStorageResourceItems; virtual; procedure DoneRestore; function DoGetResourceImageIndex(AItem: TcxSchedulerStorageResourceItem): TImageIndex; virtual; function DoGetResourceName(AItem: TcxSchedulerStorageResourceItem): string; virtual; function GetOwner: TPersistent; override; function GetResourceItems: TcxSchedulerStorageResourceItems; virtual; procedure InitRestore; property Storage: TcxCustomSchedulerStorage read FOwner; public constructor Create(AOwner: TcxCustomSchedulerStorage); reintroduce; virtual; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function GetResourceName(AResource: TcxSchedulerStorageResourceItem): string; function GetResourceNameByID(const AResource: Variant): string; property AreImagesUsed: Boolean read GetAreImagesUsed; property ResourceItems: TcxSchedulerStorageResourceItems read GetResourceItems; published property Images: TCustomImageList read FImages write SetImages; property Items: TcxSchedulerStorageResourceItems read FItems write SetItems; property OnGetResourceImageIndex: TcxSchedulerGetResourceImageIndexEvent read FOnGetResourceImageIndex write FOnGetResourceImageIndex; property OnGetResourceName: TcxSchedulerGetResourceNameEvent read FOnGetResourceName write FOnGetResourceName; end; TcxSchedulerNotificationEvent = procedure(Sender: TObject; AEvent: TcxSchedulerEvent; var AHandled: Boolean) of object; TcxSchedulerFilterEventEvent = procedure (Sender: TcxCustomSchedulerStorage; AEvent: TcxSchedulerEvent; var Accept: Boolean) of object; { TcxSchedulerEventConflictsInfo } TcxSchedulerEventConflictsInfo = class private FExceptEventsWithoutResources: Boolean; FConflictEvents: TcxSchedulerFilteredEventList; FExcludedEvent: TcxSchedulerEvent; FEvent: TcxSchedulerEvent; FStorage: TcxCustomSchedulerStorage; FTimeRanges: TcxSchedulerTimeRanges; function GetHasConflicts: Boolean; function GetHasFreeTime: Boolean; protected ExcludedEventID: TcxSchedulerControlEventID; EventID: TcxSchedulerControlEventID; Start, Finish: TDateTime; ResourceID: Variant; procedure AddRange(AStart, AFinish: TDateTime); procedure CheckFreeTimeRanges; procedure CheckIntersectionWithEvents; procedure CheckSomeIntersection; function ExcludeFromCalculate(AEvent: TcxSchedulerEvent): Boolean; procedure ExpandRange(AEvent: TcxSchedulerEvent; var AIndex: Integer; var ALastPosition: TDateTime); procedure Init(AStorage: TcxCustomSchedulerStorage; AExceptEventsWithoutResources: Boolean; AResourceID: Variant; const AStart, AFinish: TDateTime); function IntersectEvents(ACheckedEvent: TcxSchedulerEvent): Boolean; overload; function IntersectEvents(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; overload; function IntersectTime(const AStart, AFinish: TDateTime): Boolean; overload; function IntersectTime(const AStart, AFinish, AStart1, AFinish1: TDateTime): Boolean; overload; function IsSameEvent(ACheckedEvent: TcxSchedulerEvent): Boolean; function IsSameSeries(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; public constructor Create(AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean); overload; virtual; constructor Create(AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean; const AStart, AFinish: TDateTime); overload; virtual; constructor Create(AStorage: TcxCustomSchedulerStorage; AExceptEventsWithoutResources: Boolean; const AStart, AFinish: TDateTime; AResourceID: Variant; AExcludedEvent: TcxSchedulerEvent = nil); overload; virtual; destructor Destroy; override; procedure Calculate(ACalculateFreeTime: Boolean = True); virtual; property ConflictEvents: TcxSchedulerFilteredEventList read FConflictEvents; property ExceptEventsWithoutResources: Boolean read FExceptEventsWithoutResources; property Event: TcxSchedulerEvent read FEvent; property HasConflicts: Boolean read GetHasConflicts; property HasFreeTime: Boolean read GetHasFreeTime; property Storage: TcxCustomSchedulerStorage read FStorage; property TimeRanges: TcxSchedulerTimeRanges read FTimeRanges; end; TcxSchedulerEventConflictsInfoClass = class of TcxSchedulerEventConflictsInfo; { TcxCustomSchedulerStorage } TcxSchedulerEventIntersectEvent = procedure(Sender: TcxCustomSchedulerStorage; AEvent1, AEvent2: TcxSchedulerEvent; var Allow: Boolean) of object; TcxCustomSchedulerStorage = class(TComponent, IcxSchedulerHolidaysListener) private FCustomFields: TcxCustomSchedulerStorageFields; FDataController: TcxCustomDataController; FEditor: TForm; FHolidays: TcxSchedulerHolidays; FInternalFields: TcxCustomSchedulerStorageFields; FIsChanged: Boolean; FIsLoading: Boolean; FIsModified: Boolean; FIsDeletion: Boolean; FInternalUpdate: Boolean; FListeners: TInterfaceList; FReminders: TcxSchedulerReminders; FResources: TcxSchedulerStorageResources; FRemindersEvents: TNotifyEvent; FResourcesEvents: TNotifyEvent; FStoreUsingGlobalTime: Boolean; FStoringName: string; FUpdateRemindersTimer: TTimer; FUseActualTimeRange: Boolean; FOnEventDeleted: TcxSchedulerNotificationEvent; FOnEventInserted: TcxSchedulerNotificationEvent; FOnEventIntersect: TcxSchedulerEventIntersectEvent; FOnEventModified: TcxSchedulerNotificationEvent; FOnFilterEvent: TcxSchedulerFilterEventEvent; function GetDataField(AIndex: Integer): TcxCustomSchedulerStorageField; function GetEvent(AIndex: Integer): TcxSchedulerEvent; function GetEventCount: Integer; function GetField(AIndex: Integer): TcxCustomSchedulerStorageField; function GetFieldCount: Integer; function GetInternalFieldCount: Integer; function GetIsDestroying: Boolean; function GetIsLoading: Boolean; function GetIsLocked: Boolean; function GetIsUpdatingMode: Boolean; function GetResourceCount: Integer; function GetResourceID(AIndex: Integer): Variant; function GetResourceName(AIndex: Integer): string; procedure SetEvent(AIndex: Integer; AValue: TcxSchedulerEvent); procedure SetHolidays(AValue: TcxSchedulerHolidays); procedure SetOnFilterEvent(AValue: TcxSchedulerFilterEventEvent); procedure SetReminders(AValue: TcxSchedulerReminders); procedure SetResources(AValue: TcxSchedulerStorageResources); procedure SetStoreUsingGlobalTime(AValue: Boolean); procedure StartUpdateRemindersTimer; procedure StopUpdateRemindersTimer; procedure UpdateReminders; procedure UpdateRemindersTimerEvent(Sender: TObject); protected EventsIndex: TList; FDeletedRecords: TList; FEventsList: TcxSchedulerEventList; FFields: TList; FLastEditedEvent: TcxSchedulerEvent; FNewEvents: TcxSchedulerEventList; LockCount: Integer; TimeBias: Double; // internal fields FActualFinishField: TcxCustomSchedulerStorageField; FActualStartField: TcxCustomSchedulerStorageField; FCaptionField: TcxCustomSchedulerStorageField; FEventTypeField: TcxCustomSchedulerStorageField; FFinishField: TcxCustomSchedulerStorageField; FLabelColorField: TcxCustomSchedulerStorageField; FLocationField: TcxCustomSchedulerStorageField; FMessageField: TcxCustomSchedulerStorageField; FOptionsField: TcxCustomSchedulerStorageField; FParentIDField: TcxCustomSchedulerStorageField; FRecurrenceIndexField: TcxCustomSchedulerStorageField; FRecurrenceInfoField: TcxCustomSchedulerStorageField; FReminderDateField: TcxCustomSchedulerStorageField; FReminderMinutesBeforeStartField: TcxCustomSchedulerStorageField; FResourceIDField: TcxCustomSchedulerStorageField; FStartField: TcxCustomSchedulerStorageField; FStateField: TcxCustomSchedulerStorageField; // additional for tasks FTaskCompleteField: TcxCustomSchedulerStorageField; FTaskIndexField: TcxCustomSchedulerStorageField; FTaskLinksField: TcxCustomSchedulerStorageField; FTaskStatusField: TcxCustomSchedulerStorageField; // additional for reminders FReminderResourcesData: TcxCustomSchedulerStorageField; function ActualTimeRangeAvailable: Boolean; virtual; procedure AddInternalField(var AField: TcxCustomSchedulerStorageField; AValueType: TcxValueTypeClass; AIsUnique: Boolean = True); procedure AddRecord; virtual; procedure CancelEvent(AEvent: TcxSchedulerEvent); virtual; function CanGetValueFromPattern(AIndex: Integer): Boolean; virtual; procedure Changed; virtual; procedure CreateDefaultFields; virtual; function CreateFields: TcxCustomSchedulerStorageFields; virtual; procedure CreateHolidayEvent(const ACaption: string; const ADate: TDateTime; AResourceID: Variant); virtual; function CreateReminders: TcxSchedulerReminders; virtual; function CreateResources: TcxSchedulerStorageResources; virtual; procedure CreateSubClasses; virtual; procedure CreateVersion3Fields; procedure DestroySubClasses; virtual; procedure DestroyVersion3Fields; procedure DoDeleteEvent(const ARecordIndex: Integer); virtual; procedure DoDestroyEvent(AEvent: TcxSchedulerEvent); virtual; function DoEventDeleted(AEvent: TcxSchedulerEvent): Boolean; virtual; function DoEventInserted(AEvent: TcxSchedulerEvent): Boolean; virtual; function DoEventIntersect(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; virtual; function DoEventModified(AEvent: TcxSchedulerEvent): Boolean; virtual; function DoFilterEvent(AEvent: TcxSchedulerEvent): Boolean; virtual; procedure DoRefresh; virtual; procedure GenerateHolidayEventsBySchedulerHolidays(const AResourceID: Variant; AHolidays: TcxSchedulerHolidays); virtual; function GetDataControllerClass: TcxCustomDataControllerClass; virtual; function GetEventClass: TcxSchedulerEventClass; virtual; function GetEventStoredID(AEvent: TcxSchedulerEvent): Variant; function GetFieldValueBeforePost(ARecordIndex, AFieldIndex: Integer): Variant; virtual; function GetFieldValueTypeClass(AField: TcxCustomSchedulerStorageField): TcxValueTypeClass; virtual; function GetFocusedRecordID(ARecordIndex: Integer): Variant; virtual; function GetParentForm: TForm; function GetRecordID(const ARecordIndex: Integer): Variant; virtual; function GetValue(ARecordIndex, AItemIndex: Integer): Variant; virtual; function HasEventIntersect(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; virtual; procedure ItemAdded(AItem: TcxCustomSchedulerStorageField); procedure ItemRemoved(AItem: TcxCustomSchedulerStorageField); function IsDataSettingsValid: Boolean; virtual; procedure LayoutChanged; virtual; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure PostEvent(AEvent: TcxSchedulerEvent); virtual; procedure PostEditingData(AEvent: TcxSchedulerEvent); virtual; procedure SendNotification( AIsRemoved: Boolean = False); virtual; procedure SetEventRecordInfo(AEvent: TcxSchedulerEvent; ARecordIndex: Integer; const AEventID: Variant); virtual; procedure SetFieldValueBeforePost(ARecordIndex, AFieldIndex: Integer; const AValue: Variant); virtual; procedure SetPostFieldValue(AEvent: TcxSchedulerEvent; AFieldIndex: Integer); virtual; procedure SetValue(ARecordIndex, AItemIndex: Integer; const AValue: Variant); virtual; procedure SynchronizeEventsWithRecords; virtual; procedure UpdateControl(AInfo: TcxUpdateControlInfo); virtual; procedure UpdateData; virtual; procedure UpdateItemIndexes; procedure BeginUpdateDataController; virtual; procedure EndUpdateDataController; virtual; property DataController: TcxCustomDataController read FDataController; property DataFields[Index: Integer]: TcxCustomSchedulerStorageField read GetDataField; property Editor: TForm read FEditor write FEditor; property CustomFields: TcxCustomSchedulerStorageFields read FCustomFields; property InternalFields: TcxCustomSchedulerStorageFields read FInternalFields; property InternalFieldCount: Integer read GetInternalFieldCount; property IsChanged: Boolean read FIsChanged write FIsChanged; property IsDeletion: Boolean read FIsDeletion write FIsDeletion; property IsDestroying: Boolean read GetIsDestroying; property IsLoading: Boolean read GetIsLoading; property IsLocked: Boolean read GetIsLocked; property IsModified: Boolean read FIsModified; property IsUpdatingMode: Boolean read GetIsUpdatingMode; property LastEditedEvent: TcxSchedulerEvent read FLastEditedEvent; property Listeners: TInterfaceList read FListeners; property OnEventDeleted: TcxSchedulerNotificationEvent read FOnEventDeleted write FOnEventDeleted; property OnEventInserted: TcxSchedulerNotificationEvent read FOnEventInserted write FOnEventInserted; property OnEventIntersect: TcxSchedulerEventIntersectEvent read FOnEventIntersect write FOnEventIntersect; property OnEventModified: TcxSchedulerNotificationEvent read FOnEventModified write FOnEventModified; property OnFilterEvent: TcxSchedulerFilterEventEvent read FOnFilterEvent write SetOnFilterEvent; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure AddListener(AListener: IcxSchedulerStorageListener); procedure BeginUpdate; procedure CalculateEventActualTimeRanges; function CheckRequiredFields: Boolean; virtual; function createEvent: TcxSchedulerEvent; virtual;{CreateEvent conflicts with C++ macro} function CreateOccurrence(APattern: TcxSchedulerEvent; const ADate: TDateTime; AType: TcxEventType): TcxSchedulerEvent; procedure Clear; virtual; procedure DoneRestore; procedure EndUpdate; function FindAvailableAllDay(var AStart, AFinish: TDateTime; AResourceID: Variant; AExceptEventsWithoutResources: Boolean; ADuration: TDateTime = 0): Boolean; function FindAvailableTime(var AStart, AFinish: TDateTime; AllDay: Boolean; AResourceID: Variant; AExceptEventsWithoutResources: Boolean; ADuration: TDateTime = 0; AExcludedEvent: TcxSchedulerEvent = nil): Boolean; overload; function FindAvailableTime(AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean; var AStart, AFinish: TDateTime): Boolean; overload; procedure FullRefresh; procedure GenerateHolidayEvents(const AResourceID: Variant); virtual; function GetEventByID(const AID: Variant): TcxSchedulerEvent; function GetEvents(AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime): Boolean; overload; function GetEvents(AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime; const AResourceID: Variant): Boolean; overload; function GetFieldByName(const AName: string): TcxCustomSchedulerStorageField; function GetHolidayNamesByDate(ADate: TDate; var ANames: string; AOnlyVisible: Boolean = True): Boolean; virtual; function GetReminderEvents(ADateTime: TDateTime; AList: TcxSchedulerFilteredEventList): Boolean; procedure InitRestore; function IsActive: Boolean; virtual; function IsCaptionAvailable: Boolean; virtual; function IsLabelColorAvailable: Boolean; virtual; function IsLocationAvailable: Boolean; virtual; function IsMessageAvailable: Boolean; virtual; function IsRecurrenceAvailable: Boolean; virtual; function IsReminderByResourceAvailable: Boolean; virtual; function IsReminderAvailable: Boolean; virtual; function IsStateAvailable: Boolean; virtual; procedure PopulateHolidayDates(AList: TcxSchedulerDateList; AStart, AFinish: TDate; AOnlyVisible: Boolean = True; AClearList: Boolean = True); virtual; procedure PostEvents; virtual; procedure RemoveListener(AListener: IcxSchedulerStorageListener); // IcxSchedulerHolidaysListener procedure HolidaysChanged(Sender: TObject); procedure HolidaysRemoved(Sender: TObject); property EventCount: Integer read GetEventCount; property Events[Index: Integer]: TcxSchedulerEvent read GetEvent write SetEvent; property FieldCount: Integer read GetFieldCount; property Fields[Index: Integer]: TcxCustomSchedulerStorageField read GetField; property Holidays: TcxSchedulerHolidays read FHolidays write SetHolidays; property InternalUpdate: Boolean read FInternalUpdate; property Reminders: TcxSchedulerReminders read FReminders write SetReminders; property ResourceCount: Integer read GetResourceCount; property ResourceIDs[Index: Integer]: Variant read GetResourceID; property ResourceNames[Index: Integer]: string read GetResourceName; property Resources: TcxSchedulerStorageResources read FResources write SetResources; property StoringName: string read FStoringName write FStoringName; property Values[ARecordIndex, AFieldIndex: Integer]: Variant read GetValue write SetValue; published property UseActualTimeRange: Boolean read FUseActualTimeRange write FUseActualTimeRange default False; property StoreUsingGlobalTime: Boolean read FStoreUsingGlobalTime write SetStoreUsingGlobalTime default False; property RemindersEvents: TNotifyEvent read FRemindersEvents write FRemindersEvents; property ResourcesEvents: TNotifyEvent read FResourcesEvents write FResourcesEvents; end; { TcxSchedulerStorage } TcxSchedulerStorage = class(TcxCustomSchedulerStorage) private function GetCustomFields: TcxSchedulerStorageFields; procedure SetCustomFields(const AValue: TcxSchedulerStorageFields); protected procedure DefineProperties(Filer: TFiler); override; public procedure Assign(Source: TPersistent); override; procedure SaveToFile(const AFileName: string); procedure SaveToStream(AStream: TStream); virtual; procedure LoadFromFile(const AFileName: string); procedure LoadFromStream(AStream: TStream); virtual; published property CustomFields: TcxSchedulerStorageFields read GetCustomFields write SetCustomFields; property Holidays; property Reminders; property Resources; property OnEventDeleted; property OnEventInserted; property OnEventIntersect; property OnEventModified; property OnFilterEvent; end; { TcxSchedulerControlEventID } TcxSchedulerControlEventID = class public ID, ParentID: Variant; RecurrenceIndex: Integer; constructor Create(AEvent: TcxSchedulerEvent); function SameEvent(AEvent: TcxSchedulerEvent): Boolean; function Equals(AValue: TcxSchedulerControlEventID): Boolean;{$IFDEF DELPHI12} reintroduce; {$ENDIF} end; { TcxSchedulerEventSelection } TcxEventSelectionChangedEvent = procedure (AEvent: TcxSchedulerControlEvent) of object; TcxSchedulerEventSelection = class(TcxIUnknownObject, IcxSchedulerSelectionAdapter) private FOnEventSelectionChanged: TcxEventSelectionChangedEvent; function GetCount: Integer; function GetItem(AIndex: Integer): TcxSchedulerControlEvent; function GetKey(AIndex: Integer): TcxSchedulerControlEventID; function GetKeyCount: Integer; protected FKeys: TList; FEvents: TList; FSourceEvents: TcxSchedulerEventList; procedure ClearKeys; function CreateItem(AEvent: TcxSchedulerControlEvent): TcxSchedulerControlEventID; procedure DoEventSelectionChanged(AEvent: TcxSchedulerControlEvent); function KeyIndexOf(AEvent: TcxSchedulerControlEvent): Integer; function IndexOf(AEvent: TcxSchedulerControlEvent): Integer; procedure InternalClear; procedure ReplaceSelection; property KeyCount: Integer read GetKeyCount; property Keys[Index: Integer]: TcxSchedulerControlEventID read GetKey; public constructor Create(ASourceEvents: TcxSchedulerEventList); virtual; destructor Destroy; override; procedure Add(AEvent: TcxSchedulerControlEvent; AShift: TShiftState); procedure Clear; function IsSelected(AEvent: TcxSchedulerControlEvent): Boolean; procedure Select(AEvent: TcxSchedulerEvent); procedure Update; property Count: Integer read GetCount; property Items[Index: Integer]: TcxSchedulerControlEvent read GetItem; default; property OnEventSelectionChanged: TcxEventSelectionChangedEvent read FOnEventSelectionChanged write FOnEventSelectionChanged; end; { TcxSchedulerEventList } TcxSchedulerEventList = class private FItems: TList; function GetCount: Integer; function GetFirst: TcxSchedulerEvent; function GetEvent(AIndex: Integer): TcxSchedulerEvent; function GetLast: TcxSchedulerEvent; protected procedure EventAdded(AEvent: TcxSchedulerEvent); virtual; procedure DoClear(AFreeItems: Boolean); virtual; public constructor Create; virtual; destructor Destroy; override; procedure Assign(ASource: TcxSchedulerEventList{$IFDEF DELPHI6}; AOperator: TListAssignOp = laCopy {$ENDIF}); virtual; function Add(AEvent: TcxSchedulerEvent): Integer; virtual; procedure Clear; procedure Delete(AIndex: Integer); procedure DestroyItems; function Remove(AEvent: TcxSchedulerEvent): Integer; function IndexOf(AEvent: TcxSchedulerEvent): Integer; procedure Sort(ACompare: TcxCompareEventsProc); virtual; property Count: Integer read GetCount; property First: TcxSchedulerEvent read GetFirst; property Items[Index: Integer]: TcxSchedulerEvent read GetEvent; default; property Last: TcxSchedulerEvent read GetLast; property List: TList read FItems; end; { TcxSchedulerFilteredEventList } TcxSchedulerFilteredEventList = class(TcxSchedulerEventList) private FFinish: TDateTime; FNow: TDateTime; FReminderEventsOnly: Boolean; FStart: TDateTime; FStorage: TcxCustomSchedulerStorage; function GetEvent(AIndex: Integer): TcxSchedulerControlEvent; protected function AddEvent(AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; function AddOccurrence(ACalculator: TcxSchedulerOccurrenceCalculator): TcxSchedulerControlEvent; procedure Changed; virtual; procedure CheckEvent(AEvent: TcxSchedulerEvent; const AResourceID: Variant); virtual; function CheckEventTimeRange: Boolean; virtual; procedure CheckRecurrenceEvent(AEvent: TcxSchedulerEvent; const AResourceID: Variant); procedure CheckSimpleEvent(AEvent: TcxSchedulerEvent; const AResourceID: Variant); function CreateControlEvent(AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; virtual; function GetTimeBiasDaylightSavingTime(ATime: TDateTime): TDateTime; virtual; procedure Init(const AStart, AFinish: TDateTime; AStorage: TcxCustomSchedulerStorage); virtual; function NeedAddOccurenceForReminder(AReminderStart: TDateTime; AEvent: TcxSchedulerEvent): Boolean; property Now: TDateTime read FNow; public destructor Destroy; override; property Finish: TDateTime read FFinish; property ReminderEventsOnly: Boolean read FReminderEventsOnly; property Start: TDateTime read FStart; property Storage: TcxCustomSchedulerStorage read FStorage; property Items[AIndex: Integer]: TcxSchedulerControlEvent read GetEvent; default; property Count; end; { TcxSchedulerCachedEventList } TcxSchedulerCachedEventList = class(TcxSchedulerFilteredEventList, IUnknown, IcxSchedulerSelectionAdapter) private FAbsoluteItems: TList; FAlwaysShowSelectedEvent: Boolean; FClones: TcxSchedulerFilteredEventList; FDaylightSaving: Boolean; FNewEvent: TcxSchedulerEvent; FSelStart: TDateTime; FSelFinish: TDateTime; FSelection: TcxSchedulerEventSelection; FShowEventsWithoutResource: Boolean; FTimeBias: Double; FTimeZone: Integer; FUseTimeRange: Boolean; function GetAbsoluteCount: Integer; function GetAbsoluteItem(AIndex: Integer): TcxSchedulerControlEvent; function GetAbsoluteCountInternal: Integer; function GetAbsoluteItemInternal(AIndex: Integer): TcxSchedulerControlEvent; function GetItem(AIndex: Integer): TcxSchedulerControlEvent; procedure SetSelFinish(const AValue: TDateTime); procedure SetSelStart(const AValue: TDateTime); // IcxSchedulerSelectionAdapter procedure IcxSchedulerSelectionAdapter.Add = SelectionAdd; procedure IcxSchedulerSelectionAdapter.Clear = SelectionClear; procedure IcxSchedulerSelectionAdapter.Update = SelectionUpdate; protected FBeforePostCount: Integer; FChangeRef: Integer; FExpandedTimeRange: Boolean; FHasClones: Boolean; FSavedIndex: Integer; FSavedPatternID, FSavedSourceID: Variant; FMinNecessaryDate: TDateTime; FMaxNecessaryDate: TDateTime; // IUnknown function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; // procedure Changed; override; procedure CheckEvent(AEvent: TcxSchedulerEvent; const AResourceID: Variant); override; function CheckEventTimeRange: Boolean; override; function CheckEventVisibility(AEvent: TcxSchedulerEvent; AIncludeUnassigned: Boolean): Boolean; function CreateControlEvent(AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; override; function CreateCloneList: TcxSchedulerFilteredEventList; virtual; function CreateSelection: TcxSchedulerEventSelection; virtual; procedure DoClear(AFreeItems: Boolean); override; function GetTimeBiasDaylightSavingTime(ATime: TDateTime): TDateTime; override; procedure EventAdded(AEvent: TcxSchedulerEvent); override; procedure Init(const AStart, AFinish: TDateTime; AStorage: TcxCustomSchedulerStorage); override; procedure InternalPost(AEvent: TcxSchedulerControlEvent; ACopy: Boolean); function IsDayNoneEmpty(ADay: Integer): Boolean; function IsIntersect(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; function IsSelected(AEvent: TcxSchedulerControlEvent): Boolean; virtual; procedure PopulateAbsoluteItems; procedure PostCloneForRecurrenceEvent(AEvent: TcxSchedulerControlEvent; ACopy: Boolean); virtual; procedure PostCloneForSimpleEvent(AEvent: TcxSchedulerControlEvent; ACopy: Boolean; AType: TcxEventType); virtual; procedure PostNewEvent(AEvent: TcxSchedulerControlEvent); procedure SelectionAdd(AEvent: TcxSchedulerControlEvent; Shift: TShiftState); virtual; procedure SelectionClear; virtual; procedure SelectionUpdate; virtual; public constructor Create; override; destructor Destroy; override; procedure BeforeEditing(AEvent: TcxSchedulerControlEvent; AIsInplace: Boolean); procedure BeforeUpdate; procedure DeleteEvent(AEvent: TcxSchedulerControlEvent); procedure CalculateClonesRange(var AMinDate, AMaxDate: TDateTime); function CalculateNecessaryDate(var AMinDate, AMaxDate: TDateTime): Boolean; procedure CalculateSelectionRange(var AMinDate, AMaxDate: TDateTime); procedure CancelClones; function CreateEvent: TcxSchedulerControlEvent; function CreateClones: TcxSchedulerEventList; procedure ExtractEvents(const ADate: TDateTime; AList: TcxSchedulerEventList); procedure ExtractUsedDays(AList: TcxSchedulerDateList); function HasConflict(IsDragCopy: Boolean; AStartDrag: Boolean): Boolean; function HasIntersection(AEvent: TcxSchedulerControlEvent): Boolean; overload; function HasIntersection(AList: TList): Boolean; overload; function HasIntersection(AList1, AList2: TcxSchedulerEventList; AExcludeEquals: Boolean): Boolean; overload; function LastEditedEvent: TcxSchedulerControlEvent; procedure PostClones(ACopy: Boolean); procedure PostEvent(AEvent: TcxSchedulerControlEvent); procedure Sort(ACompare: TcxCompareEventsProc); override; // property AbsoluteCount: Integer read GetAbsoluteCount; property AbsoluteItems[Index: Integer]: TcxSchedulerControlEvent read GetAbsoluteItem; property AlwaysShowSelectedEvent: Boolean read FAlwaysShowSelectedEvent write FAlwaysShowSelectedEvent; property TimeZone: Integer read FTimeZone write FTimeZone; property Clones: TcxSchedulerFilteredEventList read FClones; property DaylightSaving: Boolean read FDaylightSaving write FDaylightSaving; property ShowEventsWithoutResource: Boolean read FShowEventsWithoutResource write FShowEventsWithoutResource; property SelStart: TDateTime read FSelStart write SetSelStart; property SelFinish: TDateTime read FSelFinish write SetSelFinish; property Selection: TcxSchedulerEventSelection read FSelection; property Items[Index: Integer]: TcxSchedulerControlEvent read GetItem; default; property UseTimeRange: Boolean read FUseTimeRange write FUseTimeRange; end; { TcxSchedulerOccuranceCalculator } TcxSchedulerOccurrenceCalculator = class protected FActualStart: TDateTime; FCalcForReminders: Boolean; FDate: Integer; FDay: Word; FDayNumber: Integer; FDayType: TcxDayType; FEvent: TcxSchedulerEvent; FFinishDate: TDateTime; FIndex: Integer; FMonth: Word; FOccurDays: TDays; FOccurrenceFinish: TDateTime; FOccurrenceStart: TDateTime; FPeriodicity: Integer; FRecurCount: Integer; FRecurrence: TcxRecurrence; FStartOfWeek: Integer; FVisibleFinish: TDateTime; FVisibleStart: TDateTime; FWeekStart: Integer; FWorkDays: TDays; FYear: Word; FYearPeriodicity: Integer; // FOccurence: TcxSchedulerControlEvent; FOccurencePos: Integer; procedure CalcFirstDate; procedure CalcNextDate; function GetCertainDay(const ADate, ANumber: Integer; ADayType: TcxDayType): Integer; function GetDayForMonth: Integer; virtual; function GetDayFromOccurDays(const APrevDate, APeriodicity: Integer): Integer; function GetSomeDay(const ADate, ANumber: Integer; AWeekEnd: Boolean): Integer; procedure InitTimes; function IsValidOccurrence: Boolean; public constructor Create(AEvent: TcxSchedulerEvent; const AStart, AFinish: TDateTime; ACalcForReminders: Boolean = False); procedure CalcOccurrence(AIndex: Integer); procedure CalcNearestOccurrenceIntervals(AStart, AFinish: TDateTime; var AnIntervalBefore, AnIntervalAfter: TDateTime); function GetNextOccurrence: Boolean; virtual; function GetOccurrenceCount(AEndDate: TDateTime): Integer; property Event: TcxSchedulerEvent read FEvent; property Index: Integer read FIndex; property OccurrenceFinish: TDateTime read FOccurrenceFinish; property OccurrenceStart: TDateTime read FOccurrenceStart; property StartOfWeek: Integer read FStartOfWeek; property VisibleFinish: TDateTime read FVisibleFinish; property VisibleStart: TDateTime read FVisibleStart; property WorkDays: TDays read FWorkDays write FWorkDays; end; { TcxSchedulerContentNavigationInfo } TcxSchedulerContentNavigationInfo = class public FResourceID: Variant; FIntervalBefore: TDateTime; FIntervalAfter: TDateTime; constructor Create(AResourceID: Variant); end; { TcxSchedulerContentNavigationCalculator } TcxSchedulerContentNavigationCalculator = class private class procedure CalcAppointmentIntervals(AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); class procedure CalcIntervals(AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); class procedure CalcPatternIntervals(AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); class procedure ChangeResourceNavigationIntervals( AContentNavigationInfo: TObjectList); class function IsEventSharedWithAnyResource(AStorage: TcxCustomSchedulerStorage; AnEventIndex: Integer; ConsiderVisibility: Boolean): Boolean; public class procedure FindNavigationIntervals(AStorage: TcxCustomSchedulerStorage; AContentNavigationInfo: TObjectList; AStart, AFinish: TDateTime; AWithoutResources: Boolean; AShowEventsWithoutResource: Boolean); end; { TcxSchedulerCustomReminderForm } TcxSchedulerCustomReminderForm = class(TForm) private FReminders: TcxSchedulerReminders; function GetStorage: TcxCustomSchedulerStorage; protected procedure CheckFormPosition; virtual; procedure CreateParams(var Params: TCreateParams); override; procedure DoClose(var Action: TCloseAction); override; procedure DoShow; override; procedure FlashCaption; function GetFormColor: TColor; virtual; function IsLocked: Boolean; virtual; procedure LayoutChanged; virtual; procedure OpenEvent(AEvent: TcxSchedulerControlEvent); virtual; function OpenEventSupported: Boolean; virtual; procedure RestoreSelection; virtual; procedure SaveSelection; virtual; procedure ShowInactive; procedure UpdateReminderList; virtual; procedure UpdateSelectionCaptions; virtual; property Reminders: TcxSchedulerReminders read FReminders; property Storage: TcxCustomSchedulerStorage read GetStorage; public constructor Create(AReminders: TcxSchedulerReminders); reintroduce; virtual; destructor Destroy; override; end; TcxSchedulerReminderFormClass = class of TcxSchedulerCustomReminderForm; { TcxSchedulerReminderEventID } TcxSchedulerReminderEventID = class(TcxSchedulerControlEventID) protected Values: array of Variant; public constructor Create(AEvent: TcxSchedulerControlEvent); destructor Destroy; override; function SameEvent(AEvent: TcxSchedulerControlEvent): Boolean; end; { TcxSchedulerEventReminders } TcxSchedulerEventReminders = class private FInvalid: Boolean; public EventID: TcxSchedulerReminderEventID; Reminders: array of TcxSchedulerReminder; constructor Create(AEvent: TcxSchedulerControlEvent); destructor Destroy; override; procedure AddReminder(AReminder: TcxSchedulerReminder); function Find(AReminderDate: TDateTime; const AResourceID: Variant): TcxSchedulerReminder; procedure FreeReminderByIndex(AIndex: Integer); procedure FreeReminders; procedure Invalidate; function IsValid: Boolean; procedure RemoveInvalidReminders; procedure Validate; end; { TcxSchedulerEventRemindersList } TcxSchedulerEventRemindersList = class(TcxObjectList) private function GetItem(AIndex: Integer): TcxSchedulerEventReminders; {$IFDEF DELPHI9} inline; {$ENDIF} public function CreateEventReminders(AEvent: TcxSchedulerControlEvent): TcxSchedulerEventReminders; function FindForEvent(AEvent: TcxSchedulerControlEvent): TcxSchedulerEventReminders; procedure Invalidate; procedure Remove(AEventReminders: TcxSchedulerEventReminders); procedure RemoveInvalidItems; property Items[Index: Integer]: TcxSchedulerEventReminders read GetItem; end; { TcxSchedulerReminder } TcxSchedulerReminder = class private FEvent: TcxSchedulerControlEvent; FEventReminders: TcxSchedulerEventReminders; FOwner: TcxSchedulerReminders; FReminderDate: TDateTime; FResourceID: Variant; FInvalid: Boolean; function GetResourcesData: TcxSchedulerReminderResourcesData; protected procedure ClearReminder; procedure DismissEvent; virtual; procedure DismissEventForResource; virtual; procedure DoDismiss; virtual; procedure DoSnooze(var ASnoozeTime: TDateTime); virtual; function GetRecurrenceDismissDate: TDateTime; virtual; procedure SetData(const AResourceID: Variant; AReminderDate: TDateTime); procedure SnoozeEvent(const ASnoozeTime: TDateTime); virtual; procedure SnoozeEventForResource(const ATime: TDateTime); virtual; procedure Validate(AEvent: TcxSchedulerControlEvent); property EventReminders: TcxSchedulerEventReminders read FEventReminders; property Invalid: Boolean read FInvalid write FInvalid; public constructor Create(AOwner: TcxSchedulerReminders; AEvent: TcxSchedulerControlEvent); virtual; destructor Destroy; override; procedure Dismiss; procedure Snooze(ASnoozeTime: TDateTime); property Event: TcxSchedulerControlEvent read FEvent; property Owner: TcxSchedulerReminders read FOwner; property ResourceID: Variant read FResourceID; property ReminderDate: TDateTime read FReminderDate; end; { TcxSchedulerReminderList } TcxSchedulerReminderList = class(TList) private FClearing: Boolean; function GetItem(Index: Integer): TcxSchedulerReminder; {$IFDEF DELPHI9} inline; {$ENDIF} public procedure Clear; override; property Clearing: Boolean read FClearing; property Items[Index: Integer]: TcxSchedulerReminder read GetItem; default; end; { TcxSchedulerReminders } TcxSchedulerReminderEvent = procedure (Sender: TcxSchedulerReminders; AReminder: TcxSchedulerReminder; var AHandled: Boolean) of object; TcxSchedulerRemindersEvent = procedure (Sender: TcxSchedulerReminders) of object; TcxSchedulerGetEventDueTimeTextEvent = procedure ( Sender: TcxSchedulerReminders; AReminder: TcxSchedulerReminder; const ADueTimeInfo: TcxSchedulerReminderDueTimeInfo; var AText: string) of object; TcxSchedulerGetReminderWindowCaption = procedure (Sender: TcxSchedulerReminders; var ACaption: string) of object; TcxSchedulerSnoozeReminderEvent = procedure (Sender: TcxSchedulerReminders; AReminder: TcxSchedulerReminder; var ASnoozeTime: TDateTime; var AHandled: Boolean) of object; TcxSchedulerReminderOpenEvent = procedure (Sender: TcxSchedulerReminders; AEvent: TcxSchedulerControlEvent) of object; TcxSchedulerReminders = class(TcxInterfacedPersistent, IcxFormatControllerListener, IcxFormatControllerListener2, IdxSkinSupport) private FActive: Boolean; FDefaultMinutesBeforeStart: Integer; FDefaultReminder: Boolean; FEvents: TcxSchedulerFilteredEventList; FEventRemindersList: TcxSchedulerEventRemindersList; FItems: TcxSchedulerReminderList; FReminderWindowLookAndFeel: TcxLookAndFeel; FNeedCloseWindow: Boolean; FNeedRestoreSelection: Boolean; FNeedShowWindow: Boolean; FReminderByResource: Boolean; FReminderWindow: TcxSchedulerCustomReminderForm; FShowResourcesInReminderWindow: Boolean; FStorage: TcxCustomSchedulerStorage; FUpdateEventsTimer: TTimer; FUpdateRemindersTimer: TTimer; FUpdatingReminderList: Boolean; FUseReminderWindow: Boolean; FOnAlertReminder: TcxSchedulerReminderEvent; FOnDismissReminder: TcxSchedulerReminderEvent; FOnGetEventDueTimeText: TcxSchedulerGetEventDueTimeTextEvent; FOnOpenEvent: TcxSchedulerReminderOpenEvent; FOnSnoozeReminder: TcxSchedulerSnoozeReminderEvent; //reminder window events FOnGetReminderWindowCaption: TcxSchedulerGetReminderWindowCaption; FOnHideReminderWindow: TcxSchedulerRemindersEvent; FOnShowReminderWindow: TcxSchedulerRemindersEvent; procedure CreateTimers; function GetCount: Integer; function GetItem(Index: Integer): TcxSchedulerReminder; procedure SetActive(AValue: Boolean); procedure SetDefaultMinutesBeforeStart(AValue: Integer); procedure SetReminderByResource(AValue: Boolean); procedure SetReminderWindowLookAndFeel(AValue: TcxLookAndFeel); procedure SetShowResourcesInReminderWindow(AValue: Boolean); procedure StartReminder; procedure StopReminder; procedure UpdateReminderWindow; procedure OnUpdateEventsTimer(Sender: TObject); procedure OnUpdateRemindersTimer(Sender: TObject); protected //IcxFormatControllerListener procedure FormatChanged; //IcxFormatControllerListener2 procedure TimeChanged; procedure AddReminder(AEvent: TcxSchedulerControlEvent; const AResourceID: Variant; AReminderDate: TDateTime; var AEventReminders: TcxSchedulerEventReminders); procedure AddReminderToEventReminders(AReminder: TcxSchedulerReminder; var AEventReminders: TcxSchedulerEventReminders); procedure CheckAddReminder(AEvent: TcxSchedulerControlEvent; const AResourceID: Variant; AReminderDate: TDateTime; var AEventReminders: TcxSchedulerEventReminders); procedure CheckAddReminders(AEvent: TcxSchedulerControlEvent; AEventReminders: TcxSchedulerEventReminders); procedure CheckRemindersForEvent(AEvent: TcxSchedulerControlEvent); function CreateReminderWindow: TcxSchedulerCustomReminderForm; virtual; function DoAlertReminder(AReminder: TcxSchedulerReminder): Boolean; virtual; function DoDismissReminder(AReminder: TcxSchedulerReminder): Boolean; virtual; procedure DoGetEventDueTimeText(AReminder: TcxSchedulerReminder; const ADueTimeInfo: TcxSchedulerReminderDueTimeInfo; var AText: string); procedure DoGetReminderWindowCaption(var ACaption: string); virtual; procedure DoOpenEvent(AEvent: TcxSchedulerControlEvent); virtual; function DoSnoozeReminder(AReminder: TcxSchedulerReminder; var ASnoozeTime: TDateTime): Boolean; virtual; procedure DoHideReminderWindow; virtual; procedure DoShowReminderWindow; virtual; function GetFirstReminderTimeForEvent(AEvent: TcxSchedulerEvent; ANow: TDateTime): TDateTime; function GetNextPopulateEventsCacheTime(ANow: TDateTime; AIsLocked: Boolean): TDateTime; virtual; function GetNextRefreshRemindersTime(ANow: TDateTime; AIsLocked: Boolean): TDateTime; virtual; function GetNow: TDateTime; virtual; function GetReminderClass: TcxSchedulerReminderClass; virtual; function GetReminderResourcesFromEvent(AEvent: TcxSchedulerControlEvent; AGetFromPattern: Boolean): TcxSchedulerReminderResources; function GetReminderWindowCaption: string; function IsNeedAddToReminders(AEvent: TcxSchedulerControlEvent; const AReminderDate: TDateTime): Boolean; virtual; function PopulateEventsCache: Boolean; virtual; procedure RefreshReminders; virtual; procedure RemoveEventReminders(AReminder: TcxSchedulerReminder); procedure StopTimers; virtual; procedure UpdateReminderList; virtual; procedure UpdateTimer(ATimer: TTimer; AInterval: TDateTime); procedure ValidateReminderList; procedure CheckRemindersForRecurringEvent(AEvent: TcxSchedulerControlEvent; var AIndex: Integer); procedure ValidateRemindersForEvent(AEventReminders: TcxSchedulerEventReminders; AEvent: TcxSchedulerControlEvent); property Events: TcxSchedulerFilteredEventList read FEvents; property NeedCloseWindow: Boolean read FNeedCloseWindow; property NeedRestoreSelection: Boolean read FNeedRestoreSelection write FNeedRestoreSelection; property NeedShowWindow: Boolean read FNeedShowWindow; property UpdateEventsTimer: TTimer read FUpdateEventsTimer; property UpdateRemindersTimer: TTimer read FUpdateRemindersTimer; property UpdatingReminderList: Boolean read FUpdatingReminderList; public constructor Create(AStorage: TcxCustomSchedulerStorage); reintroduce; virtual; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure DismissAll; procedure SnoozeAll(ASnoozeTime: TDateTime); function GetEventDueTimeText(AReminder: TcxSchedulerReminder; ATime: TDateTime): string; function HasReminders: Boolean; procedure HideReminderWindow; function IsLocked: Boolean; virtual; function IsReminderByResourceAvailable: Boolean; function IsReminderValid(AReminder: TcxSchedulerReminder): Boolean; function IsReminderWindowShown: Boolean; procedure Refresh; procedure ShowReminderWindow; property Count: Integer read GetCount; property Items[Index: Integer]: TcxSchedulerReminder read GetItem; default; property ReminderWindow: TcxSchedulerCustomReminderForm read FReminderWindow; property Storage: TcxCustomSchedulerStorage read FStorage; published property Active: Boolean read FActive write SetActive default True; property DefaultMinutesBeforeStart: Integer read FDefaultMinutesBeforeStart write SetDefaultMinutesBeforeStart default 15; property DefaultReminder: Boolean read FDefaultReminder write FDefaultReminder default False; property ReminderByResource: Boolean read FReminderByResource write SetReminderByResource default False; property ReminderWindowLookAndFeel: TcxLookAndFeel read FReminderWindowLookAndFeel write SetReminderWindowLookAndFeel; property ShowResourcesInReminderWindow: Boolean read FShowResourcesInReminderWindow write SetShowResourcesInReminderWindow default True; property UseReminderWindow: Boolean read FUseReminderWindow write FUseReminderWindow default True; // events property OnAlertReminder: TcxSchedulerReminderEvent read FOnAlertReminder write FOnAlertReminder; property OnDismissReminder: TcxSchedulerReminderEvent read FOnDismissReminder write FOnDismissReminder; property OnOpenEvent: TcxSchedulerReminderOpenEvent read FOnOpenEvent write FOnOpenEvent; property OnSnoozeReminder: TcxSchedulerSnoozeReminderEvent read FOnSnoozeReminder write FOnSnoozeReminder; property OnHideReminderWindow: TcxSchedulerRemindersEvent read FOnHideReminderWindow write FOnHideReminderWindow; property OnShowReminderWindow: TcxSchedulerRemindersEvent read FOnShowReminderWindow write FOnShowReminderWindow; property OnGetEventDueTimeText: TcxSchedulerGetEventDueTimeTextEvent read FOnGetEventDueTimeText write FOnGetEventDueTimeText; property OnGetReminderWindowCaption: TcxSchedulerGetReminderWindowCaption read FOnGetReminderWindowCaption write FOnGetReminderWindowCaption; end; procedure cxCheckDaysList(AList: TList; var AStartDay, AFinishDay: Integer); function cxGetRecurrenceDescriptionString(ARecurrenceInfo: TcxSchedulerEventRecurrenceInfo; AFullDescription: Boolean = False): string; function cxRecurrenceInfoDataToString(const AData: TcxSchedulerEventRecurrenceInfoData): AnsiString; function cxStringToRecurrenceInfoData(const S: AnsiString): TcxSchedulerEventRecurrenceInfoData; function cxMinutesToDueTimeInfo(AMinutes: Integer): TcxSchedulerReminderDueTimeInfo; function cxDueTimeInfoToText(const AInfo: TcxSchedulerReminderDueTimeInfo): string; function cxCompareSchedulerControlEvents( AEvent1, AEvent2: TcxSchedulerControlEvent): Integer; function cxFieldValueToVariant(const AValue: Variant): Variant; function cxVariantToFieldValue(const AValue: Variant; ABLOBFormat: Boolean = False): Variant; function cxReminderResourcesDataToFieldValue(const AValue: TcxSchedulerReminderResourcesData): Variant; function cxFieldValueToReminderResourcesData(const AValue: Variant): TcxSchedulerReminderResourcesData; function cxTaskLinksToFieldValue(ALinks: TcxSchedulerEventLinks): Variant; procedure cxFieldValueToTaskLinks(const AValue: Variant; ALinks: TcxSchedulerEventLinks); function GetStreamVersion(const AStream: TStream; var AFieldCount: Integer; ACustomFieldCount: Integer = 0): Double; const cxGetRecurrenceDescriptionStringProc: TcxGetRecurrenceDescriptionStringProc = cxGetRecurrenceDescriptionString; cxDueTimeInfoToTextProc: TcxDueTimeInfoToTextProc = cxDueTimeInfoToText; cxSchedulerEventConflictsInfoClass: TcxSchedulerEventConflictsInfoClass = TcxSchedulerEventConflictsInfo; cxMaxCheckedDuration: Integer = 30;// div 2; todo: cxOriginalEventStates: array[Boolean] of Byte = (tlsBusy, tlsFree); implementation uses cxSchedulerStrs, cxSchedulerDialogs, cxSchedulerReminderWindow, Messages; type TFlashWindowExProc = function (var pfwi: FLASHWINFO): BOOL; stdcall; PRestoringItem = ^TRestoringItem; TRestoringItem = record Item: TcxSchedulerStorageResourceItem; Index: Integer; Visible: Boolean; WorkDays: TDays; WorkFinish: TTime; WorkStart: TTime; end; const DefInfoData: TcxSchedulerEventRecurrenceInfoData = (Count: 10; DayNumber: 1; DayType: cxdtDay; Finish: -1; OccurDays: []; Periodicity: 1; Recurrence: cxreDaily; Start: 0; YearPeriodicity: 1); PatternValidStatus: array[Boolean] of TcxRecurrenceValidStatus = (rvsInvalidPattern, rvsValid); FlashWindowExProc: TFlashWindowExProc = nil; scxSchedulerSignature = 'dxScheduler'; cxSchedulerStreamVersion: Double = 3.0; cxReminderResourcesDataVersion = 3; function cxSchedulerStorageFieldsCompare(AItem1, AItem2: TcxCustomSchedulerStorageField): Integer; begin Result := AItem1.FIndex - AItem2.FIndex; end; function WorkDaysToInteger(ADay: TDays): Integer; var AIndex: TDay; begin Result := 0; for AIndex := Low(TDay) to High(TDay) do if AIndex in ADay then Result := Result or (1 shl Integer(AIndex)); end; function IntegerToWorkDays(AValue: Integer): TDays; var AIndex: TDay; begin Result := []; for AIndex := Low(TDay) to High(TDay) do if (AValue shr Integer(AIndex)) and 1 <> 0 then Result := Result + [AIndex] end; function VarEqualsSoftEx(const V1, V2: Variant): Boolean; begin Result := not VarIsEmpty(V1) and not VarIsEmpty(V2) and (VarEquals(V1, V2){ or VarIsNull(V1) or VarIsNull(V2)}); end; function VarIsEmptyEx(const V: Variant): Boolean; begin Result := VarIsEmpty(V) or VarIsNull(V) or (VarIsStr(V) and (V = '')) end; function cxCompareEventsByID(AEvent1, AEvent2: TcxSchedulerEvent): Integer; begin Result := VarCompare(AEvent1.FSavedID, AEvent2.FSavedID); end; function cxIntSortProc(P1, P2: Pointer): Integer; begin Result := Integer(P1) - Integer(P2); end; function cxCompareSelectionKeys(AItem1, AItem2: TcxSchedulerControlEventID): Integer; begin Result := VarCompare(AItem1.ID, AItem2.ID); if Result = 0 then Result := VarCompare(AItem1.ParentID, AItem2.ParentID); if Result = 0 then Result := AItem1.RecurrenceIndex - AItem2.RecurrenceIndex; end; procedure cxCheckDaysList(AList: TList; var AStartDay, AFinishDay: Integer); begin AList.Sort(cxIntSortProc); AStartDay := Integer(AList[0]); AFinishDay := Integer(AList[AList.Count - 1]); end; function cxGetRecurrenceDescriptionString( ARecurrenceInfo: TcxSchedulerEventRecurrenceInfo; AFullDescription: Boolean = False): string; const Weeks: array[1..5] of string = ('first', 'second', 'third', 'fourth', 'last'); Days: array[cxdtEveryDay..cxdtWeekEndDay] of string = ('day', 'weekday', 'weekend day'); EveryDays: array[Boolean] of string = ('every %d days', 'every day'); EveryMonths1: array[Boolean] of string = ('day %d of every %d months', 'day %d of every month'); EveryMonths2: array[Boolean] of string = ('the %s %s of every %d months', 'the %s %s of every month'); procedure GetDateParts(out ADayStr, AWeekStr: string); begin with ARecurrenceInfo do begin if DayNumber in [1..5] then AWeekStr := Weeks[DayNumber] else AWeekStr := ''; if DayType in [cxdtEveryDay..cxdtWeekEndDay] then ADayStr := Days[DayType] else ADayStr := LongDayNames[Ord(DayType) - Ord(cxdtSunday) + 1]; end; end; function OccurDaysToString: string; var ADay: TDay; ACount, ASaveCount: Integer; begin Result := ''; ACount := 0; for ADay := Low(TDay) to High(TDay) do if ADay in ARecurrenceInfo.OccurDays then Inc(ACount); ASaveCount := ACount; for ADay := Low(TDay) to High(TDay) do if ADay in ARecurrenceInfo.OccurDays then if ASaveCount = 1 then begin Result := LongDayNames[Ord(ADay) + 1]; Exit; end else begin Dec(ACount); if ACount > 1 then Result := Result + LongDayNames[Ord(ADay) + 1] + ', ' else if ACount = 1 then Result := Result + LongDayNames[Ord(ADay) + 1] + ' ' else Result := Result + 'and ' + LongDayNames[Ord(ADay) + 1]; end; end; function GetTimeBounds(APattern: TcxSchedulerEvent): string; begin if APattern.AllDayEvent and (APattern.Duration = 1) then Exit; Result := ' from ' + FormatDateTime('t', APattern.Start); if APattern.Duration < 1 then Result := Result + ' to ' + FormatDateTime('t', APattern.Finish) else Result := Result + ' for ' + cxMinutesToTextProc(Round(APattern.Duration / MinuteToTime)); end; function GetDateBounds(APattern: TcxSchedulerEvent): string; begin Result := ' effective ' + FormatDateTime('ddddd', ARecurrenceInfo.Start); if ARecurrenceInfo.Count >= 0 then Result := Result + ' until ' + FormatDateTime('ddddd', ARecurrenceInfo.GetEndDate); end; var ADayStr, AWeekStr, AMonthStr: string; APattern: TcxSchedulerEvent; begin Result := ''; if not Assigned(ARecurrenceInfo) or not ARecurrenceInfo.Event.IsRecurring then Exit; with ARecurrenceInfo do begin case Recurrence of cxreDaily: if DayType = cxdtWeekDay then Result := 'every weekday' else Result := Format(EveryDays[Periodicity = 1], [Periodicity]); cxreWeekly: if Periodicity = 1 then Result := 'every ' + OccurDaysToString else Result := Format('every %d weeks on %s', [Periodicity, OccurDaysToString]); cxreMonthly: if DayType = cxdtDay then Result := Format(EveryMonths1[Periodicity = 1], [DayNumber, Periodicity]) else begin GetDateParts(ADayStr, AWeekStr); Result := Format(EveryMonths2[Periodicity = 1], [AWeekStr, ADayStr, Periodicity]); end; cxreYearly: begin if Periodicity in [1..12] then AMonthStr := LongMonthNames[Periodicity] else AMonthStr := ''; if DayType = cxdtDay then Result := Format('every %s %d', [AMonthStr, DayNumber]) else begin GetDateParts(ADayStr, AWeekStr); Result := Format('the %s %s of %s', [AWeekStr, ADayStr, AMonthStr]); end; end; end; if Event.EventType = etPattern then APattern := Event else begin APattern := Event.Pattern; if APattern = nil then APattern := Event; end; if AFullDescription then Result := 'Occurs ' + Result + GetDateBounds(APattern) + GetTimeBounds(APattern) + '.' else Result := Result + GetTimeBounds(APattern); end; end; function cxRecurrenceInfoDataToString(const AData: TcxSchedulerEventRecurrenceInfoData): AnsiString; begin SetLength(Result, SizeOf(AData)); Move(AData, Result[1], SizeOf(AData)); end; function cxStringToRecurrenceInfoData(const S: AnsiString): TcxSchedulerEventRecurrenceInfoData; begin if Length(S) = SizeOf(TcxSchedulerEventRecurrenceInfoData) then Move(S[1], Result, SizeOf(TcxSchedulerEventRecurrenceInfoData)) else Result := DefInfoData; end; function cxMinutesToDueTimeInfo(AMinutes: Integer): TcxSchedulerReminderDueTimeInfo; const MinsPerWeek = MinsPerDay * DaysPerWeek; begin with Result do begin if AMinutes = 0 then begin DueKind := dtkNow; Minutes := 0; Element := dteMinute; ElementValue := 0; Exit; end; if AMinutes < 0 then DueKind := dtkOverdue else DueKind := dtkActual; AMinutes := Abs(AMinutes); Minutes := AMinutes; case AMinutes of 1..MinsPerHour - 1: begin Element := dteMinute; ElementValue := AMinutes; end; MinsPerHour..MinsPerDay - 1: begin Element := dteHour; ElementValue := AMinutes div MinsPerHour; end; MinsPerDay..MinsPerWeek - 1: begin Element := dteDay; ElementValue := AMinutes div MinsPerDay; end else begin Element := dteWeek; ElementValue := AMinutes div MinsPerWeek; end end; end; end; function cxDueTimeInfoToText(const AInfo: TcxSchedulerReminderDueTimeInfo): string; const PluralPostfix: array[Boolean] of string = ('', 's'); ElementNames: array[TcxSchedulerReminderDueTimeElement] of string = ('minute', 'hour', 'day', 'week'); DueInFormatTexts: array[Boolean] of string = ('%d %s%s', '%d %s%s overdue'); begin with AInfo do begin if DueKind = dtkNow then Result := 'Now' else Result := Format(DueInFormatTexts[DueKind = dtkOverdue], [ElementValue, ElementNames[Element], PluralPostfix[ElementValue > 1]]); end; end; function cxCompareSchedulerControlEvents( AEvent1, AEvent2: TcxSchedulerControlEvent): Integer; var AAllDay1, AAllDay2: Boolean; begin AAllDay1 := AEvent1.AllDayEvent or (AEvent1.Duration >= 1); AAllDay2 := AEvent2.AllDayEvent or (AEvent2.Duration >= 1); Result := Byte(AAllDay2) - Byte(AAllDay1); if Result <> 0 then Exit; if AEvent1.Start < AEvent2.Start then Result := -1 else if AEvent1.Start > AEvent2.Start then Result := 1 else if AEvent1.Finish > AEvent2.Finish then Result := -1 else if AEvent1.Finish < AEvent2.Finish then Result := 1 else if AEvent1.RecordIndex < AEvent2.RecordIndex then Result := -1 else if AEvent1.RecordIndex > AEvent2.RecordIndex then Result := 1 else Result := 0; end; function cxFindEvent(AList: TList; const ID: Variant; var AEvent: TcxSchedulerEvent): Boolean; var L, H, I, C: Integer; begin Result := False; L := 0; H := AList.Count - 1; while L <= H do begin I := (L + H) shr 1; AEvent := TcxSchedulerEvent(AList.List^[I]); C := VarCompare(AEvent.FSavedID, ID); if C < 0 then L := I + 1 else begin H := I - 1; if C = 0 then begin Result := True; AList.Delete(I); Break; end; end; end; end; { TcxSchedulerStorageDataController } function TcxSchedulerStorageDataController.GetItem(Index: Integer): TObject; begin Result := Storage.FFields.List^[Index]; end; function TcxSchedulerStorageDataController.GetItemValueSource( AItemIndex: Integer): TcxDataEditValueSource; begin Result := evsValue; end; function TcxSchedulerStorageDataController.GetItemID(AItem: TObject): Integer; begin if AItem is TcxCustomSchedulerStorageField then Result := TcxCustomSchedulerStorageField(AItem).FIndex else Result := -1; end; procedure TcxSchedulerStorageDataController.UpdateData; begin Storage.UpdateData; end; procedure TcxSchedulerStorageDataController.UpdateItemIndexes; begin Storage.UpdateItemIndexes; inherited UpdateItemIndexes; end; procedure TcxSchedulerStorageDataController.UpdateControl( AInfo: TcxUpdateControlInfo); begin Storage.UpdateControl(AInfo); end; function TcxSchedulerStorageDataController.UseRecordID: Boolean; begin Result := True; end; function TcxSchedulerStorageDataController.GetStorage: TcxCustomSchedulerStorage; begin Result := TcxCustomSchedulerStorage(GetOwner) end; { TcxCustomSchedulerStorageField } constructor TcxCustomSchedulerStorageField.Create(Collection: TCollection); begin inherited Create(Collection); Storage.ItemAdded(Self); ValueTypeClass := TcxStringValueType; end; destructor TcxCustomSchedulerStorageField.Destroy; var AStorage: TcxCustomSchedulerStorage; begin AStorage := Storage; Collection := nil; AStorage.ItemRemoved(Self); inherited Destroy; end; procedure TcxCustomSchedulerStorageField.Assign(Source: TPersistent); begin if Source is TcxCustomSchedulerStorageField then ValueTypeClass := TcxCustomSchedulerStorageField(Source).ValueTypeClass else inherited Assign(Source); end; function TcxCustomSchedulerStorageField.GetDisplayName: string; begin Result := FName; if Result = '' then Result := inherited GetDisplayName; end; function TcxCustomSchedulerStorageField.GetIsActive: Boolean; begin Result := True; end; function TcxCustomSchedulerStorageField.GetIsBlob: Boolean; begin Result := False; end; function TcxCustomSchedulerStorageField.IsValueTypeStored: Boolean; begin Result := ValueTypeClass <> TcxStringValueType; end; function TcxCustomSchedulerStorageField.GetDataController: TcxCustomDataController; begin Result := Storage.DataController; end; function TcxCustomSchedulerStorageField.GetStorage: TcxCustomSchedulerStorage; begin Result := TcxCustomSchedulerStorageFields(Collection).Storage; end; function TcxCustomSchedulerStorageField.GetValue( AIndex: Integer): Variant; begin Result := Storage.Values[AIndex, FIndex]; end; function TcxCustomSchedulerStorageField.GetValueCount: Integer; begin Result := Storage.EventCount; end; function TcxCustomSchedulerStorageField.GetValueType: string; begin if ValueTypeClass = nil then Result := '' else Result := ValueTypeClass.Caption; end; function TcxCustomSchedulerStorageField.GetValueTypeClass: TcxValueTypeClass; begin Result := Storage.DataController.GetItemValueTypeClass(Index); end; procedure TcxCustomSchedulerStorageField.SetName( const AValue: string); begin if FName <> AValue then begin FName := AValue; Changed(True); end; end; procedure TcxCustomSchedulerStorageField.SetValue( AIndex: Integer; const AValue: Variant); begin Storage.Values[AIndex, FIndex] := AValue; end; procedure TcxCustomSchedulerStorageField.SetValueType( const AValue: string); begin if ValueType <> AValue then ValueTypeClass := cxValueTypeClassList.ItemByCaption(AValue); end; procedure TcxCustomSchedulerStorageField.SetValueTypeClass( AValue: TcxValueTypeClass); begin Storage.DataController.ChangeValueTypeClass(Index, AValue); end; { TcxSchedulerStorageField } procedure TcxSchedulerStorageField.Assign(Source: TPersistent); begin inherited Assign(Source); if Source is TcxSchedulerStorageField then Name := TcxSchedulerStorageField(Source).Name; end; { TcxCustomSchedulerStorageFields } function TcxCustomSchedulerStorageFields.FindFieldByName(const AName: string): TcxCustomSchedulerStorageField; var I: Integer; begin for I := 0 to Count - 1 do begin Result := TcxCustomSchedulerStorageField(inherited Items[I]); if AnsiSameText(AName, Result.Name) then Exit; end; Result := nil; end; function TcxCustomSchedulerStorageFields.GetOwner: TPersistent; begin Result := FOwner; end; procedure TcxCustomSchedulerStorageFields.Update(Item: TCollectionItem); begin inherited Update(Item); Storage.Changed; end; function TcxCustomSchedulerStorageFields.GetStorage: TcxCustomSchedulerStorage; begin Result := TcxCustomSchedulerStorage(GetOwner); end; { TcxSchedulerStorageFields } function TcxSchedulerStorageFields.Add: TcxSchedulerStorageField; begin Result := TcxSchedulerStorageField(inherited Add); end; function TcxSchedulerStorageFields.ItemByName( const AName: string): TcxSchedulerStorageField; begin Result := TcxSchedulerStorageField(FindFieldByName(AName)); end; function TcxSchedulerStorageFields.GetItem( AIndex: Integer): TcxSchedulerStorageField; begin Result := TcxSchedulerStorageField(inherited Items[AIndex]); end; procedure TcxSchedulerStorageFields.SetItem( AIndex: Integer; AValue: TcxSchedulerStorageField); begin inherited Items[AIndex].Assign(AValue); end; { TcxSchedulerEventRecurrenceInfo } constructor TcxSchedulerEventRecurrenceInfo.Create( AOwner: TcxSchedulerEvent); begin FOwner := AOwner; end; procedure TcxSchedulerEventRecurrenceInfo.Assign(Source: TPersistent); var S: AnsiString; begin if Source is TcxSchedulerEventRecurrenceInfo then begin if TcxSchedulerEventRecurrenceInfo(Source).GetValue(S) then SetValue(S) else SetValue(''); end else inherited Assign(Source); end; function TcxSchedulerEventRecurrenceInfo.GetEndDate: TDateTime; begin if Count > 0 then with TcxSchedulerOccurrenceCalculator.Create(FOwner, 0, cxMaxDate) do try CalcOccurrence(Self.Count); Result := DateOf(OccurrenceStart); finally Free; end else if Count = 0 then Result := Finish else Result := NullDate; end; function TcxSchedulerEventRecurrenceInfo.GetValidStatus: TcxRecurrenceValidStatus; function IntersectOccurrences(APrevFinish, AStart: TDateTime): Boolean; begin if FOwner.AllDayEvent then Result := DateOf(AStart) < DateOf(APrevFinish) else Result := AStart < APrevFinish; end; var AEdge, AFinish: TDateTime; begin if not FOwner.IsRecurring then begin Result := rvsValid; Exit; end; case Recurrence of cxreDaily: Result := GetDailyPatternStatus; cxreWeekly: Result := GetWeeklyPatternStatus; cxreMonthly: Result := GetMonthlyPatternStatus; else Result := GetYearlyPatternStatus; end; if Result = rvsInvalidPattern then Exit; with TcxSchedulerOccurrenceCalculator.Create(FOwner, FOwner.RecurrenceInfo.Start, cxMaxDate) do try // find a first occurrence if GetNextOccurrence then begin if FOwner.RecurrenceInfo.Count = 1 then Exit; AFinish := OccurrenceFinish; AEdge := OccurrenceStart + 14; //two weeks repeat if not GetNextOccurrence then Exit; if IntersectOccurrences(AFinish, OccurrenceStart) then begin Result := rvsInvalidDuration; Exit; end; AFinish := OccurrenceFinish; until not (Recurrence in [cxreDaily, cxreWeekly]) or (OccurrenceStart > AEdge); end else Result := rvsInvalidDuration; finally Free; end; end; procedure TcxSchedulerEventRecurrenceInfo.Validate; begin with TcxSchedulerOccurrenceCalculator.Create(FOwner, FOwner.RecurrenceInfo.Start, cxMaxDate) do try if GetNextOccurrence then FOwner.MoveTo(OccurrenceStart) else cxSchedulerError(cxGetResourceString(@scxWrongPattern)); finally Free; end; end; procedure TcxSchedulerEventRecurrenceInfo.AssignDefaultValues; begin Count := -1; DayNumber := 1; DayType := cxdtDay; Finish := -1; OccurDays := [TDay(DayOfWeek(Event.Start) - 1)]; Periodicity := 1; Recurrence := cxreWeekly; YearPeriodicity := 1; end; function TcxSchedulerEventRecurrenceInfo.GetData: TcxSchedulerEventRecurrenceInfoData; var S: AnsiString; begin if GetValue(S) then Result := cxStringToRecurrenceInfoData(S) else Result := DefInfoData; end; function TcxSchedulerEventRecurrenceInfo.GetOccurrences( AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime): Boolean; var ActualStart: TDateTime; begin ActualStart := AStart; if not (FOwner.EventType in [etPattern, etNone]) and (FOwner.Pattern <> nil) then ActualStart := FOwner.Pattern.Start; AList.Init(Trunc(ActualStart), AFinish, Storage); if (FOwner.EventType = etPattern) or FOwner.SkipExceptions then begin AList.FReminderEventsOnly := False; AList.CheckEvent(FOwner, Null); AList.Changed; end; Result := AList.Count > 0; end; function TcxSchedulerEventRecurrenceInfo.GetOwner: TPersistent; begin Result := FOwner; end; function TcxSchedulerEventRecurrenceInfo.GetValue( var AValue: AnsiString): Boolean; begin Result := FOwner.GetRecurrenceInfoValue(AValue); end; procedure TcxSchedulerEventRecurrenceInfo.SetDataItem( AOffset: Pointer; ASize: Integer; const AValue); var S: AnsiString; begin Dec(Integer(AOffset), Integer(@DefInfoData)); if not GetValue(S) then S := cxRecurrenceInfoDataToString(DefInfoData); Move(AValue, S[1 + Integer(AOffset)], ASize); SetValue(S); end; procedure TcxSchedulerEventRecurrenceInfo.SetValue( const AValue: AnsiString); begin FOwner.SetRecurrenceInfoValue(AValue); end; function TcxSchedulerEventRecurrenceInfo.GetDailyPatternStatus: TcxRecurrenceValidStatus; begin if DayType = cxdtEveryDay then Result := PatternValidStatus[Periodicity > 0] else Result := PatternValidStatus[(DayType = cxdtWeekDay) and (Periodicity = 1)] end; function TcxSchedulerEventRecurrenceInfo.GetMonthlyPatternStatus: TcxRecurrenceValidStatus; begin if DayType = cxdtDay then begin Result := PatternValidStatus[(Periodicity > 0) and (DayNumber in [1..31])]; if (Result = rvsValid) and (DayNumber in [29..31]) then Result := rvsReplaceOccurrenceDate; end else Result := PatternValidStatus[Periodicity > 0]; end; function TcxSchedulerEventRecurrenceInfo.GetWeeklyPatternStatus: TcxRecurrenceValidStatus; begin Result := PatternValidStatus[(Periodicity > 0) and (OccurDays <> [])] end; function TcxSchedulerEventRecurrenceInfo.GetYearlyPatternStatus: TcxRecurrenceValidStatus; begin if DayType = cxdtDay then Result := PatternValidStatus[(Periodicity in [1..12]) and (DayNumber >=1) and (DayNumber <= DaysPerMonth(2000, Periodicity))] else Result := PatternValidStatus[(Periodicity in [1..12])]; end; function TcxSchedulerEventRecurrenceInfo.GetCount: Integer; begin Result := GetData.Count; end; function TcxSchedulerEventRecurrenceInfo.GetDayNumber: Integer; begin Result := GetData.DayNumber; end; function TcxSchedulerEventRecurrenceInfo.GetDayType: TcxDayType; begin Result := GetData.DayType; end; function TcxSchedulerEventRecurrenceInfo.GetDismissDate: TDateTime; begin Result := GetData.DismissDate; end; function TcxSchedulerEventRecurrenceInfo.GetFinish: TDateTime; begin Result := GetData.Finish - FOwner.TimeBias; end; function TcxSchedulerEventRecurrenceInfo.GetIsInfinity: Boolean; begin with GetData do Result := (Count = 0) and (Finish = -1); end; function TcxSchedulerEventRecurrenceInfo.GetOccurDays: TDays; begin Result := GetData.OccurDays; end; function TcxSchedulerEventRecurrenceInfo.GetPeriodicity: Integer; begin Result := GetData.Periodicity; end; function TcxSchedulerEventRecurrenceInfo.GetRecurrence: TcxRecurrence; begin Result := GetData.Recurrence; end; function TcxSchedulerEventRecurrenceInfo.GetStart: TDateTime; begin Result := DateOf(FOwner.Start); end; function TcxSchedulerEventRecurrenceInfo.GetStorage: TcxCustomSchedulerStorage; begin Result := FOwner.Storage; end; function TcxSchedulerEventRecurrenceInfo.GetYearPeriodicity: Integer; begin Result := GetData.YearPeriodicity; end; procedure TcxSchedulerEventRecurrenceInfo.SetCount( const AValue: Integer); begin SetDataItem(@DefInfoData.Count, SizeOf(Integer), AValue);; end; procedure TcxSchedulerEventRecurrenceInfo.SetDayNumber( const AValue: Integer); begin SetDataItem(@DefInfoData.DayNumber, SizeOf(Integer), AValue);; end; procedure TcxSchedulerEventRecurrenceInfo.SetDayType( const AValue: TcxDayType); begin SetDataItem(@DefInfoData.DayType, SizeOf(TcxDayType), AValue);; end; procedure TcxSchedulerEventRecurrenceInfo.SetDismissDate( const AValue: TDateTime); var ADate: Integer; begin ADate := Trunc(AValue); SetDataItem(@DefInfoData.DismissDate, SizeOf(Integer), ADate); end; procedure TcxSchedulerEventRecurrenceInfo.SetFinish( AValue: TDateTime); begin AValue := DateTimeHelper.RoundTime(AValue) + FOwner.TimeBias; SetDataItem(@DefInfoData.Finish, SizeOf(AValue), AValue); end; procedure TcxSchedulerEventRecurrenceInfo.SetOccurDays( const AValue: TDays); begin SetDataItem(@DefInfoData.OccurDays, SizeOf(TDays), AValue);; end; procedure TcxSchedulerEventRecurrenceInfo.SetPeriodicity( const AValue: Integer); begin SetDataItem(@DefInfoData.Periodicity, SizeOf(Integer), AValue); end; procedure TcxSchedulerEventRecurrenceInfo.SetRecurrence( const AValue: TcxRecurrence); begin SetDataItem(@DefInfoData.Recurrence, SizeOf(TcxRecurrence), AValue); end; procedure TcxSchedulerEventRecurrenceInfo.SetStart( const AValue: TDateTime); begin FOwner.MoveTo(AValue); end; procedure TcxSchedulerEventRecurrenceInfo.SetYearPeriodicity( const AValue: Integer); begin SetDataItem(@DefInfoData.YearPeriodicity, SizeOf(Integer), AValue); end; { TcxSchedulerEventItemLink } constructor TcxSchedulerEventItemLink.Create(Collection: TCollection); begin inherited Create(Collection); FLinkRecurrenceIndex := -1; end; function TcxSchedulerEventItemLink.GetRelationAsText: string; begin Result := '(' + cxGetResourceString(sEventRelations[Integer(Relation)]) + ')'; end; function TcxSchedulerEventItemLink.CheckLinked( AEvent: TcxSchedulerEvent): Boolean; begin Result := AEvent = Link; end; function TcxSchedulerEventItemLink.CheckLinked( const ID: Variant; ARecurrenceIndex: Integer): Boolean; begin Result := (Link <> nil) and VarEqualsSoft(Link.ID, ID); if Result and Link.IsRecurring then Result := (ARecurrenceIndex = ARecurrenceIndex); end; function TcxSchedulerEventItemLink.GetData: Variant; begin Result := VarArrayCreate([0, 2], varVariant); Result[0] := Relation; if Link <> nil then Result[1] := Link.ID else Result[1] := Null; Result[2] := LinkRecurrenceIndex; end; procedure TcxSchedulerEventItemLink.SetData(const AData: Variant); var ACandidate: TcxSchedulerEvent; begin Relation := AData[0]; FLink := nil; if not VarIsNull(AData[1]) and (Storage <> nil) then begin ACandidate := Storage.GetEventByID(AData[1]); if (ACandidate <> nil) and Event.CanLink(ACandidate) then begin ACandidate.TaskLinkOwners.Add(Event); FLink := ACandidate; end; end; FLinkRecurrenceIndex := AData[2]; end; procedure TcxSchedulerEventItemLink.UpdateLink; begin if (Link = nil) or (Event = nil) then Exit; case Relation of trFinishToStart: if Event.Finish > Link.Start then Link.MoveTo(Event.Finish); trStartToStart: if Event.Start > Link.Start then Link.MoveTo(Event.Start); trFinishToFinish: if Event.Finish < Link.Finish then Link.MoveTo(Event.Finish - Link.Duration); trStartToFinish: if Event.Start < Link.Finish then Link.MoveTo(Event.Start - Link.Duration); end; end; function TcxSchedulerEventItemLink.GetEvent: TcxSchedulerEvent; begin Result := TcxSchedulerEventLinks(Collection).Event; end; function TcxSchedulerEventItemLink.GetStorage: TcxCustomSchedulerStorage; begin Result := Event.Storage; end; procedure TcxSchedulerEventItemLink.SetLink(AValue: TcxSchedulerEvent); begin if (FLink = AValue) or not Event.CanLink(AValue) then Exit; FLink := AValue; Changed(True); end; procedure TcxSchedulerEventItemLink.SetRelation(AValue: TcxSchedulerEventRelation); begin if AValue = Relation then Exit; FRelation := AValue; Changed(True); end; { TcxSchedulerEventLinks } function TcxSchedulerEventLinks.Add(AEvent: TcxSchedulerEvent; ARelation: TcxSchedulerEventRelation = trStartToFinish): TcxSchedulerEventItemLink; begin Result := nil; if Event.CanLink(AEvent) then begin BeginUpdate; try Result := inherited Add as TcxSchedulerEventItemLink; Result.FLink := AEvent; Result.FRelation := ARelation; finally EndUpdate; end; if AEvent.TaskLinkOwners.IndexOf(Event) = -1 then AEvent.TaskLinkOwners.Add(Event); Event.UpdateTaskLinks; end; end; function TcxSchedulerEventLinks.IsEventLinked(AEvent: TcxSchedulerEvent): Boolean; var AID: Variant; I, ARecurrenceIndex: Integer; begin Result := False; if AEvent = nil then Exit; for I := 0 to Count - 1 do begin if AEvent.RecordIndex < 0 then Result := ItemLinks[I].CheckLinked(AEvent) else begin AID := AEvent.ID; ARecurrenceIndex := AEvent.RecurrenceIndex; Result := ItemLinks[I].CheckLinked(AEvent.ID, ARecurrenceIndex); end; if Result then Break; end; end; function TcxSchedulerEventLinks.GetDisplayText: string; var I: Integer; AText: string; begin Result := ''; for I := 0 to Count - 1 do begin AText := VarToStr(ItemLinks[I].ID); if (Result <> '') and (AText <> '') then Result := Result + ListSeparator; Result := Result + AText; end; end; function TcxSchedulerEventLinks.GetOwner: TPersistent; begin Result := FEvent; end; procedure TcxSchedulerEventLinks.RemoveLink(ALink: TcxSchedulerEvent); var I: Integer; begin BeginUpdate; try for I := Count - 1 downto 0 do if ItemLinks[I].Link = ALink then ItemLinks[I].Free; finally EndUpdate; end; end; procedure TcxSchedulerEventLinks.Update(Item: TCollectionItem); begin inherited; Event.TaskLinksChanged(Self); end; function TcxSchedulerEventLinks.GetItemLink(AIndex: Integer): TcxSchedulerEventItemLink; begin Result := TcxSchedulerEventItemLink(inherited Items[AIndex]); end; procedure TcxSchedulerEventLinks.SetItemLink(AIndex: Integer; AValue: TcxSchedulerEventItemLink); begin ItemLinks[AIndex].Assign(AValue); end; function TcxSchedulerEventLinks.GetExpanded: Boolean; begin Result := Event.GetOptionsFlag and omCollapsed = 0; end; procedure TcxSchedulerEventLinks.SetExpanded(AValue: Boolean); begin if Event.SetOptionsFlag(omCollapsed, not AValue) then Event.TaskLinksChanged(Self); end; { TcxSchedulerEvent } constructor TcxSchedulerEvent.Create( AStorage: TcxCustomSchedulerStorage); begin Create(AStorage, -1); BeginEditing; AssignDefaultValues; end; constructor TcxSchedulerEvent.Create( AStorage: TcxCustomSchedulerStorage; ARecordIndex: Integer); begin FStorage := AStorage; FRecordIndex := ARecordIndex; FRecurrenceInfo := CreateRecurrenceInfo; FRecurrenceInfo.FOwner := Self; FTaskLinks := CreateTaskLinks; FTaskLinkOwners := CreateTaskLinkOwners; FPrevTaskComplete := 0; if FTaskLinks <> nil then FTaskLinks.FEvent := Self; end; destructor TcxSchedulerEvent.Destroy; begin FTaskLinks.Free; FTaskLinkOwners.Free; FStorage.DoDestroyEvent(Self); FRecurrenceInfo.Free; inherited Destroy; end; procedure TcxSchedulerEvent.Assign(Source: TPersistent); var I: Integer; begin if Source is TcxSchedulerEvent then begin BeginEditing; try FPattern := TcxSchedulerEvent(Source).FPattern; for I := 0 to Min(TcxSchedulerEvent(Source).ValueCount, ValueCount) - 1 do SetValueByIndex(I, TcxSchedulerEvent(Source).GetValueByIndex(I)); if EventType = etNone then FPattern := nil; Start := TcxSchedulerEvent(Source).Start; Finish := TcxSchedulerEvent(Source).Finish; //must be the last ReminderResourcesData := TcxSchedulerEvent(Source).ReminderResourcesData; finally FIsDataValid := False; EndEditing; end; end; end; procedure TcxSchedulerEvent.AssignAttributes( ASource: TcxSchedulerEvent; AUseSourceTime: Boolean = True); begin BeginEditing; try if AUseSourceTime then begin Start := ASource.Start; Finish := ASource.Finish; end; Caption := ASource.Caption; Message := ASource.Message; State := ASource.State; LabelColor := ASource.LabelColor; ResourceID := ASource.ResourceID; finally EndEditing; end; end; procedure TcxSchedulerEvent.ShareWithResource( AResourceItem: TcxSchedulerStorageResourceItem); begin if (AResourceItem = nil) then Exit; ShareWithResource(AResourceItem.ResourceID); end; procedure TcxSchedulerEvent.ShareWithResource(AResourceID: Variant); var ASharedResources: Variant; begin if IsSharedWithResource(AResourceID) or VarIsNull(AResourceID) or VarIsEmpty(AResourceID) then Exit; ASharedResources := ResourceID; if not VarIsArray(ASharedResources) then ASharedResources := VarListArrayCreate(ASharedResources); if VarIsNull(ASharedResources[0]) then ASharedResources[0] := AResourceID else VarListArrayAddValue(ASharedResources, AResourceID); ResourceID := ASharedResources; end; function TcxSchedulerEvent.IsSharedWithResource( AResourceItem: TcxSchedulerStorageResourceItem): Boolean; begin Result := False; if VarIsNull(ResourceID) or (AResourceItem = nil) then Exit; Result := IsSharedWithResource(AResourceItem.ResourceID); end; function TcxSchedulerEvent.IsSharedWithResource(AResourceID: Variant): Boolean; var I: Integer; AResources: Variant; function CheckSimpleID(AResID: Variant): Boolean; var I: Integer; begin if not VarIsArray(AResourceID) then Result := VarEqualsSoftEx(AResID, AResourceID) else begin Result := False; for I := VarArrayLowBound(AResourceID, 1) to VarArrayHighBound(AResourceID, 1) do if VarEqualsSoftEx(AResID, AResourceID[I]) then begin Result := True; Break; end; end; end; begin Result := False; AResources := ResourceID; if not VarIsArray(AResources) then Result := CheckSimpleID(AResources) else for I := VarArrayLowBound(AResources, 1) to VarArrayHighBound(AResources, 1) do begin Result := CheckSimpleID(AResources[I]); if Result then Break; end; end; procedure TcxSchedulerEvent.UnshareWithResource( AResourceItem: TcxSchedulerStorageResourceItem); begin if not IsSharedWithResource(AResourceItem) then Exit; UnshareWithResource(AResourceItem.ResourceID); end; procedure TcxSchedulerEvent.UnshareWithResource(AResourceID: Variant); var I, C: Integer; ASharedResources: Variant; ANewSharedResources: Variant; begin if not VarIsArray(ResourceID) and VarEquals(ResourceID, AResourceID) then begin ResourceID := Null; Exit; end else begin ASharedResources := ResourceID; C := VarArrayHighBound(ResourceID, 1) - VarArrayLowBound(ResourceID, 1); if C = 0 then ANewSharedResources := Null else begin ANewSharedResources := VarArrayCreate([0, C - 1], varVariant); C := 0; for I := VarArrayLowBound(ResourceID, 1) to VarArrayHighBound(ResourceID, 1) do if not VarEquals(AResourceID, ASharedResources[I]) then begin ANewSharedResources[C] := ASharedResources[I]; Inc(C); end; end; ResourceID := ANewSharedResources; end; end; procedure TcxSchedulerEvent.ReplaceResourceID(AResourceID: Variant); begin if Shared then ShareWithResource(AResourceID) else ResourceID := AResourceID; end; procedure TcxSchedulerEvent.BeginEditing; var I: Integer; begin if not IsEditing then begin SetLength(FEditValues, ValueCount); for I := 0 to ValueCount - 1 do FEditValues[I] := GetValueByIndex(I); end; Inc(FEditCount); end; procedure TcxSchedulerEvent.Cancel; begin IsModified := False; if FEditCount = 1 then begin if FEditCount = 0 then SetLength(FEditValues, 0); Storage.CancelEvent(Self); end else Dec(FEditCount); end; procedure TcxSchedulerEvent.EndEditing; begin if FEditCount = 0 then Exit; try if (FEditCount = 1) and not IsNewEvent then PostEditingData; finally Dec(FEditCount); if FEditCount = 0 then SetLength(FEditValues, 0); end; end; procedure TcxSchedulerEvent.Delete; begin if Self = nil then Exit; case EventType of etCustom: EventType := etException; etOccurrence: begin Storage.BeginUpdate; try with Storage.CreateEvent do begin Assign(Self); ParentID := Self.ID; EventType := etException; end; finally Storage.EndUpdate; end; end; else Storage.DoDeleteEvent(FIndex); end; end; procedure TcxSchedulerEvent.DeleteExceptions; var ALink: TcxSchedulerEvent; begin if not HasExceptions then Exit; Storage.BeginUpdate; try while FLink <> nil do begin ALink := FLink.FLink; Storage.DoDeleteEvent(FLink.FIndex); FLink := ALink; end; finally Storage.EndUpdate; end; end; function TcxSchedulerEvent.HasExceptions: Boolean; begin Result := (EventType = etPattern) and (Link <> nil); end; function TcxSchedulerEvent.HasReminderForResourceID(const AResourceID: Variant): Boolean; var I: Integer; AReminderResources: TcxSchedulerReminderResources; begin AReminderResources := nil; //to avoid Delphi6 warning Result := Reminder; if Result and not VarIsNull(ResourceID) then begin if Shared then begin Result := False; AReminderResources := ReminderResourcesData.Resources; for I := Low(AReminderResources) to High(AReminderResources) do if VarEquals(AReminderResources[I].ResourceID, AResourceID) then begin Result := True; Break; end; end else Result := VarEquals(ResourceID, AResourceID); end; end; function TcxSchedulerEvent.Conflicts(AExceptEventsWithoutResources: Boolean): Boolean; var AFinish: TDateTime; begin Result := False; if IsFreeState then Exit; AFinish := Finish; if (EventType = etPattern) or SkipExceptions then AFinish := Finish + cxMaxCheckedDuration; with cxSchedulerEventConflictsInfoClass.Create(Self, AExceptEventsWithoutResources, Start, AFinish) do try Result := HasConflicts; finally Free; end; end; function TcxSchedulerEvent.CreateConflictsInfo( AExceptEventsWithoutResources: Boolean): TcxSchedulerEventConflictsInfo; begin Result := cxSchedulerEventConflictsInfoClass.Create(Self, AExceptEventsWithoutResources); end; function TcxSchedulerEvent.GetCustomFieldValueByIndex(AIndex: Integer): Variant; begin Result := GetValueDef(TcxCustomSchedulerStorageField(Storage.CustomFields.Items[AIndex]), Null); end; function TcxSchedulerEvent.GetCustomFieldValueByName( const AName: String): Variant; var AField: TcxCustomSchedulerStorageField; begin AField := Storage.CustomFields.FindFieldByName(AName); if AField <> nil then Result := GetValueDef(AField, Null) else cxSchedulerError(scxInvalidFieldName); end; function TcxSchedulerEvent.GetCustomFieldValue( ACustomField: TcxCustomSchedulerStorageField): Variant; begin if (ACustomField <> nil) and (ACustomField.Storage = Storage) then Result := GetValueByIndex(ACustomField.Index) else cxSchedulerError(scxInvalidCustomField); end; procedure TcxSchedulerEvent.SetCustomFieldValueByIndex(AIndex: Integer; const AValue: Variant); begin SetValueByIndex(TcxCustomSchedulerStorageField(Storage.CustomFields.Items[AIndex]).Index, AValue); end; procedure TcxSchedulerEvent.SetCustomFieldValueByName(const AName: string; const AValue: Variant); var AField: TcxCustomSchedulerStorageField; begin AField := Storage.CustomFields.FindFieldByName(AName); if AField <> nil then SetValueByIndex(AField.Index, AValue) else cxSchedulerError(scxInvalidFieldName); end; procedure TcxSchedulerEvent.SetCustomFieldValue( ACustomField: TcxCustomSchedulerStorageField; const AValue: Variant); begin if (ACustomField <> nil) and (ACustomField.Storage = Storage) then SetValueByIndex(ACustomField.Index, AValue) else cxSchedulerError(scxInvalidCustomField); end; function TcxSchedulerEvent.GetOccurrence(ADate: TDateTime): TcxSchedulerEvent; var ACalculator: TcxSchedulerOccurrenceCalculator; ALink: TcxSchedulerEvent; AOriginalDate: TDateTime; begin Result := nil; if EventType <> etPattern then Exit; ADate := DateOf(ADate); ALink := FLink; while ALink <> nil do begin AOriginalDate := DateOf(ALink.GetOriginalDate); if AOriginalDate = ADate then begin Result := ALink; Exit; end else if AOriginalDate > ADate then break else ALink := ALink.FLink; end; ACalculator := TcxSchedulerOccurrenceCalculator.Create(Self, Start, ADate + 1); try while ACalculator.GetNextOccurrence do begin AOriginalDate := DateOf(ACalculator.OccurrenceStart); if AOriginalDate > ADate then break else if AOriginalDate = ADate then begin Result := Storage.createEvent; Result.Assign(Self); Result.Start := ACalculator.OccurrenceStart; Result.Finish := ACalculator.OccurrenceFinish; Result.RecurrenceIndex := ACalculator.Index; Result.EventType := etOccurrence; Result.ParentID := ID; Result.FPattern := Self; break; end; end; finally ACalculator.Free; end; end; function TcxSchedulerEvent.GetOriginalDate: TDateTime; begin if EventType in [etCustom, etException] then begin with TcxSchedulerOccurrenceCalculator.Create(Pattern, 0, cxMaxDate) do try CalcOccurrence(Self.RecurrenceIndex + 1); Result := OccurrenceStart; finally Free; end; end else Result := Start; end; function TcxSchedulerEvent.GetResourceItem: TcxSchedulerStorageResourceItem; var I: Integer; begin for I := 0 to Storage.ResourceCount - 1 do begin Result := Storage.Resources.ResourceItems[I]; if IsResourceEvent(Result, False) then Exit; end; Result := nil; end; function TcxSchedulerEvent.GetRecurrenceChain: TcxSchedulerEventList; var ALink: TcxSchedulerEvent; begin Result := TcxSchedulerEventList.Create; if EventType = etPattern then begin ALink := Link; while ALink <> nil do begin Result.Add(ALink); ALink := ALink.Link; end; end; end; function TcxSchedulerEvent.GetTaskLinkOwnerRelation(ATaskLinkOwner: TcxSchedulerEvent; var ARelation: TcxSchedulerEventRelation): Boolean; var I: Integer; begin Result := False; if (ATaskLinkOwner = nil) or (ATaskLinkOwner.TaskLinks = nil) then Exit; for I := 0 to ATaskLinkOwner.TaskLinks.Count - 1 do if ATaskLinkOwner.TaskLinks.ItemLinks[I].Link = Self then begin Result := True; ARelation := ATaskLinkOwner.TaskLinks.ItemLinks[I].Relation; Break; end; end; procedure TcxSchedulerEvent.GetValidTaskTimeRange(var AStart, AFinish: TDateTime); var I: Integer; ARelation: TcxSchedulerEventRelation; begin AStart := MinDateTime; AFinish := MaxDateTime; if (TaskStatus = tsComplete) or (TaskLinkOwners = nil) then Exit; for I := 0 to TaskLinkOwners.Count - 1 do if GetTaskLinkOwnerRelation(TaskLinkOwners[I], ARelation) then GetValidTaskTimeRangeByRelation(ARelation, TaskLinkOwners[I], AStart, AFinish); end; procedure TcxSchedulerEvent.GetValidTaskTimeRangeByRelation(const ARelation: TcxSchedulerEventRelation; AEvent: TcxSchedulerEvent; var AStart, AFinish: TDateTime); begin if AEvent = nil then Exit; case ARelation of trFinishToStart: AStart := Max(AStart, AEvent.Finish - GetTaskCompleteDuration); trStartToStart: AStart := Max(AStart, AEvent.Start - GetTaskCompleteDuration); trFinishToFinish: AFinish := Min(AFinish, AEvent.Finish); trStartToFinish: AFinish := Min(AFinish, AEvent.Start); end; end; function TcxSchedulerEvent.IsDayEvent(ADate: Integer): Boolean; begin Result := False; if not FIsDataValid then UpdateTemporaryData; if FFinish > ADate then Result := (FStartDate <= ADate) else if FFinish = ADate then Result := FStartDate = ADate; end; function TcxSchedulerEvent.IsDayEvent(const ADate: TDateTime): Boolean; begin Result := IsDayEvent(Integer(Trunc(ADate))); end; function TcxSchedulerEvent.IsRecurring: Boolean; begin Result := EventType in [etPattern..etCustom]; end; function TcxSchedulerEvent.IsResourceEvent( AResource: TcxSchedulerStorageResourceItem; AllowUnassigned: Boolean): Boolean; begin Result := (AResource = nil) or (AllowUnassigned and VarIsNull(ResourceID)) or IsSharedWithResource(AResource.ResourceID); end; procedure TcxSchedulerEvent.MoveTo(const AStartTime: TDateTime); begin if not CanMoveTo(AStartTime) then Exit; InternalMoveTo(AStartTime); UpdateTaskLinks; end; procedure TcxSchedulerEvent.Post; begin if (FEditCount = 1) and IsNewEvent then FStorage.PostEvent(Self); end; procedure TcxSchedulerEvent.RemoveRecurrence; begin if EventType = etPattern then begin DeleteExceptions; EventType := etNone; end; end; procedure TcxSchedulerEvent.UpdateTaskTime; var AStart, AFinish: TDateTime; begin GetValidTaskTimeRange(AStart, AFinish); if Start < AStart then MoveTo(AStart); if Finish > AFinish then MoveTo(AFinish - Duration); end; procedure TcxSchedulerEvent.UpdateTaskLinks; var I: Integer; begin if TaskLinks = nil then Exit; for I := 0 to TaskLinks.Count - 1 do with TaskLinks.ItemLinks[I] do begin if (Link = nil) or (Link.TaskStatus = tsComplete) then Continue; Link.UpdateTaskTime; end; end; procedure TcxSchedulerEvent.AssignDefaultValues; begin AllDayEvent := False; Caption := ''; Enabled := True; EventType := etNone; LabelColor := clDefault; Location := ''; Message := ''; RecurrenceIndex := -1; Reminder := Storage.Reminders.DefaultReminder; ReminderMinutesBeforeStart := Storage.Reminders.DefaultMinutesBeforeStart; Start := Now; Finish := Start + cxDefaultEventDuration; State := tlsBusy; RecurrenceInfo.AssignDefaultValues; end; procedure TcxSchedulerEvent.CalculateActualTimeRange; var AStart, AFinish: TDateTime; ALink: TcxSchedulerEvent; begin if not Storage.ActualTimeRangeAvailable then Exit; if EventType = etPattern then begin AStart := RecurrenceInfo.Start; AFinish := RecurrenceInfo.Finish; if RecurrenceInfo.IsInfinity then AFinish := cxMaxDate else with TcxSchedulerOccurrenceCalculator.Create(Self, RecurrenceInfo.Start, cxMaxDate) do try while GetNextOccurrence do begin AStart := Min(AStart, OccurrenceStart); AFinish := Max(AFinish, OccurrenceFinish); end; finally Free; end; ALink := Link; while ALink <> nil do begin AStart := Min(AStart, ALink.Start); AFinish := Max(AFinish, ALink.Finish); ALink := ALink.Link; end; end else begin AStart := Start; AFinish := Finish; if Pattern <> nil then begin AStart := Min(AStart, Pattern.Start); AFinish := Max(AFinish, Pattern.Finish); end; end; SetActualTimeRange(AStart, AFinish); end; procedure TcxSchedulerEvent.CalculateActualTimeRangePost; begin if not Storage.ActualTimeRangeAvailable then Exit; if (EventType in [etCustom, etException]) and (Pattern <> nil) then begin Pattern.CheckRecurrenceLinkEx(Self); Pattern.CalculateActualTimeRange; end; end; function TcxSchedulerEvent.CanLink(AEvent: TcxSchedulerEvent): Boolean; function IsEventLinked(AHeaderEvent: TcxSchedulerEvent): Boolean; var I: Integer; begin Result := (AHeaderEvent = nil) or (AHeaderEvent = Self); if Result then Exit; for I := 0 to AHeaderEvent.TaskLinks.Count - 1 do begin if (AHeaderEvent.TaskLinks[I].Link = nil) then Continue; Result := Result or (Self = AHeaderEvent.TaskLinks[I].Link) or IsEventLinked(AHeaderEvent.TaskLinks[I].Link); if Result then Break; end; end; begin Result := (AEvent <> nil) and ((Pattern = nil) or (Pattern <> AEvent.Pattern)) and IsSharedWithResource(AEvent.ResourceID) and not IsEventLinked(AEvent) and (AEvent.TaskLinkOwners.IndexOf(Self) = -1); end; function TcxSchedulerEvent.CanMoveTo(ANewTime: TDateTime): Boolean; var AStartTime, AFinishTime: TDateTime; begin Result := TaskStatus = tsComplete; if not Result then begin GetValidTaskTimeRange(AStartTime, AFinishTime); Result := (AStartTime <= ANewTime) and (AFinishTime >= (ANewTime + Duration)); end; end; procedure TcxSchedulerEvent.CheckLinksOnChangeEventType(ANewEventType: TcxEventType); var I: Integer; begin if ANewEventType <> etNone then begin if FTaskLinks <> nil then FTaskLinks.Clear; if (TaskLinkOwners <> nil) then for I := TaskLinkOwners.Count - 1 downto 0 do if TaskLinkOwners[I] <> nil then TaskLinkOwners[I].RemoveTaskLink(Self); end; end; procedure TcxSchedulerEvent.CheckRecurrenceLink(AEvent: TcxSchedulerEvent); var ALink: TcxSchedulerEvent; begin if (AEvent.EventType in [etCustom, etException]) and VarEquals(ID, AEvent.ParentID) then begin AEvent.FPattern := Self; if (FLink = nil) or (FLink.RecurrenceIndex >= AEvent.RecurrenceIndex) then begin AEvent.FLink := FLink; FLink := AEvent; end else begin ALink := FLink; while ALink.FLink <> nil do ALink := ALink.FLink; AEvent.FLink := nil; ALink.FLink := AEvent; end; end; end; procedure TcxSchedulerEvent.CheckRecurrenceLinkEx(AEvent: TcxSchedulerEvent); var ALink: TcxSchedulerEvent; begin if AEvent.Link <> nil then Exit; ALink := FLink; while (ALink <> nil) and (ALink <> AEvent) do ALink := ALink.Link; if ALink = nil then begin AEvent.FLink := Link; FLink := AEvent; end; end; function TcxSchedulerEvent.CheckTimeRange( const AStartDate, AFinishDate: Integer): Boolean; begin Result := (ActualStart <= AFinishDate) and (ActualFinish >= AStartDate); end; function TcxSchedulerEvent.CreateTaskLinks: TcxSchedulerEventLinks; begin Result := TcxSchedulerEventLinks.Create(TcxSchedulerEventItemLink); end; function TcxSchedulerEvent.CreateTaskLinkOwners: TcxSchedulerEventList; begin Result := TcxSchedulerEventList.Create(); end; function TcxSchedulerEvent.CreateRecurrenceInfo: TcxSchedulerEventRecurrenceInfo; begin Result := TcxSchedulerEventRecurrenceInfo.Create(Self); end; function TcxSchedulerEvent.CreateReminderResourcesData: TcxSchedulerReminderResourcesData; var ACount, I: Integer; AReminderDate, ADismissDate: TDateTime; begin Result.Version := 3; AReminderDate := ReminderDate; ADismissDate := RecurrenceInfo.DismissDate; ACount := ResourceIDCount; SetLength(Result.Resources, ACount); for I := 0 to ACount - 1 do with Result.Resources[I] do begin DismissDate := ADismissDate; ResourceID := ResourceIDs[I]; ReminderDate := AReminderDate; end; end; function TcxSchedulerEvent.GetIsFreeState: Boolean; begin Result := State = tlsFree; end; function TcxSchedulerEvent.GetOccurrenceByIndex( AIndex: Integer; var AOccurrence: TcxSchedulerEvent): Boolean; begin Result := False; if (FLink = nil) or SkipExceptions then Exit; AOccurrence := FLink; while (AOccurrence <> nil) and (AOccurrence.RecurrenceIndex <> AIndex) do AOccurrence := AOccurrence.FLink; Result := (AOccurrence <> nil) and (AOccurrence.RecurrenceIndex = AIndex); end; function TcxSchedulerEvent.GetOwner: TPersistent; begin Result := FStorage; end; function TcxSchedulerEvent.GetRecurrenceInfoValue( var AValue: AnsiString): Boolean; begin AValue := dxVariantToAnsiString(GetValueDef(FStorage.FRecurrenceInfoField, '')); Result := AValue <> ''; end; procedure TcxSchedulerEvent.GetStartFinishTime(var AStart, AFinish: TDateTime); begin AStart := Start; AFinish := Finish; end; function TcxSchedulerEvent.GetTaskLinks: TcxSchedulerEventLinks; begin Result := FTaskLinks; end; function TcxSchedulerEvent.GetTaskLinkOwners: TcxSchedulerEventList; begin Result := FTaskLinkOwners; end; function TcxSchedulerEvent.GetTaskCompleteDuration: TDateTime; begin Result := Duration * TaskComplete / 100; end; function TcxSchedulerEvent.GetValueByIndex(AIndex: Integer): Variant; begin Result := FStorage.GetValue(RecordIndex, AIndex); if (Pattern <> nil) and (Pattern <> Self) and VarIsNull(Result) and Storage.CanGetValueFromPattern(AIndex) then Result := Pattern.GetValueByIndex(AIndex); end; function TcxSchedulerEvent.GetValueDef( AField: TcxCustomSchedulerStorageField; const ADefValue: Variant): Variant; begin if not IsEditing then Result := GetValueByIndex(AField.Index) else Result := FEditValues[AField.Index]; if VarType(Result) in [varNull, varEmpty] then Result := ADefValue; end; procedure TcxSchedulerEvent.InitTaskLinks; begin FTaskLinks.Clear; FTaskLinkOwners.Clear; end; procedure TcxSchedulerEvent.InternalMoveTo(const AStartTime: TDateTime); var ADuration: Double; begin BeginEditing; try ADuration := Duration; Start := AStartTime; Duration := ADuration; finally EndEditing; end; end; procedure TcxSchedulerEvent.Modified; begin FIsModified := True; end; procedure TcxSchedulerEvent.PostEditingData; var ACount: Integer; begin if IsModified then begin ACount := Storage.DataController.RecordCount; Storage.FLastEditedEvent := Self; Storage.BeginUpdate; try CalculateActualTimeRange; if FRecordIndex <> cxInvalidRecordIndex then FStorage.PostEditingData(Self); finally if Storage.DataController.RecordCount < ACount then FRecordIndex := cxInvalidRecordIndex; CalculateActualTimeRangePost; Storage.EndUpdate; end; end; end; procedure TcxSchedulerEvent.RefreshTaskLinks; begin cxFieldValueToTaskLinks(GetValueDef(FStorage.FTaskLinksField, Null), TaskLinks); end; procedure TcxSchedulerEvent.RemoveTaskLink(ALink: TcxSchedulerEvent); begin if TaskLinks <> nil then TaskLinks.RemoveLink(ALink); end; procedure TcxSchedulerEvent.ResetReminderResourcesData; begin if Storage.IsReminderByResourceAvailable then begin if Reminder and Shared then SetValue(Storage.FReminderResourcesData, cxReminderResourcesDataToFieldValue(CreateReminderResourcesData)) else SetValue(Storage.FReminderResourcesData, Null); end; end; procedure TcxSchedulerEvent.SetActualTimeRange( const ActualStart, ActualFinish: TDateTime); begin SetValue(FStorage.FActualStartField, Integer(Trunc(ActualStart + TimeBias))); SetValue(FStorage.FActualFinishField, Integer(Trunc(ActualFinish + TimeBias))); end; procedure TcxSchedulerEvent.SetRecordIndex( const AIndex: Integer); begin if AIndex <> -1 then FSavedID := FStorage.GetRecordID(AIndex) else FSavedID := Null; FIsDataValid := False; FRecordIndex := AIndex; FLink := nil; end; procedure TcxSchedulerEvent.SetRecurrenceInfoValue( const AValue: AnsiString); begin SetValue(FStorage.FRecurrenceInfoField, AValue); end; procedure TcxSchedulerEvent.SetValue( AField: TcxCustomSchedulerStorageField; const AValue: Variant); begin SetValueByIndex(AField.Index, AValue); end; procedure TcxSchedulerEvent.SetValueByIndex( AIndex: Integer; const AValue: Variant); var ACount: Integer; APrevValue: Variant; begin if IsEditing then APrevValue := FEditValues[AIndex] else APrevValue := GetValueByIndex(AIndex); if (VarType(APrevValue) = VarType(AValue)) and VarEquals(AValue, APrevValue) then Exit; Modified; ACount := Storage.DataController.RecordCount; BeginEditing; try FEditValues[AIndex] := AValue finally EndEditing; end; if Storage.DataController.RecordCount <> ACount then FRecordIndex := cxInvalidRecordIndex; end; procedure TcxSchedulerEvent.TaskLinksChanged(Sender: TcxSchedulerEventLinks); begin if (Sender = FTaskLinks) and not Storage.IsUpdatingMode then SetValue(FStorage.FTaskLinksField, cxTaskLinksToFieldValue(TaskLinks)); end; function TcxSchedulerEvent.TimeBias: Double; begin Result := Storage.TimeBias; end; procedure TcxSchedulerEvent.UpdateTemporaryData; begin FStart := DateTimeHelper.RoundTime(TDateTime(GetValueDef(FStorage.FStartField, 0)) - TimeBias); FFinish := DateTimeHelper.RoundTime(TDateTime(GetValueDef(FStorage.FFinishField, 0)) - TimeBias); if (FPattern <> nil) and (EventType <> etPattern) then FOptions := GetValueDef(FStorage.FOptionsField, FPattern.GetOptionsFlag) else FOptions := GetValueDef(FStorage.FOptionsField, 0); FStartDate := Trunc(FStart); FIsDataValid := True; end; function TcxSchedulerEvent.GetActualFinish: Integer; begin Result := Integer(GetValueDef(FStorage.FActualFinishField, 0)); end; function TcxSchedulerEvent.GetActualStart: Integer; begin Result := Integer(GetValueDef(FStorage.FActualStartField, 0)); end; function TcxSchedulerEvent.GetAllDayEvent: Boolean; begin Result := (GetOptionsFlag and omAllDayEvent) <> 0; end; function TcxSchedulerEvent.GetCaption: string; begin Result := GetValueDef(FStorage.FCaptionField, ''); end; function TcxSchedulerEvent.GetDuration: TDateTime; begin Result := DateTimeHelper.RoundTime(Finish - Start); end; function TcxSchedulerEvent.GetEditValue(AIndex: Integer): Variant; begin if IsEditing then Result := FEditValues[AIndex] else Result := Null; end; function TcxSchedulerEvent.GetEnabled: Boolean; begin Result := (GetOptionsFlag and omEnabled) <> 0; end; function TcxSchedulerEvent.GetEventType: TcxEventType; begin Result := GetValueDef(FStorage.FEventTypeField, etNone); end; function TcxSchedulerEvent.GetFinish: TDateTime; begin if not FIsDataValid then UpdateTemporaryData; Result := FFinish; end; function TcxSchedulerEvent.GetID: Variant; begin Result := FStorage.GetRecordId(RecordIndex); end; function TcxSchedulerEvent.GetIsNewEvent: Boolean; begin Result := (FRecordIndex = -1) and (FStorage.FNewEvents.IndexOf(Self) <> - 1); end; function TcxSchedulerEvent.GetIsEditing: Boolean; begin Result := FEditCount > 0; end; function TcxSchedulerEvent.GetLabelColor: Integer; begin Result := GetValueDef(FStorage.FLabelColorField, clDefault); end; function TcxSchedulerEvent.GetLocation: string; begin Result := GetValueDef(FStorage.FLocationField, ''); end; function TcxSchedulerEvent.Getmessage: string; begin Result := GetValueDef(FStorage.FMessageField, ''); end; function TcxSchedulerEvent.GetOptionsFlag: Integer; begin if not FIsDataValid then UpdateTemporaryData; Result := FOptions; end; function TcxSchedulerEvent.GetParentID: Variant; begin Result := GetValueDef(FStorage.FParentIDField, Integer(-2)); end; function TcxSchedulerEvent.GetReadOnly: Boolean; begin Result := (GetResourceItem <> nil) and GetResourceItem.ReadOnly; end; function TcxSchedulerEvent.GetRecurrenceIndex: Integer; begin Result := GetValueDef(FStorage.FRecurrenceIndexField, 0) end; function TcxSchedulerEvent.GetReminder: Boolean; begin Result := (GetOptionsFlag and omReminder) <> 0; end; function TcxSchedulerEvent.GetReminderDate: TDateTime; var AValue: Variant; begin if not IsEditing then AValue := GetValueByIndex(FStorage.FReminderDateField.Index) else AValue := FEditValues[FStorage.FReminderDateField.Index]; if VarType(AValue) in [varNull, varEmpty] then Result := Start else Result := TDateTime(AValue) - TimeBias; end; function TcxSchedulerEvent.GetReminderMinutesBeforeStart: Integer; begin Result := GetValueDef(FStorage.FReminderMinutesBeforeStartField, Integer(-2)); end; function TcxSchedulerEvent.GetReminderResourcesData: TcxSchedulerReminderResourcesData; begin Result := cxFieldValueToReminderResourcesData(GetValueDef(FStorage.FReminderResourcesData, Null)); end; function TcxSchedulerEvent.GetResourceID: Variant; begin Result := GetValueDef(FStorage.FResourceIDField, Null); if dxVarIsBlob(Result) then Result := cxFieldValueToVariant(Result); end; function TcxSchedulerEvent.GetResourceIDCount: Integer; var AResources: Variant; begin AResources := ResourceID; if VarIsNull(AResources) then begin Result := 0; Exit; end; if VarIsArray(AResources) then Result := VarArrayHighBound(AResources, 1) - VarArrayLowBound(AResources, 1) + 1 else Result := 1; end; function TcxSchedulerEvent.GetResourceIDs(Index: Integer): Variant; var AResources: Variant; begin AResources := ResourceID; if VarIsArray(AResources) then Result := AResources[Index] else Result := AResources; end; function TcxSchedulerEvent.GetShared: Boolean; begin Result := VarIsArray(ResourceID) and ((VarArrayHighBound(ResourceID, 1) - VarArrayLowBound(ResourceID, 1)) > 0); end; function TcxSchedulerEvent.GetStart: TDateTime; begin if not FIsDataValid then UpdateTemporaryData; Result := FStart; end; function TcxSchedulerEvent.GetState: Integer; begin Result := GetValueDef(FStorage.FStateField, 0); end; function TcxSchedulerEvent.GetTaskIndex: Integer; begin Result := GetValueDef(FStorage.FTaskIndexField, -1); end; function TcxSchedulerEvent.GetTaskComplete: Integer; begin Result := GetValueDef(FStorage.FTaskCompleteField, 0); end; function TcxSchedulerEvent.GetTaskStatus: TcxSchedulerEventTaskStatus; var AStatus: Integer; begin AStatus := GetValueDef(FStorage.FTaskStatusField, 0); if (AStatus < 0) or (Integer(AStatus) > Integer(High(TcxSchedulerEventTaskStatus))) then Result := tsNotStarted else Result := TcxSchedulerEventTaskStatus(AStatus); end; function TcxSchedulerEvent.GetValueCount: Integer; begin Result := FStorage.FieldCount; end; procedure TcxSchedulerEvent.InternalSetTaskComplete(const AValue: Integer; AUpdateTaskStatus: Boolean = True); begin if TaskComplete = AValue then Exit; if (AValue = 100) and (TaskComplete <> 100) then FPrevTaskComplete := TaskComplete else if AValue = 0 then FPrevTaskComplete := 0; SetValue(FStorage.FTaskCompleteField, AValue); if AUpdateTaskStatus then begin if AValue = 100 then InternalSetTaskStatus(tsComplete, False) else if (AValue = 0) and not (TaskStatus in [tsWaiting, tsDeferred]) then InternalSetTaskStatus(tsNotStarted, False) else InternalSetTaskStatus(tsInProgress, False); end; Post; UpdateTaskTime; end; procedure TcxSchedulerEvent.InternalSetTaskStatus(AValue: TcxSchedulerEventTaskStatus; AUpdateTaskComplete: Boolean = True); begin if TaskStatus = AValue then Exit; SetValue(FStorage.FTaskStatusField, AValue); if AUpdateTaskComplete then case AValue of tsNotStarted: InternalSetTaskComplete(0, False); tsComplete: InternalSetTaskComplete(100, False); else InternalSetTaskComplete(FPrevTaskComplete, False); end; end; procedure TcxSchedulerEvent.SetAllDayEvent(const AValue: Boolean); begin if SetOptionsFlag(omAllDayEvent, AValue) then begin if AValue then begin Start := DateOf(Start); if DateOf(Finish) <= Start then Finish := Start + 1 else Finish := DateOf(Finish) end else begin Start := DateOf(Start) + cxTime8AM; Finish := DateOf(Finish) + cxTime8AM + cxHalfHour; end; end; end; procedure TcxSchedulerEvent.SetCaption(const AValue: string); begin SetValue(FStorage.FCaptionField, AValue); end; procedure TcxSchedulerEvent.SetDuration(const AValue: TDateTime); begin Finish := Start + DateTimeHelper.RoundTime(AValue); end; procedure TcxSchedulerEvent.SetEditValue(AIndex: Integer; const AValue: Variant); begin if not IsEditing then Exit; FEditValues[AIndex] := AValue; end; procedure TcxSchedulerEvent.SetEnabled(const AValue: Boolean); begin SetOptionsFlag(omEnabled, AValue); end; procedure TcxSchedulerEvent.SetEventType(AValue: TcxEventType); var AResetRecurrence: Boolean; begin CheckLinksOnChangeEventType(AValue); AResetRecurrence := FStorage.IsRecurrenceAvailable; if not AResetRecurrence then AValue := etNone; AResetRecurrence := AResetRecurrence and (AValue = etNone) and (AValue <> EventType); SetValue(FStorage.FEventTypeField, AValue); if AResetRecurrence then RecurrenceInfo.AssignDefaultValues; end; procedure TcxSchedulerEvent.SetFinish(const AValue: TDateTime); begin FFinish := DateTimeHelper.RoundTime(AValue); SetValue(FStorage.FFinishField, FFinish + TimeBias); end; procedure TcxSchedulerEvent.SetLabelColor(const AValue: Integer); begin SetValue(FStorage.FLabelColorField, AValue); end; procedure TcxSchedulerEvent.SetLocation(const AValue: string); begin SetValue(FStorage.FLocationField, AValue); end; procedure TcxSchedulerEvent.SetMessage(const AValue: string); begin SetValue(FStorage.FMessageField, AValue); end; function TcxSchedulerEvent.SetOptionsFlag(const AMask: Integer; AValue: Boolean): Boolean; begin if not FIsDataValid then UpdateTemporaryData; Result := (FOptions and AMask = AMask) <> AValue; if AValue then FOptions := FOptions or AMask else FOptions := FOptions and not AMask; SetValue(FStorage.FOptionsField, FOptions); end; procedure TcxSchedulerEvent.SetParentID(const AValue: Variant); begin SetValue(FStorage.FParentIDField, AValue); end; procedure TcxSchedulerEvent.SetRecurrenceIndex(const AValue: Integer); begin SetValue(FStorage.FRecurrenceIndexField, AValue); end; procedure TcxSchedulerEvent.SetRecurrenceInfo( AValue: TcxSchedulerEventRecurrenceInfo); begin FRecurrenceInfo.Assign(AValue); end; procedure TcxSchedulerEvent.SetReminder(const AValue: Boolean); begin SetOptionsFlag(omReminder, AValue); ResetReminderResourcesData; end; procedure TcxSchedulerEvent.SetReminderDate(AValue: TDateTime); begin SetValue(FStorage.FReminderDateField, AValue + TimeBias); ResetReminderResourcesData; end; procedure TcxSchedulerEvent.SetReminderMinutesBeforeStart(const AValue: Integer); begin if ReminderMinutesBeforeStart <> AValue then begin ReminderDate := FStart - MinuteToTime * AValue; ResetReminderResourcesData; end; SetValue(FStorage.FReminderMinutesBeforeStartField, AValue); end; procedure TcxSchedulerEvent.SetReminderResourcesData(const AValue: TcxSchedulerReminderResourcesData); begin SetValue(FStorage.FReminderResourcesData, cxReminderResourcesDataToFieldValue(AValue)); end; procedure TcxSchedulerEvent.SetResourceID(const AValue: Variant); begin SetValue(FStorage.FResourceIDField, cxVariantToFieldValue(AValue, FStorage.FResourceIDField.IsBlob)); ResetReminderResourcesData; end; procedure TcxSchedulerEvent.SetStart(const AValue: TDateTime); begin FStart := DateTimeHelper.RoundTime(AValue); FStartDate := Trunc(FStart); SetValue(FStorage.FStartField, FStart + TimeBias); ReminderDate := FStart - MinuteToTime * ReminderMinutesBeforeStart; RecurrenceInfo.DismissDate := DateOf(ReminderDate) - 1; end; procedure TcxSchedulerEvent.SetState(const AValue: Integer); begin SetValue(FStorage.FStateField, AValue); end; procedure TcxSchedulerEvent.SetTaskComplete(const AValue: Integer); begin InternalSetTaskComplete(AValue); end; procedure TcxSchedulerEvent.SetTaskIndex(const AValue: Integer); begin SetValue(FStorage.FTaskIndexField, AValue); end; procedure TcxSchedulerEvent.SetTaskStatus(AValue: TcxSchedulerEventTaskStatus); begin InternalSetTaskStatus(AValue); end; { TcxSchedulerControlEvent } constructor TcxSchedulerControlEvent.Create( AStorage: TcxCustomSchedulerStorage); begin FStorage := AStorage; SetLength(FValues, AStorage.FieldCount); ClearValues; SetRecordIndex(-1); FRecurrenceInfo := CreateRecurrenceInfo; FRecurrenceInfo.FOwner := Self; AssignDefaultValues; end; constructor TcxSchedulerControlEvent.Create(ASource: TcxSchedulerEvent); begin SetLength(FValues, ASource.ValueCount); ClearValues; inherited Create(ASource.FStorage); FTimeBias := ASource.TimeBias; FIsClone := ASource is TcxSchedulerControlEvent; SetRecordIndex(ASource.RecordIndex); FSource := ASource; FLink := ASource.FLink; Assign(ASource); end; constructor TcxSchedulerControlEvent.Create( ASource: TcxSchedulerEvent; const AStart, AFinish: TDateTime); begin Create(ASource); Start := AStart; Finish := AFinish; end; destructor TcxSchedulerControlEvent.Destroy; begin if FIsClone and (Source is TcxSchedulerControlEvent) then TcxSchedulerControlEvent(Source).FIsSource := False; SetLength(FValues, 0); inherited Destroy; end; procedure TcxSchedulerControlEvent.Assign(Source: TPersistent); function GetPattern: TcxSchedulerEvent; begin if IsClone then Result := TcxSchedulerEvent(Source).FPattern else if TcxSchedulerEvent(Source).EventType = etPattern then Result := TcxSchedulerEvent(Source) else Result := nil; end; var I: Integer; begin if Source is TcxSchedulerEvent then begin for I := 0 to ValueCount - 1 do FValues[I] := TcxSchedulerEvent(Source).GetValueByIndex(I); FIsDataValid := False; FPattern := GetPattern; end; end; procedure TcxSchedulerControlEvent.BeginEditing; begin // do nothing for end; procedure TcxSchedulerControlEvent.Delete; begin if EventType = etOccurrence then inherited Delete else if Source <> nil then Source.Delete; end; procedure TcxSchedulerControlEvent.EndEditing; begin end; function TcxSchedulerControlEvent.GetTaskLinkOwnerRelation(ATaskLinkOwner: TcxSchedulerEvent; var ARelation: TcxSchedulerEventRelation): Boolean; begin if Source <> nil then Result := Source.GetTaskLinkOwnerRelation(ATaskLinkOwner, ARelation) else Result := inherited GetTaskLinkOwnerRelation(ATaskLinkOwner, ARelation); end; procedure TcxSchedulerControlEvent.GetValidTaskTimeRange(var AStart, AFinish: TDateTime); begin if Source <> nil then Source.GetValidTaskTimeRange(AStart, AFinish) else inherited GetValidTaskTimeRange(AStart, AFinish); end; function TcxSchedulerControlEvent.IsOrigin(AEvent: TcxSchedulerEvent): Boolean; begin if IsClone then Result := TcxSchedulerControlEvent(Source).IsOrigin(AEvent) else Result := Source = AEvent; end; procedure TcxSchedulerControlEvent.lockResource(const ALockedResource: Variant); begin FLockedResource := ALockedResource; end; procedure TcxSchedulerControlEvent.unlockResource; begin FLockedResource := Null; end; procedure TcxSchedulerControlEvent.UpdateTaskTime; begin if Source <> nil then Source.UpdateTaskTime else inherited UpdateTaskTime; end; procedure TcxSchedulerControlEvent.UpdateTaskLinks; begin // Don't delete!!! end; function TcxSchedulerControlEvent.CanMoveTo(ANewTime: TDateTime): Boolean; begin Result := (Source = nil) or Source.CanMoveTo(ANewTime); end; procedure TcxSchedulerControlEvent.CheckLinksOnChangeEventType(ANewEventType: TcxEventType); begin // don't delete end; procedure TcxSchedulerControlEvent.ClearValues; var I: Integer; begin for I := 0 to Length(FValues) - 1 do FValues[I] := Null; unlockResource; end; function TcxSchedulerControlEvent.CreateTaskLinks: TcxSchedulerEventLinks; begin Result := nil; end; function TcxSchedulerControlEvent.GetTaskLinks: TcxSchedulerEventLinks; begin if Source <> nil then Result := Source.TaskLinks else Result := inherited GetTaskLinks; end; function TcxSchedulerControlEvent.GetTaskLinkOwners: TcxSchedulerEventList; begin if Source <> nil then Result := Source.TaskLinkOwners else Result := inherited GetTaskLinkOwners; end; function TcxSchedulerControlEvent.GetValueByIndex( AIndex: Integer): Variant; begin Result := FValues[AIndex]; if (Pattern <> nil) and VarIsNull(Result) and Storage.CanGetValueFromPattern(AIndex) then Result := Pattern.GetValueByIndex(AIndex); if (AIndex = FStorage.FResourceIDField.Index) and not VarIsNull(FLockedResource) then Result := FLockedResource; end; procedure TcxSchedulerControlEvent.SetValueByIndex( AIndex: Integer; const AValue: Variant); begin Modified; FValues[AIndex] := AValue; end; function TcxSchedulerControlEvent.TimeBias: Double; begin Result := FTimeBias; end; function TcxSchedulerControlEvent.GetNonExceptionLinkCount: Integer; var I: Integer; begin Result := 0; if TaskLinks = nil then Exit; for I := 0 to TaskLinks.Count - 1 do if (TaskLinks[I].Link <> nil) and (TaskLinks[I].Link.EventType <> etException) then Inc(Result); end; function TcxSchedulerControlEvent.GetSelected: Boolean; begin if SelectionAdapter <> nil then Result := SelectionAdapter.IsSelected(Self) else begin if Source = nil then Result := True else Result := FIsClone; end; end; procedure TcxSchedulerControlEvent.SetSelected(AValue: Boolean); begin if (AValue <> GetSelected) and (SelectionAdapter <> nil) then SelectionAdapter.Add(Self, [ssCtrl]); end; { TcxSchedulerStorageResourceItems } constructor TcxSchedulerStorageResourceItems.Create( AOwner: TcxSchedulerStorageResources; AItemClass: TcxSchedulerStorageResourceItemClass); begin FOwner := AOwner; inherited Create(AItemClass); end; function TcxSchedulerStorageResourceItems.Add: TcxSchedulerStorageResourceItem; begin Result := TcxSchedulerStorageResourceItem(inherited Add); end; function TcxSchedulerStorageResourceItems.GetOwner: TPersistent; begin Result := FOwner; end; procedure TcxSchedulerStorageResourceItems.Update(Item: TCollectionItem); begin inherited Update(Item); Storage.Changed; end; function TcxSchedulerStorageResourceItems.GetItem( AIndex: Integer): TcxSchedulerStorageResourceItem; begin Result := TcxSchedulerStorageResourceItem(inherited Items[AIndex]); end; function TcxSchedulerStorageResourceItems.GetStorage: TcxCustomSchedulerStorage; begin Result := FOwner.Storage; end; procedure TcxSchedulerStorageResourceItems.SetItem( AIndex: Integer; AValue: TcxSchedulerStorageResourceItem); begin Items[AIndex].Assign(AValue); end; function TcxSchedulerStorageResourceItems.GetVisibleResource( AIndex: Integer): TcxSchedulerStorageResourceItem; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if GetItem(I).Visible then begin if AIndex = 0 then begin Result := GetItem(I); Break; end; Dec(AIndex); end; end; function TcxSchedulerStorageResourceItems.GetVisibleResourceCount: Integer; var I: Integer; begin Result := 0; for I := 0 to Count - 1 do if GetItem(I).Visible then Inc(Result); end; { TcxSchedulerStorageResourceItem } constructor TcxSchedulerStorageResourceItem.Create(Collection: TCollection); begin FColor := clDefault; FImageIndex := -1; FVisible := True; FReadOnly := False; FWorkDays := DateTimeHelper.WorkDays; FWorkFinish := DateTimeHelper.WorkFinish; FWorkStart := DateTimeHelper.WorkStart; inherited Create(Collection); end; procedure TcxSchedulerStorageResourceItem.Assign(Source: TPersistent); begin if Source is TcxSchedulerStorageResourceItem then begin FColor := TcxSchedulerStorageResourceItem(Source).FColor; FImageIndex := TcxSchedulerStorageResourceItem(Source).FImageIndex; FName := TcxSchedulerStorageResourceItem(Source).FName; FReadOnly := TcxSchedulerStorageResourceItem(Source).FReadOnly; FResourceID := TcxSchedulerStorageResourceItem(Source).FResourceID; FVisible := TcxSchedulerStorageResourceItem(Source).FVisible; end else inherited Assign(Source); end; procedure TcxSchedulerStorageResourceItem.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); Filer.DefineProperty('WorkStart', ReadWorkStart, WriteWorkStart, FWorkStartAssigned); Filer.DefineProperty('WorkFinish', ReadWorkFinish, WriteWorkFinish, FWorkFinishAssigned); end; function TcxSchedulerStorageResourceItem.GetDisplayName: string; begin Result := TcxSchedulerStorageResourceItems(Collection). Resources.DoGetResourceName(Self); end; procedure TcxSchedulerStorageResourceItem.SetName( const AValue: string); begin if AValue = FName then Exit; FName := AValue; Changed(True); end; procedure TcxSchedulerStorageResourceItem.SetColor( const AValue: TColor); begin FColor := AValue; Changed(True); end; procedure TcxSchedulerStorageResourceItem.SetImageIndex( const AValue: TImageIndex); begin FImageIndex := AValue; Changed(True); end; procedure TcxSchedulerStorageResourceItem.SetResourceID( const AValue: Variant); begin FResourceID := AValue; Changed(True); end; procedure TcxSchedulerStorageResourceItem.SetVisible(const AValue: Boolean); begin FVisible := AValue; Changed(True); end; procedure TcxSchedulerStorageResourceItem.SetWorkStart(const AValue: TTime); begin if AValue <> FWorkStart then begin FWorkStart := DateTimeHelper.RoundTime(AValue); FWorkStartAssigned := FWorkStart <> DateTimeHelper.WorkStart; Changed(True); end; end; procedure TcxSchedulerStorageResourceItem.SetWorkDays(AValue: TDays); begin if AValue <> FWorkDays then begin FWorkDays := AValue; Changed(True); end; end; procedure TcxSchedulerStorageResourceItem.SetWorkFinish(const AValue: TTime); begin if AValue <> FWorkFinish then begin FWorkFinish := DateTimeHelper.RoundTime(AValue); FWorkFinishAssigned := FWorkFinish <> DateTimeHelper.WorkFinish; Changed(True); end; end; function TcxSchedulerStorageResourceItem.GetActualImageIndex: TImageIndex; begin Result := Resources.DoGetResourceImageIndex(Self); if (Resources.Images = nil) or (Resources.Images.Count <= Result) then Result := -1; end; function TcxSchedulerStorageResourceItem.GetResources: TcxSchedulerStorageResources; begin Result := TcxSchedulerStorageResourceItems(Collection).Resources; end; function TcxSchedulerStorageResourceItem.IsWorkDaysStored: Boolean; begin Result := FWorkDays <> DateTimeHelper.WorkDays; end; procedure TcxSchedulerStorageResourceItem.ReadWorkFinish(AReader: TReader); begin FWorkFinish := AReader.ReadFloat; end; procedure TcxSchedulerStorageResourceItem.ReadWorkStart(AReader: TReader); begin FWorkStart := AReader.ReadFloat; end; procedure TcxSchedulerStorageResourceItem.WriteWorkFinish(AWriter: TWriter); begin AWriter.WriteFloat(FWorkFinish); end; procedure TcxSchedulerStorageResourceItem.WriteWorkStart(AWriter: TWriter); begin AWriter.WriteFloat(FWorkStart); end; { TcxSchedulerStorageResources } constructor TcxSchedulerStorageResources.Create( AOwner: TcxCustomSchedulerStorage); begin FOwner := AOwner; inherited Create(AOwner); FItems := CreateItems; end; destructor TcxSchedulerStorageResources.Destroy; begin FItems.Free; inherited Destroy; end; procedure TcxSchedulerStorageResources.Assign( Source: TPersistent); begin if Source is TcxSchedulerStorageResources then begin FItems.Assign(TcxSchedulerStorageResources(Source).Items); FImages := TcxSchedulerStorageResources(Source).Images; end else inherited; end; function TcxSchedulerStorageResources.GetResourceName( AResource: TcxSchedulerStorageResourceItem): string; begin Result := DoGetResourceName(AResource); end; function TcxSchedulerStorageResources.GetResourceNameByID(const AResource: Variant): string; var I: Integer; AResourceItem: TcxSchedulerStorageResourceItem; begin Result := ''; if VarIsEmptyEx(AResource) then Exit; for I := 0 to ResourceItems.Count - 1 do begin AResourceItem := ResourceItems[I]; if VarEqualsSoft(AResource, AResourceItem.ResourceID) then begin Result := DoGetResourceName(AResourceItem); Break; end; end; end; function TcxSchedulerStorageResources.GetObjectName: string; begin if Storage.StoringName <> '' then Result := Storage.StoringName else Result := Storage.Name; end; function TcxSchedulerStorageResources.DecodePropertyName(const AName: string; var ASubValue: string): Integer; begin Result := StrToIntDef('$' + Copy(AName, 9, 8), -1); ASubValue := Copy(AName, 17, Length(AName) - 16); end; function TcxSchedulerStorageResources.GetProperties( AProperties: TStrings): Boolean; var I: Integer; APropertyName: string; begin Result := ResourceItems.Count > 0; for I := 0 to ResourceItems.Count - 1 do with ResourceItems[I] do begin APropertyName := 'Resource' + IntToHex(I, 8); AProperties.Add(APropertyName); AProperties.Add(APropertyName + 'WorkStart'); AProperties.Add(APropertyName + 'WorkFinish'); AProperties.Add(APropertyName + 'WorkDays'); end; end; procedure TcxSchedulerStorageResources.GetPropertyValue(const AName: string; var AValue: Variant); var AItem: TcxSchedulerStorageResourceItem; ASubValue: string; begin if ResourceItems.Count = 0 then Exit; if Pos('Resource', AName) = 1 then begin AItem := TcxSchedulerStorageResourceItem( ResourceItems.FindItemID(DecodePropertyName(AName, ASubValue))); if AItem <> nil then begin if SameText(ASubValue, 'WorkStart') then AValue := AItem.WorkStart else if SameText(ASubValue, 'WorkFinish') then AValue := AItem.WorkFinish else if SameText(ASubValue, 'WorkDays') then AValue := WorkDaysToInteger(AItem.WorkDays) else AValue := ((AItem.Index and $FFFF) shl 1) or Ord(AItem.Visible); end; end; end; procedure TcxSchedulerStorageResources.SetPropertyValue(const AName: string; const AValue: Variant); var AItem: TcxSchedulerStorageResourceItem; ASubValue: string; P: PRestoringItem; function GetRestoreItem(AItem: TcxSchedulerStorageResourceItem): PRestoringItem; var I: Integer; begin for I := 0 to FRestoringItems.Count - 1 do if AItem = PRestoringItem(FRestoringItems.Items[I])^.Item then begin Result := PRestoringItem(FRestoringItems.Items[I]); Exit; end; New(Result); Result^.WorkDays := DateTimeHelper.WorkDays; Result^.WorkFinish := DateTimeHelper.WorkFinish; Result^.WorkStart := DateTimeHelper.WorkStart; Result^.Item := AItem; FRestoringItems.Add(Result); end; begin if ResourceItems.Count = 0 then Exit; if Pos('Resource', AName) = 1 then begin AItem := TcxSchedulerStorageResourceItem(ResourceItems.FindItemID( DecodePropertyName(AName, ASubValue))); if AItem <> nil then begin P := GetRestoreItem(AItem); if SameText(ASubValue, 'WorkStart') then P^.WorkStart := AValue else if SameText(ASubValue, 'WorkFinish') then P^.WorkFinish := AValue else if SameText(ASubValue, 'WorkDays') then P^.WorkDays := IntegerToWorkDays(AValue) else begin P^.Index := (AValue shr 1) and $FFFFFFF; P^.Visible := Boolean(AValue and 1); end; end; end; end; procedure TcxSchedulerStorageResources.Changed; begin Storage.Changed; end; function TcxSchedulerStorageResources.CreateItems: TcxSchedulerStorageResourceItems; begin Result := TcxSchedulerStorageResourceItems.Create( Self, TcxSchedulerStorageResourceItem); end; function CompareRestoringItems(Item1, Item2: Pointer): Integer; begin Result := PRestoringItem(Item1).Index - PRestoringItem(Item2).Index; end; procedure TcxSchedulerStorageResources.DoneRestore; var I: Integer; P: PRestoringItem; begin FRestoringItems.Sort(CompareRestoringItems); Storage.BeginUpdate; try for I := 0 to FRestoringItems.Count - 1 do begin P := FRestoringItems[I]; P.Item.Index := P.Index; P.Item.Visible := P.Visible; P.Item.WorkFinish := P.WorkFinish; P.Item.WorkStart := P.WorkStart; P.Item.WorkDays := P.WorkDays; Dispose(P); end; finally Storage.EndUpdate; FreeAndNil(FRestoringItems); end; end; function TcxSchedulerStorageResources.DoGetResourceImageIndex( AItem: TcxSchedulerStorageResourceItem): TImageIndex; begin Result := AItem.ImageIndex; if Assigned(FOnGetResourceImageIndex) then FOnGetResourceImageIndex(Storage, AItem, Result); end; function TcxSchedulerStorageResources.DoGetResourceName( AItem: TcxSchedulerStorageResourceItem): string; begin Result := ''; if AItem <> nil then Result := AItem.Name; if Assigned(FOnGetResourceName) then FOnGetResourceName(Storage, AItem, Result); end; function TcxSchedulerStorageResources.GetOwner: TPersistent; begin Result := FOwner; end; function TcxSchedulerStorageResources.GetResourceItems: TcxSchedulerStorageResourceItems; begin Result := Items; end; procedure TcxSchedulerStorageResources.InitRestore; begin FRestoringItems := TList.Create; end; function TcxSchedulerStorageResources.GetAreImagesUsed: Boolean; var I: Integer; begin Result := (Images <> nil); if Result then begin Result := False; for I := 0 to ResourceItems.Count - 1 do begin Result := Result or (ResourceItems[I].ActualImageIndex >= 0); if Result then Break; end; end; end; procedure TcxSchedulerStorageResources.SetImages(AValue: TCustomImageList); begin if AValue <> FImages then begin if FImages <> nil then FImages.RemoveFreeNotification(Storage); FImages := AValue; if FImages <> nil then FImages.FreeNotification(Storage); Changed; end; end; procedure TcxSchedulerStorageResources.SetItems( AValue: TcxSchedulerStorageResourceItems); begin FItems.Assign(AValue); end; function cxCompareConflictEvents(AEvent1, AEvent2: TcxSchedulerEvent): Integer; begin if AEvent1.Start = AEvent2.Start then Result := 0 else if AEvent1.Start < AEvent2.Start then Result := -1 else Result := 1; end; function cxCompareConflictEventsEx(AEvent1, AEvent2: TcxSchedulerEvent): Integer; begin if AEvent1 = AEvent2 then Result := 0 else if AEvent1.Finish <= AEvent2.Start then Result := -1 else if AEvent1.Start = AEvent2.Start then Result := 0 else Result := 1; end; { TcxSchedulerEventConflictsInfo } constructor TcxSchedulerEventConflictsInfo.Create( AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean); begin FEvent := AEvent; Init(AEvent.Storage, AExceptEventsWithoutResources, AEvent.ResourceID, NullDate, NullDate); Calculate; end; constructor TcxSchedulerEventConflictsInfo.Create(AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean; const AStart, AFinish: TDateTime); begin FEvent := AEvent; Init(AEvent.Storage, AExceptEventsWithoutResources, AEvent.ResourceID, AStart, AFinish); Calculate(False); end; constructor TcxSchedulerEventConflictsInfo.Create( AStorage: TcxCustomSchedulerStorage; AExceptEventsWithoutResources: Boolean; const AStart, AFinish: TDateTime; AResourceID: Variant; AExcludedEvent: TcxSchedulerEvent = nil); begin Init(AStorage, AExceptEventsWithoutResources, AResourceID, AStart, AFinish); FExcludedEvent := AExcludedEvent; if AExcludedEvent <> nil then ExcludedEventID := TcxSchedulerControlEventID.Create(AExcludedEvent); Calculate; end; destructor TcxSchedulerEventConflictsInfo.Destroy; begin ExcludedEventID.Free; FConflictEvents.Free; FTimeRanges.Free; inherited Destroy; end; procedure TcxSchedulerEventConflictsInfo.Init( AStorage: TcxCustomSchedulerStorage; AExceptEventsWithoutResources: Boolean; AResourceID: Variant; const AStart, AFinish: TDateTime); begin Start := AStart; Finish := AFinish; FStorage := AStorage; FExceptEventsWithoutResources := AExceptEventsWithoutResources; FConflictEvents := TcxSchedulerFilteredEventList.Create; FTimeRanges := TcxSchedulerTimeRanges.CreateEx(Self); ResourceID := AResourceID; end; procedure TcxSchedulerEventConflictsInfo.AddRange(AStart, AFinish: TDateTime); begin AStart := Min(Finish, Max(AStart, Start)); AFinish := Max(Start, Min(AFinish, Finish)); with DateTimeHelper do begin if (RoundTime(AStart) <> RoundTime(AFinish)) and (AFinish > AStart) then FTimeRanges.Add(AStart, AFinish); end; end; procedure TcxSchedulerEventConflictsInfo.Calculate( ACalculateFreeTime: Boolean = True); begin FConflictEvents.DestroyItems; FTimeRanges.Clear; if (FEvent <> nil) and ACalculateFreeTime then begin Start := FEvent.Start; Finish := FEvent.Finish; EventID := TcxSchedulerControlEventID.Create(FEvent); end; try if (FEvent = nil) or not FEvent.IsFreeState then begin Storage.GetEvents(FConflictEvents, Start - 1, Finish + 1, ResourceID); if ACalculateFreeTime then begin FConflictEvents.Sort(cxCompareConflictEvents); CheckIntersectionWithEvents end else begin FConflictEvents.Sort(cxCompareConflictEventsEx); CheckSomeIntersection; end; end; if ACalculateFreeTime then CheckFreeTimeRanges; finally EventID.Free; end; end; procedure TcxSchedulerEventConflictsInfo.CheckFreeTimeRanges; var I: Integer; AStart, AFinish: TDateTime; begin if not HasConflicts then AddRange(Start, Finish) else begin I := 0; AStart := Start; AFinish := Finish; while I < ConflictEvents.Count do begin AFinish := ConflictEvents[I].Start; AddRange(AStart, AFinish); ExpandRange(ConflictEvents[I], I, AFinish); AStart := AFinish; end; AddRange(AStart, Finish); end; end; procedure TcxSchedulerEventConflictsInfo.CheckIntersectionWithEvents; var I: Integer; begin for I := FConflictEvents.Count - 1 downto 0 do begin if ExcludeFromCalculate(FConflictEvents[I]) then begin FConflictEvents[I].Free; FConflictEvents.Delete(I); end; end; end; procedure TcxSchedulerEventConflictsInfo.CheckSomeIntersection; var I, J: Integer; AEvent, ACheckedEvent: TcxSchedulerEvent; AList: TcxSchedulerFilteredEventList; AHasIntersection: Boolean; begin AList := TcxSchedulerFilteredEventList.Create; try if Event.SkipExceptions or (Event.EventType = etPattern) then Event.RecurrenceInfo.GetOccurrences(AList, Start, Finish) else AList.Add(TcxSchedulerControlEvent.Create(Event)); // delete equals for I := FConflictEvents.Count - 1 downto 0 do begin AEvent := FConflictEvents[I]; if AEvent.IsFreeState or IsSameEvent(AEvent) or IsSameSeries(FEvent, AEvent) then begin AEvent.Free; FConflictEvents.Delete(I); end; end; // AHasIntersection := False; for I := 0 to AList.Count - 1 do begin if AHasIntersection then Break; AEvent := AList[I]; for J := 0 to FConflictEvents.Count - 1 do begin ACheckedEvent := FConflictEvents[J]; AHasIntersection := IntersectEvents(AEvent, ACheckedEvent); if AHasIntersection and not ExceptEventsWithoutResources then AHasIntersection := not VarIsNull(ACheckedEvent.ResourceID); if ExceptEventsWithoutResources and AHasIntersection then AHasIntersection := VarIsEmptyEx(ACheckedEvent.ResourceID) or VarIsEmptyEx(AEvent.ResourceID) or (ACheckedEvent.IsSharedWithResource(AEvent.ResourceID) or AEvent.IsSharedWithResource(ACheckedEvent.ResourceID)) else AHasIntersection := AHasIntersection and (ACheckedEvent.IsSharedWithResource(AEvent.ResourceID) or AEvent.IsSharedWithResource(ACheckedEvent.ResourceID)); AHasIntersection := AHasIntersection and Storage.HasEventIntersect(FEvent, ACheckedEvent); if AHasIntersection then Break; end; end; if not AHasIntersection then FConflictEvents.DoClear(True); finally AList.Free; end; end; function TcxSchedulerEventConflictsInfo.ExcludeFromCalculate(AEvent: TcxSchedulerEvent): Boolean; begin Result := AEvent.IsFreeState or not IntersectEvents(AEvent); if not Result and (ExcludedEventID <> nil) then Result := ExcludedEventID.SameEvent(AEvent); end; procedure TcxSchedulerEventConflictsInfo.ExpandRange(AEvent: TcxSchedulerEvent; var AIndex: Integer; var ALastPosition: TDateTime); var ACheckedEvent: TcxSchedulerEvent; ARangeStart, ARangeFinish: TDateTime; begin ARangeStart := AEvent.Start; ARangeFinish := AEvent.Finish; while AIndex < ConflictEvents.Count do begin ACheckedEvent := ConflictEvents[AIndex]; if IntersectTime(ARangeStart, ARangeFinish, ACheckedEvent.Start, ACheckedEvent.Finish) then begin ARangeStart := Min(ARangeStart, ACheckedEvent.Start); ARangeFinish := Max(ARangeFinish, ACheckedEvent.Finish); end else Break; Inc(AIndex); end; ALastPosition := ARangeFinish; end; function TcxSchedulerEventConflictsInfo.IntersectEvents( ACheckedEvent: TcxSchedulerEvent): Boolean; begin Result := IntersectTime(ACheckedEvent.Start, ACheckedEvent.Finish); if Result and not ExceptEventsWithoutResources then Result := not VarIsNull(ACheckedEvent.ResourceID); if Result and (FEvent <> nil) then Result := ACheckedEvent.IsSharedWithResource(ResourceID) and not IsSameEvent(ACheckedEvent); if Result and (FEvent <> nil) then Result := not IsSameSeries(ACheckedEvent, FEvent); if Result and (FExcludedEvent <> nil) then Result := not IsSameSeries(ACheckedEvent, FExcludedEvent); end; function TcxSchedulerEventConflictsInfo.IntersectEvents( AEvent1, AEvent2: TcxSchedulerEvent): Boolean; begin Result := IntersectTime(AEvent1.Start, AEvent1.Finish, AEvent2.Start, AEvent2.Finish); end; function TcxSchedulerEventConflictsInfo.IntersectTime( const AStart, AFinish: TDateTime): Boolean; begin Result := IntersectTime(AStart, AFinish, Start, Finish); end; function TcxSchedulerEventConflictsInfo.IntersectTime( const AStart, AFinish, AStart1, AFinish1: TDateTime): Boolean; begin Result := (AStart < AFinish1) and (AStart1 < AFinish); end; function TcxSchedulerEventConflictsInfo.IsSameEvent( ACheckedEvent: TcxSchedulerEvent): Boolean; begin Result := (EventID <> nil) and EventID.SameEvent(ACheckedEvent); end; function TcxSchedulerEventConflictsInfo.IsSameSeries( AEvent1, AEvent2: TcxSchedulerEvent): Boolean; begin Result := AEvent1.RecordIndex = AEvent2.RecordIndex; if (AEvent1.RecordIndex < 0) or (AEvent2.RecordIndex < 0) then Exit; if not Result then Result := VarEquals(AEvent1.ID, AEvent2.ID); if not Result and (AEvent1.EventType <> etNone) then Result := VarEquals(AEvent1.ParentID, AEvent2.ID); if not Result and (AEvent2.EventType <> etNone) then Result := VarEquals(AEvent1.ID, AEvent2.ParentID); if not Result and (AEvent1.EventType <> etNone) and (AEvent2.EventType <> etNone) then Result := VarEquals(AEvent1.ParentID, AEvent2.ParentID); end; function TcxSchedulerEventConflictsInfo.GetHasConflicts: Boolean; begin Result := FConflictEvents.Count > 0; end; function TcxSchedulerEventConflictsInfo.GetHasFreeTime: Boolean; begin Result := FTimeRanges.Count > 0; end; { TcxCustomSchedulerStorage } constructor TcxCustomSchedulerStorage.Create(AOwner: TComponent); begin inherited Create(AOwner); EventsIndex := TList.Create; FIsLoading := True; CreateSubClasses; FIsLoading := False; end; destructor TcxCustomSchedulerStorage.Destroy; begin StopUpdateRemindersTimer; EventsIndex.Free; SendNotification(True); DestroySubClasses; Holidays := nil; inherited Destroy; end; procedure TcxCustomSchedulerStorage.Assign( Source: TPersistent); begin if Source is TcxCustomSchedulerStorage then begin Resources := TcxCustomSchedulerStorage(Source).Resources; CustomFields.Assign(TcxCustomSchedulerStorage(Source).CustomFields); InternalFields.Assign(TcxCustomSchedulerStorage(Source).InternalFields); end; end; procedure TcxCustomSchedulerStorage.AddListener( AListener: IcxSchedulerStorageListener); begin if FListeners.IndexOf(AListener) = -1 then FListeners.Add(AListener); end; procedure TcxCustomSchedulerStorage.BeginUpdate; begin BeginUpdateDataController; end; procedure TcxCustomSchedulerStorage.Clear; begin BeginUpdate; try while EventCount > 0 do Events[0].Delete; finally EndUpdate; end; end; procedure TcxCustomSchedulerStorage.DoneRestore; begin if ResourceCount > 0 then Resources.DoneRestore end; procedure TcxCustomSchedulerStorage.CalculateEventActualTimeRanges; var I: Integer; begin if not ActualTimeRangeAvailable then Exit; BeginUpdate; try for I := 0 to EventCount - 1 do Events[I].CalculateActualTimeRange; finally EndUpdate; end; end; function TcxCustomSchedulerStorage.CheckRequiredFields: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.CreateEvent: TcxSchedulerEvent; begin Result := GetEventClass.Create(Self); FNewEvents.Add(Result); end; function TcxCustomSchedulerStorage.CreateOccurrence(APattern: TcxSchedulerEvent; const ADate: TDateTime; AType: TcxEventType): TcxSchedulerEvent; var ACalculator: TcxSchedulerOccurrenceCalculator; AOccurrence: TcxSchedulerEvent; begin Result := nil; if not (AType in [etCustom, etException]) or (APattern.EventType <> etPattern) then Exit; ACalculator := TcxSchedulerOccurrenceCalculator.Create(APattern, APattern.Start, ADate + 7); try while ACalculator.GetNextOccurrence do begin if APattern.GetOccurrenceByIndex(ACalculator.Index, AOccurrence) then Continue else if DateOf(ACalculator.OccurrenceStart) > DateOf(ADate) then Break else if DateOf(ACalculator.OccurrenceStart) = DateOf(ADate) then begin Result := CreateEvent; Result.Assign(APattern); Result.Start := ACalculator.OccurrenceStart; Result.Finish := ACalculator.OccurrenceFinish; Result.RecurrenceIndex := ACalculator.Index; Result.EventType := AType; Result.ParentID := APattern.ID; Result.FPattern := APattern; Break; end; end; finally ACalculator.Free; end; end; procedure TcxCustomSchedulerStorage.EndUpdate; begin FInternalUpdate := True; try try if LockCount = 1 then begin PostEvents; if FDeletedRecords.Count > 0 then TcxSchedulerStorageDataController(DataController).DeleteRecords(FDeletedRecords); FDeletedRecords.Count := 0; end; finally EndUpdateDataController; end; if FIsChanged then Changed; finally FInternalUpdate := False; end; end; function TcxCustomSchedulerStorage.FindAvailableAllDay( var AStart, AFinish: TDateTime; AResourceID: Variant; AExceptEventsWithoutResources: Boolean; ADuration: TDateTime = 0): Boolean; var I, J: Integer; AList: TcxSchedulerFilteredEventList; AStartDay: TDateTime; begin Result := False; AStartDay := EncodeTime(0, 0, 1, 0); if ADuration = 0 then ADuration := Max(1, Trunc(AFinish) - Trunc(AStart)); AList := TcxSchedulerFilteredEventList.Create; try for I := Trunc(AStart) to Trunc(AStart) + cxMaxCheckedDuration do begin Result := not GetEvents(AList, I + AStartDay, I + ADuration - AStartDay, AResourceID); if not Result then begin Result := True; for J := 0 to AList.Count - 1 do Result := Result and AList[J].IsFreeState; end; if Result then begin AStart := I; AFinish := AStart + ADuration; Break; end; end; finally AList.Free; end; end; function TcxCustomSchedulerStorage.FindAvailableTime( var AStart, AFinish: TDateTime; AllDay: Boolean; AResourceID: Variant; AExceptEventsWithoutResources: Boolean; ADuration: TDateTime = 0; AExcludedEvent: TcxSchedulerEvent = nil): Boolean; var I: Integer; AInfo: TcxSchedulerEventConflictsInfo; begin if ADuration = 0 then ADuration := AFinish - AStart; if AllDay then Result := FindAvailableAllDay(AStart, AFinish, AResourceID, AExceptEventsWithoutResources, ADuration) else begin AInfo := TcxSchedulerEventConflictsInfo.Create(Self, AExceptEventsWithoutResources, Trunc(AStart), Trunc(AFinish) + cxMaxCheckedDuration, AResourceID, AExcludedEvent); try Result := AInfo.HasFreeTime; for I := 0 to AInfo.TimeRanges.Count - 1 do if (AInfo.TimeRanges[I].Duration >= ADuration) and (DateTimeHelper.RoundTime(AInfo.TimeRanges[I].Finish - ADuration) >= AStart) then begin if AInfo.TimeRanges[I].Start > AStart then AStart := AInfo.TimeRanges[I].Start; AFinish := AStart + ADuration; Result := True; Break; end; finally AInfo.Free; end; end; end; function TcxCustomSchedulerStorage.FindAvailableTime(AEvent: TcxSchedulerEvent; AExceptEventsWithoutResources: Boolean; var AStart, AFinish: TDateTime): Boolean; var I: Integer; S: TDateTime; AInfo: TcxSchedulerEventConflictsInfo; begin Result := AEvent.Conflicts(AExceptEventsWithoutResources); S := AEvent.Start; AEvent.GetStartFinishTime(AStart, AFinish); if Result then begin if AEvent.EventType <> etPattern then begin AFinish := AFinish + cxMaxCheckedDuration; Result := FindAvailableTime(AStart, AFinish, AEvent.AllDayEvent, AEvent.ResourceID, AExceptEventsWithoutResources, AEvent.Duration, AEvent); end else begin AEvent.BeginEditing; try AInfo := cxSchedulerEventConflictsInfoClass.Create(Self, AExceptEventsWithoutResources, Trunc(AEvent.Start), Trunc(AEvent.Finish) + 1, AEvent.ResourceID); try Result := False; for I := 1 to 24 * 6 do begin AEvent.MoveTo(AStart + I * 10 * MinuteToTime); if not AEvent.Conflicts(AExceptEventsWithoutResources) then begin AEvent.GetStartFinishTime(AStart, AFinish); Result := True; Break; end; end; finally AInfo.Free; end; finally AEvent.MoveTo(S); AEvent.Cancel; end; end; end end; procedure TcxCustomSchedulerStorage.FullRefresh; begin if IsUpdatingMode then Exit; FIsLoading := True; try DoRefresh; finally FIsLoading := False; SendNotification; end; end; procedure TcxCustomSchedulerStorage.GenerateHolidayEvents(const AResourceID: Variant); begin GenerateHolidayEventsBySchedulerHolidays(AResourceID, Holidays); end; function TcxCustomSchedulerStorage.GetEventByID(const AID: Variant): TcxSchedulerEvent; var I: Integer; begin Result := nil; for I := 0 to EventCount - 1 do if VarEquals(AID, Events[I].ID) then begin Result := Events[I]; break; end; end; function TcxCustomSchedulerStorage.GetEvents( AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime): Boolean; begin Result := GetEvents(AList, AStart, AFinish, Null); end; function TcxCustomSchedulerStorage.GetEvents( AList: TcxSchedulerFilteredEventList; const AStart, AFinish: TDateTime; const AResourceID: Variant): Boolean; var I, J, C: Integer; AEvent: TcxSchedulerEvent; AStartDate, AFinishDate: Integer; begin AList.Init(AStart, AFinish, Self); AList.FReminderEventsOnly := False; AStartDate := Trunc(AStart); AFinishDate := Trunc(AFinish) + 1; for I := 0 to EventCount - 1 do begin AEvent := Events[I]; if not ActualTimeRangeAvailable or AEvent.CheckTimeRange(AStartDate, AFinishDate) then begin if not VarIsArray(AResourceID) then AList.CheckEvent(AEvent, AResourceID) else begin C := AList.Count; for J := VarArrayLowBound(AResourceID, 1) to VarArrayHighBound(AResourceID, 1) do begin AList.CheckEvent(AEvent, AResourceID[J]); if AList.Count <> C then Break; end; end; end; end; AList.Changed; Result := AList.Count > 0; end; function TcxCustomSchedulerStorage.GetFieldByName( const AName: string): TcxCustomSchedulerStorageField; begin Result := CustomFields.FindFieldByName(AName); end; function TcxCustomSchedulerStorage.GetHolidayNamesByDate(ADate: TDate; var ANames: string; AOnlyVisible: Boolean = True): Boolean; begin Result := (Holidays <> nil) and Holidays.GetHolidayNamesByDate(ADate, ANames, AOnlyVisible); end; function TcxCustomSchedulerStorage.GetReminderEvents( ADateTime: TDateTime; AList: TcxSchedulerFilteredEventList): Boolean; var I: Integer; begin AList.Init(NullDate, ADateTime + 14, Self); //calculate for two weeks (= max AdvanceTime) AList.FReminderEventsOnly := True; AList.FNow := Reminders.GetNow; for I := 0 to EventCount - 1 do AList.CheckEvent(Events[I], Null); AList.Changed; Result := AList.Count > 0; end; procedure TcxCustomSchedulerStorage.PopulateHolidayDates(AList: TcxSchedulerDateList; AStart, AFinish: TDate; AOnlyVisible: Boolean = True; AClearList: Boolean = True); begin if AList <> nil then begin if AClearList then AList.Clear; if Holidays <> nil then Holidays.PopulateHolidayDates(AList, AStart, AFinish, AOnlyVisible, AClearList); end; end; procedure TcxCustomSchedulerStorage.PostEvents; begin if not IsActive or (FNewEvents.Count = 0) then Exit; BeginUpdate; try while FNewEvents.Count <> 0 do FNewEvents.Last.Post; finally EndUpdate; end; end; procedure TcxCustomSchedulerStorage.InitRestore; begin if ResourceCount > 0 then Resources.InitRestore; end; function TcxCustomSchedulerStorage.IsActive: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsCaptionAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsLabelColorAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsLocationAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsMessageAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsRecurrenceAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsReminderByResourceAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsReminderAvailable: Boolean; begin Result := True; end; function TcxCustomSchedulerStorage.IsStateAvailable: Boolean; begin Result := True; end; procedure TcxCustomSchedulerStorage.BeginUpdateDataController; begin Inc(LockCount); DataController.BeginUpdate; end; procedure TcxCustomSchedulerStorage.EndUpdateDataController; begin Dec(LockCount); DataController.EndUpdate; end; function TcxCustomSchedulerStorage.GetFieldValueTypeClass( AField: TcxCustomSchedulerStorageField): TcxValueTypeClass; begin if AField = nil then Result := TcxIntegerValueType else Result := DataController.GetItemValueTypeClass(AField.Index); end; procedure TcxCustomSchedulerStorage.RemoveListener( AListener: IcxSchedulerStorageListener); begin FListeners.Remove(AListener); end; // IcxSchedulerHolidaysListener procedure TcxCustomSchedulerStorage.HolidaysChanged(Sender: TObject); begin LayoutChanged; end; procedure TcxCustomSchedulerStorage.HolidaysRemoved(Sender: TObject); begin FHolidays.RemoveListener(Self); FHolidays := nil; LayoutChanged; end; function TcxCustomSchedulerStorage.ActualTimeRangeAvailable: Boolean; begin Result := UseActualTimeRange; end; procedure TcxCustomSchedulerStorage.AddInternalField( var AField: TcxCustomSchedulerStorageField; AValueType: TcxValueTypeClass; AIsUnique: Boolean = True); begin AField := TcxCustomSchedulerStorageField(InternalFields.Add); AField.ValueTypeClass := AValueType; AField.FIsUnique := AIsUnique; end; procedure TcxCustomSchedulerStorage.AddRecord; begin DataController.AppendRecord; end; procedure TcxCustomSchedulerStorage.CancelEvent(AEvent: TcxSchedulerEvent); begin Dec(AEvent.FEditCount); if (AEvent.FEditCount = 0) and AEvent.IsNewEvent then AEvent.Free; Changed; end; function TcxCustomSchedulerStorage.CanGetValueFromPattern( AIndex: Integer): Boolean; begin Result := AIndex in [ FCaptionField.Index, FLabelColorField.Index, FLocationField.Index, FMessageField.Index, FOptionsField.Index, FReminderMinutesBeforeStartField.Index, FStateField.Index, FReminderDateField.Index, FReminderResourcesData.Index]; Result := Result or (AIndex >= InternalFieldCount); end; procedure TcxCustomSchedulerStorage.Changed; begin FIsChanged := IsLocked; if not IsLocked then SendNotification; end; procedure TcxCustomSchedulerStorage.CreateDefaultFields; begin AddInternalField(FCaptionField, TcxStringValueType); AddInternalField(FEventTypeField, TcxIntegerValueType); AddInternalField(FFinishField, TcxDateTimeValueType); AddInternalField(FLabelColorField, TcxIntegerValueType); AddInternalField(FLocationField, TcxStringValueType); AddInternalField(FMessageField, TcxStringValueType); AddInternalField(FOptionsField, TcxIntegerValueType); AddInternalField(FParentIDField, TcxIntegerValueType); AddInternalField(FRecurrenceIndexField, TcxIntegerValueType, False); AddInternalField(FRecurrenceInfoField, TcxVariantValueType, False); AddInternalField(FReminderDateField, TcxDateTimeValueType); AddInternalField(FReminderMinutesBeforeStartField, TcxIntegerValueType); AddInternalField(FResourceIDField, TcxVariantValueType, False); AddInternalField(FStartField, TcxDateTimeValueType); AddInternalField(FStateField, TcxIntegerValueType); AddInternalField(FActualFinishField, TcxIntegerValueType, False); AddInternalField(FActualStartField, TcxIntegerValueType, False); // Version 3 fields CreateVersion3Fields; end; function TcxCustomSchedulerStorage.CreateFields: TcxCustomSchedulerStorageFields; begin Result := TcxSchedulerStorageFields.Create(TcxSchedulerStorageField); end; procedure TcxCustomSchedulerStorage.CreateHolidayEvent(const ACaption: string; const ADate: TDateTime; AResourceID: Variant); begin with createEvent do begin Caption := ACaption; Start := ADate; Finish := Start + 1; AllDayEvent := True; State := tlsFree; ResourceID := AResourceID; Post; end; end; function TcxCustomSchedulerStorage.CreateReminders: TcxSchedulerReminders; begin Result := TcxSchedulerReminders.Create(Self); end; function TcxCustomSchedulerStorage.CreateResources: TcxSchedulerStorageResources; begin Result := TcxSchedulerStorageResources.Create(Self); end; procedure TcxCustomSchedulerStorage.CreateSubClasses; begin FDeletedRecords := TList.Create; FResources := CreateResources; FInternalFields := CreateFields; FInternalFields.FOwner := Self; FCustomFields := CreateFields; FCustomFields.FOwner := Self; FFields := TList.Create; FNewEvents := TcxSchedulerEventList.Create; FEventsList := TcxSchedulerEventList.Create; FListeners := TInterfaceList.Create(); FDataController := GetDataControllerClass.Create(Self); FReminders := CreateReminders; CreateDefaultFields; end; procedure TcxCustomSchedulerStorage.CreateVersion3Fields; var I: Integer; begin AddInternalField(FTaskCompleteField, TcxIntegerValueType, False); AddInternalField(FTaskIndexField, TcxIntegerValueType, False); AddInternalField(FTaskLinksField, TcxVariantValueType, False); AddInternalField(FTaskStatusField, TcxIntegerValueType, False); AddInternalField(FReminderResourcesData, TcxVariantValueType, False); if CustomFields.Count > 0 then begin for I := 0 to InternalFields.Count - 1 do TcxCustomSchedulerStorageField(InternalFields.Items[I]).FIndex := I; for I := 0 to CustomFields.Count - 1 do TcxCustomSchedulerStorageField(CustomFields.Items[I]).FIndex := I + InternalFields.Count; FFields.Sort(@cxSchedulerStorageFieldsCompare); DataController.UpdateItemIndexes; end; end; procedure TcxCustomSchedulerStorage.DestroySubClasses; begin FReminders.Free; try FCustomFields.Clear; FInternalFields.Clear; FEventsList.DestroyItems; FNewEvents.DestroyItems; FDeletedRecords.Free; finally FDataController.Free; FNewEvents.Free; FEventsList.Free; FCustomFields.Free; FInternalFields.Free; FFields.Free; FResources.Free; FreeAndNil(FEditor); FListeners.Free; end; end; procedure TcxCustomSchedulerStorage.DestroyVersion3Fields; procedure DeleteField(var AField: TcxCustomSchedulerStorageField); begin try FInternalFields.Delete(AField.Index) finally AField := nil; end; end; begin DeleteField(FTaskCompleteField); DeleteField(FTaskIndexField); DeleteField(FTaskLinksField); DeleteField(FTaskStatusField); DeleteField(FReminderResourcesData); end; procedure TcxCustomSchedulerStorage.DoDeleteEvent( const ARecordIndex: Integer); var I: Integer; AParentEvent, AChildEvent: TcxSchedulerEvent; AEventsChain: TcxSchedulerEventList; begin AParentEvent := FEventsList[ARecordIndex]; if AParentEvent = LastEditedEvent then FLastEditedEvent := nil; if IsUpdatingMode or IsDeletion or DoEventDeleted(AParentEvent) then Exit; IsDeletion := True; BeginUpdate; FDeletedRecords.Add(Pointer(AParentEvent.RecordIndex)); try AEventsChain := AParentEvent.GetRecurrenceChain; try for I := 0 to AEventsChain.Count - 1 do begin AChildEvent := AEventsChain[I]; DoEventDeleted(AChildEvent); //ignore Allow parameter for the database integrity FDeletedRecords.Add(Pointer(AChildEvent.RecordIndex)); AChildEvent.Free; end; AParentEvent.Free; finally AEventsChain.Free; end; finally for I := ARecordIndex to FEventsList.Count - 1 do TcxSchedulerEvent(FEventsList.FItems.List^[I]).FIndex := I; IsDeletion := False; EndUpdate; end; end; procedure TcxCustomSchedulerStorage.DoDestroyEvent( AEvent: TcxSchedulerEvent); begin if not AEvent.FIsDeletion then begin FEventsList.Remove(AEvent); FNewEvents.Remove(AEvent); end; end; function TcxCustomSchedulerStorage.DoEventDeleted( AEvent: TcxSchedulerEvent): Boolean; begin Result := False; if AEvent = LastEditedEvent then FLastEditedEvent := nil; if Assigned(FOnEventDeleted) then FOnEventDeleted(Self, AEvent, Result); end; function TcxCustomSchedulerStorage.DoEventInserted( AEvent: TcxSchedulerEvent): Boolean; begin Result := False; if Assigned(FOnEventInserted) then FOnEventInserted(Self, AEvent, Result); end; function TcxCustomSchedulerStorage.DoEventIntersect(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; begin Result := False; if Assigned(FOnEventIntersect) then FOnEventIntersect(Self, AEvent1, AEvent2, Result); end; function TcxCustomSchedulerStorage.DoEventModified( AEvent: TcxSchedulerEvent): Boolean; begin Result := False; with AEvent do begin if IsModified and Assigned(FOnEventModified) then FOnEventModified(Self, AEvent, Result); end; end; function TcxCustomSchedulerStorage.DoFilterEvent(AEvent: TcxSchedulerEvent): Boolean; begin Result := True; if Assigned(FOnFilterEvent) then FOnFilterEvent(Self, AEvent, Result); end; procedure TcxCustomSchedulerStorage.DoRefresh; var I, J: Integer; AEvent: TcxSchedulerEvent; begin Reminders.StopTimers; if LockCount > 0 then Exit; SynchronizeEventsWithRecords; for I := 0 to EventCount - 1 do begin AEvent := Events[I]; AEvent.FIndex := I; AEvent.TaskLinkOwners.Clear; if AEvent.EventType = etPattern then begin AEvent.FLink := nil; for J := 0 to EventCount - 1 do if J <> I then AEvent.CheckRecurrenceLink(Events[J]); end; end; for I := 0 to EventCount - 1 do Events[I].InitTaskLinks; for I := 0 to EventCount - 1 do Events[I].RefreshTaskLinks; if Reminders.Active then StartUpdateRemindersTimer; end; procedure TcxCustomSchedulerStorage.GenerateHolidayEventsBySchedulerHolidays( const AResourceID: Variant; AHolidays: TcxSchedulerHolidays); var I: Integer; begin if (AHolidays = nil) or (AHolidays.Count = 0) then Exit; BeginUpdate; try for I := 0 to AHolidays.Count - 1 do if AHolidays[I].IsVisible then CreateHolidayEvent(AHolidays[I].DisplayText, DateOf(AHolidays[I].Date), AResourceID); finally EndUpdate; end; end; function TcxCustomSchedulerStorage.GetDataControllerClass: TcxCustomDataControllerClass; begin Result := TcxSchedulerStorageDataController; end; function TcxCustomSchedulerStorage.GetEventStoredID(AEvent: TcxSchedulerEvent): Variant; begin Result := AEvent.FSavedID; end; function TcxCustomSchedulerStorage.GetFieldValueBeforePost( ARecordIndex, AFieldIndex: Integer): Variant; begin Result := Values[ARecordIndex, AFieldIndex]; end; function TcxCustomSchedulerStorage.GetFocusedRecordID(ARecordIndex: Integer): Variant; begin Result := DataController.GetRecordId(ARecordIndex); end; function TcxCustomSchedulerStorage.GetEventClass: TcxSchedulerEventClass; begin Result := TcxSchedulerEvent; end; function TcxCustomSchedulerStorage.GetParentForm: TForm; var AOwner: TComponent; begin AOwner := Owner; while not (AOwner is TForm) and (AOwner <> nil) do AOwner := AOwner.Owner; Result := TForm(AOwner); end; function TcxCustomSchedulerStorage.GetRecordID( const ARecordIndex: Integer): Variant; begin if ARecordIndex >= DataController.RecordCount then Result := Null else Result := DataController.GetRecordID(ARecordIndex); end; function TcxCustomSchedulerStorage.GetValue( ARecordIndex, AItemIndex: Integer): Variant; begin if ARecordIndex = cxInvalidRecordIndex then Result := Null else begin if DataController.IsEditing and (ARecordIndex = DataController.EditingRecordIndex) then Result := DataController.GetEditValue(AItemIndex, evsValue) else Result := DataController.Values[ARecordIndex, AItemIndex]; end; end; function TcxCustomSchedulerStorage.HasEventIntersect(AEvent1, AEvent2: TcxSchedulerEvent): Boolean; begin Result := not DoEventIntersect(AEvent1, AEvent2); end; procedure TcxCustomSchedulerStorage.ItemAdded( AItem: TcxCustomSchedulerStorageField); begin if FFields.IndexOf(AItem) = -1 then try AItem.FIndex := FFields.Add(AItem); DataController.AddItem(AItem); finally DataController.UpdateItemIndexes; LayoutChanged; end; end; procedure TcxCustomSchedulerStorage.ItemRemoved( AItem: TcxCustomSchedulerStorageField); begin if FFields.Remove(AItem) <> -1 then try DataController.RemoveItem(AItem); finally UpdateItemIndexes; LayoutChanged; end; end; function TcxCustomSchedulerStorage.IsDataSettingsValid: Boolean; begin Result := True; end; procedure TcxCustomSchedulerStorage.LayoutChanged; begin SendNotification; end; procedure TcxCustomSchedulerStorage.Loaded; begin inherited Loaded; DataController.Loaded; FullRefresh; end; procedure TcxCustomSchedulerStorage.Notification( AComponent: TComponent; Operation: TOperation); begin if (Resources <> Nil) and (Operation = opRemove)and (AComponent = Resources.Images) then Resources.Images := nil; inherited Notification(AComponent, Operation); end; procedure TcxCustomSchedulerStorage.PostEvent( AEvent: TcxSchedulerEvent); var ARecordIndex: Integer; begin BeginUpdate; try if AEvent.IsNewEvent then begin FNewEvents.Remove(AEvent); FEventsList.Add(AEvent); if DoEventInserted(AEvent) then Exit; if CheckRequiredFields then begin ARecordIndex := DataController.RecordCount; AddRecord; if ARecordIndex < DataController.RecordCount then begin AEvent.SetRecordIndex(ARecordIndex); AEvent.EndEditing; AEvent.FSavedID := GetFocusedRecordID(ARecordIndex); end; end else AEvent.Free; end; finally EndUpdate; end; end; procedure TcxCustomSchedulerStorage.PostEditingData( AEvent: TcxSchedulerEvent); var AFieldIndex: Integer; begin if DoEventModified(AEvent) then Exit; BeginUpdateDataController; try for AFieldIndex := 0 to AEvent.ValueCount - 1 do SetPostFieldValue(AEvent, AFieldIndex); finally EndUpdateDataController; end; end; procedure TcxCustomSchedulerStorage.SendNotification( AIsRemoved: Boolean = False); var I: Integer; AIntf: IcxSchedulerStorageListener; begin if LockCount <> 0 then Exit; for I := Listeners.Count - 1 downto 0 do if Supports(Listeners[I], IcxSchedulerStorageListener, AIntf) then begin if AIsRemoved then AIntf.StorageRemoved(Self) else if not IsUpdatingMode then begin FIsChanged := False; AIntf.StorageChanged(Self); end; end; end; procedure TcxCustomSchedulerStorage.SetEventRecordInfo(AEvent: TcxSchedulerEvent; ARecordIndex: Integer; const AEventID: Variant); begin AEvent.SetRecordIndex(ARecordIndex); AEvent.FSavedID := AEventID; end; procedure TcxCustomSchedulerStorage.SetFieldValueBeforePost( ARecordIndex, AFieldIndex: Integer; const AValue: Variant); begin Values[ARecordIndex, AFieldIndex] := AValue; end; procedure TcxCustomSchedulerStorage.SetPostFieldValue(AEvent: TcxSchedulerEvent; AFieldIndex: Integer); var AEventValue, APatternValue, AStoredValue: Variant; begin AEventValue := AEvent.FEditValues[AFieldIndex]; if (AEvent.Pattern <> nil) and (AEvent.EventType = etCustom) and CanGetValueFromPattern(AFieldIndex) then begin APatternValue := Values[AEvent.Pattern.RecordIndex, AFieldIndex]; AStoredValue := GetFieldValueBeforePost(AEvent.RecordIndex, AFieldIndex); if not VarEquals(AEventValue, APatternValue) or (not VarEquals(AEventValue, AStoredValue) and not VarIsNull(AStoredValue)) then SetFieldValueBeforePost(AEvent.RecordIndex, AFieldIndex, AEventValue); end else SetFieldValueBeforePost(AEvent.RecordIndex, AFieldIndex, AEventValue); end; procedure TcxCustomSchedulerStorage.SetValue( ARecordIndex, AItemIndex: Integer; const AValue: Variant); begin if ARecordIndex <> cxInvalidRecordIndex then DataController.Values[ARecordIndex, AItemIndex] := AValue; end; procedure TcxCustomSchedulerStorage.SynchronizeEventsWithRecords; var ID: Variant; AEvent: TcxSchedulerEvent; IndexList, DestList: TList; I, ACount: Integer; begin if not IsDataSettingsValid then ACount := 0 else ACount := DataController.RecordCount; IndexList := FEventsList.FItems; IndexList.Sort(TListSortCompare(@cxCompareEventsByID)); DestList := TList.Create; try FEventsList.FItems := DestList; DestList.Count := ACount; for I := 0 to ACount - 1 do begin ID := DataController.GetRecordID(I); if not cxFindEvent(IndexList, ID, AEvent) then AEvent := GetEventClass.Create(Self, I); AEvent.SetRecordIndex(I); AEvent.FPattern := nil; DestList[I] := AEvent; end; for I := 0 to IndexList.Count - 1 do begin if FLastEditedEvent = IndexList.List^[I] then FLastEditedEvent := nil; TObject(IndexList.List^[I]).Free; end; finally IndexList.Free; end; end; procedure TcxCustomSchedulerStorage.UpdateControl( AInfo: TcxUpdateControlInfo); begin if (AInfo is TcxDataChangedInfo) or (AInfo is TcxUpdateRecordInfo) then FullRefresh; end; procedure TcxCustomSchedulerStorage.UpdateData; begin end; procedure TcxCustomSchedulerStorage.UpdateItemIndexes; var I: Integer; begin for I := 0 to FieldCount - 1 do TcxCustomSchedulerStorageField(FFields[I]).FIndex := I; SendNotification; end; function TcxCustomSchedulerStorage.GetDataField( AIndex: Integer): TcxCustomSchedulerStorageField; begin Result := TcxCustomSchedulerStorageField(FFields[AIndex]); end; function TcxCustomSchedulerStorage.GetEvent( AIndex: Integer): TcxSchedulerEvent; begin Result := FEventsList[AIndex]; end; function TcxCustomSchedulerStorage.GetEventCount: Integer; begin Result := FEventsList.Count; end; function TcxCustomSchedulerStorage.GetField(AIndex: Integer): TcxCustomSchedulerStorageField; begin Result := TcxCustomSchedulerStorageField(FFields[AIndex]); end; function TcxCustomSchedulerStorage.GetFieldCount: Integer; begin Result := FFields.Count end; function TcxCustomSchedulerStorage.GetInternalFieldCount: Integer; begin Result := FInternalFields.Count; end; function TcxCustomSchedulerStorage.GetIsDestroying: Boolean; begin Result := csDestroying in ComponentState; end; function TcxCustomSchedulerStorage.GetIsLoading: Boolean; begin Result := csLoading in ComponentState; end; function TcxCustomSchedulerStorage.GetIsLocked: Boolean; begin Result := DataController.LockCount > 0 end; function TcxCustomSchedulerStorage.GetIsUpdatingMode: Boolean; begin Result := FIsLoading or IsLoading or IsDestroying; end; function TcxCustomSchedulerStorage.GetResourceCount: Integer; begin Result := Resources.ResourceItems.Count; end; function TcxCustomSchedulerStorage.GetResourceID(AIndex: Integer): Variant; begin Result := Resources.ResourceItems[AIndex].ResourceID; end; function TcxCustomSchedulerStorage.GetResourceName(AIndex: Integer): string; begin Result := Resources.ResourceItems[AIndex].DisplayName; end; procedure TcxCustomSchedulerStorage.SetEvent( AIndex: Integer; AValue: TcxSchedulerEvent); begin Events[AIndex].Assign(AValue); end; procedure TcxCustomSchedulerStorage.SetHolidays(AValue: TcxSchedulerHolidays); begin if AValue <> FHolidays then begin if FHolidays <> nil then begin FHolidays.RemoveListener(Self); end; FHolidays := AValue; if FHolidays <> nil then begin FHolidays.AddListener(Self); end; FullRefresh; end; end; procedure TcxCustomSchedulerStorage.SetOnFilterEvent( AValue: TcxSchedulerFilterEventEvent); begin if @FOnFilterEvent <> @AValue then begin FOnFilterEvent := AValue; SendNotification; end; end; procedure TcxCustomSchedulerStorage.SetReminders( AValue: TcxSchedulerReminders); begin FReminders.Assign(AValue); end; procedure TcxCustomSchedulerStorage.SetResources( AValue: TcxSchedulerStorageResources); begin FResources.Assign(AValue); end; procedure TcxCustomSchedulerStorage.SetStoreUsingGlobalTime(AValue: Boolean); begin if StoreUsingGlobalTime <> AValue then begin FStoreUsingGlobalTime := AValue; if AValue then begin with DateTimeHelper do TimeBias := TimeZoneBias(CurrentTimeZone) end else TimeBias := 0; Changed; end; end; procedure TcxCustomSchedulerStorage.StartUpdateRemindersTimer; begin if (FUpdateRemindersTimer <> nil) or (not Reminders.Active or (csDesigning in ComponentState)) then Exit; FUpdateRemindersTimer := TTimer.Create(nil); FUpdateRemindersTimer.Interval := 50; FUpdateRemindersTimer.OnTimer := UpdateRemindersTimerEvent; end; procedure TcxCustomSchedulerStorage.StopUpdateRemindersTimer; begin FreeAndNil(FUpdateRemindersTimer); end; procedure TcxCustomSchedulerStorage.UpdateReminders; begin StopUpdateRemindersTimer; with Reminders do if Active then Refresh; end; procedure TcxCustomSchedulerStorage.UpdateRemindersTimerEvent( Sender: TObject); begin UpdateReminders; end; { TcxSchedulerStorage } procedure TcxSchedulerStorage.Assign(Source: TPersistent); var AMemStream: TMemoryStream; begin if Source is TcxSchedulerStorage then begin AMemStream := TMemoryStream.Create; try TcxSchedulerStorage(Source).SaveToStream(AMemStream); AMemStream.Position := 0; LoadFromStream(AMemStream); finally AMemStream.Free; end; end else inherited Assign(Source); end; procedure TcxSchedulerStorage.SaveToFile( const AFileName: string); var AStream: TFileStream; begin AStream := TFileStream.Create(AFileName, fmCreate); try SaveToStream(AStream); finally AStream.Free; end; end; procedure TcxSchedulerStorage.SaveToStream(AStream: TStream); begin WriteAnsiStringProc(AStream, scxSchedulerSignature); AStream.WriteBuffer(cxSchedulerStreamVersion, SizeOf(cxSchedulerStreamVersion)); DataController.SaveToStream(AStream); end; procedure TcxSchedulerStorage.LoadFromFile(const AFileName: string); var AStream: TFileStream; begin AStream := TFileStream.Create(AFileName, fmOpenRead); try LoadFromStream(AStream); finally AStream.Free; end; end; procedure TcxSchedulerStorage.LoadFromStream( AStream: TStream); var C: Integer; AVersion: Double; AMemStream: TMemoryStream; begin AMemStream := TMemoryStream.Create; BeginUpdate; try SaveToStream(AMemStream); try DataController.RecordCount := 0; DataController.Post; AVersion := GetStreamVersion(AStream, C, CustomFields.Count); if AVersion < 0 then cxSchedulerError(cxGetResourceString(@cxSDataInvalidStreamFormat)); try if AVersion < 3.0 then DestroyVersion3Fields; DataController.LoadFromStream(AStream); finally if AVersion < 3.0 then CreateVersion3Fields; end; except Clear; DataController.LoadFromStream(AMemStream); raise; end; finally AMemStream.Free; if IsUpdatingMode then DoRefresh; EndUpdate; end; end; procedure TcxSchedulerStorage.DefineProperties( Filer: TFiler); begin inherited DefineProperties(Filer); Filer.DefineBinaryProperty('BinaryData', LoadFromStream, SaveToStream, DataController.RecordCount > 0); end; function TcxSchedulerStorage.GetCustomFields: TcxSchedulerStorageFields; begin Result := TcxSchedulerStorageFields(inherited CustomFields) end; procedure TcxSchedulerStorage.SetCustomFields( const AValue: TcxSchedulerStorageFields); begin CustomFields.Assign(AValue); end; { TcxSchedulerControlEventID } constructor TcxSchedulerControlEventID.Create(AEvent: TcxSchedulerEvent); begin if AEvent.RecordIndex <> -1 then begin ID := AEvent.ID; ParentID := AEvent.ParentID; RecurrenceIndex := AEvent.RecurrenceIndex end else begin ID := Null; ParentID := Null; RecurrenceIndex := -1; end; end; function TcxSchedulerControlEventID.SameEvent(AEvent: TcxSchedulerEvent): Boolean; begin Result := VarEquals(AEvent.ID, ID) and VarEquals(AEvent.ParentID, ParentID) and (AEvent.RecurrenceIndex = RecurrenceIndex); end; function TcxSchedulerControlEventID.Equals(AValue: TcxSchedulerControlEventID): Boolean; begin Result := (AValue = Self) or VarEquals(AValue.ID, ID) and VarEquals(AValue.ParentID, ParentID) and (AValue.RecurrenceIndex = RecurrenceIndex); end; { TcxSchedulerEventSelection } constructor TcxSchedulerEventSelection.Create( ASourceEvents: TcxSchedulerEventList); begin FKeys := TList.Create; FEvents := TList.Create; FSourceEvents := ASourceEvents; end; destructor TcxSchedulerEventSelection.Destroy; begin InternalClear; FEvents.Free; FKeys.Free; inherited Destroy; end; procedure TcxSchedulerEventSelection.Add( AEvent: TcxSchedulerControlEvent; AShift: TShiftState); var AIndex: Integer; ASelected: Boolean; begin ASelected := (AEvent <> nil) and AEvent.Selected; if (AEvent = nil) or ([ssShift, ssCtrl] * AShift = []) then InternalClear; if AEvent <> nil then try AIndex := KeyIndexOf(AEvent); if (ssCtrl in AShift) and (AIndex >= 0) then begin Keys[AIndex].Free; FKeys.Delete(AIndex); end else if AIndex < 0 then FKeys.Add(CreateItem(AEvent)); finally Update; if ASelected <> AEvent.Selected then DoEventSelectionChanged(AEvent); end; end; procedure TcxSchedulerEventSelection.Clear; begin if Count = 0 then Exit; InternalClear; DoEventSelectionChanged(nil); end; function TcxSchedulerEventSelection.IsSelected( AEvent: TcxSchedulerControlEvent): Boolean; begin Result := KeyIndexOf(AEvent) >= 0; end; procedure TcxSchedulerEventSelection.Select(AEvent: TcxSchedulerEvent); begin InternalClear; FKeys.Add(TcxSchedulerControlEventID.Create(AEvent)); DoEventSelectionChanged(nil); end; procedure TcxSchedulerEventSelection.Update; begin FKeys.Sort(TListSortCompare(@cxCompareSelectionKeys)); ReplaceSelection; end; procedure TcxSchedulerEventSelection.ClearKeys; var I: Integer; begin for I := FKeys.Count - 1 downto 0 do TObject(FKeys.List^[I]).Free; FKeys.Clear; end; function TcxSchedulerEventSelection.CreateItem( AEvent: TcxSchedulerControlEvent): TcxSchedulerControlEventID; begin Result := TcxSchedulerControlEventID.Create(AEvent); end; procedure TcxSchedulerEventSelection.DoEventSelectionChanged( AEvent: TcxSchedulerControlEvent); begin if Assigned(FOnEventSelectionChanged) then FOnEventSelectionChanged(AEvent); end; function TcxSchedulerEventSelection.KeyIndexOf( AEvent: TcxSchedulerControlEvent): Integer; var I, L, R, C: Integer; AItemForSearch: TcxSchedulerControlEventID; begin Result := -1; L := 0; R := KeyCount - 1; if R < L then Exit; AItemForSearch := CreateItem(AEvent); try while L <= R do begin I := (L + R) shr 1; C := cxCompareSelectionKeys(Keys[I], AItemForSearch); if C < 0 then L := I + 1 else begin R := I - 1; if C = 0 then begin Result := I; Break; end; end; end; finally AItemForSearch.Free; end; end; function TcxSchedulerEventSelection.IndexOf( AEvent: TcxSchedulerControlEvent): Integer; begin Result := FEvents.IndexOf(AEvent); end; procedure TcxSchedulerEventSelection.InternalClear; begin ClearKeys; FEvents.Clear; end; procedure TcxSchedulerEventSelection.ReplaceSelection; var AIndex, I: Integer; begin FEvents.Clear; for I := 0 to FSourceEvents.Count - 1 do begin AIndex := KeyIndexOf(TcxSchedulerControlEvent(FSourceEvents[I])); if AIndex <> -1 then FEvents.Add(FSourceEvents[I]); end; ClearKeys; for I := 0 to FEvents.Count - 1 do FKeys.Add(CreateItem(TcxSchedulerControlEvent(FEvents[I]))); FKeys.Sort(TListSortCompare(@cxCompareSelectionKeys)); end; function TcxSchedulerEventSelection.GetCount: Integer; begin Result := FEvents.Count; end; function TcxSchedulerEventSelection.GetItem( AIndex: Integer): TcxSchedulerControlEvent; begin Result := TcxSchedulerControlEvent(FEvents.List^[AIndex]) end; function TcxSchedulerEventSelection.GetKey( AIndex: Integer): TcxSchedulerControlEventID; begin Result := FKeys.List^[AIndex]; end; function TcxSchedulerEventSelection.GetKeyCount: Integer; begin Result := FKeys.Count; end; { TcxSchedulerEventList } constructor TcxSchedulerEventList.Create; begin FItems := TList.Create; end; destructor TcxSchedulerEventList.Destroy; begin FItems.Free; inherited Destroy; end; procedure TcxSchedulerEventList.Assign(ASource: TcxSchedulerEventList{$IFDEF DELPHI6}; AOperator: TListAssignOp = laCopy {$ENDIF}); {$IFNDEF DELPHI6} var I: Integer; {$ENDIF} begin if ASource = nil then Exit; {$IFDEF DELPHI6} FItems.Assign(ASource.FItems, AOperator, nil); {$ELSE} FItems.Clear; FItems.Capacity := ASource.FItems.Capacity; for I := 0 to ASource.FItems.Count - 1 do FItems.Add(ASource.FItems.List^[I]); {$ENDIF} end; function TcxSchedulerEventList.Add( AEvent: TcxSchedulerEvent): Integer; begin Result := FItems.Add(AEvent); EventAdded(AEvent); end; procedure TcxSchedulerEventList.Clear; begin DoClear(False); end; procedure TcxSchedulerEventList.Delete(AIndex: Integer); begin FItems.Delete(AIndex); end; procedure TcxSchedulerEventList.DestroyItems; begin DoClear(True); end; function TcxSchedulerEventList.Remove( AEvent: TcxSchedulerEvent): Integer; begin Result := FItems.Remove(AEvent); end; function TcxSchedulerEventList.IndexOf( AEvent: TcxSchedulerEvent): Integer; begin Result := FItems.IndexOf(AEvent); end; procedure TcxSchedulerEventList.Sort( ACompare: TcxCompareEventsProc); begin FItems.Sort(@ACompare); end; procedure TcxSchedulerEventList.EventAdded( AEvent: TcxSchedulerEvent); begin end; procedure TcxSchedulerEventList.DoClear(AFreeItems: Boolean); var I: Integer; begin if AFreeItems then for I := FItems.Count - 1 downto 0 do with Items[I] do begin FIsDeletion := True; Free; end; FItems.Clear; end; function TcxSchedulerEventList.GetCount: Integer; begin Result := FItems.Count; end; function TcxSchedulerEventList.GetFirst: TcxSchedulerEvent; begin Result := TcxSchedulerEvent(FItems.First); end; function TcxSchedulerEventList.GetEvent( AIndex: Integer): TcxSchedulerEvent; begin Result := TcxSchedulerEvent(FItems.List^[AIndex]); end; function TcxSchedulerEventList.GetLast: TcxSchedulerEvent; begin Result := TcxSchedulerEvent(FItems.Last); end; { TcxSchedulerFilteredEventList } destructor TcxSchedulerFilteredEventList.Destroy; begin DestroyItems; inherited Destroy; end; function TcxSchedulerFilteredEventList.AddEvent( AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; begin Result := CreateControlEvent(AEvent); Add(Result); end; function TcxSchedulerFilteredEventList.AddOccurrence( ACalculator: TcxSchedulerOccurrenceCalculator): TcxSchedulerControlEvent; var AReminderStart: TDateTime; begin Result := nil; if ReminderEventsOnly and not ACalculator.Event.Reminder then Exit; begin if ReminderEventsOnly then begin AReminderStart := ACalculator.OccurrenceStart - ACalculator.Event.ReminderMinutesBeforeStart * MinuteToTime; if NeedAddOccurenceForReminder(AReminderStart, ACalculator.Event) then begin if (ACalculator.FOccurence <> nil) and (DateOf(AReminderStart) < DateOf(FNow)) then begin FreeAndNil(ACalculator.FOccurence); Delete(ACalculator.FOccurencePos); end; ACalculator.FOccurencePos := Count; Result := AddEvent(ACalculator.Event); ACalculator.FOccurence := Result; end; end else if (ACalculator.OccurrenceStart <= Finish) and (ACalculator.OccurrenceFinish >= Start) then Result := AddEvent(ACalculator.Event); if Result = nil then Exit; if ACalculator.Event.RecordIndex >= 0 then Result.ParentID := ACalculator.Event.ID; Result.Start := ACalculator.OccurrenceStart - Result.TimeBias + GetTimeBiasDaylightSavingTime(ACalculator.OccurrenceStart) + Storage.TimeBias; Result.Finish := ACalculator.OccurrenceFinish - Result.TimeBias + GetTimeBiasDaylightSavingTime(ACalculator.OccurrenceStart) + Storage.TimeBias; Result.RecurrenceIndex := ACalculator.Index; Result.EventType := etOccurrence; Result.FPattern := ACalculator.Event; Result.FOptions := ACalculator.Event.FOptions; Result.ReminderDate := ACalculator.Event.ReminderDate; end; if (Result <> nil) and not Storage.DoFilterEvent(Result) then begin if ACalculator.FOccurence = Result then ACalculator.FOccurence := nil; FreeAndNil(Result); Delete(Count - 1); end; end; procedure TcxSchedulerFilteredEventList.Changed; begin end; procedure TcxSchedulerFilteredEventList.CheckEvent( AEvent: TcxSchedulerEvent; const AResourceID: Variant); begin if AEvent.EventType in [etNone, etCustom] then CheckSimpleEvent(AEvent, AResourceID) else if (AEvent.EventType = etPattern) or AEvent.SkipExceptions then CheckRecurrenceEvent(AEvent, AResourceID); end; function TcxSchedulerFilteredEventList.CheckEventTimeRange: Boolean; begin Result := True; end; procedure TcxSchedulerFilteredEventList.CheckRecurrenceEvent( AEvent: TcxSchedulerEvent; const AResourceID: Variant); var AOccurrence: TcxSchedulerEvent; ACalculator: TcxSchedulerOccurrenceCalculator; begin ACalculator := TcxSchedulerOccurrenceCalculator.Create(AEvent, AEvent.Start, FFinish, ReminderEventsOnly); try while ACalculator.GetNextOccurrence do begin if not AEvent.GetOccurrenceByIndex(ACalculator.Index, AOccurrence) then if VarIsNull(AResourceID) or AEvent.IsSharedWithResource(AResourceID) then AddOccurrence(ACalculator); end; finally ACalculator.Free; end; end; procedure TcxSchedulerFilteredEventList.CheckSimpleEvent( AEvent: TcxSchedulerEvent; const AResourceID: Variant); begin if not Storage.DoFilterEvent(AEvent) then Exit; if VarIsNull(AResourceID) or AEvent.IsSharedWithResource(AResourceID) then begin if FReminderEventsOnly then begin if AEvent.Reminder and (AEvent.ReminderDate <= Finish) then AddEvent(AEvent).FPattern := AEvent.FPattern; end else if not CheckEventTimeRange or ((AEvent.Start <= Finish) and (AEvent.Finish >= Start)) then AddEvent(AEvent).FPattern := AEvent.FPattern; end; end; function TcxSchedulerFilteredEventList.CreateControlEvent( AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; begin Result := TcxSchedulerControlEvent.Create(AEvent); Result.FTimeBias := AEvent.TimeBias; Result.FLink := AEvent.FLink; end; function TcxSchedulerFilteredEventList.GetTimeBiasDaylightSavingTime( ATime: TDateTime): TDateTime; begin Result := 0; end; procedure TcxSchedulerFilteredEventList.Init( const AStart, AFinish: TDateTime; AStorage: TcxCustomSchedulerStorage); begin DestroyItems; FStart := AStart; FFinish := AFinish; FStorage := AStorage; end; function TcxSchedulerFilteredEventList.NeedAddOccurenceForReminder( AReminderStart: TDateTime; AEvent: TcxSchedulerEvent): Boolean; begin Result := (AEvent.RecurrenceInfo.DismissDate < DateOf(Now)) and (AReminderStart > AEvent.RecurrenceInfo.DismissDate) and (AReminderStart < Finish); end; function TcxSchedulerFilteredEventList.GetEvent( AIndex: Integer): TcxSchedulerControlEvent; begin Result := TcxSchedulerControlEvent(FItems.List^[AIndex]) end; { TcxSchedulerCachedEventList } constructor TcxSchedulerCachedEventList.Create; begin inherited Create; FAbsoluteItems := TList.Create; FSelection := CreateSelection; FClones := CreateCloneList; FShowEventsWithoutResource := True; FTimeZone := -1; FUseTimeRange := True; end; destructor TcxSchedulerCachedEventList.Destroy; begin FreeAndNil(FClones); FreeAndNil(FSelection); FreeAndNil(FAbsoluteItems); inherited Destroy; end; procedure TcxSchedulerCachedEventList.BeforeEditing( AEvent: TcxSchedulerControlEvent; AIsInplace: Boolean); function GetEventID(AEvent: TcxSchedulerEvent): Variant; begin Result := Null; if AEvent <> nil then Result := AEvent.ID; end; begin AEvent.FIsEditing := AIsInplace; FSavedPatternID := GetEventID(AEvent.Pattern); FSavedSourceID := GetEventID(AEvent.Source); FSavedIndex := AEvent.RecurrenceIndex; end; procedure TcxSchedulerCachedEventList.BeforeUpdate; begin FExpandedTimeRange := CalculateNecessaryDate( FMinNecessaryDate, FMaxNecessaryDate); end; procedure TcxSchedulerCachedEventList.DeleteEvent( AEvent: TcxSchedulerControlEvent); begin if (AEvent.Source <> nil) or (AEvent.EventType = etOccurrence) then AEvent.Delete else begin FItems.Remove(AEvent); FAbsoluteItems.Remove(AEvent); AEvent.Free; end; end; procedure TcxSchedulerCachedEventList.CalculateClonesRange( var AMinDate, AMaxDate: TDateTime); var I: Integer; begin if Clones.Count = 0 then Exit; AMinDate := Clones[0].Start; AMaxDate := Clones[0].Finish; for I := 1 to Clones.Count - 1 do begin AMinDate := Min(AMinDate, Clones[I].Start); AMaxDate := Max(AMaxDate, Clones[I].Finish); end; end; function TcxSchedulerCachedEventList.CalculateNecessaryDate( var AMinDate, AMaxDate: TDateTime): Boolean; var AMin, AMax: TDateTime; begin Result := (Clones.Count > 0) or (Selection.Count > 0); if not Result then Exit; if Clones.Count > 0 then CalculateClonesRange(AMinDate, AMaxDate); if Selection.Count > 0 then CalculateSelectionRange(AMin, AMax) else Exit; if Clones.Count > 0 then begin AMinDate := Min(AMinDate, AMin); AMaxDate := Max(AMaxDate, AMax); end else begin AMinDate := AMin; AMaxDate := AMax; end; end; procedure TcxSchedulerCachedEventList.CalculateSelectionRange( var AMinDate, AMaxDate: TDateTime); var I: Integer; begin if Selection.Count = 0 then Exit; AMinDate := Selection.Items[0].Start; AMaxDate := Selection.Items[0].Finish; for I := 1 to Selection.Count - 1 do begin AMinDate := Min(AMinDate, Selection.Items[I].Start); AMaxDate := Max(AMaxDate, Selection.Items[I].Finish); end; end; procedure TcxSchedulerCachedEventList.CancelClones; begin FHasClones := False; FClones.DestroyItems; Changed; end; function TcxSchedulerCachedEventList.CreateEvent: TcxSchedulerControlEvent; begin Storage.FLastEditedEvent := nil; Result := TcxSchedulerControlEvent.Create(Storage); Result.FIsSource := True; FItems.Add(Result); FAbsoluteItems.Add(Result); end; function TcxSchedulerCachedEventList.CreateClones: TcxSchedulerEventList; var I: Integer; AEvent: TcxSchedulerControlEvent; begin FClones.DestroyItems; for I := 0 to Selection.Count - 1 do begin AEvent := CreateControlEvent(Selection.Items[I]); Selection.Items[I].FIsSource := True; AEvent.FIsClone := True; AEvent.FPattern := AEvent.Source.FPattern; FClones.Add(AEvent); end; Result := FClones; FHasClones := FClones.Count > 0; FExpandedTimeRange := CalculateNecessaryDate(FMinNecessaryDate, FMaxNecessaryDate); Changed; end; procedure TcxSchedulerCachedEventList.ExtractEvents( const ADate: TDateTime; AList: TcxSchedulerEventList); var I: Integer; AEvent: TcxSchedulerEvent; begin AList.Clear; for I := 0 to AbsoluteCount - 1 do begin AEvent := AbsoluteItems[I]; if AEvent.IsDayEvent(ADate) and (AList.IndexOf(AEvent) = -1) then AList.Add(AEvent); end; end; procedure TcxSchedulerCachedEventList.ExtractUsedDays(AList: TcxSchedulerDateList); var I: Integer; begin AList.Count := 0; for I := Trunc(FStart) to Trunc(FFinish) do if IsDayNoneEmpty(I) then AList.AddEx(I); end; function TcxSchedulerCachedEventList.HasConflict(IsDragCopy: Boolean; AStartDrag: Boolean): Boolean; begin if AStartDrag then Result := (Selection.Count > 1) and HasIntersection(Selection.FEvents) else if (Selection.Count = 1) and (Clones.Count = 0) then Result := HasIntersection(Selection[0]) else Result := HasIntersection(Self, Clones, not IsDragCopy); end; function TcxSchedulerCachedEventList.HasIntersection(AEvent: TcxSchedulerControlEvent): Boolean; var I: Integer; begin Result := False; for I := 0 to FItems.Count - 1 do begin if FItems[I] = AEvent then Continue; Result := IsIntersect(TcxSchedulerControlEvent(FItems[I]), AEvent); if Result then Exit; end; end; function TcxSchedulerCachedEventList.HasIntersection(AList: TList): Boolean; var I, J: Integer; begin Result := False; for I := 0 to AList.Count - 1 do for J := 0 to AList.Count - 1 do begin Result := (I <> J) and IsIntersect( TcxSchedulerEvent(AList[I]), TcxSchedulerEvent(AList[J])); if Result then Exit; end; end; function TcxSchedulerCachedEventList.HasIntersection( AList1, AList2: TcxSchedulerEventList; AExcludeEquals: Boolean): Boolean; var I, J: Integer; begin Result := False; for I := 0 to AList1.Count - 1 do for J := 0 to AList2.Count - 1 do begin if AExcludeEquals and (AList1[I] = TcxSchedulerControlEvent(AList2[J]).Source) then Continue; Result := IsIntersect(AList1[I], AList2[J]); if Result then Exit; end; end; function TcxSchedulerCachedEventList.LastEditedEvent: TcxSchedulerControlEvent; function FindByEvent(ASource: TcxSchedulerEvent): TcxSchedulerControlEvent; var I: Integer; begin Result := nil; for I := 0 to AbsoluteCount - 1 do if AbsoluteItems[I].Source = ASource then begin Result := AbsoluteItems[I]; if Result.RecurrenceIndex = FSavedIndex then Exit; end; end; function FindByID(AID: Variant; ActualValue: TcxSchedulerControlEvent): TcxSchedulerControlEvent; var I: Integer; begin Result := ActualValue; if (ActualValue <> nil) or VarIsNull(AID) then Exit; for I := 0 to AbsoluteCount - 1 do if VarEqualsSoft(AbsoluteItems[I].ID, AID) then begin Result := AbsoluteItems[I]; if Result.RecurrenceIndex = FSavedIndex then Exit; end; end; var ASource: TcxSchedulerEvent; begin ASource := nil; if VarIsNull(FSavedPatternID) and VarIsNull(FSavedSourceID) or ((Storage.LastEditedEvent <> nil) and (Storage.LastEditedEvent.EventType <> etNone)) then ASource := Storage.LastEditedEvent; Result := FindByID(FSavedPatternID, FindByID(FSavedSourceID, FindByEvent(ASource))); end; procedure TcxSchedulerCachedEventList.PostClones(ACopy: Boolean); var I: Integer; begin Storage.BeginUpdate; try for I := 0 to FClones.Count - 1 do InternalPost(TcxSchedulerControlEvent(FClones[I]), ACopy); finally Selection.Clear; CancelClones; Storage.EndUpdate; end; end; procedure TcxSchedulerCachedEventList.PostEvent( AEvent: TcxSchedulerControlEvent); begin FBeforePostCount := Count; try AEvent.FIsEditing := False; if AEvent.Source = nil then PostNewEvent(AEvent) else if AEvent.EventType in [etNone, etCustom] then PostCloneForSimpleEvent(AEvent, False, AEvent.EventType) else if AEvent.EventType = etOccurrence then PostCloneForSimpleEvent(AEvent, True, etCustom) except FNewEvent := nil; Storage.SendNotification(False); raise; end; end; procedure TcxSchedulerCachedEventList.Sort(ACompare: TcxCompareEventsProc); begin inherited Sort(ACompare); FAbsoluteItems.Sort(TListSortCompare(@ACompare)); end; procedure TcxSchedulerCachedEventList.Changed; begin if FChangeRef <> 0 then Exit; Inc(FChangeRef); PopulateAbsoluteItems; if (Count > FBeforePostCount) and (FNewEvent <> nil) then begin Selection.ClearKeys; Selection.Select(FNewEvent); end; FNewEvent := nil; Selection.Update; if FHasClones then begin CreateClones; PopulateAbsoluteItems; end; inherited Changed; Dec(FChangeRef); end; procedure TcxSchedulerCachedEventList.CheckEvent( AEvent: TcxSchedulerEvent; const AResourceID: Variant); begin if CheckEventVisibility(AEvent, ShowEventsWithoutResource) then inherited CheckEvent(AEvent, AResourceID); end; function TcxSchedulerCachedEventList.CheckEventTimeRange: Boolean; begin Result := UseTimeRange; end; function TcxSchedulerCachedEventList.CheckEventVisibility( AEvent: TcxSchedulerEvent; AIncludeUnassigned: Boolean): Boolean; var I: Integer; AItems: TcxSchedulerStorageResourceItems; begin Result := VarIsNull(AEvent.ResourceID); if Result and AIncludeUnassigned then Exit else begin AItems := Storage.Resources.ResourceItems; Result := AItems.Count = 0; for I := 0 to AItems.Count - 1 do if AItems[I].Visible and AEvent.IsResourceEvent(AItems[I], False) then begin Result := True; Exit; end; end; end; function TcxSchedulerCachedEventList.CreateControlEvent( AEvent: TcxSchedulerEvent): TcxSchedulerControlEvent; begin Result := inherited CreateControlEvent(AEvent); Result.FTimeBias := FTimeBias + GetTimeBiasDaylightSavingTime(Start); end; function TcxSchedulerCachedEventList.CreateCloneList: TcxSchedulerFilteredEventList; begin Result := TcxSchedulerFilteredEventList.Create; end; function TcxSchedulerCachedEventList.CreateSelection: TcxSchedulerEventSelection; begin Result := TcxSchedulerEventSelection.Create(Self); end; procedure TcxSchedulerCachedEventList.DoClear(AFreeItems: Boolean); begin if FClones <> nil then FClones.DestroyItems; inherited DoClear(True); end; procedure TcxSchedulerCachedEventList.EventAdded( AEvent: TcxSchedulerEvent); begin TcxSchedulerControlEvent(AEvent).SelectionAdapter := Self; inherited EventAdded(AEvent); end; function TcxSchedulerCachedEventList.GetTimeBiasDaylightSavingTime( ATime: TDateTime): TDateTime; begin Result := 0; if DaylightSaving then Result := TcxSchedulerDateTimeHelper.TimeZoneDaylightBias(Start, FTimeZone) * MinuteToTime; end; procedure TcxSchedulerCachedEventList.Init(const AStart, AFinish: TDateTime; AStorage: TcxCustomSchedulerStorage); begin FHasClones := (FClones <> nil) and (FClones.Count > 0); if FExpandedTimeRange then inherited Init(Min(AStart, FMinNecessaryDate), Max(AFinish, FMaxNecessaryDate), AStorage) else inherited Init(AStart, AFinish, AStorage); with DateTimeHelper do begin if Storage.StoreUsingGlobalTime then FTimeBias := TimeZoneBias(FTimeZone) else FTimeBias := TimeZoneBias(FTimeZone) - TimeZoneBias(CurrentTimeZone); end; end; procedure TcxSchedulerCachedEventList.InternalPost( AEvent: TcxSchedulerControlEvent; ACopy: Boolean); begin if AEvent.EventType = etNone then PostCloneForSimpleEvent(AEvent, ACopy, etNone) else PostCloneForRecurrenceEvent(AEvent, ACopy); end; function TcxSchedulerCachedEventList.IsDayNoneEmpty(ADay: Integer): Boolean; var I: Integer; begin Result := False; for I := 0 to Count - 1 do begin Result := Items[I].IsDayEvent(ADay); if Result then Break; end; end; function TcxSchedulerCachedEventList.IsIntersect( AEvent1, AEvent2: TcxSchedulerEvent): Boolean; begin Result := not (AEvent1.IsFreeState or AEvent2.IsFreeState); if Result then Result := (((AEvent1.Start < AEvent2.Finish) and (AEvent2.Start < AEvent1.Finish)) or ((AEvent2.Start < AEvent1.Finish) and (AEvent1.Start < AEvent2.Finish))); if Result then Result := (VarIsNull(AEvent2.ResourceID) or AEvent1.IsSharedWithResource(AEvent2.ResourceID)) or (VarIsNull(AEvent1.ResourceID) or AEvent2.IsSharedWithResource(AEvent1.ResourceID)); Result := Result and Storage.HasEventIntersect(AEvent2, AEvent1); end; function TcxSchedulerCachedEventList.IsSelected( AEvent: TcxSchedulerControlEvent): Boolean; begin Result := AEvent.IsClone or (Selection.IsSelected(AEvent) and (AlwaysShowSelectedEvent or (FClones.Count = 0))); end; procedure TcxSchedulerCachedEventList.PopulateAbsoluteItems; var I: Integer; AEvent: TcxSchedulerEvent; begin FAbsoluteItems.Count := 0; FAbsoluteItems.Capacity := GetAbsoluteCountInternal; for I := 0 to GetAbsoluteCountInternal - 1 do begin AEvent := GetAbsoluteItemInternal(I); if not CheckEventTimeRange or ((AEvent.Start <= SelFinish) and (SelStart <= AEvent.Finish)) then FAbsoluteItems.Add(GetAbsoluteItemInternal(I)); end; end; procedure TcxSchedulerCachedEventList.PostCloneForRecurrenceEvent( AEvent: TcxSchedulerControlEvent; ACopy: Boolean); const ANewType: array[Boolean] of TcxEventType = (etCustom, etNone); begin if not ACopy and (AEvent.EventType = etOccurrence) then PostCloneForSimpleEvent(AEvent, True, etCustom) else PostCloneForSimpleEvent(AEvent, ACopy, ANewType[ACopy]); end; procedure TcxSchedulerCachedEventList.PostCloneForSimpleEvent( AEvent: TcxSchedulerControlEvent; ACopy: Boolean; AType: TcxEventType); var AStorageEvent: TcxSchedulerEvent; begin AEvent.EventType := AType; if ACopy then begin if AEvent.IsClone then TcxSchedulerControlEvent(AEvent.Source).FSource := Storage.CreateEvent else AEvent.FSource := Storage.CreateEvent; end; if AEvent.IsClone then AStorageEvent := TcxSchedulerControlEvent(AEvent.Source).Source else AStorageEvent := AEvent.Source; AStorageEvent.FPattern := AEvent.FPattern; AStorageEvent.BeginEditing; try AStorageEvent.Assign(AEvent); AStorageEvent.MoveTo(AEvent.Start + AEvent.TimeBias - Storage.TimeBias); if AType <> etNone then AStorageEvent.ParentID := AEvent.Pattern.ID; finally AStorageEvent.EndEditing; AStorageEvent.Post; end; end; procedure TcxSchedulerCachedEventList.PostNewEvent( AEvent: TcxSchedulerControlEvent); begin AEvent.FTimeBias := -FTimeBias; FBeforePostCount := Count - 1; FNewEvent := Storage.CreateEvent; try FNewEvent.Assign(AEvent); FNewEvent.Post; except FNewEvent := nil; raise; end; end; procedure TcxSchedulerCachedEventList.SelectionAdd( AEvent: TcxSchedulerControlEvent; Shift: TShiftState); begin Selection.Add(AEvent, Shift); end; procedure TcxSchedulerCachedEventList.SelectionClear; begin Selection.Clear; end; procedure TcxSchedulerCachedEventList.SelectionUpdate; begin Selection.Update; end; function TcxSchedulerCachedEventList._AddRef: Integer; begin Result := -1; end; function TcxSchedulerCachedEventList._Release: Integer; begin Result := -1; end; function TcxSchedulerCachedEventList.QueryInterface( const IID: TGUID; out Obj): HResult; const E_NOINTERFACE = HResult($80004002); begin if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE; end; function TcxSchedulerCachedEventList.GetAbsoluteCount: Integer; begin Result := FAbsoluteItems.Count; end; function TcxSchedulerCachedEventList.GetAbsoluteItem( AIndex: Integer): TcxSchedulerControlEvent; begin Result := TcxSchedulerControlEvent(FAbsoluteItems.List^[AIndex]) end; function TcxSchedulerCachedEventList.GetAbsoluteCountInternal: Integer; begin Result := Count + FClones.Count; end; function TcxSchedulerCachedEventList.GetAbsoluteItemInternal( AIndex: Integer): TcxSchedulerControlEvent; begin if AIndex >= Count then Result := TcxSchedulerControlEvent(FClones.Items[AIndex - Count]) else Result := Items[AIndex]; end; function TcxSchedulerCachedEventList.GetItem( AIndex: Integer): TcxSchedulerControlEvent; begin Result := TcxSchedulerControlEvent(FItems.List^[AIndex]) end; procedure TcxSchedulerCachedEventList.SetSelFinish(const AValue: TDateTime); begin FSelFinish := AValue; if FExpandedTimeRange then FSelFinish := Max(FSelFinish, FMaxNecessaryDate); end; procedure TcxSchedulerCachedEventList.SetSelStart(const AValue: TDateTime); begin FSelStart := AValue; if FExpandedTimeRange then FSelStart := Min(FSelStart, FMinNecessaryDate); end; { TcxSchedulerOccurrenceCalculator } constructor TcxSchedulerOccurrenceCalculator.Create( AEvent: TcxSchedulerEvent; const AStart, AFinish: TDateTime; ACalcForReminders: Boolean = False); begin FCalcForReminders := ACalcForReminders; FWorkDays := DateTimeHelper.WorkDays; FStartOfWeek := DateTimeHelper.StartOfWeek; FEvent := AEvent; FVisibleStart := AStart; FVisibleFinish := AFinish; FRecurCount := FEvent.RecurrenceInfo.Count; InitTimes; FDayNumber := FEvent.RecurrenceInfo.DayNumber; FDayType := FEvent.RecurrenceInfo.DayType; FOccurDays := FEvent.RecurrenceInfo.OccurDays; FPeriodicity := FEvent.RecurrenceInfo.Periodicity; FRecurrence := Event.RecurrenceInfo.Recurrence; FYearPeriodicity := Event.RecurrenceInfo.YearPeriodicity; end; procedure TcxSchedulerOccurrenceCalculator.CalcOccurrence(AIndex: Integer); begin InitTimes; FFinishDate := cxMaxDate; FRecurCount := -1; while (AIndex > 0) and GetNextOccurrence do Dec(AIndex); end; procedure TcxSchedulerOccurrenceCalculator.CalcNearestOccurrenceIntervals( AStart, AFinish: TDateTime; var AnIntervalBefore, AnIntervalAfter: TDateTime); function OccurrenceExists: Boolean; var AOccurence: TcxSchedulerEvent; begin Result := not (FEvent.GetOccurrenceByIndex(FIndex, AOccurence) and (AOccurence.EventType in [etException, etCustom])); end; begin InitTimes; AnIntervalBefore := cxMaxDateTime; while GetNextOccurrence and (FOccurrenceFinish < AStart) do if IsValidOccurrence and OccurrenceExists then AnIntervalBefore := AStart - FOccurrenceStart; AnIntervalAfter := cxMaxDateTime; if IsValidOccurrence then begin InitTimes; while GetNextOccurrence and (FOccurrenceStart <= AFinish) do; if IsValidOccurrence and (FOccurrenceStart > AFinish) then begin if OccurrenceExists then AnIntervalAfter := FOccurrenceStart - AFinish else begin while GetNextOccurrence and not OccurrenceExists do; if IsValidOccurrence then AnIntervalAfter := FOccurrenceStart - AFinish; end; end; end; end; function TcxSchedulerOccurrenceCalculator.GetNextOccurrence: Boolean; begin FDate := Trunc(FOccurrenceStart); case FRecurrence of cxreWeekly: begin FWeekStart := FDate - (DayOfWeek(FDate) - 1) + StartOfWeek; if FWeekStart > FDate then Dec(FWeekStart, 7); end; cxreMonthly: DecodeDate(FDate, FYear, FMonth, FDay); cxreYearly: begin DecodeDate(FDate, FYear, FMonth, FDay); FMonth := FPeriodicity; end; end; repeat //DELPHI8! check Trunc() if (FIndex = - 1) then CalcFirstDate else CalcNextDate; FOccurrenceFinish := FDate + (FOccurrenceFinish - DateOf(FOccurrenceStart)); FOccurrenceStart := FDate + TimeOf(FOccurrenceStart); Inc(FIndex); until (not FCalcForReminders and (DateOf(FOccurrenceStart) >= DateOf(FVisibleStart))) or (FCalcForReminders and (DateOf(FOccurrenceStart) >= DateOf(FActualStart))); Result := IsValidOccurrence; end; function TcxSchedulerOccurrenceCalculator.GetOccurrenceCount( AEndDate: TDateTime): Integer; begin Result := 0; InitTimes; while GetNextOccurrence and (DateOf(FOccurrenceStart) <= DateOf(AEndDate)) do Inc(Result); end; procedure TcxSchedulerOccurrenceCalculator.CalcFirstDate; begin //DELPHI8! check Trunc() FDate := Trunc(FActualStart); case FRecurrence of cxreDaily: if FDayType in [cxdtWeekDay, cxdtWeekEndDay] then FDate := GetSomeDay(FDate, 1, FDayType = cxdtWeekEndDay); cxreWeekly: begin FWeekStart := FDate - (DayOfWeek(FDate) - 1) + StartOfWeek; if FWeekStart > FDate then Dec(FWeekStart, 7); FDate := GetDayFromOccurDays(FDate - 1, 1); end; cxreMonthly: begin DecodeDate(FDate, FYear, FMonth, FDay); FDate := GetDayForMonth; end; cxreYearly: begin DecodeDate(FDate, FYear, FMonth, FDay); FMonth := FPeriodicity; FDate := GetDayForMonth; if FDate < DateOf(FOccurrenceStart) then begin Inc(FYear); FDate := GetDayForMonth; end; end; end; end; procedure TcxSchedulerOccurrenceCalculator.CalcNextDate; var ADay: Word; begin case FRecurrence of cxreDaily: if FDayType = cxdtEveryDay then Inc(FDate, FPeriodicity) else FDate := GetSomeDay(FDate + 1, 1, FDayType = cxdtWeekEndDay); cxreWeekly: FDate := GetDayFromOccurDays(FDate, FPeriodicity); cxreMonthly: begin IncAMonth(FYear, FMonth, ADay, FPeriodicity); FDate := GetDayForMonth; end; cxreYearly: begin Inc(FYear, FYearPeriodicity); FDate := GetDayForMonth; end; end; end; function TcxSchedulerOccurrenceCalculator.GetCertainDay( const ADate, ANumber: Integer; ADayType: TcxDayType): Integer; var AYear, AMonth, ADay: Word; AOffset: Integer; begin DecodeDate(ADate, AYear, AMonth, ADay); AOffset := Ord(ADayType) - Ord(cxdtSunDay) - (DayOfWeek(ADate - ADay + 1) - 1); if AOffset < 0 then Inc(AOffset, 7); Inc(AOffset, (ANumber - 1) * 7); if AOffset > DaysInAMonth(AYear, AMonth) - 1 then Dec(AOffset, 7); Result := ADate - ADay + 1 + AOffset; end; function TcxSchedulerOccurrenceCalculator.GetDayForMonth: Integer; function GetADay(const ADate: Integer; ACondition: Boolean): Integer; begin if ACondition then Result := ADate + DaysInAMonth(FYear, FMonth) else Result := ADate + FDayNumber; end; begin Result := Trunc(EncodeDate(FYear, FMonth, 1)) - 1; case FDayType of cxdtDay: Result := GetADay(Result, FDayNumber > DaysInAMonth(FYear, FMonth)); cxdtEveryDay: Result := GetADay(Result, FDayNumber = 5); cxdtWeekDay, cxdtWeekEndDay: Result := GetSomeDay(Result + 1, FDayNumber, FDayType = cxdtWeekEndDay); cxdtSunday..cxdtSaturday: Result := GetCertainDay(Result + 1, FDayNumber, FDayType); end; end; function TcxSchedulerOccurrenceCalculator.GetDayFromOccurDays( const APrevDate, APeriodicity: Integer): Integer; var ADelta: Integer; ADay: TDay; begin repeat for ADelta := 0 to 6 do begin ADay := TDay(StartOfWeek + ADelta - 7 * Byte(StartOfWeek + ADelta > 6)); if ADay in FOccurDays then begin Result := FWeekStart + ADelta; if Result > APrevDate then Exit; end; end; Inc(FWeekStart, 7 * APeriodicity); until False; end; function TcxSchedulerOccurrenceCalculator.GetSomeDay( const ADate, ANumber: Integer; AWeekEnd: Boolean): Integer; var AYear, AMonth, ADay: Word; I: Integer; begin if ANumber = 5 then begin DecodeDate(ADate, AYear, AMonth, ADay); Result := ADate - ADay + DaysInAMonth(AYear, AMonth); while not (AWeekEnd xor (TDay(DayOfWeek(Result) - 1) in WorkDays)) do Dec(Result); end else begin Result := ADate; I := 1; repeat while not (AWeekEnd xor (TDay(DayOfWeek(Result) - 1) in WorkDays)) do Inc(Result); if ANumber = I then Break; Inc(Result); Inc(I); until False; end; end; procedure TcxSchedulerOccurrenceCalculator.InitTimes; begin if FRecurCount = 0 then FFinishDate := FEvent.RecurrenceInfo.Finish else begin if FCalcForReminders and (FRecurCount > 0) then FFinishDate := FEvent.RecurrenceInfo.GetEndDate else FFinishDate := VisibleFinish; end; FOccurrenceStart := FEvent.Start; FOccurrenceFinish := FOccurrenceStart + FEvent.Duration; if (FEvent.EventType <> etPattern) and (FEvent.Pattern <> nil) then begin FOccurrenceStart := FEvent.Pattern.Start; FOccurrenceFinish := FOccurrenceStart + FEvent.Pattern.Duration; end; FActualStart := FOccurrenceStart; FIndex := -1; end; function TcxSchedulerOccurrenceCalculator.IsValidOccurrence: Boolean; begin Result := (DateOf(FOccurrenceStart) <= FVisibleFinish) and (((FRecurCount > 0) and (FIndex < FRecurCount)) or ((FRecurCount <= 0) and ((DateOf(FOccurrenceStart) <= FFinishDate) or (FCalcForReminders and (DateOf(FOccurrenceStart) <= FFinishDate))))); end; { TcxSchedulerContentNavigationInfo } constructor TcxSchedulerContentNavigationInfo.Create(AResourceID: Variant); begin FResourceID := AResourceID; FIntervalBefore := cxMaxDateTime; FIntervalAfter := cxMaxDateTime; end; { TcxSchedulerContentNavigationCalculator } class procedure TcxSchedulerContentNavigationCalculator.FindNavigationIntervals( AStorage: TcxCustomSchedulerStorage; AContentNavigationInfo: TObjectList; AStart, AFinish: TDateTime; AWithoutResources: Boolean; AShowEventsWithoutResource: Boolean); procedure ProcessEventsWithoutResource(AnEventIndex: Integer); begin if AShowEventsWithoutResource and not IsEventSharedWithAnyResource(AStorage, AnEventIndex, False) or (AStorage.ResourceCount = 0) then CalcIntervals(AStorage.FEventsList[AnEventIndex], TcxSchedulerContentNavigationInfo(AContentNavigationInfo[AContentNavigationInfo.Count - 1]), AStart, AFinish); end; procedure WithResources; var AnEventIndex, AResourceIndex, AResourceInfoCount: Integer; begin for AnEventIndex := 0 to AStorage.FEventsList.Count - 1 do begin AResourceIndex := 0; AResourceInfoCount := AContentNavigationInfo.Count - IfThen(AShowEventsWithoutResource, 1); while AResourceIndex < AResourceInfoCount do begin if AStorage.FEventsList[AnEventIndex].IsSharedWithResource( TcxSchedulerContentNavigationInfo(AContentNavigationInfo[AResourceIndex]).FResourceID) then CalcIntervals(AStorage.FEventsList[AnEventIndex], TcxSchedulerContentNavigationInfo(AContentNavigationInfo[AResourceIndex]), AStart, AFinish); Inc(AResourceIndex); end; ProcessEventsWithoutResource(AnEventIndex); end; end; procedure WithoutResources; var AnEventIndex: Integer; begin for AnEventIndex := 0 to AStorage.FEventsList.Count - 1 do begin if IsEventSharedWithAnyResource(AStorage, AnEventIndex, True) then CalcIntervals(AStorage.FEventsList[AnEventIndex], TcxSchedulerContentNavigationInfo(AContentNavigationInfo[0]), AStart, AFinish); ProcessEventsWithoutResource(AnEventIndex); end; end; begin if (AStorage = nil) or (AContentNavigationInfo = nil) then Exit; if AShowEventsWithoutResource or (AContentNavigationInfo.Count = 0) and (AStorage.ResourceCount = 0) then AContentNavigationInfo.Add(TcxSchedulerContentNavigationInfo.Create(0)); if not AWithoutResources then WithResources else WithoutResources; if AShowEventsWithoutResource then begin ChangeResourceNavigationIntervals(AContentNavigationInfo); AContentNavigationInfo.Delete(AContentNavigationInfo.Count - 1); end; end; class procedure TcxSchedulerContentNavigationCalculator.CalcAppointmentIntervals( AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); var ANewInterval: TDateTime; begin if AnEvent.Start < AStart then ANewInterval := AStart - AnEvent.Start else ANewInterval := cxMaxDateTime; AInfo.FIntervalBefore := Min(AInfo.FIntervalBefore, ANewInterval); if AFinish < AnEvent.Start then ANewInterval := AnEvent.Start - AFinish else ANewInterval := cxMaxDateTime; AInfo.FIntervalAfter := Min(AInfo.FIntervalAfter, ANewInterval); end; class procedure TcxSchedulerContentNavigationCalculator.CalcIntervals( AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); begin case AnEvent.EventType of etNone: CalcAppointmentIntervals(AnEvent, AInfo, AStart, AFinish); etOccurrence, etCustom: if AnEvent.Pattern <> nil then CalcAppointmentIntervals(AnEvent, AInfo, AStart, AFinish); etPattern: CalcPatternIntervals(AnEvent, AInfo, AStart, AFinish); end; end; class procedure TcxSchedulerContentNavigationCalculator.CalcPatternIntervals( AnEvent: TcxSchedulerEvent; AInfo: TcxSchedulerContentNavigationInfo; AStart, AFinish: TDateTime); var AOccurrenceCalculator: TcxSchedulerOccurrenceCalculator; ANewIntervalAfter, ANewIntervalBefore: TDateTime; begin AOccurrenceCalculator := TcxSchedulerOccurrenceCalculator.Create(AnEvent, DateOf(cxMinDateTime), cxMaxDate); try AOccurrenceCalculator.CalcNearestOccurrenceIntervals(AStart, AFinish, ANewIntervalBefore, ANewIntervalAfter); finally AOccurrenceCalculator.Free; end; AInfo.FIntervalBefore := Min(AInfo.FIntervalBefore, ANewIntervalBefore); AInfo.FIntervalAfter := Min(AInfo.FIntervalAfter, ANewIntervalAfter); end; class procedure TcxSchedulerContentNavigationCalculator.ChangeResourceNavigationIntervals( AContentNavigationInfo: TObjectList); var I: Integer; ABefore, AnAfter: TDateTime; begin ABefore := TcxSchedulerContentNavigationInfo( AContentNavigationInfo[AContentNavigationInfo.Count - 1]).FIntervalBefore; AnAfter := TcxSchedulerContentNavigationInfo( AContentNavigationInfo[AContentNavigationInfo.Count - 1]).FIntervalAfter; for I := 0 to AContentNavigationInfo.Count - 2 do begin TcxSchedulerContentNavigationInfo(AContentNavigationInfo[I]).FIntervalBefore := Min(TcxSchedulerContentNavigationInfo(AContentNavigationInfo[I]).FIntervalBefore, ABefore); TcxSchedulerContentNavigationInfo(AContentNavigationInfo[I]).FIntervalAfter := Min(TcxSchedulerContentNavigationInfo(AContentNavigationInfo[I]).FIntervalAfter, AnAfter); end; end; class function TcxSchedulerContentNavigationCalculator.IsEventSharedWithAnyResource( AStorage: TcxCustomSchedulerStorage; AnEventIndex: Integer; ConsiderVisibility: Boolean): Boolean; var AResourceIndex: Integer; AnEvent: TcxSchedulerEvent; begin AnEvent := AStorage.FEventsList[AnEventIndex]; AResourceIndex := 0; Result := False; while not Result and (AResourceIndex < AStorage.Resources.Items.Count) do begin Result := AnEvent.IsSharedWithResource(AStorage.ResourceIDs[AResourceIndex]) and (not ConsiderVisibility or AStorage.Resources.Items[AResourceIndex].Visible); Inc(AResourceIndex); end; end; { TcxSchedulerCustomReminderForm } constructor TcxSchedulerCustomReminderForm.Create( AReminders: TcxSchedulerReminders); begin inherited Create(nil); FReminders := AReminders; end; destructor TcxSchedulerCustomReminderForm.Destroy; begin Reminders.FReminderWindow := nil; inherited Destroy; end; procedure TcxSchedulerCustomReminderForm.CheckFormPosition; var X, Y: Integer; ACenterForm: TCustomForm; begin if Position = poScreenCenter then begin X := (Screen.Width - Width) div 2; Y := (Screen.Height - Height) div 2; if X < Screen.DesktopLeft then X := Screen.DesktopLeft; if Y < Screen.DesktopTop then Y := Screen.DesktopTop; SetBounds(X, Y, Width, Height); end else if Position in [poMainFormCenter, poOwnerFormCenter] then begin ACenterForm := Application.MainForm; if (Position = poOwnerFormCenter) and (Owner is TCustomForm) then ACenterForm := TCustomForm(Owner); if Assigned(ACenterForm) then begin X := ((ACenterForm.Width - Width) div 2) + ACenterForm.Left; Y := ((ACenterForm.Height - Height) div 2) + ACenterForm.Top; end else begin X := (Screen.Width - Width) div 2; Y := (Screen.Height - Height) div 2; end; if X < 0 then X := 0; if Y < 0 then Y := 0; SetBounds(X, Y, Width, Height); end else if Position = poDesktopCenter then begin X := ((Screen.DesktopWidth div 2) + Screen.DesktopLeft - (Width div 2)); Y := ((Screen.DesktopHeight div 2) + Screen.DesktopTop - (Height div 2)); if X < Screen.DesktopLeft then X := Screen.DesktopLeft; if Y < Screen.DesktopTop then Y := Screen.DesktopTop; SetBounds(X, Y, Width, Height); end; end; procedure TcxSchedulerCustomReminderForm.CreateParams( var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW; end; procedure TcxSchedulerCustomReminderForm.DoClose(var Action: TCloseAction); begin inherited DoClose(Action); if Action = caHide then Action := caFree; Reminders.DoHideReminderWindow; cxDialogsMetricsStore.StoreMetrics(Self); end; procedure TcxSchedulerCustomReminderForm.DoShow; begin SetControlLookAndFeel(Self, Reminders.ReminderWindowLookAndFeel); if UseSchedulerColorInDialogs then Color := GetFormColor; UpdateReminderList; inherited DoShow; Reminders.DoShowReminderWindow; end; procedure TcxSchedulerCustomReminderForm.FlashCaption; var AFlashInfo: TFlashWInfo; begin if Assigned(FlashWindowExProc) then begin AFlashInfo.cbSize := SizeOf(TFlashWInfo); AFlashInfo.hwnd := Handle; AFlashInfo.uCount := 1; AFlashInfo.dwFlags := FLASHW_ALL; AFlashInfo.dwTimeout := 1000; FlashWindowExProc(AFlashInfo); end else FlashWindow(Handle, True); end; function TcxSchedulerCustomReminderForm.GetFormColor: TColor; begin Result := Reminders.ReminderWindowLookAndFeel.Painter.DefaultSchedulerControlColor; end; function TcxSchedulerCustomReminderForm.IsLocked: Boolean; begin Result := (csDestroying in ComponentState) or (Reminders.Storage.ComponentState * [csLoading, csDestroying] <> []) or Reminders.NeedRestoreSelection or Reminders.IsLocked; end; procedure TcxSchedulerCustomReminderForm.LayoutChanged; begin end; procedure TcxSchedulerCustomReminderForm.OpenEvent( AEvent: TcxSchedulerControlEvent); begin Reminders.DoOpenEvent(AEvent); end; function TcxSchedulerCustomReminderForm.OpenEventSupported: Boolean; begin Result := Assigned(Reminders.FOnOpenEvent); end; procedure TcxSchedulerCustomReminderForm.RestoreSelection; begin end; procedure TcxSchedulerCustomReminderForm.SaveSelection; begin end; procedure TcxSchedulerCustomReminderForm.ShowInactive; begin if not Visible then begin cxDialogsMetricsStore.InitDialog(Self); CheckFormPosition; if Application.Active then begin ShowWindow(Handle, SW_SHOWNA); Visible := True; end else Show; end else ShowWindow(Handle, SW_SHOWNA); FlashCaption; end; procedure TcxSchedulerCustomReminderForm.UpdateReminderList; begin end; procedure TcxSchedulerCustomReminderForm.UpdateSelectionCaptions; begin Caption := Reminders.GetReminderWindowCaption; end; function TcxSchedulerCustomReminderForm.GetStorage: TcxCustomSchedulerStorage; begin Result := Reminders.Storage; end; { TcxSchedulerReminderEventID } constructor TcxSchedulerReminderEventID.Create(AEvent: TcxSchedulerControlEvent); var I: Integer; begin SetLength(Values, AEvent.ValueCount); for I := Low(Values) to High(Values) do begin if AEvent.Storage.Fields[I].IsUnique then Values[I] := AEvent.Values[I] else Values[I] := Null; end; ID := AEvent.FSavedID; ParentID := AEvent.ParentID; RecurrenceIndex := AEvent.RecurrenceIndex; end; destructor TcxSchedulerReminderEventID.Destroy; begin Values := nil; inherited Destroy; end; function TcxSchedulerReminderEventID.SameEvent( AEvent: TcxSchedulerControlEvent): Boolean; var I: Integer; begin Result := inherited SameEvent(AEvent); if Result then for I := Low(Values) to High(Values) do if AEvent.Storage.Fields[I].IsUnique and not VarEquals(AEvent.Values[I], Values[I]) then begin Result := False; Break; end; end; { TcxSchedulerEventReminders } constructor TcxSchedulerEventReminders.Create(AEvent: TcxSchedulerControlEvent); begin inherited Create; EventID := TcxSchedulerReminderEventID.Create(AEvent); end; destructor TcxSchedulerEventReminders.Destroy; begin FreeReminders; EventID.Free; inherited Destroy; end; procedure TcxSchedulerEventReminders.AddReminder(AReminder: TcxSchedulerReminder); begin SetLength(Reminders, Length(Reminders) + 1); Reminders[High(Reminders)] := AReminder; AReminder.FEventReminders := Self; end; function TcxSchedulerEventReminders.Find(AReminderDate: TDateTime; const AResourceID: Variant): TcxSchedulerReminder; var I: Integer; AReminder: TcxSchedulerReminder; begin Result := nil; for I := Low(Reminders) to High(Reminders) do begin AReminder := Reminders[I]; if (AReminder.ReminderDate = AReminderDate) and VarEquals(AReminder.ResourceID, AResourceID) then begin Result := AReminder; Break; end; end; end; procedure TcxSchedulerEventReminders.FreeReminderByIndex(AIndex: Integer); var I: Integer; begin Reminders[AIndex].Free; for I := AIndex + 1 to High(Reminders) do Reminders[I - 1] := Reminders[I]; SetLength(Reminders, Length(Reminders) - 1); end; procedure TcxSchedulerEventReminders.FreeReminders; var I: Integer; begin for I := Low(Reminders) to High(Reminders) do Reminders[I].Free; Reminders := nil; end; procedure TcxSchedulerEventReminders.Invalidate; var I: Integer; begin FInvalid := True; for I := Low(Reminders) to High(Reminders) do Reminders[I].Invalid := True; end; function TcxSchedulerEventReminders.IsValid: Boolean; begin Result := not FInvalid and (Length(Reminders) > 0); end; procedure TcxSchedulerEventReminders.RemoveInvalidReminders; var I: Integer; begin for I := High(Reminders) downto Low(Reminders) do if Reminders[I].Invalid then FreeReminderByIndex(I); end; procedure TcxSchedulerEventReminders.Validate; begin RemoveInvalidReminders; FInvalid := False; end; { TcxSchedulerEventRemindersList } function TcxSchedulerEventRemindersList.CreateEventReminders( AEvent: TcxSchedulerControlEvent): TcxSchedulerEventReminders; begin Result := TcxSchedulerEventReminders.Create(AEvent); Add(Result); end; function TcxSchedulerEventRemindersList.FindForEvent( AEvent: TcxSchedulerControlEvent): TcxSchedulerEventReminders; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].EventID.SameEvent(AEvent) then begin Result := Items[I]; Break; end; end; procedure TcxSchedulerEventRemindersList.Invalidate; var I: Integer; begin for I := 0 to Count - 1 do Items[I].Invalidate; end; procedure TcxSchedulerEventRemindersList.Remove(AEventReminders: TcxSchedulerEventReminders); begin inherited Remove(AEventReminders); AEventReminders.Free; end; procedure TcxSchedulerEventRemindersList.RemoveInvalidItems; var I: Integer; begin for I := Count - 1 downto 0 do if not Items[I].IsValid then Remove(Items[I]); end; function TcxSchedulerEventRemindersList.GetItem(AIndex: Integer): TcxSchedulerEventReminders; begin Result := TcxSchedulerEventReminders(inherited Items[AIndex]); end; { TcxSchedulerReminder } constructor TcxSchedulerReminder.Create( AOwner: TcxSchedulerReminders; AEvent: TcxSchedulerControlEvent); begin inherited Create; FOwner := AOwner; FEvent := AEvent; end; destructor TcxSchedulerReminder.Destroy; begin with Owner.FItems do if not Clearing then Remove(Self); inherited Destroy; end; procedure TcxSchedulerReminder.Dismiss; begin DoDismiss; end; procedure TcxSchedulerReminder.Snooze(ASnoozeTime: TDateTime); begin DoSnooze(ASnoozeTime); end; procedure TcxSchedulerReminder.ClearReminder; begin if Event.EventType in [etCustom, etNone] then Event.Source.Reminder := False else Event.Pattern.RecurrenceInfo.DismissDate := GetRecurrenceDismissDate; Event.Reminder := False; end; procedure TcxSchedulerReminder.DismissEvent; begin if Owner.IsReminderByResourceAvailable and Event.Shared then DismissEventForResource else ClearReminder; end; procedure TcxSchedulerReminder.DismissEventForResource; var AData: TcxSchedulerReminderResourcesData; AReminderResources, ANewReminderResources: TcxSchedulerReminderResources; I, J, AIndex: Integer; begin AData := GetResourcesData; AReminderResources := AData.Resources; for I := Low(AReminderResources) to High(AReminderResources) do if VarEqualsSoftEx(AReminderResources[I].ResourceID, ResourceID) then begin if Event.EventType in [etCustom, etNone, etPattern] then begin if Length(AReminderResources) > 1 then begin SetLength(ANewReminderResources, Length(AReminderResources) - 1); AIndex := 0; for J := Low(AReminderResources) to High(AReminderResources) do if I <> J then begin ANewReminderResources[AIndex] := AReminderResources[J]; Inc(AIndex); end; AData.Resources := ANewReminderResources; Event.Source.ReminderResourcesData := AData; Event.Reminder := False; end else ClearReminder; end else begin AData.Resources[I].DismissDate := GetRecurrenceDismissDate; Event.Pattern.ReminderResourcesData := AData; Event.Reminder := False; end; Break; end; end; procedure TcxSchedulerReminder.DoDismiss; begin if not Owner.DoDismissReminder(Self) then DismissEvent; end; procedure TcxSchedulerReminder.DoSnooze(var ASnoozeTime: TDateTime); begin if not Owner.DoSnoozeReminder(Self, ASnoozeTime) then SnoozeEvent(ASnoozeTime); end; function TcxSchedulerReminder.GetRecurrenceDismissDate: TDateTime; begin Result := DateOf(Now); end; procedure TcxSchedulerReminder.SetData(const AResourceID: Variant; AReminderDate: TDateTime); begin FReminderDate := AReminderDate; FResourceID := AResourceID; end; procedure TcxSchedulerReminder.SnoozeEvent(const ASnoozeTime: TDateTime); var ATime: TDateTime; begin if ASnoozeTime > 0 then ATime := DateTimeHelper.RoundTime(Owner.GetNow + Max(ASnoozeTime, MinuteToTime)) else begin ATime := DateTimeHelper.RoundTime(Event.Start + ASnoozeTime); if ATime <= Owner.GetNow then Exit; end; if Owner.IsReminderByResourceAvailable and Event.Shared then SnoozeEventForResource(ATime) else begin if Event.EventType in [etCustom, etNone] then Event.Source.ReminderDate := ATime else begin Event.Pattern.BeginEditing; Event.Pattern.ReminderDate := ATime; Event.Pattern.RecurrenceInfo.DismissDate := DateOf(ATime) - MinuteToTime; Event.Pattern.EndEditing; Event.Pattern.Post; end; Event.ReminderDate := ATime; end; end; procedure TcxSchedulerReminder.SnoozeEventForResource(const ATime: TDateTime); var AData: TcxSchedulerReminderResourcesData; I: Integer; begin AData := GetResourcesData; for I := Low(AData.Resources) to High(AData.Resources) do if VarEqualsSoftEx(AData.Resources[I].ResourceID, ResourceID) then begin AData.Resources[I].ReminderDate := ATime; AData.Resources[I].DismissDate := DateOf(ATime) - MinuteToTime; if Event.EventType in [etCustom, etNone] then Event.Source.ReminderResourcesData := AData else Event.Pattern.ReminderResourcesData := AData; Event.ReminderDate := ATime; Break; end; end; procedure TcxSchedulerReminder.Validate(AEvent: TcxSchedulerControlEvent); begin FInvalid := False; FEvent := AEvent; end; function TcxSchedulerReminder.GetResourcesData: TcxSchedulerReminderResourcesData; begin if Event.EventType = etOccurrence then Result := Event.Pattern.ReminderResourcesData else Result := Event.Source.ReminderResourcesData; end; { TcxSchedulerReminderList } procedure TcxSchedulerReminderList.Clear; var I: Integer; begin FClearing := True; try for I := 0 to Count - 1 do Items[I].Free; inherited Clear; finally FClearing := False; end; end; function TcxSchedulerReminderList.GetItem( Index: Integer): TcxSchedulerReminder; begin Result := inherited Items[Index]; end; { TcxSchedulerReminders } constructor TcxSchedulerReminders.Create(AStorage: TcxCustomSchedulerStorage); begin inherited Create(AStorage); FStorage := AStorage; FDefaultMinutesBeforeStart := 15; FUseReminderWindow := True; FReminderWindowLookAndFeel := TcxLookAndFeel.Create(nil); FEvents := TcxSchedulerFilteredEventList.Create; FItems := TcxSchedulerReminderList.Create; FEventRemindersList := TcxSchedulerEventRemindersList.Create; FShowResourcesInReminderWindow := True; CreateTimers; Active := True; cxFormatController.AddListener(Self); end; destructor TcxSchedulerReminders.Destroy; begin cxFormatController.RemoveListener(Self); FUpdateEventsTimer.Free; FUpdateRemindersTimer.Free; FreeAndNil(FReminderWindow); FReminderWindowLookAndFeel.Free; FEventRemindersList.Free; FItems.Free; FEvents.Free; inherited Destroy; end; procedure TcxSchedulerReminders.Assign(Source: TPersistent); begin inherited Assign(Source); if Source is TcxSchedulerReminders then with TcxSchedulerReminders(Source) do begin Self.Active := Active; Self.DefaultReminder := DefaultReminder; Self.DefaultMinutesBeforeStart := DefaultMinutesBeforeStart; Self.ReminderByResource := ReminderByResource; Self.ReminderWindowLookAndFeel := ReminderWindowLookAndFeel; Self.ShowResourcesInReminderWindow := ShowResourcesInReminderWindow; Self.UseReminderWindow := UseReminderWindow; end; end; procedure TcxSchedulerReminders.DismissAll; var I: Integer; begin if not HasReminders then Exit; Storage.BeginUpdate; try for I := Count - 1 downto 0 do Items[I].Dismiss; finally Storage.EndUpdate; end; end; procedure TcxSchedulerReminders.SnoozeAll(ASnoozeTime: TDateTime); var I: Integer; begin if not HasReminders then Exit; Storage.BeginUpdate; try for I := Count - 1 downto 0 do Items[I].Snooze(ASnoozeTime); finally Storage.EndUpdate; end; end; function TcxSchedulerReminders.GetEventDueTimeText( AReminder: TcxSchedulerReminder; ATime: TDateTime): string; var ADueTimeInfo: TcxSchedulerReminderDueTimeInfo; AMinutes: Integer; begin AMinutes := Trunc((AReminder.Event.Start - ATime) * MinsPerDay); ADueTimeInfo := cxMinutesToDueTimeInfo(AMinutes); if Assigned(cxDueTimeInfoToTextProc) then Result := cxDueTimeInfoToTextProc(ADueTimeInfo) else Result := cxDueTimeInfoToText(ADueTimeInfo); DoGetEventDueTimeText(AReminder, ADueTimeInfo, Result); end; function TcxSchedulerReminders.HasReminders: Boolean; begin Result := FItems.Count > 0; end; procedure TcxSchedulerReminders.HideReminderWindow; begin if IsReminderWindowShown then ReminderWindow.Close; end; function TcxSchedulerReminders.IsLocked: Boolean; begin with Storage do Result := FIsLoading or (ComponentState * [csDesigning, csDestroying, csLoading] <> []) or IsLocked; end; function TcxSchedulerReminders.IsReminderByResourceAvailable: Boolean; begin Result := ReminderByResource and Storage.IsReminderByResourceAvailable; end; function TcxSchedulerReminders.IsReminderValid( AReminder: TcxSchedulerReminder): Boolean; begin Result := FItems.IndexOf(AReminder) >= 0; end; function TcxSchedulerReminders.IsReminderWindowShown: Boolean; begin Result := (ReminderWindow <> nil) and not (csDestroying in ReminderWindow.ComponentState) and ReminderWindow.Showing; end; procedure TcxSchedulerReminders.Refresh; begin if PopulateEventsCache then RefreshReminders; end; procedure TcxSchedulerReminders.FormatChanged; begin end; procedure TcxSchedulerReminders.TimeChanged; begin Refresh; end; procedure TcxSchedulerReminders.AddReminder( AEvent: TcxSchedulerControlEvent; const AResourceID: Variant; AReminderDate: TDateTime; var AEventReminders: TcxSchedulerEventReminders); var AReminder: TcxSchedulerReminder; begin AReminder := GetReminderClass.Create(Self, AEvent); AReminder.SetData(AResourceID, AReminderDate); if not DoAlertReminder(AReminder) then begin FItems.Add(AReminder); AddReminderToEventReminders(AReminder, AEventReminders); FNeedShowWindow := UseReminderWindow; end else AReminder.Free; end; procedure TcxSchedulerReminders.AddReminderToEventReminders( AReminder: TcxSchedulerReminder; var AEventReminders: TcxSchedulerEventReminders); begin if AEventReminders = nil then AEventReminders := FEventRemindersList.CreateEventReminders(AReminder.Event); AEventReminders.AddReminder(AReminder); end; procedure TcxSchedulerReminders.CheckAddReminder(AEvent: TcxSchedulerControlEvent; const AResourceID: Variant; AReminderDate: TDateTime; var AEventReminders: TcxSchedulerEventReminders); begin if IsNeedAddToReminders(AEvent, AReminderDate) then AddReminder(AEvent, AResourceID, AReminderDate, AEventReminders); end; procedure TcxSchedulerReminders.CheckAddReminders( AEvent: TcxSchedulerControlEvent; AEventReminders: TcxSchedulerEventReminders); var I: Integer; AIsOccurrence: Boolean; AReminderResources: TcxSchedulerReminderResources; begin AReminderResources := nil; if IsReminderByResourceAvailable and AEvent.Shared then begin AIsOccurrence := AEvent.EventType = etOccurrence; AReminderResources := GetReminderResourcesFromEvent(AEvent, AIsOccurrence); for I := Low(AReminderResources) to High(AReminderResources) do with AReminderResources[I] do begin if not AIsOccurrence or (DateOf(GetNow) > DismissDate) then CheckAddReminder(AEvent, ResourceID, ReminderDate, AEventReminders); end; end else CheckAddReminder(AEvent, AEvent.ResourceID, AEvent.ReminderDate, AEventReminders); end; procedure TcxSchedulerReminders.CheckRemindersForEvent(AEvent: TcxSchedulerControlEvent); var AEventReminders: TcxSchedulerEventReminders; begin if AEvent = nil then Exit; AEventReminders := FEventRemindersList.FindForEvent(AEvent); if AEventReminders = nil then CheckAddReminders(AEvent, AEventReminders) else ValidateRemindersForEvent(AEventReminders, AEvent); end; function TcxSchedulerReminders.CreateReminderWindow: TcxSchedulerCustomReminderForm; begin if Assigned(cxReminderFormClass) then Result := cxReminderFormClass.Create(Self) else Result := TcxSchedulerReminderForm.Create(Self); end; function TcxSchedulerReminders.DoAlertReminder( AReminder: TcxSchedulerReminder): Boolean; begin Result := False; if Assigned(FOnAlertReminder) then FOnAlertReminder(Self, AReminder, Result); end; function TcxSchedulerReminders.DoDismissReminder( AReminder: TcxSchedulerReminder): Boolean; begin Result := False; if Assigned(FOnDismissReminder) then FOnDismissReminder(Self, AReminder, Result); end; procedure TcxSchedulerReminders.DoGetEventDueTimeText(AReminder: TcxSchedulerReminder; const ADueTimeInfo: TcxSchedulerReminderDueTimeInfo; var AText: string); begin if Assigned(FOnGetEventDueTimeText) then FOnGetEventDueTimeText(Self, AReminder, ADueTimeInfo, AText); end; procedure TcxSchedulerReminders.DoGetReminderWindowCaption( var ACaption: string); begin if Assigned(FOnGetReminderWindowCaption) then FOnGetReminderWindowCaption(Self, ACaption); end; procedure TcxSchedulerReminders.DoOpenEvent( AEvent: TcxSchedulerControlEvent); begin if Assigned(FOnOpenEvent) then FOnOpenEvent(Self, AEvent); end; function TcxSchedulerReminders.DoSnoozeReminder( AReminder: TcxSchedulerReminder; var ASnoozeTime: TDateTime): Boolean; begin Result := False; if Assigned(FOnSnoozeReminder) then FOnSnoozeReminder(Self, AReminder, ASnoozeTime, Result); end; procedure TcxSchedulerReminders.DoHideReminderWindow; begin if Assigned(FOnHideReminderWindow) then FOnHideReminderWindow(Self); end; procedure TcxSchedulerReminders.DoShowReminderWindow; begin if Assigned(FOnShowReminderWindow) then FOnShowReminderWindow(Self); end; function TcxSchedulerReminders.GetFirstReminderTimeForEvent( AEvent: TcxSchedulerEvent; ANow: TDateTime): TDateTime; var I: Integer; AReminderResources: TcxSchedulerReminderResources; begin AReminderResources := nil; if not (IsReminderByResourceAvailable and AEvent.Shared) then Result := AEvent.ReminderDate else begin AReminderResources := AEvent.ReminderResourcesData.Resources; if Length(AReminderResources) = 0 then Result := AEvent.ReminderDate else begin Result := AReminderResources[Low(AReminderResources)].ReminderDate; for I := Low(AReminderResources) + 1 to High(AReminderResources) do if AReminderResources[I].ReminderDate > ANow then Result := Min(Result, AReminderResources[I].ReminderDate); end; end; end; function TcxSchedulerReminders.GetNextPopulateEventsCacheTime( ANow: TDateTime; AIsLocked: Boolean): TDateTime; begin if not AIsLocked then Result := DateOf(ANow) + 1 {one day lookaround} else Result := ANow + SecondToTime; {repeat in one second} end; function TcxSchedulerReminders.GetNextRefreshRemindersTime( ANow: TDateTime; AIsLocked: Boolean): TDateTime; var I: Integer; AReminderDate: TDateTime; begin Result := ANow; if not AIsLocked then begin Result := Result + ReminderRefreshInterval; for I := 0 to Events.Count - 1 do begin AReminderDate := GetFirstReminderTimeForEvent(Events[I].Source, ANow); if AReminderDate > ANow then Result := Min(AReminderDate, Result); end; end; Result := Max(Result, ANow + SecondToTime); end; function TcxSchedulerReminders.GetNow: TDateTime; begin Result := Now; end; function TcxSchedulerReminders.GetReminderClass: TcxSchedulerReminderClass; begin Result := TcxSchedulerReminder; end; function TcxSchedulerReminders.GetReminderResourcesFromEvent( AEvent: TcxSchedulerControlEvent; AGetFromPattern: Boolean): TcxSchedulerReminderResources; begin if AGetFromPattern then Result := AEvent.Pattern.ReminderResourcesData.Resources else Result := AEvent.ReminderResourcesData.Resources; end; function TcxSchedulerReminders.GetReminderWindowCaption: string; begin if Count = 1 then Result := cxGetResourceString(@scxrCaptionReminder) else Result := Format(cxGetResourceString(@scxrCaptionReminders), [Count]); DoGetReminderWindowCaption(Result); end; function TcxSchedulerReminders.IsNeedAddToReminders( AEvent: TcxSchedulerControlEvent; const AReminderDate: TDateTime): Boolean; var AEventStart, ANow: TDateTime; begin ANow := GetNow; Result := AReminderDate <= ANow; if Result and (AEvent.EventType = etOccurrence) then begin AEventStart := AEvent.Start; Result := not ((DateOf(ANow) = DateOf(AEventStart)) and (AEventStart - AEvent.ReminderMinutesBeforeStart * MinuteToTime > ANow)); end; end; function TcxSchedulerReminders.PopulateEventsCache: Boolean; var ANow, ANextTime: TDateTime; begin Result := not IsLocked; ANow := GetNow; ANextTime := GetNextPopulateEventsCacheTime(ANow, not Result); if Result then begin if IsReminderWindowShown then begin ReminderWindow.SaveSelection; NeedRestoreSelection := True; end; Storage.GetReminderEvents(DateOf(ANextTime), Events); end; UpdateTimer(UpdateEventsTimer, ANextTime - ANow); end; procedure TcxSchedulerReminders.RefreshReminders; var ANow, ANextTime: TDateTime; AIsLocked: Boolean; begin ANow := GetNow; AIsLocked := IsLocked; ANextTime := GetNextRefreshRemindersTime(ANow, AIsLocked); if not AIsLocked then UpdateReminderList; UpdateTimer(UpdateRemindersTimer, ANextTime - ANow); end; procedure TcxSchedulerReminders.RemoveEventReminders( AReminder: TcxSchedulerReminder); begin if AReminder.EventReminders = nil then AReminder.Free else FEventRemindersList.Remove(AReminder.EventReminders); end; procedure TcxSchedulerReminders.StopTimers; begin FUpdateEventsTimer.Enabled := False; FUpdateRemindersTimer.Enabled := False; end; procedure TcxSchedulerReminders.CheckRemindersForRecurringEvent( AEvent: TcxSchedulerControlEvent; var AIndex: Integer); var AOccurrenceEvent: TcxSchedulerControlEvent; ACurrentPattern: TcxSchedulerEvent; ANow: TDateTime; AFound: Boolean; AEventStart: TDateTime; begin ANow := GetNow; //find a right occurrence for a current pattern AOccurrenceEvent := nil; ACurrentPattern := AEvent.Pattern; AFound := False; while AIndex >= 0 do begin AEvent := Events[AIndex]; if not AEvent.IsRecurring or (ACurrentPattern <> AEvent.Pattern) then begin Inc(AIndex); //correct index for an outer loop Break; end; //check a prev occurrence for a current pattern if (AEvent.EventType <> etException) and (AEvent.ReminderDate < ANow) then begin if AEvent.EventType <> etOccurrence then CheckRemindersForEvent(AEvent) else if not AFound then begin AEventStart := AEvent.Start; if DateOf(AEventStart) > DateOf(ANow) then begin if AEventStart - AEvent.ReminderMinutesBeforeStart * MinuteToTime < ANow then AOccurrenceEvent := AEvent; end else begin if DateOf(AEventStart) = DateOf(ANow) then AOccurrenceEvent := AEvent else if AOccurrenceEvent = nil then AOccurrenceEvent := AEvent; AFound := True; end; end; end; Dec(AIndex); end; CheckRemindersForEvent(AOccurrenceEvent); end; procedure TcxSchedulerReminders.ValidateReminderList; var AIndex: Integer; AEvent: TcxSchedulerControlEvent; begin FNeedShowWindow := False; FNeedCloseWindow := FItems.Count > 0; FEventRemindersList.Invalidate; //need the countdown loop to ensure that the next occurrences (if exist) //from the current chain are already in the list (FItems) AIndex := Events.Count - 1; while AIndex >= 0 do begin AEvent := Events[AIndex]; if AEvent.EventType = etOccurrence then CheckRemindersForRecurringEvent(AEvent, AIndex) else CheckRemindersForEvent(AEvent); Dec(AIndex); end; FEventRemindersList.RemoveInvalidItems; FNeedCloseWindow := FNeedCloseWindow and (FItems.Count = 0); end; procedure TcxSchedulerReminders.ValidateRemindersForEvent( AEventReminders: TcxSchedulerEventReminders; AEvent: TcxSchedulerControlEvent); procedure ValidateResourceReminder(AEventReminders: TcxSchedulerEventReminders; AEvent: TcxSchedulerControlEvent; const AResourceID: Variant; AReminderDate: TDateTime); var AReminder: TcxSchedulerReminder; begin AReminder := AEventReminders.Find(AReminderDate, AResourceID); if AReminder = nil then CheckAddReminder(AEvent, AResourceID, AReminderDate, AEventReminders) else if IsNeedAddToReminders(AEvent, AReminderDate) then AReminder.Validate(AEvent); end; var I: Integer; AReminderResources: TcxSchedulerReminderResources; AIsOccurrence: Boolean; begin AReminderResources := nil; //to avoid Delphi6 warning if IsReminderByResourceAvailable and AEvent.Shared then begin AIsOccurrence := AEvent.EventType = etOccurrence; AReminderResources := GetReminderResourcesFromEvent(AEvent, AIsOccurrence); for I := Low(AReminderResources) to High(AReminderResources) do with AReminderResources[I] do begin if not AIsOccurrence or (DateOf(GetNow) > DismissDate) then ValidateResourceReminder(AEventReminders, AEvent, ResourceID, ReminderDate); end; end else ValidateResourceReminder(AEventReminders, AEvent, AEvent.ResourceID, AEvent.ReminderDate); AEventReminders.Validate; end; procedure TcxSchedulerReminders.UpdateReminderList; var ARestoreSelection: Boolean; begin if IsLocked or UpdatingReminderList then Exit; FUpdatingReminderList := True; try ValidateReminderList; ARestoreSelection := NeedRestoreSelection; NeedRestoreSelection := False; if IsReminderWindowShown then begin if NeedCloseWindow then HideReminderWindow else begin if NeedShowWindow and not ARestoreSelection then begin ReminderWindow.SaveSelection; ARestoreSelection := True; end; if ARestoreSelection then ReminderWindow.RestoreSelection; end; if NeedShowWindow then ReminderWindow.FlashCaption; end else if NeedShowWindow then ShowReminderWindow; finally FUpdatingReminderList := False; end; end; procedure TcxSchedulerReminders.UpdateTimer(ATimer: TTimer; AInterval: TDateTime); begin if Active then begin ATimer.Enabled := False; ATimer.Interval := Trunc(AInterval * MSecsPerDay); ATimer.Enabled := True; end; end; procedure TcxSchedulerReminders.CreateTimers; begin FUpdateEventsTimer := TTimer.Create(nil); FUpdateEventsTimer.Enabled := False; FUpdateEventsTimer.OnTimer := OnUpdateEventsTimer; FUpdateRemindersTimer := TTimer.Create(nil); FUpdateRemindersTimer.Enabled := False; FUpdateRemindersTimer.OnTimer := OnUpdateRemindersTimer; end; function TcxSchedulerReminders.GetCount: Integer; begin Result := FItems.Count; end; function TcxSchedulerReminders.GetItem( Index: Integer): TcxSchedulerReminder; begin if (Index >= 0) and (Index < Count) then Result := FItems[Index] else Result := nil; end; procedure TcxSchedulerReminders.SetActive(AValue: Boolean); begin if FActive <> AValue then begin FActive := AValue; if AValue then StartReminder else StopReminder; Storage.SendNotification; end; end; procedure TcxSchedulerReminders.SetDefaultMinutesBeforeStart(AValue: Integer); begin FDefaultMinutesBeforeStart := Max(0, AValue); end; procedure TcxSchedulerReminders.SetReminderByResource(AValue: Boolean); begin if FReminderByResource <> AValue then begin FReminderByResource := AValue; Refresh; UpdateReminderWindow; end; end; procedure TcxSchedulerReminders.SetReminderWindowLookAndFeel( AValue: TcxLookAndFeel); begin FReminderWindowLookAndFeel.Assign(AValue); end; procedure TcxSchedulerReminders.SetShowResourcesInReminderWindow(AValue: Boolean); begin if FShowResourcesInReminderWindow <> AValue then begin FShowResourcesInReminderWindow := AValue; UpdateReminderWindow; end; end; procedure TcxSchedulerReminders.ShowReminderWindow; begin if ReminderWindow = nil then FReminderWindow := CreateReminderWindow; UpdateReminderList; ReminderWindow.ShowInactive; end; procedure TcxSchedulerReminders.StartReminder; begin if (csDesigning in Storage.ComponentState) then Exit; FUpdateEventsTimer.Enabled := True; FUpdateRemindersTimer.Enabled := True; Refresh; end; procedure TcxSchedulerReminders.StopReminder; begin StopTimers; HideReminderWindow; FEventRemindersList.Clear; FItems.Clear; FEvents.Clear; end; procedure TcxSchedulerReminders.UpdateReminderWindow; begin if IsReminderWindowShown then ReminderWindow.LayoutChanged; end; procedure TcxSchedulerReminders.OnUpdateEventsTimer(Sender: TObject); begin Refresh; end; procedure TcxSchedulerReminders.OnUpdateRemindersTimer(Sender: TObject); begin RefreshReminders; end; var User32Lib: HMODULE; TempStream: TMemoryStream; TempWriter: TcxWriter; TempReader: TcxReader; function cxVariantToFieldValue(const AValue: Variant; ABLOBFormat: Boolean = False): Variant; var S: AnsiString; begin if {$IFDEF DELPHI12} ABLOBFormat or {$ENDIF} (VarIsArray(AValue) and (VarArrayHighBound(AValue, 1) > 0)) then begin TempStream.Clear; TempWriter.WriteInteger(varArray or varVariant); TempWriter.WriteInteger(0); TempWriter.WriteVariant(AValue); TempStream.Position := SizeOf(Integer); TempWriter.WriteInteger(TempStream.Size); SetLength(S, TempStream.Size); if TempStream.Size > 0 then Move(TempStream.Memory^, S[1], TempStream.Size); Result := S; end else if VarIsArray(AValue) then begin Result := AValue[0]; if VarIsArray(Result) then Result := cxVariantToFieldValue(Result, ABLOBFormat); end else Result := AValue; end; function cxFieldValueToVariant(const AValue: Variant): Variant; var S: AnsiString; begin if dxVarIsBlob(AValue) then begin S := dxVariantToAnsiString(AValue); if Length(S) > SizeOf(Integer) * 2 then begin TempStream.Clear; TempStream.Size := Length(S); Move(S[1], TempStream.Memory^, TempStream.Size); if (TempReader.ReadInteger = (varArray or varVariant)) and (TempReader.ReadInteger = TempStream.Size) then begin Result := TempReader.ReadVariant; Exit; end; end; {$IFDEF DELPHI12} Result := S; Exit; {$ENDIF} end; Result := AValue; end; function cxReminderResourcesDataToFieldValue(const AValue: TcxSchedulerReminderResourcesData): Variant; var S: AnsiString; I: Integer; begin if Length(AValue.Resources) = 0 then begin Result := Null; Exit; end; TempStream.Clear; TempWriter.WriteByte(AValue.Version); TempWriter.WriteInteger(Length(AValue.Resources)); TempWriter.WriteInteger(0); for I := Low(AValue.Resources) to High(AValue.Resources) do with AValue.Resources[I] do begin TempWriter.WriteDateTime(DismissDate); TempWriter.WriteVariant(ResourceID); TempWriter.WriteDateTime(ReminderDate); end; TempStream.Position := SizeOf(Integer) + SizeOf(Byte); TempWriter.WriteInteger(TempStream.Size); SetLength(S, TempStream.Size); if TempStream.Size > 0 then Move(TempStream.Memory^, S[1], TempStream.Size); Result := S; end; function cxFieldValueToReminderResourcesData(const AValue: Variant): TcxSchedulerReminderResourcesData; var S: AnsiString; ACount, I: Integer; begin Result.Version := 0; Result.Resources := nil; if dxVarIsBlob(AValue) then begin S := dxVariantToAnsiString(AValue); if Length(S) > SizeOf(Integer) + SizeOf(Byte) then begin TempStream.Clear; TempStream.Size := Length(S); Move(S[1], TempStream.Memory^, TempStream.Size); Result.Version := TempReader.ReadByte; ACount := TempReader.ReadInteger; if (Result.Version = 3) and (ACount > 0) and (TempReader.ReadInteger = TempStream.Size) then begin SetLength(Result.Resources, ACount); for I := 0 to ACount - 1 do with Result.Resources[I] do begin DismissDate := TempReader.ReadDateTime; ResourceID := TempReader.ReadVariant; ReminderDate := TempReader.ReadDateTime; end; end; end end; end; function cxTaskLinksToFieldValue(ALinks: TcxSchedulerEventLinks): Variant; var I: Integer; ADataArray: Variant; begin if ALinks.Count = 0 then begin Result := Null; Exit; end; ADataArray := VarArrayCreate([0, ALinks.Count - 1], varVariant); for I := 0 to ALinks.Count - 1 do ADataArray[I] := ALinks[I].GetData; Result := cxVariantToFieldValue(ADataArray, True); end; procedure cxFieldValueToTaskLinks(const AValue: Variant; ALinks: TcxSchedulerEventLinks); var I, L, H: Integer; ADataValue: Variant; begin if VarIsNull(AValue) and (ALinks.Count = 0) then Exit; ALinks.BeginUpdate; try ALinks.Clear; ADataValue := cxFieldValueToVariant(AValue); if VarIsArray(ADataValue) then begin L := VarArrayLowBound(ADataValue, 1); H := VarArrayHighBound(ADataValue, 1); if (H - L + 1 = 3) and not VarIsArray(ADataValue[0]) then begin if ALinks.Event.Storage.GetEventByID(ADataValue[1]) <> nil then TcxSchedulerEventItemLink(ALinks.Add).SetData(ADataValue); end else for I := L to H do if ALinks.Event.Storage.GetEventByID(ADataValue[I][1]) <> nil then TcxSchedulerEventItemLink(ALinks.Add).SetData(ADataValue[I]); end; finally ALinks.EndUpdate; end; end; function GetStreamVersion(const AStream: TStream; var AFieldCount: Integer; ACustomFieldCount: Integer = 0): Double; function TryRead(const AOriginal: AnsiString; var ABuffer; const ABufferSize: Integer): Boolean; var L: Integer; ACandidate: AnsiString; begin Result := (AStream.Size - AStream.Position) > (Length(AOriginal) + SizeOf(L)); if Result then AStream.Read(L, SizeOf(L)); Result := L = Length(AOriginal); if Result then begin SetLength(ACandidate, L); AStream.ReadBuffer(ACandidate[1], L); Result := ACandidate = AOriginal; end; if Result then AStream.ReadBuffer(ABuffer, ABufferSize); end; var APos: Integer; begin Result := 0; APos := AStream.Position; if not TryRead(scxSchedulerSignature, Result, SizeOf(Result)) then begin AStream.Position := APos; if TryRead('DataController1', AFieldCount, SizeOf(AFieldCount)) then begin if (AFieldCount - ACustomFieldCount) = 15 then Result := 1 else if (AFieldCount - ACustomFieldCount) = 17 then Result := 2 else Result := 3; end; end else begin APos := AStream.Position; if not TryRead('DataController1', AFieldCount, SizeOf(AFieldCount)) then Result := -1; end; AStream.Position := APos; end; initialization TempStream := TMemoryStream.Create; TempWriter := TcxWriter.Create(TempStream); TempReader := TcxReader.Create(TempStream); // User32Lib := LoadLibrary(user32); FlashWindowExProc := GetProcAddress(User32Lib, 'FlashWindowEx'); finalization TempStream.Free; TempWriter.Free; TempReader.Free; // FreeLibrary(User32Lib); end.