jvtfmanager.pas

East make Tray Icon in delphi

  TJvTFScheduleManagerCacheType = (ctNone, ctTimed, ctBuffer);
  TJvTFScheduleManagerCache = class(TPersistent)
  private
    FCacheType: TJvTFScheduleManagerCacheType;
    FTimedDelay: Integer;
    FBufferCount: Integer;
    FTimer: TTimer;
    procedure SetCacheType(Value: TJvTFScheduleManagerCacheType);
    procedure SetTimedDelay(Value: Integer);
    procedure SetBufferCount(Value: Integer);
  protected
    FScheduleManager: TJvTFScheduleManager;
    procedure FlushManager; virtual;
    procedure TimerOnTimer(Sender: TObject); virtual;
  public
    constructor Create(SchedManager: TJvTFScheduleManager);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property CacheType: TJvTFScheduleManagerCacheType read FCacheType write SetCacheType
      default ctTimed;
    property TimedDelay: Integer read FTimedDelay write SetTimedDelay
      default 30000;
    property BufferCount: Integer read FBufferCount write SetBufferCount
      default 7;
  end;

  TJvTFSchedLoadMode = (slmOnDemand, slmBatch);
  TJvTFLoadBatchEvent = procedure(Sender: TObject; BatchName: string;
    BatchStartDate, BatchEndDate: TDate) of object;

  TJvTFGetApptDisplayTextEvent = procedure(Sender: TObject; Source: TComponent;
    Appt: TJvTFAppt; var DisplayText: string) of object;

  TJvTFApptDescEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
    var Description: string) of object;

  TJvTFScheduleManager = class(TComponent)
  private
    FAlwaysPost: Boolean;
    FAppts: TStringList;
    FSchedules: TStringList;
    FConControls: TStringList;
    FConComponents: TStringList;
    FOnNeedAppts: TJvTFSchedEvent;
    FOnRefreshAppt: TJvTFApptEvent;
    FOnRefreshSched: TJvTFSchedEvent;
    FOnRefreshAll: TNotifyEvent;
    FOnDeleteAppt: TJvTFApptEvent;
    FOnPostAppt: TJvTFApptEvent;
    FOnFlush: TJvTFFlushEvent;
    FOnCreateAppt: TJvTFApptEvent;
    FOnCreateSchedule: TJvTFSchedEvent;
    FOnDestroyAppt: TJvTFApptEvent;
    FOnDestroySchedule: TJvTFSchedEvent;
    FOnGetApptDisplayText: TJvTFGetApptDisplayTextEvent;
    FOnGetApptDescription: TJvTFApptDescEvent;
    FOnSetApptDescription: TJvTFApptDescEvent;

    FSchedLoadMode: TJvTFSchedLoadMode;
    FOnLoadBatch: TJvTFLoadBatchEvent;
    FOnBatchesProcessed: TNotifyEvent;

    FRefreshAutoReconcile: Boolean;

    FStateImages: TCustomImageList;
    FCustomImages: TCustomImageList;
    FStateImageMap: TJvTFStateImageMap;
    FCache: TJvTFScheduleManagerCache;

    // implicit post fix
    FOnPostApptQuery: TJvTFPostApptQueryEvent;

    function GetAppt(Index: Integer): TJvTFAppt;
    function GetSchedule(Index: Integer): TJvTFSched;
    function GetConControl(Index: Integer): TJvTFControl;
    function GetConComponent(Index: Integer): TJvTFComponent;
    procedure SetStateImages(Value: TCustomImageList);
    procedure SetCustomImages(Value: TCustomImageList);
    procedure SetCache(Value: TJvTFScheduleManagerCache);

    procedure SetTFSchedLoadMode(Value: TJvTFSchedLoadMode);
    procedure SetRefreshAutoReconcile(Value: Boolean);
  protected
    FLoadingAppts: Boolean;
    FRefreshing: Boolean;
    FImageChangeLink: TChangeLink;
    FFlushing: Boolean;
    FDestroying: Boolean;
    FSchedBatch: TStringList;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ConnectControl(ApptCtrl: TJvTFControl);
    procedure DisconnectControl(ApptCtrl: TJvTFControl);
    procedure ConnectComponent(Comp: TJvTFComponent);
    procedure DisconnectComponent(Comp: TJvTFComponent);

    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
    procedure NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure NotifySchedule(Sched: TJvTFSched; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure NotifyApptCtrl(ApptCtrl: TJvTFControl; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure NotifyComp(Comp: TJvTFComponent; Sender: TObject;
      Code: TJvTFServNotifyCode);

    procedure RetrieveSchedule(const SchedName: string; SchedDate: TDate;
      var Schedule: TJvTFSched; var LoadedNow: Boolean);

    procedure NeedAppts(Schedule: TJvTFSched); virtual;
    procedure AddAppt(Appt: TJvTFAppt);
    procedure RemoveAppt(Appt: TJvTFAppt);
    procedure RemoveSchedule(Sched: TJvTFSched);

    //procedure RefreshAppt(Appt : TJvTFAppt);
    procedure DeleteAppt(Appt: TJvTFAppt);
    procedure PostAppt(Appt: TJvTFAppt);

    // implicit post fix
    function QueryPostAppt(Appt: TJvTFAppt): Boolean;

    procedure AddToBatch(ASched: TJvTFSched);
    procedure LoadBatch(const BatchName: string; BatchStartDate,
      BatchEndDate: TDate); virtual;

    procedure RequestRefresh(ApptCtrl: TJvTFControl;
      Schedule: TJvTFSched); overload; dynamic;
    procedure RequestRefresh(Comp: TJvTFComponent;
      Schedule: TJvTFSched); overload; dynamic;

    procedure ImageListChange(Sender: TObject);
    procedure FlushAppts;
    function FlushObject(FlushObj: TObject): Boolean;

    procedure DoCreateApptEvent(anAppt: TJvTFAppt); dynamic;
    procedure DoCreateScheduleEvent(aSchedule: TJvTFSched); dynamic;
    procedure DoDestroyApptEvent(anAppt: TJvTFAppt); dynamic;
    procedure DoDestroyScheduleEvent(aSchedule: TJvTFSched); dynamic;

    procedure SetApptDescription(Appt: TJvTFAppt; var Value: string); virtual;
    procedure GetApptDescription(Appt: TJvTFAppt; var Value: string); virtual;
  public
    class function GetScheduleID(const SchedName: string; SchedDate: TDate): string;
    class function GenerateApptID: string; virtual;

    function GetSchedClass: TJvTFSchedClass; dynamic;
    function GetApptClass: TJvTFApptClass; dynamic;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ApptCount: Integer;
    property Appts[Index: Integer]: TJvTFAppt read GetAppt;
    function FindAppt(const ID: string): TJvTFAppt;

    function ScheduleCount: Integer;
    property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
    function FindSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;

    function ConControlCount: Integer;
    property ConControls[Index: Integer]: TJvTFControl read GetConControl;
    function ConComponentCount: Integer;
    property ConComponents[Index: Integer]: TJvTFComponent read GetConComponent;

    function RequestSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
      SchedDate: TDate): TJvTFSched; overload;
    function RequestSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
      SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched; overload;

    function RequestSchedule(Comp: TJvTFComponent; const SchedName: string;
      SchedDate: TDate): TJvTFSched; overload;
    function RequestSchedule(Comp: TJvTFComponent; const SchedName: string;
      SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched; overload;

    procedure ReleaseSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
      SchedDate: TDate); overload;
    procedure ReleaseSchedule(Comp: TJvTFComponent; const SchedName: string;
      SchedDate: TDate); overload;

    procedure ProcessBatches;

    procedure RequestAppt(const ID: string; var Appt: TJvTFAppt; var New: Boolean);

    property LoadingAppts: Boolean read FLoadingAppts;
    property Refreshing: Boolean read FRefreshing;

    procedure dbPostAppt(Appt: TJvTFAppt);
    procedure dbDeleteAppt(Appt: TJvTFAppt);
    procedure dbRefreshAppt(Appt: TJvTFAppt);
    procedure dbRefreshSched(Sched: TJvTFSched);
    procedure dbRefreshAll;
    procedure dbRefreshOrphans;
    function dbNewAppt(const ID: string): TJvTFAppt;

    procedure PostAppts;
    procedure RefreshAppts;
    procedure ReconcileRefresh(Scope: TObject);

    procedure RefreshConnections(Trigger: TObject); virtual;
    property Flushing: Boolean read FFlushing;
    procedure Flush(All: Boolean = False); virtual;

    function GetApptDisplayText(AComponent: TComponent;
      Appt: TJvTFAppt): string; virtual;
  published
    property AlwaysPost: Boolean read FAlwaysPost write FAlwaysPost default False;
    property OnNeedAppts: TJvTFSchedEvent read FOnNeedAppts write FOnNeedAppts;
    property OnRefreshAppt: TJvTFApptEvent read FOnRefreshAppt write FOnRefreshAppt;
    property OnRefreshSched: TJvTFSchedEvent read FOnRefreshSched
      write FOnRefreshSched;
    property OnRefreshAll: TNotifyEvent read FOnRefreshAll write FOnRefreshAll;
    property OnPostAppt: TJvTFApptEvent read FOnPostAppt write FOnPostAppt;
    property OnDeleteAppt: TJvTFApptEvent read FOnDeleteAppt write FOnDeleteAppt;
    property StateImages: TCustomImageList read FStateImages write SetStateImages;
    property CustomImages: TCustomImageList read FCustomImages write SetCustomImages;
    property StateImageMap: TJvTFStateImageMap read FStateImageMap write FStateImageMap;
    property Cache: TJvTFScheduleManagerCache read FCache write SetCache;
    // implicit post fix
    property OnPostApptQuery: TJvTFPostApptQueryEvent read FOnPostApptQuery
      write FOnPostApptQuery;
    property OnFlush: TJvTFFlushEvent read FOnFlush write FOnFlush;
    property OnCreateAppt: TJvTFApptEvent read FOnCreateAppt write FOnCreateAppt;
    property OnDestroyAppt: TJvTFApptEvent read FOnDestroyAppt write FOnDestroyAppt;
    property OnCreateSchedule: TJvTFSchedEvent read FOnCreateSchedule
      write FOnCreateSchedule;
    property OnDestroySchedule: TJvTFSchedEvent read FOnDestroySchedule
      write FOnDestroySchedule;
    property OnLoadBatch: TJvTFLoadBatchEvent read FOnLoadBatch write FOnLoadBatch;
    property OnBatchesProcessed: TNotifyEvent read FOnBatchesProcessed
      write FOnBatchesProcessed;
    property OnGetApptDisplayText: TJvTFGetApptDisplayTextEvent
      read FOnGetApptDisplayText write FOnGetApptDisplayText;
    property OnGetApptDescription: TJvTFApptDescEvent read FOnGetApptDescription
      write FOnGetApptDescription;
    property OnSetApptDescription: TJvTFApptDescEvent read FOnSetApptDescription
      write FOnSetApptDescription;

    property SchedLoadMode: TJvTFSchedLoadMode read FSchedLoadMode
      write SetTFSchedLoadMode default slmOnDemand;
    property RefreshAutoReconcile: Boolean read FRefreshAutoReconcile
      write SetRefreshAutoReconcile default False;
  end;

  TJvTFHintProps = class(TPersistent)
  private
    FHintColor: TColor;
    FHintHidePause: Integer;
    FHintPause: Integer;
    procedure SetHintColor(Value: TColor);
    procedure SetHintHidePause(Value: Integer);
    procedure SetHintPause(Value: Integer);
  protected
    FControl: TJvTFControl;
    procedure Change; virtual;
  public
    constructor Create(AOwner: TJvTFControl);
    procedure Assign(Source: TPersistent); override;
  published
    property HintColor: TColor read FHintColor write SetHintColor default clDefault;
    property HintHidePause: Integer read FHintHidePause write SetHintHidePause default -1;
    property HintPause: Integer read FHintPause write SetHintPause default -1;
  end;

  TJvTFHintType = (shtAppt, shtStartEnd, shtCell, shtObj);

  TJvTFShowHintEvent = procedure(Sender: TObject; HintType: TJvTFHintType;
    Ref: TObject; var HintRect: TRect; var HintText: string) of object;

  // NOTE:
  // The Pause property has the same meaning as the Application.HintPause
  // property.  The ShortPause property has the same meaning as the
  // Application.HintHidePause property.
  TJvTFHint = class(THintWindow)
  private
    FTimer: TTimer;
    FPause: Integer;
    FShortPause: Integer;
    FOnShowHint: TJvTFShowHintEvent;
    FRefProps: TJvTFHintProps;
    procedure SetPause(Value: Integer);
    procedure SetShortPause(Value: Integer);
  protected
    FApptCtrl: TJvTFControl;
    FOldAppt: TJvTFAppt;
    FOldObj: TObject;
    FShortTimer: Boolean;
    FHintRect: TRect;
    FHintText: string;
    FHintCell: TPoint;
    FHintType: TJvTFHintType;
    procedure TimerOnTimer(Sender: TObject); virtual;
    procedure PrepTimer(Short: Boolean);
    procedure SetHintText(StartDate, EndDate: TDate; StartTime, EndTime: TTime;
      const Desc: string; ShowDatesTimes, ShowDesc: Boolean);
    procedure DoHint(Sustained: Boolean);
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF VCL}
    procedure PropertyCheck; dynamic;
  public
    constructor Create(anApptCtrl: TJvTFControl); reintroduce;
    destructor Destroy; override;
    procedure ActivateHint(Rect: TRect; const AHint: THintString); override;
    procedure ApptHint(Appt: TJvTFAppt; X, Y: Integer;
      ShowDatesTimes, ShowDesc, FormattedDesc: Boolean); virtual;
    procedure StartEndHint(StartDate, EndDate: TDate; StartTime, EndTime: TTime;
      X, Y: Integer; ShowDates: Boolean);
    procedure CellHint(Row, Col: Integer; const HintText: string; CellRect: TRect);

    procedure MultiLineObjHint(Obj: TObject; X, Y: Integer; Hints: TStrings);

    procedure ReleaseHandle; virtual;
    // See above note on Pause and ShortPause properties
    property Pause: Integer read FPause write SetPause default 3000;
    property ShortPause: Integer read FShortPause write SetShortPause default 1500;
    property OnShowHint: TJvTFShowHintEvent read FOnShowHint write FOnShowHint;
    property HintType: TJvTFHintType read FHintType;
    property RefProps: TJvTFHintProps read FRefProps write FRefProps;
  end;

  TJvTFDragInfo = class(TObject)
  private
    FApptCtrl: TJvTFControl;
    FSchedule: TJvTFSched;
    FAppt: TJvTFAppt;
    FShift: TShiftState;
  public
    property ApptCtrl: TJvTFControl read FApptCtrl write FApptCtrl;
    property Schedule: TJvTFSched read FSchedule write FSchedule;
    property Appt: TJvTFAppt read FAppt write FAppt;
    property Shift: TShiftState read FShift write FShift;
  end;

  {$IFDEF USEJVCL}
  TJvTFComponent = class(TJvComponent)
  {$ELSE}
  TJvTFComponent = class(TComponent)
  {$ENDIF USEJVCL}
  private
    FScheduleManager: TJvTFScheduleManager;
    FSchedules: TStringList;
    procedure SetManager(Value: TJvTFScheduleManager);
    function GetSchedule(Index: Integer): TJvTFSched;
  protected
    FDateFormat: string;
    FTimeFormat: string;

    procedure UpdateDesigner;

    procedure SetDateFormat(const Value: string); virtual;
    procedure SetTimeFormat(const Value: string); virtual;
    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
    procedure ReqSchedNotification(Schedule: TJvTFSched); virtual;
    procedure RelSchedNotification(Schedule: TJvTFSched); virtual;
    procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure RefreshComponent; dynamic;
    property DateFormat: string read FDateFormat write SetDateFormat;
    property TimeFormat: string read FTimeFormat write SetTimeFormat;
    procedure DestroyApptNotification(anAppt: TJvTFAppt); virtual;
    procedure DestroySchedNotification(ASched: TJvTFSched); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ScheduleCount: Integer;
    property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
    function FindSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
    function RetrieveSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
    procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); virtual;
    procedure ReleaseSchedules;
    procedure ProcessBatches;
  published
    property ScheduleManager: TJvTFScheduleManager read FScheduleManager write SetManager;
  end;

  {$IFDEF USEJVCL}
  TJvTFControl = class(TJvCustomControl)
  {$ELSE}
  TJvTFControl = class(TCustomControl)
  {$ENDIF USEJVCL}
  private
    FScheduleManager: TJvTFScheduleManager;
    FSchedules: TStringList;
    //    FNavigator : TJvTFNavigator;
    //    FOnNavigate : TJvTFNavEvent;
    procedure SetManager(Value: TJvTFScheduleManager);
    function GetSchedule(Index: Integer): TJvTFSched;
    //    procedure SetNavigator(Value: TJvTFNavigator);
  protected
    FDateFormat: string;
    FTimeFormat: string;
    FDragInfo: TJvTFDragInfo;
    FShift: TShiftState;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetDateFormat(const Value: string); virtual;
    procedure SetTimeFormat(const Value: string); virtual;
    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;