lazarus-ccr/components/jvcllaz/run/JvTimeFramework/jvtfmanager.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTFManager.PAS, released on 2003-08-01.

The Initial Developer of the Original Code is Unlimited Intelligence Limited.
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
All Rights Reserved.

Contributor(s):
Mike Kolter (original code)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvTFManager;

{$mode objfpc}{$H+}

interface

uses
  LCLIntf, LCLType,
  Classes, SysUtils, Controls,
  Graphics, ImgList, ExtCtrls, Printers, Forms,
  //JvComponentBase,
  JvComponent, JvTypes, JvTFUtils;

const
  CN_REQUESTREFRESH = $BD01;

type
  // Redeclaration of this type.  It is used in JvTFMonths.TJvTFDrawDWTitleEvent.
  // If not redeclared here, Delphi complains of 'unknown type' because it
  // will not automatically bring in 'JvTFUtils' into the uses clause when
  // a TJvTFDrawDWTitleEvent prototype is created.
  TTFDayOfWeek = JvTFUtils.TTFDayOfWeek;
  EJvTFScheduleManagerError = class(Exception);

  TJvTFTimeRange = record
    StartTime: TTime;
    EndTime: TTime;
  end;

  TJvTFServNotifyCode = (sncDestroyAppt,
    sncDestroySchedule,
    sncLoadAppt,
    sncSchedLoadAppt,
    sncSchedUnloadAppt,
    sncPostAppt,
    sncDeleteAppt,
    sncRequestSchedule,
    sncReleaseSchedule,
    sncConnectComponent,
    sncDisconnectComponent,
    sncConnectControl,
    sncDisconnectControl,
    sncConnectAppt,
    sncDisconnectAppt,
    sncRefresh);

  TJvTFScheduleManager = class;
  {$M+}
  TJvTFSched = class;
  {$M-}
  TJvTFAppt = class;
  TJvTFComponent = class;
  TJvTFControl = class;
  TJvTFPrinter = class;
  TJvTFHint = class;
  //  TJvTFNavigator = class;

  TJvTFSchedClass = class of TJvTFSched;
  TJvTFApptClass = class of TJvTFAppt;
  TJvTFHintClass = class of TJvTFHint;

  TCNRequestRefresh = record
    Msg: Cardinal;
    Schedule: TJvTFSched;
    Unused: Longint;
    Result: Longint;
  end;

  TJvTFDateList = class
  private
    FOnChange: TNotifyEvent;
  protected
    FList: TStringList;
    function GetDate(Index: Integer): TDate;
    procedure Change; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(ADate: TDate): Integer;
    procedure Delete(Index: Integer);
    procedure Clear;
    function Count: Integer;
    function IndexOf(ADate: TDate): Integer;
    property Dates[Index: Integer]: TDate read GetDate; default;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TJvTFNavEvent = procedure(Sender: TObject; aControl: TJvTFControl;
    SchedNames: TStringList; Dates: TJvTFDateList) of object;
  TJvTFControlEvent = procedure(Sender: TObject; aControl: TJvTFControl) of object;
  TJvTFSchedEvent = procedure(Sender: TObject; Schedule: TJvTFSched) of object;
  TJvTFApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt) of object;
  TJvTFVarApptEvent = procedure(Sender: TObject; var Appt: TJvTFAppt) of object;
  TJvTFFlushEvent = procedure(Sender, FlushObj: TObject; var FlushIt: Boolean) of object;

  // implicit post fix
  TJvTFPostApptQueryEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
    var CanPost: Boolean) of object;

  TJvTFCustomImageMap = class(TPersistent)
  private
    FMap: TStringList;
    function GetImage(MapIndex: Integer): Integer;
    procedure SetImage(MapIndex: Integer; Value: Integer);
    function GetImageName(MapIndex: Integer): string;
  protected
    FAppt: TJvTFAppt;
    procedure Change;
  public
    constructor Create(anAppt: TJvTFAppt);
    destructor Destroy; override;
    property Images[MapIndex: Integer]: Integer read GetImage write SetImage; default;
    property ImageNames[MapIndex: Integer]: string read GetImageName;
    function Count: Integer;
    procedure Add(const ImageName: string; ImageIndex: Integer);
    procedure Delete(MapIndex: Integer);
    procedure Move(SrcMapIndex, DestMapIndex: Integer);
    function FindMapIndex(const ImageName: string): Integer;
    function FindImageIndex(const ImageName: string): Integer;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
  end;

  TJvTFStatePic = (spAlarmEnabled, spAlarmDisabled, spShared, spRecurring,
    spModified);

  TJvTFStateImageMap = class(TPersistent)
  private
    FPics: array[Low(TJvTFStatePic)..High(TJvTFStatePic)] of Integer;

    procedure SetImage(StatePicID: TJvTFStatePic; Value: Integer);
    function GetImage(StatePicID: TJvTFStatePic): Integer;
    function GetAlarmDisabled: Integer;
    function GetAlarmEnabled: Integer;
    function GetModified: Integer;
    function GetRecurring: Integer;
    function GetShared: Integer;
    procedure SetAlarmDisabled(const Value: Integer);
    procedure SetAlarmEnabled(const Value: Integer);
    procedure SetModified(const Value: Integer);
    procedure SetRecurring(const Value: Integer);
    procedure SetShared(const Value: Integer);
  protected
    FScheduleManager: TJvTFScheduleManager;
    FUpdating: Boolean;
    procedure Change;
  public
    constructor Create(Serv: TJvTFScheduleManager);
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
    property Pics[Index: TJvTFStatePic]: Integer read GetImage write SetImage;
  published
    property AlarmEnabled: Integer {index spAlarmEnabled}
    read GetAlarmEnabled write SetAlarmEnabled;
    property AlarmDisabled: Integer {index spAlarmDisabled}
    read GetAlarmDisabled write SetAlarmDisabled;
    property Shared: Integer {index spShared}
    read GetShared write SetShared;
    property Recurring: Integer {index spRecurring}
    read GetRecurring write SetRecurring;
    //read GetImage write SetImage;
    property Modified: Integer {index spModified}
    read GetModified write SetModified;
  end;

  TDynTimeRangeArray = array of TJvTFTimeRange;

  TDynApptArray = array of TJvTFAppt;

  TDynSchedArray = array of TJvTFSched;

  TJvTFAppt = class(TPersistent)
  private
    FStartDate: TDate;
    FEndDate: TDate;
    FStartTime: TTime;
    FEndTime: TTime;
    FDescription: string;
    FAlarmEnabled: Boolean;
    FAlarmAdvance: Integer;
    FImageMap: TJvTFCustomImageMap;
    FData: Integer;
    FPersistent: Boolean;
    FColor: TColor;
    FBarColor: TColor;
    FRefreshed: Boolean;
    FGlyph: TPicture;
    FDestroying: Boolean;

    function GetDescription: string;
    procedure SetDescription(Value: string);
    procedure SetAlarmEnabled(Value: Boolean);
    procedure SetAlarmAdvance(Value: Integer);
    procedure SetColor(Value: TColor);
    procedure SetBarColor(Value: TColor);
    function GetStartDateTime: TDateTime;
    function GetEndDateTime: TDateTime;
    function GetStartDate: TDate;
    function GetEndDate: TDate;
    function GetStartTime: TTime;
    function GetEndTime: TTime;
    procedure SetRefreshed(Value: Boolean);
    procedure SetGlyph(const Value: TPicture);
  protected
    FID: string;
    FModified: Boolean;
    FScheduleManager: TJvTFScheduleManager;
    FConnections: TStringList;
    FSchedules: TStringList;
    FDeleting: Boolean;
    // implicit post fix
    FUpdating: Boolean;

    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode);
    procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure NotifySchedule(Sched: TJvTFSched; Sender: TObject;
      Code: TJvTFServNotifyCode);

    function GetConnection(Index: Integer): TJvTFSched;
    function GetSchedule(Index: Integer): string;
    procedure CheckConnections;

    procedure Connect(Schedule: TJvTFSched);
    procedure Disconnect(Schedule: TJvTFSched);
    procedure Change;
    procedure InternalClearSchedules;
    procedure DeleteApptNotification;
    // implicit post fix
    procedure PostApptNotification;
    procedure RefreshNotification;

    property Destroying: Boolean read FDestroying;
  public
    constructor Create(Serv: TJvTFScheduleManager; const ApptID: string); virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure SetStartEnd(NewStartDate: TDate; NewStartTime: TTime;
      NewEndDate: TDate; NewEndTime: TTime);

    procedure SetModified;
    function Modified: Boolean; dynamic;
    property ScheduleManager: TJvTFScheduleManager read FScheduleManager;

    function ConnectionCount: Integer;
    property Connections[Index: Integer]: TJvTFSched read GetConnection;

    function ScheduleCount: Integer;
    property Schedules[Index: Integer]: string read GetSchedule;
    procedure AddSchedule(const SchedName: string);
    procedure RemoveSchedule(const SchedName: string);
    procedure AssignSchedules(List: TStrings);
    procedure ClearSchedules;
    function IndexOfSchedule(const SchedName: string): Integer;
    function Shared: Boolean;

    procedure Post;
    procedure Refresh;
    procedure Delete;

    // implicit post fix
    procedure BeginUpdate;
    procedure EndUpdate;
    property Updating: Boolean read FUpdating;

    property ImageMap: TJvTFCustomImageMap read FImageMap write FImageMap;
    procedure RefreshControls;
    property Refreshed: Boolean read FRefreshed write SetRefreshed;
  published
    property ID: string read FID;
    property StartDate: TDate read GetStartDate;
    property EndDate: TDate read GetEndDate;
    property StartTime: TTime read GetStartTime;
    property EndTime: TTime read GetEndTime;
    property StartDateTime: TDateTime read GetStartDateTime;
    property EndDateTime: TDateTime read GetEndDateTime;
    property Description: string read GetDescription write SetDescription;
    property AlarmEnabled: Boolean read FAlarmEnabled write SetAlarmEnabled;
    property AlarmAdvance: Integer read FAlarmAdvance write SetAlarmAdvance;
    property Data: Integer read FData write FData;
    property Persistent: Boolean read FPersistent write FPersistent;
    property Color: TColor read FColor write SetColor default clDefault;
    property BarColor: TColor read FBarColor write SetBarColor default clDefault;
    property Glyph: TPicture read FGlyph write SetGlyph;
  end;

  {$M+}
  TJvTFSched = class(TObject)
  private
    FAppts: TStringList;
    FConControls: TStringList;
    FConComponents: TStringList;
    FDestroying: Boolean;
    FData: Integer;
    FPersistent: Boolean;
    FSchedDisplayName: string;
    procedure SetSchedDisplayName(const Value: string);

    function GetAppt(Index: Integer): TJvTFAppt;
  protected
    FSchedName: string;
    FSchedDate: TDate;
    FScheduleManager: TJvTFScheduleManager;
    FCached: Boolean;
    FCachedTime: Int64; //DWORD;
    procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode);
    procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
      Code: TJvTFServNotifyCode);
    function GetConControl(Index: Integer): TJvTFControl;
    function GetConComponent(Index: Integer): TJvTFComponent;
    procedure ConnectAppt(Appt: TJvTFAppt);
    procedure DisconnectAppt(Appt: TJvTFAppt);
    procedure ConnectionsOnChange(Sender: TObject);
    procedure CheckConnections;
    function GetFreeUsedTime(FreeTime: Boolean): TDynTimeRangeArray; dynamic;
  public
    constructor Create(Serv: TJvTFScheduleManager; const AName: string; ADate: TDate); virtual;
    destructor Destroy; override;

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

    function ConControlCount: Integer;
    property ConControls[Index: Integer]: TJvTFControl read GetConControl;

    function ConComponentCount: Integer;
    property ConComponents[Index: Integer]: TJvTFComponent read GetConComponent;

    procedure AddAppt(Appt: TJvTFAppt);
    procedure RemoveAppt(Appt: TJvTFAppt);

    //procedure RefreshAppts;
    procedure Refresh;
    procedure PostAppts;

    // Conflict and free time methods
    function GetFreeTime: TDynTimeRangeArray; dynamic;
    function GetUsedTime: TDynTimeRangeArray; dynamic;
    function TimeIsFree(TimeRange: TJvTFTimeRange): Boolean; overload; dynamic;
    function TimeIsFree(RangeStart, RangeEnd: TTime): Boolean; overload; dynamic;
    // The ApptHasConflicts(anAppt: TJvTFAppt) method declared here checks
    //  ONLY THIS SCHEDULE!!
    function ApptHasConflicts(anAppt: TJvTFAppt): Boolean; dynamic;
    function EnumConflicts(TimeRange: TJvTFTimeRange): TDynApptArray;
      overload; dynamic;
    function EnumConflicts(RangeStart, RangeEnd: TTime): TDynApptArray;
      overload; dynamic;
    // The following EnumConflicts(anAppt: TJvTFAppt) checks
    //  ONLY THIS SCHEDULE!!
    function EnumConflicts(anAppt: TJvTFAppt): TDynApptArray;
      overload; dynamic;

    property Cached: Boolean read FCached;
    property CachedTime: Int64 {DWORD} read FCachedTime;
    property Destroying: Boolean read FDestroying;

    function GetFirstAppt: TJvTFAppt;
    function GetLastAppt: TJvTFAppt;
  published
    property SchedDisplayName: string read FSchedDisplayName
      write SetSchedDisplayName;
    property SchedName: string read FSchedName;
    property SchedDate: TDate read FSchedDate;
    property ScheduleManager: TJvTFScheduleManager read FScheduleManager;
    property Data: Integer read FData write FData;
    property Persistent: Boolean read FPersistent write FPersistent;
  end;
  {$M-}

  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;
    FApptBeingDestroyed: TJvTFAppt;

    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;
      out Schedule: TJvTFSched; out 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 dbDeleteAllAppt;
    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);
    procedure CreateParams(var Params: TCreateParams); override;
    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; const ExtraDesc: string = ''); 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;

  TJvTFComponent = class(TComponent)   //TJvComponent)
  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;

  TJvTFControl = class(TJvCustomControl)
  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;
    procedure ReqSchedNotification(Schedule: TJvTFSched); virtual;
    procedure RelSchedNotification(Schedule: TJvTFSched); virtual;
    procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
      Code: TJvTFServNotifyCode);
    procedure CNRequestRefresh(var Msg: TCNRequestRefresh); message CN_REQUESTREFRESH;
    procedure RefreshControl; 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;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Navigate(aControl: TJvTFControl; SchedNames: TStringList;
      Dates: TJvTFDateList); virtual;
    //    property Navigator: TJvTFNavigator read FNavigator write SetNavigator;
    //    property OnNavigate: TJvTFNavEvent read FOnNavigate write FOnNavigate;
  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;
    property DragInfo: TJvTFDragInfo read FDragInfo;
    procedure ProcessBatches;
  published
    property ScheduleManager: TJvTFScheduleManager read FScheduleManager write SetManager;
  end;

  EJvTFPrinterError = class(Exception);
  TJvTFMargins = TRect;
  TJvTFPrinterMeasure = (pmPixels, pmInches, pmMM);
  TJvTFPrinterState = (spsNoDoc, spsCreating, spsAssembling, spsFinished);
  TJvTFPrinterDrawEvent = procedure(Sender: TObject; aCanvas: TCanvas;
    ARect: TRect; PageNum: Integer) of object;

  TJvTFProgressEvent = procedure(Sender: TObject; Current, Total: Integer)
    of object;

  TJvTFPrinterPageLayout = class(TPersistent)
  private
    FFooterHeight: Integer;
    FHeaderHeight: Integer;
    FMargins: TJvTFMargins;
    FPrinter: TJvTFPrinter;
    procedure SetFooterHeight(Value: Integer);
    procedure SetHeaderHeight(Value: Integer);
    function GetMargin(Index: Integer): Integer;
    procedure SetMargin(Index: Integer; Value: Integer);
  protected
    procedure Change; virtual;
    property Printer: TJvTFPrinter read FPrinter;
    procedure SetPropertyCheck;
  public
    constructor Create(aPrinter: TJvTFPrinter); virtual;
    procedure Assign(Source: TPersistent); override;
  published
    property FooterHeight: Integer read FFooterHeight write SetFooterHeight;
    property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight;
    property MarginLeft: Integer index 1 read GetMargin write SetMargin;
    property MarginTop: Integer index 2 read GetMargin write SetMargin;
    property MarginRight: Integer index 3 read GetMargin write SetMargin;
    property MarginBottom: Integer index 4 read GetMargin write SetMargin;
  end;

  TJvTFPrinter = class(TJvTFComponent)
  private
    FPages: TStringList;
    FBodies: TStringList;
    FMarginOffsets: TJvTFMargins; // always in pixels
    FMeasure: TJvTFPrinterMeasure;
    FOnDrawBody: TJvTFPrinterDrawEvent;
    FOnDrawHeader: TJvTFPrinterDrawEvent;
    FOnDrawFooter: TJvTFPrinterDrawEvent;
    FOnPrintProgress: TJvTFProgressEvent;
    FOnAssembleProgress: TJvTFProgressEvent;
    FOnMarginError: TNotifyEvent;
    FTitle: string;
    FDirectPrint: Boolean;
    function GetPage(Index: Integer): TBitmap;  //was: TMetafile;
    function GetBodyHeight: Integer; // always in pixels
    function GetBodyWidth: Integer; // always in pixels
    function GetBodyLeft: Integer; // always in pixels
    function GetBodyTop: Integer; // always in pixels
    function GetDocDateTime: TDateTime;
    procedure SetPageLayout(Value: TJvTFPrinterPageLayout);
    procedure SetDirectPrint(Value: Boolean);
  protected
    FPageLayout: TJvTFPrinterPageLayout;
    FState: TJvTFPrinterState;
    FDocDateTime: TDateTime;
    FPageCount: Integer; // NOTE: SEE GetPageCount !!
    FConvertingProps: Boolean;
    FAborted: Boolean;
    procedure SetMarginOffset(Index: Integer; Value: Integer); // always in pixels
    function GetMarginOffset(Index: Integer): Integer; // always in pixels
    function GetUnprintable: TJvTFMargins; // always in pixels
    procedure MarginError; dynamic;
    procedure InitializeMargins;
    property BodyHeight: Integer read GetBodyHeight; // always in pixels
    property BodyWidth: Integer read GetBodyWidth; // always in pixels
    property BodyLeft: Integer read GetBodyLeft; // always in pixels
    property BodyTop: Integer read GetBodyTop; // always in pixels
    procedure DrawBody(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
    procedure DrawHeader(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
    procedure DrawFooter(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
    procedure SetTitle(const Value: string); virtual;
    function GetPageCount: Integer;
    procedure SetMeasure(Value: TJvTFPrinterMeasure); virtual;
    procedure CreateLayout; virtual;
    procedure SetPropertyCheck; dynamic;

    procedure GetHeaderFooterRects(out HeaderRect, FooterRect: TRect);

    // document management methods
    procedure CreateDoc; dynamic;
    procedure NewPage; dynamic;
    procedure FinishDoc; dynamic;
    procedure NewDoc; dynamic;
    property DirectPrint: Boolean read FDirectPrint write SetDirectPrint
      default False;

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

    property PageCount: Integer read GetPageCount;
    property Pages[Index: Integer]: TBitmap read GetPage;   // was: TMetaFile

    function ConvertMeasure(Value: Integer; FromMeasure,
      ToMeasure: TJvTFPrinterMeasure; Horizontal: Boolean): Integer;
    function ScreenToPrinter(Value: Integer; Horizontal: Boolean): Integer;
    function PrinterToScreen(Value: Integer; Horizontal: Boolean): Integer;

    property State: TJvTFPrinterState read FState;
    procedure FreeDoc; dynamic;
    procedure Print; dynamic;
    procedure AbortPrint;
    property DocDateTime: TDateTime read GetDocDateTime;
    property ConvertingProps: Boolean read FConvertingProps;
    procedure SaveDocToFiles(BaseFileName: TFileName);
    property Aborted: Boolean read FAborted;
  published
    property PageLayout: TJvTFPrinterPageLayout read FPageLayout
      write SetPageLayout;
    property Measure: TJvTFPrinterMeasure read FMeasure write SetMeasure
      default pmInches;
    property OnDrawBody: TJvTFPrinterDrawEvent read FOnDrawBody
      write FOnDrawBody;
    property OnDrawHeader: TJvTFPrinterDrawEvent read FOnDrawHeader
      write FOnDrawHeader;
    property OnDrawFooter: TJvTFPrinterDrawEvent read FOnDrawFooter
      write FOnDrawFooter;
    property OnPrintProgress: TJvTFProgressEvent read FOnPrintProgress
      write FOnPrintProgress;
    property OnAssembleProgress: TJvTFProgressEvent read FOnAssembleProgress
      write FOnAssembleProgress;
    property OnMarginError: TNotifyEvent read FOnMarginError
      write FOnMarginError;
    property Title: string read FTitle write SetTitle;
  end;

  TJvTFUniversalPrinter = class(TJvTFPrinter)
  public
    procedure NewDoc; override;
    procedure CreateDoc; override;
    procedure NewPage; override;
    procedure FinishDoc; override;
  published
    property DirectPrint;
  end;

  TJvTFDWNameSource = (dwnsSysLong, dwnsSysShort, dwnsCustom);

  TJvTFDrawDWTitleEvent = procedure(Sender: TObject; aCanvas: TCanvas;
    ARect: TRect; DOW: TTFDayOfWeek; DWName: string) of object;

  TJvTFDWNames = class(TPersistent)
  private
    FSource: TJvTFDWNameSource;
    FDWN_Sunday: string;
    FDWN_Monday: string;
    FDWN_Tuesday: string;
    FDWN_Wednesday: string;
    FDWN_Thursday: string;
    FDWN_Friday: string;
    FDWN_Saturday: string;
    FOnChange: TNotifyEvent;
    procedure SetDWN(Index: Integer; const Value: string);
    function GetDWN(Index: Integer): string;
    procedure SetSource(Value: TJvTFDWNameSource);
  protected
    procedure Change; virtual;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function GetDWName(DWIndex: Integer): string;
  published
    property Source: TJvTFDWNameSource read FSource write SetSource default dwnsSysShort;
    property DWN_Sunday: string index 1 read GetDWN write SetDWN;
    property DWN_Monday: string index 2 read GetDWN write SetDWN;
    property DWN_Tuesday: string index 3 read GetDWN write SetDWN;
    property DWN_Wednesday: string index 4 read GetDWN write SetDWN;
    property DWN_Thursday: string index 5 read GetDWN write SetDWN;
    property DWN_Friday: string index 6 read GetDWN write SetDWN;
    property DWN_Saturday: string index 7 read GetDWN write SetDWN;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  //  TJvTFNavigator = class(TComponent)
  //  private
  //    FBeforeNavigate: TJvTFNavEvent;
  //    FAfterNavigate: TJvTFNavEvent;
  //    FControls: TStringList;
  //    function GetControl(Index: Integer): TJvTFControl;
  //  protected
  //    FNavigating: Boolean;
  //    procedure RegisterControl(aControl: TJvTFControl);
  //    procedure UnregisterControl(aControl: TJvTFControl);
  //  public
  //    constructor Create(AOwner: TComponent); override;
  //    destructor Destroy; override;
  //
  //    function ControlCount: Integer;
  //    property Controls[Index: Integer]: TJvTFControl read GetControl;
  //
  //    procedure Navigate(aControl: TJvTFControl; SchedNames: TStringList;
  //      Dates: TJvTFDateList); virtual;
  //    property Navigating: Boolean read FNavigating;
  //  published
  //    property BeforeNavigate: TJvTFNavEvent read FBeforeNavigate
  //      write FBeforeNavigate;
  //    property AfterNavigate: TJvTFNavEvent read FAfterNavigate
  //      write FAfterNavigate;
  //  end;


implementation

uses
  Dialogs,
  JvResources, JvJVCLUtils; //, JclSysUtils;

function AdjustEndTime(ATime: TTime): TTime;
begin
  Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0)));
end;

function CenterRect(Rect1, Rect2: TRect): TRect;
var
  Rect1Width, Rect1Height, Rect2Width, Rect2Height: Integer;
begin
  Rect1Width := Rect1.Right - Rect1.Left - 1;
  Rect1Height := Rect1.Bottom - Rect1.Top - 1;
  Rect2Width := Rect2.Right - Rect2.Left - 1;
  Rect2Height := Rect2.Bottom - Rect2.Top - 1;

  Result.Left := Rect1.Left + ((Rect1Width - Rect2Width) div 2) - 1;
  Result.Top := Rect1.Top + ((Rect1Height - Rect2Height) div 2) - 1;
  Result.Right := Result.Left + Rect2Width;
  Result.Bottom := Result.Top + Rect2Height;
end;

function MoveRect(ARect: TRect; NewLeft, NewTop: Integer): TRect;
begin
  Result := ARect;
  OffsetRect(Result, NewLeft - ARect.Left, NewTop - ARect.Top);
end;

function StripCRLF(const S: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
    if (S[I] <> #13) and (S[I] <> #10) then
      Result := Result + S[I];
end;

//=== { TJvTFCustomImageMap } ================================================

constructor TJvTFCustomImageMap.Create(anAppt: TJvTFAppt);
begin
  if not Assigned(anAppt) then
    raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateCustomImageMap);

  inherited Create;
  FAppt := anAppt;
  FMap := TStringList.Create;
end;

destructor TJvTFCustomImageMap.Destroy;
begin
  FMap.Free;
  inherited Destroy;
end;

function TJvTFCustomImageMap.GetImage(MapIndex: Integer): Integer;
begin
  Result := PtrInt(FMap.Objects[MapIndex]);
end;

procedure TJvTFCustomImageMap.SetImage(MapIndex, Value: Integer);
begin
  FMap.Objects[MapIndex] := TObject(PtrInt(Value));
end;

function TJvTFCustomImageMap.GetImageName(MapIndex: Integer): string;
begin
  Result := FMap[MapIndex];
end;

procedure TJvTFCustomImageMap.Change;
begin
  if Assigned(FAppt.ScheduleManager) then
  begin
    FAppt.ScheduleManager.RefreshConnections(FAppt);
    // implicit post fix
    FAppt.Change;
  end;
end;

function TJvTFCustomImageMap.Count: Integer;
begin
  Result := FMap.Count;
end;

procedure TJvTFCustomImageMap.Add(const ImageName: string; ImageIndex: Integer);
begin
  if FMap.IndexOf(ImageName) = -1 then
  begin
    FMap.AddObject(ImageName, TObject(PtrInt(ImageIndex)));
    Change;
  end;
end;

procedure TJvTFCustomImageMap.Delete(MapIndex: Integer);
begin
  FMap.Delete(MapIndex);
  Change;
end;

procedure TJvTFCustomImageMap.Move(SrcMapIndex, DestMapIndex: Integer);
begin
  FMap.Move(SrcMapIndex, DestMapIndex);
end;

function TJvTFCustomImageMap.FindMapIndex(const ImageName: string): Integer;
begin
  Result := FMap.IndexOf(ImageName);
end;

function TJvTFCustomImageMap.FindImageIndex(const ImageName: string): Integer;
begin
  Result := FindMapIndex(ImageName);
  if Result > -1 then
    Result := GetImage(Result);
end;

procedure TJvTFCustomImageMap.Clear;
begin
  while FMap.Count > 0 do
    FMap.Delete(0);
  Change;
end;

procedure TJvTFCustomImageMap.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvTFCustomImageMap then
  begin
    while FMap.Count > 0 do
      FMap.Delete(0);

    for I := 0 to TJvTFCustomImageMap(Source).Count - 1 do
      Add(TJvTFCustomImageMap(Source).ImageNames[I],
        TJvTFCustomImageMap(Source).Images[I]);
    Change;
  end
  else
    inherited Assign(Source);
end;

//=== { TJvTFStateImageMap } =================================================

constructor TJvTFStateImageMap.Create(Serv: TJvTFScheduleManager);
var
  I: TJvTFStatePic;
begin
  inherited Create;

  for I := Low(TJvTFStatePic) to High(TJvTFStatePic) do
    FPics[I] := -1;

  FUpdating := False;
end;

procedure TJvTFStateImageMap.SetImage(StatePicID: TJvTFStatePic; Value: Integer);
begin
  if Value < -1 then
    Value := -1;
  if FPics[StatePicID] <> Value then
  begin
    FPics[StatePicID] := Value;
    Change;
  end;
end;

function TJvTFStateImageMap.GetImage(StatePicID: TJvTFStatePic): Integer;
begin
  Result := FPics[StatePicID];
end;

function TJvTFStateImageMap.GetAlarmDisabled: Integer;
begin
  Result := GetImage(spAlarmDisabled);
end;

function TJvTFStateImageMap.GetAlarmEnabled: Integer;
begin
  Result := GetImage(spAlarmEnabled);
end;

function TJvTFStateImageMap.GetModified: Integer;
begin
  Result := GetImage(spModified);
end;

function TJvTFStateImageMap.GetRecurring: Integer;
begin
  Result := GetImage(spRecurring);
end;

function TJvTFStateImageMap.GetShared: Integer;
begin
  Result := GetImage(spShared);
end;

procedure TJvTFStateImageMap.SetAlarmDisabled(const Value: Integer);
begin
  SetImage(spAlarmDisabled, Value);
end;

procedure TJvTFStateImageMap.SetAlarmEnabled(const Value: Integer);
begin
  SetImage(spAlarmEnabled, Value);
end;

procedure TJvTFStateImageMap.SetModified(const Value: Integer);
begin
  SetImage(spModified, Value);
end;

procedure TJvTFStateImageMap.SetRecurring(const Value: Integer);
begin
  SetImage(spRecurring, Value);
end;

procedure TJvTFStateImageMap.SetShared(const Value: Integer);
begin
  SetImage(spShared, Value);
end;

procedure TJvTFStateImageMap.Change;
begin
  if Assigned(FScheduleManager) and not (csLoading in FScheduleManager.ComponentState) and
    not (csDesigning in FScheduleManager.ComponentState) and not FUpdating then
    FScheduleManager.RefreshConnections(nil);
end;

procedure TJvTFStateImageMap.BeginUpdate;
begin
  FUpdating := True;
end;

procedure TJvTFStateImageMap.EndUpdate;
begin
  if FUpdating then
  begin
    FUpdating := False;
    Change;
  end;
end;

procedure TJvTFStateImageMap.Clear;
var
  I: TJvTFStatePic;
begin
  for I := Low(TJvTFStatePic) to High(TJvTFStatePic) do
    FPics[I] := -1;
  Change;
end;

procedure TJvTFStateImageMap.Assign(Source: TPersistent);
var
  Pic: TJvTFStatePic;
begin
  if Source is TJvTFStateImageMap then
  begin
    for Pic := Low(TJvTFStatePic) to High(TJvTFStatePic) do
      FPics[Pic] := TJvTFStateImageMap(Source).Pics[Pic];
    Change;
  end
  else
    inherited Assign(Source);
end;

//=== { TJvTFAppt } ==========================================================

constructor TJvTFAppt.Create(Serv: TJvTFScheduleManager; const ApptID: string);
begin
  if not Assigned(Serv) then
    raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateAppointmentObject);

  inherited Create;

  FGlyph := TPicture.Create;

  FSchedules := TStringList.Create;
  FConnections := TStringList.Create;

  FStartDate := Date;
  FStartTime := Time;
  FEndDate := Date;
  FEndTime := FStartTime + EncodeTime(0, 1, 0, 0);
  FScheduleManager := Serv;
  FDestroying := False;

  if ApptID <> '' then
    FID := ApptID
  else
    FID := FScheduleManager.GenerateApptID;

  FModified := False;
  FColor := clDefault;
  FBarColor := clDefault;

  FImageMap := TJvTFCustomImageMap.Create(Self);

  ScheduleManager.Notify(Self, sncLoadAppt);

  Serv.DoCreateApptEvent(Self);
end;

destructor TJvTFAppt.Destroy;
begin
  FDestroying := True;
  if Assigned(ScheduleManager) then
    ScheduleManager.DoDestroyApptEvent(Self);

  ScheduleManager.Notify(Self, sncDestroyAppt);

  FSchedules.Free;
  FConnections.Free;
  FImageMap.Free;

  FGlyph.Free;

  inherited Destroy;
end;

function TJvTFAppt.GetDescription: string;
begin
  Result := FDescription;
  ScheduleManager.GetApptDescription(Self, Result);
end;

procedure TJvTFAppt.SetDescription(Value: string);
begin
  ScheduleManager.SetApptDescription(Self, Value);
  if Value <> FDescription then
  begin
    FDescription := Value;
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end;
  end;
end;

procedure TJvTFAppt.SetAlarmEnabled(Value: Boolean);
begin
  if Value <> FAlarmEnabled then
  begin
    FAlarmEnabled := Value;
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end;
  end;
end;

procedure TJvTFAppt.SetAlarmAdvance(Value: Integer);
begin
  if Value < 0 then
    Value := 0;

  if Value <> FAlarmAdvance then
  begin
    FAlarmAdvance := Value;
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end;
  end;
end;

procedure TJvTFAppt.SetColor(Value: TColor);
begin
  if Value <> FColor then
  begin
    FColor := Value;
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end;
  end;
end;

procedure TJvTFAppt.SetBarColor(Value: TColor);
begin
  if Value <> FBarColor then
  begin
    FBarColor := Value;
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end;
  end;
end;

procedure TJvTFAppt.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
begin
  case Code of
    sncConnectAppt:
      Connect(TJvTFSched(Sender));
    sncDisconnectAppt:
      Disconnect(TJvTFSched(Sender));
    // implicit post fix
    //sncPostAppt: FModified := False;
    sncPostAppt:
      PostApptNotification;
    sncDeleteAppt:
      InternalClearSchedules;
    sncRefresh:
      FModified := False;
  end;
end;

procedure TJvTFAppt.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Serv) then
    Serv.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
end;

procedure TJvTFAppt.NotifySchedule(Sched: TJvTFSched; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Sched) then
    Sched.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleNotificationFailed);
end;

function TJvTFAppt.GetConnection(Index: Integer): TJvTFSched;
begin
  Result := TJvTFSched(FConnections.Objects[Index]);
end;

function TJvTFAppt.GetSchedule(Index: Integer): string;
begin
  Result := FSchedules[Index];
end;

procedure TJvTFAppt.CheckConnections;
var
  Schedule: TJvTFSched;
  I: Integer;
  ADate: TDate;
  Temp: TStringList;
begin
  // Schedules --> Connections
  for I := 0 to ScheduleCount - 1 do
  begin
    ADate := StartDate;
    while Trunc(ADate) <= Trunc(EndDate) do
    begin
      Schedule := ScheduleManager.FindSchedule(Schedules[I], ADate);
      if Assigned(Schedule) and (FConnections.IndexOfObject(Schedule) = -1) then
        Connect(Schedule);

      ADate := ADate + 1;
    end;
  end;

  // Connections --> Schedules
  Temp := TStringList.Create;
  try
    Temp.Assign(FConnections);
    for I := 0 to Temp.Count - 1 do
    begin
      Schedule := TJvTFSched(Temp.Objects[I]);
      if (FSchedules.IndexOf(Schedule.SchedName) = -1) or
        ((Trunc(Schedule.SchedDate) < Trunc(StartDate)) or
        (Trunc(Schedule.SchedDate) > Trunc(EndDate))) then
        Disconnect(Schedule);
    end;
  finally
    Temp.Free;
  end;

  { implicit post fix
  If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
    // To avoid display anomolies we need to post the appt here.
    Post;
  }
end;

procedure TJvTFAppt.Connect(Schedule: TJvTFSched);
var
  SchedID: string;
  I: Integer;
begin
  if Assigned(Schedule) then
  begin
    Schedule.Notify(Self, sncConnectAppt);

    SchedID := ScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
    I := FConnections.IndexOf(SchedID);
    if I = -1 then
    begin
      FConnections.AddObject(SchedID, Schedule);
      ScheduleManager.RefreshConnections(Schedule);
    end;
  end;
end;

procedure TJvTFAppt.Disconnect(Schedule: TJvTFSched);
var
  I: Integer;
begin
  if Assigned(Schedule) then
  begin
    Schedule.Notify(Self, sncDisconnectAppt);

    I := FConnections.IndexOfObject(Schedule);
    if I > -1 then
    begin
      FConnections.Delete(I);
      ScheduleManager.RefreshConnections(Schedule);
    end;
  end;
end;

procedure TJvTFAppt.Change;
begin
  // implicit post fix
  if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing and not Updating then
    Post;
  ScheduleManager.RefreshConnections(Self);
end;

procedure TJvTFAppt.InternalClearSchedules;
begin
  FSchedules.Clear;
  CheckConnections;
end;

procedure TJvTFAppt.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvTFAppt then
  begin
    for I := 0 to TJvTFAppt(Source).ScheduleCount - 1 do
      AddSchedule(TJvTFAppt(Source).Schedules[I]);
    ImageMap.Assign(TJvTFAppt(Source).ImageMap);
    SetStartEnd(TJvTFAppt(Source).StartDate, TJvTFAppt(Source).StartTime,
      TJvTFAppt(Source).EndDate, TJvTFAppt(Source).EndTime);
    Description := TJvTFAppt(Source).Description;
    AlarmEnabled := TJvTFAppt(Source).AlarmEnabled;
    AlarmAdvance := TJvTFAppt(Source).AlarmAdvance;
    Data := TJvTFAppt(Source).Data;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFAppt.SetStartEnd(NewStartDate: TDate; NewStartTime: TTime;
  NewEndDate: TDate; NewEndTime: TTime);
begin
  // The following avoids time overflow into next day when it is not
  //  intended.  (Add appt to last row of days would cause invalid
  //  start/end exception.)
  if Frac(NewEndTime) <= EncodeTime(0, 0, 0, 999) then
    NewEndTime := EncodeTime(23, 59, 59, 0);

  if Trunc(NewStartDate) <= Trunc(NewEndDate) then
  begin
    if Trunc(NewStartDate) = Trunc(NewEndDate) then
      if Frac(NewStartTime) >= Frac(NewEndTime) then
        raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidStartAndEndTimes);

    FStartDate := NewStartDate;
    FEndDate := NewEndDate;
    FStartTime := NewStartTime;
    FEndTime := NewEndTime;

    CheckConnections;

    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      Change;
    end
  end
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidStartAndEndDates);
end;

procedure TJvTFAppt.SetModified;
begin
  FModified := True;
  // implicit post fix
  Change;
end;

function TJvTFAppt.Modified: Boolean;
begin
  Result := FModified;
end;

function TJvTFAppt.ConnectionCount: Integer;
begin
  Result := FConnections.Count;
end;

function TJvTFAppt.ScheduleCount: Integer;
begin
  Result := FSchedules.Count;
end;

procedure TJvTFAppt.AddSchedule(const SchedName: string);
var
  ADate: TDate;
  Schedule: TJvTFSched;
begin
  if SchedName = '' then
    Exit;

  // Add it to the schedules list
  if FSchedules.IndexOf(SchedName) = -1 then
  begin
    FSchedules.Add(SchedName);
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      // implicit post fix
      Change;
    end;
  end;

  // Check for needed connections
  //  (Only connects to currently loaded schedules.  Will not load a schedule.)
  ADate := StartDate;
  while Trunc(ADate) <= Trunc(EndDate) do
  begin
    Schedule := ScheduleManager.FindSchedule(SchedName, ADate);
    if Assigned(Schedule) then
      Connect(Schedule);
    ADate := ADate + 1;
  end;

  { implicit post fix
  // To avoid display anomolies we need to post the appt here.
  If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
    Post;
  }
end;

procedure TJvTFAppt.RemoveSchedule(const SchedName: string);
var
  I: Integer;
  ADate: TDate;
  Schedule: TJvTFSched;
begin
  if SchedName = '' then
    Exit;

  // Remove it from the schedule list
  I := FSchedules.IndexOf(SchedName);
  if I > -1 then
  begin
    FSchedules.Delete(I);
    if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
    begin
      FModified := True;
      // implicit post fix
      Change;
    end;
  end;

  // Check for invalid connections and disconnect
  ADate := StartDate;
  while Trunc(ADate) <= Trunc(EndDate) do
  begin
    Schedule := ScheduleManager.FindSchedule(SchedName, ADate);
    if Assigned(Schedule) then
      Disconnect(Schedule);

    ADate := ADate + 1;
  end;

  { implicit post fix
  // To avoid display anomolies we need to post the appt here.
  If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
    Post;
  }
end;

procedure TJvTFAppt.AssignSchedules(List: TStrings);
begin
  FSchedules.Assign(List);
  if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
  begin
    FModified := True;
    // implicit post fix
    Change;
  end;

  CheckConnections;
end;

procedure TJvTFAppt.ClearSchedules;
begin
  FSchedules.Clear;

  if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
  begin
    FModified := True;
    // implicit post fix
    Change;
  end;

  CheckConnections;
end;

function TJvTFAppt.IndexOfSchedule(const SchedName: string): Integer;
begin
  Result := FSchedules.IndexOf(SchedName);
end;

function TJvTFAppt.Shared: Boolean;
begin
  Result := ScheduleCount > 1;
end;

procedure TJvTFAppt.Post;
begin
  ScheduleManager.dbPostAppt(Self);
end;

procedure TJvTFAppt.Refresh;
begin
  ScheduleManager.dbRefreshAppt(Self);
end;

procedure TJvTFAppt.Delete;
begin
  ScheduleManager.dbDeleteAppt(Self);
end;

procedure TJvTFAppt.RefreshControls;
begin
  ScheduleManager.RefreshConnections(Self);
end;

function TJvTFAppt.GetEndDateTime: TDateTime;
begin
  Result := Trunc(EndDate) + Frac(EndTime);
end;

function TJvTFAppt.GetStartDateTime: TDateTime;
begin
  Result := Trunc(StartDate) + Frac(StartTime);
end;

function TJvTFAppt.GetEndDate: TDate;
begin
  Result := Int(FEndDate);
end;

function TJvTFAppt.GetEndTime: TTime;
begin
  Result := Frac(FEndTime);
end;

function TJvTFAppt.GetStartDate: TDate;
begin
  Result := Int(FStartDate);
end;

function TJvTFAppt.GetStartTime: TTime;
begin
  Result := Frac(FStartTime);
end;

procedure TJvTFAppt.DeleteApptNotification;
begin
  FDeleting := True;
  try
    InternalClearSchedules;
  finally
    FDeleting := False;
  end;
end;

procedure TJvTFAppt.PostApptNotification;
begin
  FModified := False;
  FUpdating := False;
end;

procedure TJvTFAppt.BeginUpdate;
begin
  FUpdating := True;
end;

procedure TJvTFAppt.EndUpdate;
begin
  if FUpdating then
  begin
    FUpdating := False;
    Change;
  end;
end;

procedure TJvTFAppt.SetRefreshed(Value: Boolean);
begin
  FRefreshed := Value;
end;

procedure TJvTFAppt.SetGlyph(const Value: TPicture);
begin
  FGlyph.Assign(Value);
end;

procedure TJvTFAppt.RefreshNotification;
begin
  FModified := False;
  Refreshed := False;
end;

//=== { TJvTFSched } =========================================================

constructor TJvTFSched.Create(Serv: TJvTFScheduleManager; const AName: string;
  ADate: TDate);
begin
  inherited Create;

  FScheduleManager := Serv;
  FSchedName := AName;
  FSchedDate := ADate;

  FAppts := TStringList.Create;
  FConControls := TStringList.Create;
  FConControls.OnChange := @ConnectionsOnChange;
  FConComponents := TStringList.Create;
  FConComponents.OnChange := @ConnectionsOnChange;

  if Assigned(Serv) then
    Serv.DoCreateScheduleEvent(Self);
end;

destructor TJvTFSched.Destroy;
var
  Ctrl: TJvTFControl;
  Comp: TJvTFComponent;
  Appt: TJvTFAppt;
begin
  FDestroying := True;

  if Assigned(ScheduleManager) then
    ScheduleManager.DoDestroyScheduleEvent(Self);

  while ConControlCount > 0 do
  begin
    Ctrl := TJvTFControl(FConControls.Objects[0]);
    ScheduleManager.ReleaseSchedule(Ctrl, SchedName, SchedDate);
  end;

  while ConComponentCount > 0 do
  begin
    Comp := TJvTFComponent(FConComponents.Objects[0]);
    ScheduleManager.ReleaseSchedule(Comp, SchedName, SchedDate);
  end;

  while ApptCount > 0 do
  begin
    Appt := Appts[0];
    Appt.Notify(Self, sncDisconnectAppt);
  end;

  ScheduleManager.Notify(Self, sncDestroySchedule);

  FAppts.Free;
  FConControls.Free;
  FConComponents.Free;

  inherited Destroy;
end;

function TJvTFSched.GetAppt(Index: Integer): TJvTFAppt;
begin
  Result := TJvTFAppt(FAppts.Objects[Index]);
end;

procedure TJvTFSched.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
var
  I: Integer;
  ConList: TStringList;
begin
  if Sender is TJvTFControl then
    ConList := FConControls
  else
  if Sender is TJvTFComponent then
    ConList := FConComponents
  else
    ConList := nil;

  case Code of
    sncRequestSchedule:
      if ConList.IndexOfObject(Sender) = -1 then
        ConList.AddObject('', Sender);
    sncReleaseSchedule:
      begin
        I := ConList.IndexOfObject(Sender);
        if I > -1 then
          ConList.Delete(I);
      end;
    sncConnectAppt:
      ConnectAppt(TJvTFAppt(Sender));
    sncDisconnectAppt:
      DisconnectAppt(TJvTFAppt(Sender));
  end;
end;

procedure TJvTFSched.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Serv) then
    Serv.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
end;

procedure TJvTFSched.NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Appt) then
    Appt.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEAppointmentNotificationFailed);
end;

function TJvTFSched.GetConControl(Index: Integer): TJvTFControl;
begin
  Result := TJvTFControl(FConControls.Objects[Index]);
end;

function TJvTFSched.GetConComponent(Index: Integer): TJvTFComponent;
begin
  Result := TJvTFComponent(FConComponents.Objects[Index]);
end;

procedure TJvTFSched.ConnectAppt(Appt: TJvTFAppt);
begin
  if FAppts.IndexOf(Appt.ID) = -1 then
    FAppts.AddObject(Appt.ID, Appt);
end;

procedure TJvTFSched.DisconnectAppt(Appt: TJvTFAppt);
var
  I: Integer;
begin
  I := FAppts.IndexOf(Appt.ID);
  if I > -1 then
    FAppts.Delete(I);
end;

procedure TJvTFSched.ConnectionsOnChange(Sender: TObject);
begin
  if (FConControls.Count = 0) and (FConComponents.Count = 0) then
  begin
    FCached := True;
    FCachedTime := GetTickCount64; //Windows.GetTickCount;
  end
  else
    FCached := False;
end;

procedure TJvTFSched.CheckConnections;
var
  I: Integer;
  Appt: TJvTFAppt;
  DateHit, NameMatch, NotConnected: Boolean;
begin
  // Check each appt in the ScheduleManager to see if that appt should be connected
  //  to this schedule.  If so, then connect it.
  for I := 0 to ScheduleManager.ApptCount - 1 do
  begin
    Appt := ScheduleManager.Appts[I];
    DateHit := (Trunc(SchedDate) >= Trunc(Appt.StartDate)) and
      (Trunc(SchedDate) <= Trunc(Appt.EndDate));
    NameMatch := Appt.IndexOfSchedule(SchedName) > -1;
    NotConnected := ApptByID(Appt.ID) = nil;
    if DateHit and NameMatch and NotConnected then
      Appt.Notify(Self, sncConnectAppt);
  end;
end;

function TJvTFSched.GetFreeUsedTime(FreeTime: Boolean): TDynTimeRangeArray;
var
  // 60 mins X 24 hrs = 1440 ==> minutes in a day
  DayArray: array [0..1439] of Boolean; // I'm a poet and don't know it.
  I, J, MinStart, MinEnd: Integer;
  anAppt: TJvTFAppt;
  StartTime, EndTime: TTime;
  Switch, MinIsFree, InRange: Boolean;

  function TimeToMinNum(ATime: TTime): Integer;
  var
    H, M, S, MS: Word;
  begin
    DecodeTime(ATime, H, M, S, MS);
    Result := H * 60 + M;
  end;

  function MinNumToTime(MinNum: Integer): TTime;
  begin
    Result := EncodeTime(MinNum div 60, MinNum mod 60, 0, 0);
  end;

  procedure StartRange;
  begin
    StartTime := MinNumToTime(I);
    InRange := True;
  end;

  procedure EndRange;
  begin
    EndTime := MinNumToTime(I);

    // add range to resultant array
    SetLength(Result, Length(Result) + 1);
    Result[High(Result)].StartTime := StartTime;
    Result[High(Result)].EndTime := EndTime;

    InRange := False;
  end;

begin
  // Initialize resultant array
  SetLength(Result, 1);
  Result[0].StartTime := 0.0;
  Result[0].EndTime := EncodeTime(23, 59, 59, 0);

  // EXIT if nothing to do
  if ApptCount = 0 then
  begin
    if not FreeTime then
      SetLength(Result, 0);
    Exit;
  end;

  // Initialize working array
  //  True ==> free minute
  //  False ==> used minute
  for I := 0 to 1439 do
    DayArray[I] := True;

  // Go through the appts and mark used minutes in the working array
  for I := 0 to ApptCount - 1 do
  begin
    anAppt := Appts[I];
    MinStart := TimeToMinNum(anAppt.StartTime);
    MinEnd := TimeToMinNum(AdjustEndTime(anAppt.EndTime));

    for J := MinStart to MinEnd do
      DayArray[J] := False;
  end;

  // Now convert working array to resultant array
  SetLength(Result, 0);
  MinIsFree := not FreeTime;
  for I := 0 to 1439 do
  begin
    Switch := DayArray[I] xor MinIsFree;
    MinIsFree := DayArray[I];
    if Switch then
      if MinIsFree then
        if FreeTime then
          StartRange
        else
          EndRange
      else
      if FreeTime then
        EndRange
      else
        StartRange
  end;

  // close and add the last range if needed
  if InRange then
  begin
    I := 1439; // set I to last min of day
    EndRange;
  end;
end;

function TJvTFSched.ApptCount: Integer;
begin
  Result := FAppts.Count;
end;

function TJvTFSched.ApptByID(const ID: string): TJvTFAppt;
var
  I: Integer;
begin
  Result := nil;
  I := FAppts.IndexOf(ID);
  if I > -1 then
    Result := TJvTFAppt(FAppts.Objects[I]);
end;

function TJvTFSched.ConControlCount: Integer;
begin
  Result := FConControls.Count;
end;

function TJvTFSched.ConComponentCount: Integer;
begin
  Result := FConComponents.Count;
end;

procedure TJvTFSched.AddAppt(Appt: TJvTFAppt);
begin
  if Assigned(Appt) then
    Appt.AddSchedule(SchedName);
end;

procedure TJvTFSched.RemoveAppt(Appt: TJvTFAppt);
begin
  if Assigned(Appt) then
    Appt.RemoveSchedule(SchedName);
end;
{
procedure TJvTFSched.RefreshAppts;
Var
  I,
  J,
  K: Integer;
  ApptIDList,
  RefList: TStringList;
  Appt: TJvTFAppt;
  Sched: TJvTFSched;
  RefID: string;
begin
  // In a multi-user environment, appt objects may be deleted as a result
  // of calling dbRefreshAppt.  (Component user may call Appt.Free.)
  // To account for this we need to build a list of appt ID's instead of
  // working directly from the ScheduleManager's appointment list.
  // We also need to build a list of connections (Components and
  // TJvTFControls) that need to be refreshed.

  ApptIDList := TStringList.Create;
  RefList := TStringList.Create;
  RefList.Duplicates := dupIgnore;
  Try
    For I := 0 to ApptCount - 1 do
      Begin
        Appt := Appts[I];
        ApptIDList.Add(Appt.ID);
        For J := 0 to Appt.ConnectionCount - 1 do
          Begin
            Sched := Appt.Connections[J];
            For K := 0 to Sched.ConComponentCount - 1 do
              Begin
                RefID := IntToStr(Integer(Sched.ConComponents[K]));
                RefList.AddObject(RefID, Sched.ConComponents[K]);
              End;
            For K := 0 to Sched.ConControlCount - 1 do
              Begin
                RefID := IntToStr(Integer(Sched.ConControls[K]));
                RefList.AddObject(RefID, Sched.ConControls[K]);
              End;
          End;
      End;

    For I := 0 to ApptIDList.Count - 1 do
      Begin
        Appt := ScheduleManager.FindAppt(ApptIDList[I]);
        If Assigned(Appt) Then
          ScheduleManager.dbRefreshAppt(Appt);
      End;

    For I := 0 to RefList.Count - 1 do
      ScheduleManager.RefreshConnections(RefList.Objects[I]);
  Finally
    ApptIDList.Free;
    RefList.Free;
  End;
end;
}

procedure TJvTFSched.PostAppts;
var
  I: Integer;
begin
  for I := 0 to ApptCount - 1 do
    ScheduleManager.dbPostAppt(Appts[I]);
end;

function TJvTFSched.GetFreeTime: TDynTimeRangeArray;
begin
  Result := GetFreeUsedTime(True);
end;

function TJvTFSched.GetUsedTime: TDynTimeRangeArray;
begin
  Result := GetFreeUsedTime(False);
end;

function TJvTFSched.TimeIsFree(TimeRange: TJvTFTimeRange): Boolean;
var
  Appt: TJvTFAppt;
  I: Integer;
begin
  Result := True;
  I := 0;

  while (I < ApptCount) and Result do
  begin
    Appt := Appts[I];
    if (Frac(Appt.StartTime) <= Frac(AdjustEndTime(TimeRange.EndTime))) and
      (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(TimeRange.StartTime)) then
      Result := False
    else
      Inc(I);
  end;
end;

function TJvTFSched.TimeIsFree(RangeStart, RangeEnd: TTime): Boolean;
var
  TimeRange: TJvTFTimeRange;
begin
  TimeRange.StartTime := RangeStart;
  TimeRange.EndTime := RangeEnd;
  Result := TimeIsFree(TimeRange);
end;

function TJvTFSched.ApptHasConflicts(anAppt: TJvTFAppt): Boolean;
var
  Appt: TJvTFAppt;
  I: Integer;
begin
  Result := False;
  I := 0;

  while (I < ApptCount) and not Result do
  begin
    Appt := Appts[I];
    if (Appt <> anAppt) and // Don't flag for the given appt
    (Frac(Appt.StartTime) <= Frac(AdjustEndTime(anAppt.EndTime))) and
      (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(anAppt.StartTime)) then
      Result := True
    else
      Inc(I);
  end;
end;

function TJvTFSched.EnumConflicts(TimeRange: TJvTFTimeRange): TDynApptArray;
var
  Appt: TJvTFAppt;
  I: Integer;
begin
  SetLength(Result, 0);
  for I := 0 to ApptCount - 1 do
  begin
    Appt := Appts[I];
    if (Frac(Appt.StartTime) <= Frac(AdjustEndTime(TimeRange.EndTime))) and
      (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(TimeRange.StartTime)) then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := Appt;
    end;
  end;
end;

function TJvTFSched.EnumConflicts(RangeStart, RangeEnd: TTime): TDynApptArray;
var
  TimeRange: TJvTFTimeRange;
begin
  TimeRange.StartTime := RangeStart;
  TimeRange.EndTime := RangeEnd;
  Result := EnumConflicts(TimeRange);
end;

function TJvTFSched.EnumConflicts(anAppt: TJvTFAppt): TDynApptArray;
var
  Appt: TJvTFAppt;
  I: Integer;
begin
  SetLength(Result, 0);
  for I := 0 to ApptCount - 1 do
  begin
    Appt := Appts[I];
    if (Appt <> anAppt) and // don't add the given appt
    (Frac(Appt.StartTime) <= Frac(AdjustEndTime(anAppt.EndTime))) and
      (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(anAppt.StartTime)) then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := Appt;
    end;
  end;
end;

function TJvTFSched.GetFirstAppt: TJvTFAppt;
var
  I: Integer;
  anAppt: TJvTFAppt;
begin
  Result := nil;
  I := 0;
  while (I < ApptCount) do
  begin
    anAppt := Appts[I];
    if Trunc(anAppt.StartDate) < Trunc(SchedDate) then
    begin
      Result := anAppt;
      Break; // APPOINTMENT STARTS AT 0:00 (12:00am) SO LEAVE LOOP
    end
    else
    if not Assigned(Result) then
      Result := anAppt
    else
    if Frac(anAppt.StartTime) < Frac(Result.StartTime) then
      Result := anAppt;
    Inc(I);
  end;
end;

function TJvTFSched.GetLastAppt: TJvTFAppt;
var
  I: Integer;
  anAppt: TJvTFAppt;
begin
  Result := nil;
  I := 0;
  while (I < ApptCount) do
  begin
    anAppt := Appts[I];
    if Trunc(anAppt.EndDate) > Trunc(SchedDate) then
    begin
      Result := anAppt;
      Break; // APPOINTMENT ENDS AT 23:59 (11:59pm) SO LEAVE LOOP
    end
    else
    if not Assigned(Result) then
      Result := anAppt
    else
    if Frac(anAppt.EndTime) > Frac(Result.EndTime) then
      Result := anAppt;
    Inc(I);
  end;
end;

procedure TJvTFSched.Refresh;
begin
  ScheduleManager.dbRefreshSched(Self);
end;

procedure TJvTFSched.SetSchedDisplayName(const Value: string);
begin
  if FSchedDisplayName <> Value then
  begin
    FSchedDisplayName := Value;
    ScheduleManager.RefreshConnections(Self);
  end;
end;

//=== { TJvTFScheduleManagerCache } ==========================================

constructor TJvTFScheduleManagerCache.Create(SchedManager: TJvTFScheduleManager);
begin
  inherited Create;
  FScheduleManager := SchedManager;

  FCacheType := ctTimed;
  FTimedDelay := 30000;
  FBufferCount := 7;

  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := @TimerOnTimer;
  FTimer.Interval := FTimedDelay;
  FTimer.Enabled := FCacheType = ctTimed;
end;

destructor TJvTFScheduleManagerCache.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TJvTFScheduleManagerCache.SetCacheType(Value: TJvTFScheduleManagerCacheType);
begin
  if Value <> FCacheType then
  begin
    FCacheType := Value;
    FTimer.Enabled := Value = ctTimed;
    FlushManager;
  end;
end;

procedure TJvTFScheduleManagerCache.SetTimedDelay(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  if Value <> FTimedDelay then
  begin
    FTimedDelay := Value;
    FTimer.Enabled := False;
    FTimer.Interval := Value;
    if CacheType = ctTimed then
    begin
      FTimer.Enabled := True;
      FlushManager;
    end;
  end;
end;

procedure TJvTFScheduleManagerCache.SetBufferCount(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  if Value <> FBufferCount then
  begin
    FBufferCount := Value;
    if CacheType = ctBuffer then
      FlushManager;
  end;
end;

procedure TJvTFScheduleManagerCache.FlushManager;
begin
  if Assigned(FScheduleManager) then
    FScheduleManager.Flush(False);
end;

procedure TJvTFScheduleManagerCache.TimerOnTimer(Sender: TObject);
begin
  FlushManager;
end;

procedure TJvTFScheduleManagerCache.Assign(Source: TPersistent);
begin
  if Source is TJvTFScheduleManagerCache then
  begin
    FCacheType := TJvTFScheduleManagerCache(Source).CacheType;
    FTimedDelay := TJvTFScheduleManagerCache(Source).TimedDelay;
    FBufferCount := TJvTFScheduleManagerCache(Source).BufferCount;
    if FTimer.Enabled then
    begin
      FTimer.Enabled := False;
      FTimer.Interval := FTimedDelay;
      FTimer.Enabled := FCacheType = ctTimed;
    end;
    FlushManager;
  end
  else
    inherited Assign(Source);
end;

//=== { TJvTFScheduleManager } ===============================================

constructor TJvTFScheduleManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSchedLoadMode := slmOnDemand;
  FAppts := TStringList.Create;
  FSchedules := TStringList.Create;

  FSchedBatch := TStringList.Create;
  FSchedBatch.Sorted := True;
  FSchedBatch.Duplicates := dupIgnore;

  FConControls := TStringList.Create;
  FConComponents := TStringList.Create;

  FStateImageMap := TJvTFStateImageMap.Create(Self);
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := @ImageListChange;

  FCache := TJvTFScheduleManagerCache.Create(Self);
  FApptBeingDestroyed := nil;
end;

destructor TJvTFScheduleManager.Destroy;
begin
  FDestroying := True;

  while ConControlCount > 0 do
    ConControls[0].ScheduleManager := nil;

  while ConComponentCount > 0 do
    ConComponents[0].ScheduleManager := nil;

  while ScheduleCount > 0 do
    Schedules[0].Free;

  while ApptCount > 0 do
    Appts[0].Free;

  FAppts.Free;
  FSchedBatch.Free;
  FSchedules.Free;
  FConControls.Free;
  FConComponents.Free;
  FStateImageMap.Free;

  StateImages := nil;
  CustomImages := nil;
  FImageChangeLink.Free;

  FCache.Free;

  inherited Destroy;
end;

class function TJvTFScheduleManager.GetScheduleID(const SchedName: string;
  SchedDate: TDate): string;
begin
  Result := SchedName + IntToStr(Trunc(SchedDate));
end;

class function TJvTFScheduleManager.GenerateApptID: string;
var
  I: Integer;
begin
  Result := FloatToStr(Now);
  Randomize;
  for I := 1 to 5 do
    Result := Result + Chr(Random(25) + 65);
end;

function TJvTFScheduleManager.GetAppt(Index: Integer): TJvTFAppt;
begin
  Result := TJvTFAppt(FAppts.Objects[Index]);
end;

function TJvTFScheduleManager.GetSchedule(Index: Integer): TJvTFSched;
begin
  Result := TJvTFSched(FSchedules.Objects[Index]);
end;

function TJvTFScheduleManager.GetConControl(Index: Integer): TJvTFControl;
begin
  Result := TJvTFControl(FConControls.Objects[Index]);
end;

function TJvTFScheduleManager.GetConComponent(Index: Integer): TJvTFComponent;
begin
  Result := TJvTFComponent(FConComponents.Objects[Index]);
end;

procedure TJvTFScheduleManager.SetStateImages(Value: TCustomImageList);
begin
  ReplaceImageListReference(Self, Value, FStateImages, FImageChangeLink);
end;

procedure TJvTFScheduleManager.SetCustomImages(Value: TCustomImageList);
begin
  ReplaceImageListReference(Self, Value, FCustomImages, FImageChangeLink);
end;

procedure TJvTFScheduleManager.SetCache(Value: TJvTFScheduleManagerCache);
begin
  FCache.Assign(Value);
end;

procedure TJvTFScheduleManager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = StateImages then
    begin
      StateImages := nil;
      RefreshConnections(nil);
    end
    else
    if AComponent = CustomImages then
    begin
      CustomImages := nil;
      RefreshConnections(nil);
    end;
end;

procedure TJvTFScheduleManager.ConnectControl(ApptCtrl: TJvTFControl);
var
  I: Integer;
begin
  if not Assigned(ApptCtrl) then
    Exit;

  I := FConControls.IndexOfObject(ApptCtrl);
  if I = -1 then
    FConControls.AddObject('', ApptCtrl);
end;

procedure TJvTFScheduleManager.DisconnectControl(ApptCtrl: TJvTFControl);
var
  I: Integer;
begin
  if not Assigned(ApptCtrl) then
    Exit;

  I := FConControls.IndexOfObject(ApptCtrl);
  if I > -1 then
  begin
    ApptCtrl.ReleaseSchedules;
    FConControls.Delete(I);
  end;
end;

procedure TJvTFScheduleManager.ConnectComponent(Comp: TJvTFComponent);
var
  I: Integer;
begin
  if not Assigned(Comp) then
    Exit;

  I := FConComponents.IndexOfObject(Comp);
  if I = -1 then
    FConComponents.AddObject('', Comp);
end;

procedure TJvTFScheduleManager.DisconnectComponent(Comp: TJvTFComponent);
var
  I: Integer;
begin
  if not Assigned(Comp) then
    Exit;

  I := FConComponents.IndexOfObject(Comp);
  if I > -1 then
  begin
    Comp.ReleaseSchedules;
    FConComponents.Delete(I);
  end;
end;

procedure TJvTFScheduleManager.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
begin
  case Code of
    sncConnectComponent:
      ConnectComponent(TJvTFComponent(Sender));
    sncDisconnectComponent:
      DisconnectComponent(TJvTFComponent(Sender));
    sncConnectControl:
      ConnectControl(TJvTFControl(Sender));
    sncDisconnectControl:
      DisconnectControl(TJvTFControl(Sender));
    sncLoadAppt:
      AddAppt(TJvTFAppt(Sender));
    sncDestroyAppt:
      RemoveAppt(TJvTFAppt(Sender));
    sncDestroySchedule:
      RemoveSchedule(TJvTFSched(Sender));
  end;
end;

procedure TJvTFScheduleManager.NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Appt) then
    Appt.Notify(Sender, Code);
end;

procedure TJvTFScheduleManager.NotifySchedule(Sched: TJvTFSched; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Sched) then
    Sched.Notify(Sender, Code);
end;

procedure TJvTFScheduleManager.NotifyApptCtrl(ApptCtrl: TJvTFControl;
  Sender: TObject; Code: TJvTFServNotifyCode);
begin
  if Assigned(ApptCtrl) then
    ApptCtrl.Notify(Sender, Code);
end;

procedure TJvTFScheduleManager.NotifyComp(Comp: TJvTFComponent;
  Sender: TObject; Code: TJvTFServNotifyCode);
begin
  if Assigned(Comp) then
    Comp.Notify(Sender, Code);
end;

procedure TJvTFScheduleManager.RetrieveSchedule(const SchedName: string; SchedDate: TDate;
  out Schedule: TJvTFSched; out LoadedNow: Boolean);
var
  SchedID: string;
  I: Integer;
begin
  SchedID := GetScheduleID(SchedName, SchedDate);
  I := FSchedules.IndexOf(SchedID);

  if I > -1 then
  begin
    Schedule := TJvTFSched(FSchedules.Objects[I]);
    LoadedNow := False;
  end
  else
  begin
    //Schedule := TJvTFSched.Create(Self, SchedName, SchedDate);
    Schedule := GetSchedClass.Create(Self, SchedName, SchedDate);
    FSchedules.AddObject(SchedID, Schedule);
    LoadedNow := True;
    if Cache.CacheType = ctBuffer then
      Flush(False);
    Schedule.CheckConnections;
  end;
end;

procedure TJvTFScheduleManager.NeedAppts(Schedule: TJvTFSched);
begin
  FLoadingAppts := True;
  try
    if Assigned(FOnNeedAppts) then
      FOnNeedAppts(Self, Schedule);
  finally
    FLoadingAppts := False;
    RefreshConnections(Schedule);
  end;
end;

procedure TJvTFScheduleManager.AddAppt(Appt: TJvTFAppt);
begin
  if FAppts.IndexOfObject(Appt) = -1 then
    FAppts.AddObject(Appt.ID, Appt);
end;

procedure TJvTFScheduleManager.RemoveAppt(Appt: TJvTFAppt);
var
  I: Integer;
  IndexOfAppt: Integer;
begin
  if Appt = FApptBeingDestroyed then
    Exit;  // Do Nothing if this is already the Appt we are
           // destroying ourselves

  IndexOfAppt := FAppts.IndexOfObject(Appt);
  if IndexOfAppt = -1 then
    Exit; // Nothing to do if the appt is not in our list

  for I := 0 to ConControlCount - 1 do
    NotifyApptCtrl(ConControls[I], Appt, sncDestroyAppt);

  for I := 0 to ConComponentCount - 1 do
    NotifyComp(ConComponents[I], Appt, sncDestroyAppt);

  while Appt.ConnectionCount > 0 do
    Appt.Notify(Appt.Connections[0], sncDisconnectAppt);

  FAppts.Delete(IndexOfAppt);

  // Do not free if the appt is being destroyed by someone else
  if not Appt.Destroying then
  begin
    FApptBeingDestroyed := Appt;
    try
      Appt.Free;
    finally
      FApptBeingDestroyed := nil;
    end;
  end;
end;

procedure TJvTFScheduleManager.RemoveSchedule(Sched: TJvTFSched);
var
  I: Integer;
begin
  for I := 0 to ConControlCount - 1 do
    NotifyApptCtrl(ConControls[I], Sched, sncDestroySchedule);

  for I := 0 to ConComponentCount - 1 do
    NotifyComp(ConComponents[I], Sched, sncDestroySchedule);

  FSchedules.Delete(FSchedules.IndexOfObject(Sched));
  Flush(False);
end;

{
procedure TJvTFScheduleManager.RefreshAppt(Appt: TJvTFAppt);
begin
  FLoadingAppts := True;
  Try
    NotifyAppt(Appt, Self, sncRefresh);
    If Assigned(FOnRefreshAppt) Then
      FOnRefreshAppt(Self, Appt);
  Finally
    FLoadingAppts := False;
  End;
end;
}

procedure TJvTFScheduleManager.DeleteAppt(Appt: TJvTFAppt);
begin
  if Assigned(FOnDeleteAppt) then
    FOnDeleteAppt(Self, Appt);
end;

procedure TJvTFScheduleManager.PostAppt(Appt: TJvTFAppt);
begin
  if Assigned(FOnPostAppt) then
    FOnPostAppt(Self, Appt);
end;

procedure TJvTFScheduleManager.RequestRefresh(ApptCtrl: TJvTFControl;
  Schedule: TJvTFSched);
begin
  NotifyApptCtrl(ApptCtrl, Self, sncRefresh);
  {
    If Assigned(ApptCtrl) Then
      Windows.PostMessage(ApptCtrl.Handle, CN_REQUESTREFRESH, WPARAM(Schedule), 0)
    Else
      Raise EJvTFScheduleManagerError.Create('Could not send refresh request.  ' +
                                        'ApptCtrl not assigned');
  }
end;

procedure TJvTFScheduleManager.RequestRefresh(Comp: TJvTFComponent;
  Schedule: TJvTFSched);
begin
  NotifyComp(Comp, Self, sncRefresh);
end;

procedure TJvTFScheduleManager.ImageListChange(Sender: TObject);
begin
  if not (csDestroying in ComponentState) then
    RefreshConnections(nil);
end;

procedure TJvTFScheduleManager.FlushAppts;
var
  I: Integer;
begin
  I := 0;
  while I < ApptCount do
    if (Appts[I].ConnectionCount = 0) and not Appts[I].Persistent then
    begin
      if not FlushObject(Appts[I]) then
        Inc(I);
    end
    else
      Inc(I);
end;

function TJvTFScheduleManager.FlushObject(FlushObj: TObject): Boolean;
var
  FlushIt: Boolean;
begin
  Result := False;
  if Assigned(FlushObj) then
  begin
    FlushIt := True;
    if Assigned(FOnFlush) then
      FOnFlush(Self, FlushObj, FlushIt);
    if FlushIt then
      FlushObj.Free;
    Result := FlushIt;
  end;
end;

procedure TJvTFScheduleManager.DoCreateApptEvent(anAppt: TJvTFAppt);
begin
  if Assigned(FOnCreateAppt) then
    FOnCreateAppt(Self, anAppt);
end;

procedure TJvTFScheduleManager.DoCreateScheduleEvent(aSchedule: TJvTFSched);
begin
  if Assigned(FOnCreateSchedule) then
    FOnCreateSchedule(Self, aSchedule);
end;

procedure TJvTFScheduleManager.DoDestroyApptEvent(anAppt: TJvTFAppt);
begin
  if Assigned(FOnDestroyAppt) then
    FOnDestroyAppt(Self, anAppt);
end;

procedure TJvTFScheduleManager.DoDestroyScheduleEvent(aSchedule: TJvTFSched);
begin
  if Assigned(FOnDestroySchedule) then
    FOnDestroySchedule(Self, aSchedule);
end;

function TJvTFScheduleManager.ApptCount: Integer;
begin
  Result := FAppts.Count;
end;

function TJvTFScheduleManager.FindAppt(const ID: string): TJvTFAppt;
var
  I: Integer;
begin
  Result := nil;
  I := FAppts.IndexOf(ID);
  if I > -1 then
    Result := TJvTFAppt(FAppts.Objects[I]);
end;

function TJvTFScheduleManager.ScheduleCount: Integer;
begin
  Result := FSchedules.Count;
end;

function TJvTFScheduleManager.FindSchedule(const SchedName: string;
  SchedDate: TDate): TJvTFSched;
var
  I: Integer;
begin
  Result := nil;
  I := FSchedules.IndexOf(GetScheduleID(SchedName, SchedDate));
  if I > -1 then
    Result := TJvTFSched(FSchedules.Objects[I]);
end;

function TJvTFScheduleManager.ConControlCount: Integer;
begin
  Result := FConControls.Count;
end;

function TJvTFScheduleManager.ConComponentCount: Integer;
begin
  Result := FConComponents.Count;
end;

function TJvTFScheduleManager.RequestSchedule(ApptCtrl: TJvTFControl;
  const SchedName: string; SchedDate: TDate): TJvTFSched;
var
  ApptsNeeded: Boolean;
begin
  RetrieveSchedule(SchedName, SchedDate, Result, ApptsNeeded);

  if Assigned(ApptCtrl) then
  begin
    Result.Notify(ApptCtrl, sncRequestSchedule);
    ApptCtrl.Notify(Result, sncRequestSchedule);
  end;

  if ApptsNeeded then
    if SchedLoadMode = slmOnDemand then
      NeedAppts(Result)
    else
    begin
      AddToBatch(Result);
    end;
end;

function TJvTFScheduleManager.RequestSchedule(ApptCtrl: TJvTFControl;
  const SchedName: string; SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched;
begin
  RetrieveSchedule(SchedName, SchedDate, Result, LoadedNow);

  if Assigned(ApptCtrl) then
  begin
    Result.Notify(ApptCtrl, sncRequestSchedule);
    ApptCtrl.Notify(Result, sncRequestSchedule);
  end;

  if LoadedNow then
  begin
    if SchedLoadMode = slmOnDemand then
      NeedAppts(Result)
    else
      AddToBatch(Result);
  end;
end;

function TJvTFScheduleManager.RequestSchedule(Comp: TJvTFComponent;
  const SchedName: string; SchedDate: TDate): TJvTFSched;
var
  ApptsNeeded: Boolean;
begin
  Result := nil;
  RetrieveSchedule(SchedName, SchedDate, Result, ApptsNeeded);

  if Assigned(Comp) then
  begin
    Result.Notify(Comp, sncRequestSchedule);
    Comp.Notify(Result, sncRequestSchedule);
  end;

  if ApptsNeeded then
  begin
    if SchedLoadMode = slmOnDemand then
      NeedAppts(Result)
    else
      AddToBatch(Result);
  end;
end;

function TJvTFScheduleManager.RequestSchedule(Comp: TJvTFComponent;
  const SchedName: string; SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched;
begin
  Result := nil;
  RetrieveSchedule(SchedName, SchedDate, Result, LoadedNow);

  if Assigned(Comp) then
  begin
    Result.Notify(Comp, sncRequestSchedule);
    Comp.Notify(Result, sncRequestSchedule);
  end;

  if LoadedNow then
  begin
    if SchedLoadMode = slmOnDemand then
      NeedAppts(Result)
    else
      AddToBatch(Result);
  end;
end;

procedure TJvTFScheduleManager.ReleaseSchedule(ApptCtrl: TJvTFControl;
  const SchedName: string; SchedDate: TDate);
var
  SchedID: string;
  I: Integer;
  Schedule: TJvTFSched;
begin
  SchedID := GetScheduleID(SchedName, SchedDate);
  I := FSchedules.IndexOf(SchedID);

  if I > -1 then
  begin
    Schedule := TJvTFSched(FSchedules.Objects[I]);

    if Assigned(ApptCtrl) then
    begin
      Schedule.Notify(ApptCtrl, sncReleaseSchedule);
      ApptCtrl.Notify(Schedule, sncReleaseSchedule);
    end;

    if (Cache.CacheType = ctBuffer) then
      Flush(False);
  end;
end;

procedure TJvTFScheduleManager.ReleaseSchedule(Comp: TJvTFComponent;
  const SchedName: string; SchedDate: TDate);
var
  SchedID: string;
  I: Integer;
  Schedule: TJvTFSched;
begin
  SchedID := GetScheduleID(SchedName, SchedDate);
  I := FSchedules.IndexOf(SchedID);

  if I > -1 then
  begin
    Schedule := TJvTFSched(FSchedules.Objects[I]);

    if Assigned(Comp) then
    begin
      Schedule.Notify(Comp, sncReleaseSchedule);
      Comp.Notify(Schedule, sncReleaseSchedule);
    end;

    if Cache.CacheType = ctBuffer then
      Flush(False);
  end;
end;

procedure TJvTFScheduleManager.RequestAppt(const ID: string; var Appt: TJvTFAppt;
  var New: Boolean);
var
  I: Integer;
begin
  I := -1;
  if ID <> '' then
    I := FAppts.IndexOf(ID);

  if I > -1 then
  begin
    Appt := TJvTFAppt(FAppts.Objects[I]);
    New := False;
  end
  else
  begin
    //Appt := TJvTFAppt.Create(Self, ID);
    Appt := GetApptClass.Create(Self, ID);
    New := True;
  end;
end;

procedure TJvTFScheduleManager.dbPostAppt(Appt: TJvTFAppt);
begin
  { implicit post fix
    If Assigned(Appt) Then
      If (AlwaysPost or Appt.Modified) Then
        Begin
          PostAppt(Appt);
          Appt.Notify(Self, sncPostAppt);
        End;
  }

    // implicit post fix
  if Assigned(Appt) and
    (AlwaysPost or Appt.Modified) and
    QueryPostAppt(Appt) then
  begin
    PostAppt(Appt);
    Appt.Notify(Self, sncPostAppt);
  end;
end;

procedure TJvTFScheduleManager.dbDeleteAppt(Appt: TJvTFAppt);
begin
  if Assigned(Appt) then
  begin
    DeleteAppt(Appt);
    Appt.Notify(Self, sncDeleteAppt);
  end;
end;

procedure TJvTFScheduleManager.dbDeleteAllAppt;
var
  I: Integer;
begin
  for I := FAppts.Count - 1 downto 0 do
    RemoveAppt(TJvTFAppt(FAppts.Objects[0]));
end;

procedure TJvTFScheduleManager.dbRefreshAppt(Appt: TJvTFAppt);
begin
  if Assigned(Appt) then
  begin
    FRefreshing := True;
    try
      Appt.Notify(Self, sncRefresh);
      if Assigned(FOnRefreshAppt) then
        FOnRefreshAppt(Self, Appt);
      if RefreshAutoReconcile then
        ReconcileRefresh(Appt);
    finally
      FRefreshing := False;

      // BUG - IT'S A LITTLE LATE TO BE USING THE APPT AS A REFRESH TRIGGER!!!
      //RefreshConnections(Appt);
      // Use nil as trigger to refresh everything
      RefreshConnections(nil);
    end;
  end;
  {
    If Assigned(Appt) Then
      RefreshAppt(Appt);
  }
end;

function TJvTFScheduleManager.dbNewAppt(const ID: string): TJvTFAppt;
var
  New: Boolean = false;  // to silence the compiler
begin
  Result := nil;
  RequestAppt(ID, Result, New);
  if not New then
    raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateNewAppointment);
end;

procedure TJvTFScheduleManager.PostAppts;
var
  I: Integer;
begin
  for I := 0 to ApptCount - 1 do
    dbPostAppt(Appts[I]);
end;

procedure TJvTFScheduleManager.RefreshAppts;
var
  I: Integer;
  ApptIDList: TStringList;
  Appt: TJvTFAppt;
begin
  // In a multi-user environment, appt objects may be deleted as a result
  // of calling dbRefreshAppt.  (Component user may call Appt.Free.)
  // To account for this we need to build a list of appt ID's instead of
  // working directly from the ScheduleManager's appointment list.

  ApptIDList := TStringList.Create;
  try
    for I := 0 to ApptCount - 1 do
    begin
      Appt := Appts[I];
      ApptIDList.Add(Appt.ID);
    end;

    for I := 0 to ApptIDList.Count - 1 do
    begin
      Appt := FindAppt(ApptIDList[I]);
      if Assigned(Appt) then
        dbRefreshAppt(Appt);
    end;

    RefreshConnections(nil);
  finally
    ApptIDList.Free;
  end;
end;

procedure TJvTFScheduleManager.RefreshConnections(Trigger: TObject);
var
  Sched: TJvTFSched;
  Appt: TJvTFAppt;
  I: Integer;
begin
  // Do not refresh if we're loading or refreshing appts
  if FLoadingAppts or Refreshing then
    Exit;

  if Trigger = nil then
  begin
    // refresh all schedules for all controls connected to ScheduleManager
    for I := 0 to ConControlCount - 1 do
      RequestRefresh(ConControls[I], nil);
    // refresh all schedules for all components connected to the ScheduleManager
    for I := 0 to ConComponentCount - 1 do
      RequestRefresh(ConComponents[I], nil);
  end
  else
  if Trigger is TJvTFComponent then
  begin
    // refresh all schedules for given component
    RequestRefresh(TJvTFComponent(Trigger), nil);
  end
  else
  if Trigger is TJvTFControl then
  begin
    // refresh all schedules for given control
    RequestRefresh(TJvTFControl(Trigger), nil);
  end
  else
  if Trigger is TJvTFSched then
  begin
    // refresh all appt controls connected to schedule
    Sched := TJvTFSched(Trigger);
    for I := 0 to Sched.ConControlCount - 1 do
      RequestRefresh(Sched.ConControls[I], Sched);
    // refresh all utf components connected to schedule
    for I := 0 to Sched.ConComponentCount - 1 do
      RequestRefresh(Sched.ConComponents[I], Sched);
  end
  else
  if Trigger is TJvTFAppt then
  begin
    // refresh all appt controls for all schedules connected to this appt
    Appt := TJvTFAppt(Trigger);
    for I := 0 to Appt.ConnectionCount - 1 do
      RefreshConnections(Appt.Connections[I]);
  end
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidTriggerForRefreshControls)
end;

procedure TJvTFScheduleManager.Flush(All: Boolean); //param All defaults to False
var
  I: Integer;
  Sched: TJvTFSched;
  MRUList: TStringList;
  CacheTimeUp: Boolean;
begin
  if FFlushing or FDestroying then
    Exit;

  FFlushing := True;
  try
    if All then
    begin
      I := 0;
      while I < ScheduleCount do
      begin
        Sched := Schedules[I];
        if Sched.Cached and not Sched.Persistent then
        begin
          if not FlushObject(Sched) then
            Inc(I);
        end
        else
          Inc(I);
      end;
      FlushAppts;
    end
    else
    if Cache.CacheType = ctTimed then
    begin
      I := 0;
      while I < ScheduleCount do
      begin
        Sched := Schedules[I];
        CacheTimeUp := GetTickCount64 - Sched.CachedTime >= Cache.TimedDelay;
//        CacheTimeUp := Windows.GetTickCount - Sched.CachedTime >=  UINT(Cache.TimedDelay);
        if Sched.Cached and CacheTimeUp then
        begin
          if not FlushObject(Sched) then
            Inc(I);
        end
        else
          Inc(I);
      end;
      FlushAppts;
    end
    else
    if Cache.CacheType = ctBuffer then
    begin
      MRUList := TStringList.Create;
      try
        MRUList.Sorted := True;
        MRUList.Duplicates := dupAccept;
        for I := 0 to ScheduleCount - 1 do
        begin
          Sched := Schedules[I];
          if Sched.Cached then
            MRUList.AddObject(IntToHex(Sched.CachedTime, 8), Sched);
        end;
        for I := 0 to MRUList.Count - 1 - Cache.BufferCount do
          FlushObject(MRUList.Objects[I]);
        FlushAppts;
      finally
        MRUList.Free;
      end;
    end;

  finally
    FFlushing := False;
  end;
end;

procedure TJvTFScheduleManager.dbRefreshAll;
var
  I: Integer;
begin
  FRefreshing := True;
  try
    for I := 0 to ApptCount - 1 do
      NotifyAppt(Appts[I], Self, sncRefresh);
    if Assigned(FOnRefreshAll) then
      FOnRefreshAll(Self);
    if RefreshAutoReconcile then
      ReconcileRefresh(Self);
  finally
    FRefreshing := False;
    RefreshConnections(nil);
  end;
end;

procedure TJvTFScheduleManager.dbRefreshOrphans;
var
  I: Integer;
begin
  for I := 0 to ApptCount - 1 do
    if Appts[I].ConnectionCount = 0 then
      dbRefreshAppt(Appts[I]);
end;

procedure TJvTFScheduleManager.dbRefreshSched(Sched: TJvTFSched);
var
  I: Integer;
begin
  if Assigned(Sched) then
  begin
    FRefreshing := True;
    try
      for I := 0 to Sched.ApptCount - 1 do
        NotifyAppt(Sched.Appts[I], Self, sncRefresh);
      if Assigned(FOnRefreshSched) then
        FOnRefreshSched(Self, Sched);
      if RefreshAutoReconcile then
        ReconcileRefresh(Sched);
    finally
      FRefreshing := False;
      RefreshConnections(Sched);
    end;
  end;
end;

procedure TJvTFScheduleManager.SetTFSchedLoadMode(Value: TJvTFSchedLoadMode);
begin
  if (Value <> FSchedLoadMode) and (Value = slmOnDemand) then
    // make sure we process any queued batches before changing mode
    ProcessBatches;

  FSchedLoadMode := Value;
end;

procedure TJvTFScheduleManager.AddToBatch(ASched: TJvTFSched);
var
  SchedID: string;
begin
  SchedID := TJvTFScheduleManager.GetScheduleID(ASched.SchedName, ASched.SchedDate);
  FSchedBatch.AddObject(SchedID, ASched);
end;

procedure TJvTFScheduleManager.ProcessBatches;
var
  I: Integer;
  ASched: TJvTFSched;
  CompName: string;
  CompDate: TDate;
  BatchName: string;
  BatchStartDate: TDate;
  BatchEndDate: TDate;

  procedure UpdateCompares(ASched: TJvTFSched);
  begin
    CompName := ASched.SchedName;
    CompDate := ASched.SchedDate;
  end;

  procedure NewBatch(ASched: TJvTFSched);
  begin
    BatchName := ASched.SchedName;
    BatchStartDate := ASched.SchedDate;
    BatchEndDate := ASched.SchedDate;
  end;

begin
  if FSchedBatch.Count = 0 then
    Exit;

  // added by Mike 1/14/01
  FLoadingAppts := True;
  try
    // Prime the process (reminds me of COBOL - yuck!)
    ASched := TJvTFSched(FSchedBatch.Objects[0]);
    UpdateCompares(ASched);
    NewBatch(ASched);

    for I := 1 to FSchedBatch.Count - 1 do
    begin
      ASched := TJvTFSched(FSchedBatch.Objects[I]);

      if (ASched.SchedName <> CompName) or
        (Trunc(ASched.SchedDate) - 1 <> Trunc(CompDate)) then
      begin
        // Hit new batch.  Load the current batch and then
        // set batch info to new batch.
        LoadBatch(BatchName, BatchStartDate, BatchEndDate);
        NewBatch(ASched);
      end
      else
        // Still in current batch.  Update the batch end date.
        BatchEndDate := ASched.SchedDate;

      UpdateCompares(ASched);
    end;

    // Load the last batch
    LoadBatch(BatchName, BatchStartDate, BatchEndDate);

    FSchedBatch.Clear;

    // ADD OnBatchesProcessed EVENT HERE !!
    if Assigned(FOnBatchesProcessed) then
      FOnBatchesProcessed(Self);
  finally
    // added by Mike 1/14/01
    FLoadingAppts := False;
    // added by Mike 1/14/01
    RefreshConnections(nil);
  end;
end;

procedure TJvTFScheduleManager.LoadBatch(const BatchName: string; BatchStartDate,
  BatchEndDate: TDate);
begin
  if Assigned(FOnLoadBatch) then
    FOnLoadBatch(Self, BatchName, BatchStartDate, BatchEndDate);
end;

function TJvTFScheduleManager.QueryPostAppt(Appt: TJvTFAppt): Boolean;
begin
  Result := True;
  if Assigned(FOnPostApptQuery) then
    FOnPostApptQuery(Self, Appt, Result);
end;

function TJvTFScheduleManager.GetApptDisplayText(AComponent: TComponent;
  Appt: TJvTFAppt): string;
begin
  if Assigned(Appt) then
    Result := Appt.Description
  else
    Result := '';

  if Assigned(FOnGetApptDisplayText) then
    FOnGetApptDisplayText(Self, AComponent, Appt, Result);
end;

procedure TJvTFScheduleManager.SetApptDescription(Appt: TJvTFAppt; var Value: string);
begin
  if Assigned(FOnSetApptDescription) then
    FOnSetApptDescription(Self, Appt, Value);
end;

procedure TJvTFScheduleManager.GetApptDescription(Appt: TJvTFAppt; var Value: string);
begin
  if Assigned(FOnGetApptDescription) then
    FOnGetApptDescription(Self, Appt, Value);
end;

function TJvTFScheduleManager.GetApptClass: TJvTFApptClass;
begin
  Result := TJvTFAppt;
end;

function TJvTFScheduleManager.GetSchedClass: TJvTFSchedClass;
begin
  Result := TJvTFSched;
end;

procedure TJvTFScheduleManager.ReconcileRefresh(Scope: TObject);
var
  Appt: TJvTFAppt;
  Sched: TJvTFSched;
  I: Integer;
begin
  if Scope is TJvTFAppt then
  begin
    Appt := TJvTFAppt(Scope);
    if not Appt.Refreshed then
      Appt.ClearSchedules;
  end
  else
  if Scope is TJvTFSched then
  begin
    Sched := TJvTFSched(Scope);
    I := 0;
    while I < Sched.ApptCount do
    begin
      Appt := Sched.Appts[I];
      if not Appt.Refreshed then
        Appt.ClearSchedules
      else
        Inc(I);
    end;
  end
  else
  if Scope is TJvTFScheduleManager then
    for I := 0 to ApptCount - 1 do
      ReconcileRefresh(Appts[I])
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidScopeInReconcileRefresh);
end;

procedure TJvTFScheduleManager.SetRefreshAutoReconcile(Value: Boolean);
begin
  FRefreshAutoReconcile := Value;
end;

//=== { TJvTFHint } ==========================================================

constructor TJvTFHint.Create(anApptCtrl: TJvTFControl);
begin
  inherited Create(anApptCtrl);
  FApptCtrl := anApptCtrl;
  FTimer := TTimer.Create(Self);
  FShortPause := 1000;
  FPause := 3000;
  FTimer.OnTimer := @TimerOnTimer;
  PrepTimer(True);
end;

destructor TJvTFHint.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TJvTFHint.SetPause(Value: Integer);
begin
  FPause := Value;
end;

procedure TJvTFHint.SetShortPause(Value: Integer);
begin
  FShortPause := Value;
end;

procedure TJvTFHint.TimerOnTimer(Sender: TObject);
begin
  FTimer.Enabled := False;

  if FShortTimer then
    DoHint(False)
  else
  begin
    ReleaseHandle;
    PrepTimer(True);
  end;
end;

procedure TJvTFHint.PrepTimer(Short: Boolean);
begin
  ReleaseHandle;
  FShortTimer := Short;
  if Short then
    FTimer.Interval := FShortPause
  else
    FTimer.Interval := FPause;
end;

procedure TJvTFHint.SetHintText(StartDate, EndDate: TDate; StartTime,
  EndTime: TTime; const Desc: string; ShowDatesTimes, ShowDesc: Boolean);
var
  ShowDates: Boolean;
  HintText, DFormat, TFormat: string;
begin
  HintText := '';
  if ShowDatesTimes then
  begin
    DFormat := FApptCtrl.DateFormat;
    TFormat := FApptCtrl.TimeFormat;
    ShowDates := Trunc(StartDate) <> Trunc(EndDate);

    if ShowDates then
      HintText := FormatDateTime(DFormat, StartDate) + ' ';
    HintText := HintText + FormatDateTime(TFormat, StartTime) + ' - ';
    if ShowDates then
      HintText := HintText + FormatDateTime(DFormat, EndDate) + ' ';
    HintText := HintText + FormatDateTime(TFormat, EndTime);
  end;

  if ShowDesc then
  begin
    if HintText <> '' then
      HintText := HintText + #13#10;
    HintText := HintText + Desc;
  end;
  FHintText := HintText;
end;

procedure TJvTFHint.DoHint(Sustained: Boolean);
var
  Ref: TObject;
begin
  PropertyCheck;
  {
  If Assigned(FOnShowHint) Then
    FOnShowHint(Self, HintType, FHintRect, FHintText);
  }

  if Assigned(FOnShowHint) then
  begin
    if HintType = shtAppt then
      Ref := FOldAppt
    else
    if HintType = shtObj then
      Ref := FOldObj
    else
      Ref := nil;

    FOnShowHint(Self, HintType, Ref, FHintRect, FHintText);
  end;
//  if not Windows.IsRectEmpty(FHintRect) and (FHintText <> '') then
  if not IsRectEmpty(FHintRect) and (FHintText <> '') then
      if Sustained then
      begin
        inherited ActivateHint(FHintRect, FHintText);
      end
      else
        ActivateHint(FHintRect, FHintText);
end;



procedure TJvTFHint.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  { wp --- to do
  with Params do
  begin
    WindowClass.Style := WindowClass.Style and not CS_SAVEBITS;
  end;
  }
end;


procedure TJvTFHint.ActivateHint(Rect: TRect; const AHint: THintString);
begin
  PrepTimer(False);
  inherited ActivateHint(Rect, AHint);
  // Reset the timer so we get the full interval
  FTimer.Enabled := False;
  FTimer.Enabled := True;
end;

procedure TJvTFHint.ApptHint(Appt: TJvTFAppt; X, Y: Integer; ShowDatesTimes,
  ShowDesc, FormattedDesc: Boolean; const ExtraDesc: string = '');
var
  HintTopLeft: TPoint;
  Immediate: Boolean;
  ApptDesc: string;
begin
  if Appt <> FOldAppt then
  begin
    FHintType := shtAppt;
    Immediate := not FShortTimer;
    FHintCell := Point(-100, -100);
    FOldAppt := Appt;
    if Assigned(Appt) then
    begin
      ApptDesc := Appt.Description;
      if not FormattedDesc then
        ApptDesc := StripCRLF(ApptDesc);
      ApptDesc := ExtraDesc + ApptDesc;
      SetHintText(Appt.StartDate, Appt.EndDate, Appt.StartTime, Appt.EndTime,
        ApptDesc, ShowDatesTimes, ShowDesc);
      FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
      HintTopLeft := FApptCtrl.ClientToScreen(Point(X, Y));
      FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);
      if Immediate then
        DoHint(False)
      else
      begin
        PrepTimer(True);
        FTimer.Enabled := True;
      end;
    end
    else
    begin
      ReleaseHandle;
      PrepTimer(True);
    end;
  end;
end;

procedure TJvTFHint.StartEndHint(StartDate, EndDate: TDate; StartTime,
  EndTime: TTime; X, Y: Integer; ShowDates: Boolean);
var
  HintTopLeft: TPoint;
begin
  FHintType := shtStartEnd;
  SetHintText(StartDate, EndDate, StartTime, EndTime, '', True, False);
  FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
  HintTopLeft := FApptCtrl.ClientToScreen(Point(X, Y));
  FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);
  if HandleAllocated and Showing then
    BoundsRect := FHintRect
  else
    DoHint(True);
end;

procedure TJvTFHint.CellHint(Row, Col: Integer; const HintText: string; CellRect: TRect);
var
  Immediate: Boolean;
  DiffCell: Boolean;
begin
  DiffCell := (Row <> FHintCell.Y) or (Col <> FHintCell.X);
  if DiffCell or not FTimer.Enabled then
  begin
    FHintType := shtCell;
    FOldAppt := nil;
    ReleaseHandle;
    FHintCell.X := Col;
    FHintCell.Y := Row;
    Immediate := not FShortTimer;
    FHintText := HintText;
    //If (FHintText <> '') and DiffCell Then
    if FHintText <> '' then
    begin
      CellRect.TopLeft := FApptCtrl.ClientToScreen(CellRect.TopLeft);
      CellRect.BottomRight := FApptCtrl.ClientToScreen(CellRect.BottomRight);
      FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
      FHintRect := CenterRect(CellRect, FHintRect);
      if Immediate then
        DoHint(False)
      else
      begin
        PrepTimer(True);
        FTimer.Enabled := True;
      end;
    end
    else
    begin
      ReleaseHandle;
      PrepTimer(True);
    end;
  end;
end;

procedure TJvTFHint.ReleaseHandle;
begin
  FTimer.Enabled := False;
  DestroyHandle;
end;

procedure TJvTFHint.PropertyCheck;
begin
  if Assigned(RefProps) then
  begin
    if RefProps.HintColor = clDefault then
      Color := Application.HintColor
    else
      Color := RefProps.HintColor;

    if RefProps.HintHidePause = -1 then
      Pause := Application.HintHidePause
    else
      Pause := RefProps.HintHidePause;

    if RefProps.HintPause = -1 then
      ShortPause := Application.HintPause
    else
      ShortPause := RefProps.HintPause;
  end;
end;

procedure TJvTFHint.MultiLineObjHint(Obj: TObject; X, Y: Integer;
  Hints: TStrings);
var
  Immediate: Boolean;
  HintTopLeft: TPoint;
begin
  if Obj <> FOldObj then
  begin
    FOldAppt := nil;
    FHintType := shtObj;
    Immediate := not FShortTimer;
    FHintCell := Point(-100, -100);
    FOldObj := Obj;
    if Assigned(Obj) and (Hints.Count > 0) then
    begin
      FHintText := Hints.Text;
      FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
      HintTopLeft := FApptCtrl.ClientToScreen(Point(X + 8, Y + 16));
      FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);

      if Immediate then
        DoHint(False)
      else
      begin
        PrepTimer(True);
        FTimer.Enabled := True;
      end;
    end
    else
    begin
      ReleaseHandle;
      PrepTimer(True);
    end;
  end;
end;

//=== { TJvTFControl } =======================================================

constructor TJvTFControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSchedules := TStringList.Create;
  FTimeFormat := 't'; // global short time format
  FDateFormat := 'ddddd'; // global short date format
end;

destructor TJvTFControl.Destroy;
begin
  ScheduleManager := nil;
  FSchedules.Free;

  inherited Destroy;
end;

procedure TJvTFControl.SetManager(Value: TJvTFScheduleManager);
begin
  if Value <> FScheduleManager then
  begin
    if Assigned(FScheduleManager) then
      FScheduleManager.Notify(Self, sncDisconnectControl);
    FScheduleManager := nil;

    if Assigned(Value) then
      Value.Notify(Self, sncConnectControl);
    FScheduleManager := Value;
  end;
end;

function TJvTFControl.GetSchedule(Index: Integer): TJvTFSched;
begin
  Result := TJvTFSched(FSchedules.Objects[Index]);
end;

procedure TJvTFControl.SetDateFormat(const Value: string);
begin
  if FDateFormat <> Value then
  begin
    FDateFormat := Value;
    Invalidate;
  end;
end;

procedure TJvTFControl.SetTimeFormat(const Value: string);
begin
  if FTimeFormat <> Value then
  begin
    FTimeFormat := Value;
    Invalidate;
  end;
end;

procedure TJvTFControl.Notify(Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  case Code of
    sncRequestSchedule:
      ReqSchedNotification(TJvTFSched(Sender));
    sncReleaseSchedule:
      RelSchedNotification(TJvTFSched(Sender));
    sncRefresh:
      RefreshControl;
    sncDestroyAppt:
      DestroyApptNotification(TJvTFAppt(Sender));
    sncDestroySchedule:
      DestroySchedNotification(TJvTFSched(Sender));
  end;
end;

procedure TJvTFControl.ReqSchedNotification(Schedule: TJvTFSched);
var
  SchedID: string;
begin
  SchedID := TJvTFScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
  if FSchedules.IndexOf(SchedID) = -1 then
    FSchedules.AddObject(SchedID, Schedule);
end;

procedure TJvTFControl.RelSchedNotification(Schedule: TJvTFSched);
var
  I: Integer;
begin
  I := FSchedules.IndexOfObject(Schedule);
  if I > -1 then
    FSchedules.Delete(I);
end;

procedure TJvTFControl.NotifyManager(Serv: TJvTFScheduleManager;
  Sender: TObject; Code: TJvTFServNotifyCode);
begin
  if Assigned(Serv) then
    Serv.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
end;

procedure TJvTFControl.CNRequestRefresh(var Msg: TCNRequestRefresh);
begin
  Invalidate;
end;

procedure TJvTFControl.RefreshControl;
begin
  Invalidate;
end;

procedure TJvTFControl.DestroyApptNotification(anAppt: TJvTFAppt);
begin
  // do nothing, leave implementation to successors
end;

procedure TJvTFControl.DestroySchedNotification(ASched: TJvTFSched);
begin
  // do nothing, leave implementation to successors
end;

procedure TJvTFControl.DoStartDrag(var DragObject: TDragObject);
begin
  inherited DoStartDrag(DragObject);

  FDragInfo := TJvTFDragInfo.Create;
  with FDragInfo do
  begin
    ApptCtrl := Self;
    Shift := Self.FShift;
  end;

  {
  Originally, a specific drag object was created and given to the DragObject
  param.  This worked fine.  Because of differences in the VCL DragObject
  hierarachy between D3 and D4, the decision was made to move away from
  using a drag object.

    FDragAppt := TDragAppt.Create(Self);
    With FDragAppt do
      Begin
        ApptCtrl := Self;
        Schedule := SelSchedule;
        Appt := SelAppt;
        Shift := FDragShift;
      End;
    DragObject := FDragAppt;
  }
end;

procedure TJvTFControl.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  inherited DoEndDrag(Target, X, Y);

  FDragInfo.Free;
  FDragInfo := nil;
end;

procedure TJvTFControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  FShift := Shift;
end;

function TJvTFControl.ScheduleCount: Integer;
begin
  Result := FSchedules.Count;
end;

function TJvTFControl.FindSchedule(const SchedName: string;
  SchedDate: TDate): TJvTFSched;
var
  I: Integer;
begin
  Result := nil;

  I := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
  if I > -1 then
    Result := TJvTFSched(FSchedules.Objects[I]);
end;

function TJvTFControl.RetrieveSchedule(const SchedName: string;
  SchedDate: TDate): TJvTFSched;
begin
  Result := FindSchedule(SchedName, SchedDate);

  if not Assigned(Result) then
    if Assigned(ScheduleManager) then
      Result := ScheduleManager.RequestSchedule(Self, SchedName, SchedDate)
    else
      raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotRetrieveSchedule);
end;

procedure TJvTFControl.ReleaseSchedule(const SchedName: string;
  SchedDate: TDate);
var
  SchedID: string;
begin
  if Assigned(ScheduleManager) then begin
    SchedID := TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate);
    if FSchedules.IndexOf(SchedID) > -1 then
      ScheduleManager.ReleaseSchedule(Self, SchedName, SchedDate)
  end;

{  wp:
   original code - crashes sometimes at program end in GetScheduleID
   when ScheduleManager is nil

  SchedID := TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate);
  if FSchedules.IndexOf(SchedID) > -1 then
    if Assigned(ScheduleManager) then
      ScheduleManager.ReleaseSchedule(Self, SchedName, SchedDate)
    else
      raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotReleaseSchedule);
 }
end;

procedure TJvTFControl.ReleaseSchedules;
begin
  while ScheduleCount > 0 do
    ReleaseSchedule(Schedules[0].SchedName, Schedules[0].SchedDate);
end;

procedure TJvTFControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  //  If (AComponent = Navigator) and (Operation = opRemove) Then
  //    Navigator := nil;
end;

//procedure TJvTFControl.SetNavigator(Value: TJvTFNavigator);
//begin
//  If Value <> FNavigator Then
//    Begin
//      If Assigned(FNavigator) Then
//        FNavigator.UnregisterControl(Self);
//      FNavigator := nil;
//
//      If Assigned(Value) Then
//        Value.RegisterControl(Self);
//      FNavigator := Value;
//    End;
//end;

procedure TJvTFControl.Navigate(aControl: TJvTFControl;
  SchedNames: TStringList; Dates: TJvTFDateList);
begin
  //  If Assigned(FOnNavigate) Then
  //    FOnNavigate(Self, aControl, SchedNames, Dates);
end;

procedure TJvTFControl.ProcessBatches;
begin
  if Assigned(ScheduleManager) and (ScheduleManager.SchedLoadMode = slmBatch) then
    ScheduleManager.ProcessBatches;
end;

//=== { TJvTFComponent } =====================================================

constructor TJvTFComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSchedules := TStringList.Create;
  FTimeFormat := 't'; // global short time format
  FDateFormat := 'ddddd'; // global short date format
end;

destructor TJvTFComponent.Destroy;
begin
  ScheduleManager := nil;
  FSchedules.Free;

  inherited Destroy;
end;

procedure TJvTFComponent.DestroyApptNotification(anAppt: TJvTFAppt);
begin
  // do nothing, leave implementation to descendants
end;

procedure TJvTFComponent.DestroySchedNotification(ASched: TJvTFSched);
begin
  // do nothing, leave implementation to descendants
end;

function TJvTFComponent.FindSchedule(const SchedName: string;
  SchedDate: TDate): TJvTFSched;
var
  I: Integer;
begin
  Result := nil;

  I := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
  if I > -1 then
    Result := TJvTFSched(FSchedules.Objects[I]);
end;

function TJvTFComponent.GetSchedule(Index: Integer): TJvTFSched;
begin
  Result := TJvTFSched(FSchedules.Objects[Index]);
end;

procedure TJvTFComponent.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
begin
  case Code of
    sncRequestSchedule:
      ReqSchedNotification(TJvTFSched(Sender));
    sncReleaseSchedule:
      RelSchedNotification(TJvTFSched(Sender));
    sncRefresh:
      RefreshComponent;
    sncDestroyAppt:
      DestroyApptNotification(TJvTFAppt(Sender));
    sncDestroySchedule:
      DestroySchedNotification(TJvTFSched(Sender));
  end;
end;

procedure TJvTFComponent.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
  Code: TJvTFServNotifyCode);
begin
  if Assigned(Serv) then
    Serv.Notify(Sender, Code)
  else
    raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
end;

procedure TJvTFComponent.ProcessBatches;
begin
  if Assigned(ScheduleManager) and (ScheduleManager.SchedLoadMode = slmBatch) then
    ScheduleManager.ProcessBatches;
end;

procedure TJvTFComponent.RefreshComponent;
begin
  // do nothing, leave implementation to descendants
end;

procedure TJvTFComponent.ReleaseSchedule(const SchedName: string;
  SchedDate: TDate);
var
  SchedID: string;
begin
  SchedID := TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate);
  if FSchedules.IndexOf(SchedID) > -1 then
    if Assigned(ScheduleManager) then
      ScheduleManager.ReleaseSchedule(Self, SchedName, SchedDate)
    else
      raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotReleaseSchedule);
end;

procedure TJvTFComponent.ReleaseSchedules;
begin
  while ScheduleCount > 0 do
    ReleaseSchedule(Schedules[0].SchedName, Schedules[0].SchedDate);
end;

procedure TJvTFComponent.RelSchedNotification(Schedule: TJvTFSched);
var
  I: Integer;
begin
  I := FSchedules.IndexOfObject(Schedule);
  if I > -1 then
    FSchedules.Delete(I);
end;

procedure TJvTFComponent.ReqSchedNotification(Schedule: TJvTFSched);
var
  SchedID: string;
begin
  SchedID := TJvTFScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
  if FSchedules.IndexOf(SchedID) = -1 then
    FSchedules.AddObject(SchedID, Schedule);
end;

function TJvTFComponent.RetrieveSchedule(const SchedName: string;
  SchedDate: TDate): TJvTFSched;
begin
  Result := FindSchedule(SchedName, SchedDate);

  if not Assigned(Result) then
    if Assigned(ScheduleManager) then
      Result := ScheduleManager.RequestSchedule(Self, SchedName, SchedDate)
    else
      raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotRetrieveSchedule);
end;

function TJvTFComponent.ScheduleCount: Integer;
begin
  Result := FSchedules.Count;
end;

procedure TJvTFComponent.SetDateFormat(const Value: string);
begin
  FDateFormat := Value;
end;

procedure TJvTFComponent.SetManager(Value: TJvTFScheduleManager);
begin
  if Value <> FScheduleManager then
  begin
    if Assigned(FScheduleManager) then
      FScheduleManager.Notify(Self, sncDisconnectComponent);
    FScheduleManager := nil;

    if Assigned(Value) then
      Value.Notify(Self, sncConnectComponent);
    FScheduleManager := Value;
  end;
end;

procedure TJvTFComponent.SetTimeFormat(const Value: string);
begin
  FTimeFormat := Value;
end;

procedure TJvTFComponent.UpdateDesigner;
var
  ParentForm: TCustomForm;
begin
  if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then
  begin
    try
      ParentForm := TCustomForm(Owner);
      if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
        ParentForm.Designer.Modified;
    except
      // handle the exception by doing nothing
    end;
  end;
end;

//=== { TJvTFPrinter } =======================================================

constructor TJvTFPrinter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CreateLayout;
  FMeasure := pmInches;
  FPages := TStringList.Create;
  FBodies := TStringList.Create;
  InitializeMargins;
end;

destructor TJvTFPrinter.Destroy;
begin
  FreeDoc;
  FBodies.Free;
  FPages.Free;

  FPageLayout.Free;
  inherited Destroy;
end;

procedure TJvTFPrinter.AbortPrint;
begin
  if Printer.Printing then
    Printer.Abort
  else
    FAborted := True;
end;

function TJvTFPrinter.ConvertMeasure(Value: Integer; FromMeasure,
  ToMeasure: TJvTFPrinterMeasure; Horizontal: Boolean): Integer;
const
  MMFactor = 2.54;
var
  PPI: Integer;
begin
  if Horizontal then
    PPI := Printer.XDPI
  else
    PPI := Printer.YDPI;
  if (FromMeasure = pmPixels) and (ToMeasure = pmInches) then
    Result := round(Value / PPI * 100)
  else
  if (FromMeasure = pmPixels) and (ToMeasure = pmMM) then
    Result := round(Value / PPI * 100 * MMFactor)
  else
  if (FromMeasure = pmInches) and (ToMeasure = pmPixels) then
    Result := round(Value / 100 * PPI)
  else
  if (FromMeasure = pmInches) and (ToMeasure = pmMM) then
    Result := round(Value * MMFactor)
  else
  if (FromMeasure = pmMM) and (ToMeasure = pmPixels) then
    Result := round(Value / MMFactor / 100 * PPI)
  else
  if (FromMeasure = pmMM) and (ToMeasure = pmInches) then
    Result := round(Value / MMFactor)
  else
    Result := Value;
end;

procedure TJvTFPrinter.CreateDoc;
begin
  if State = spsNoDoc then
  begin
    FState := spsCreating;
    FAborted := False;

    FDocDateTime := Now;
    if DirectPrint then
      Printer.BeginDoc;
  end
  else
    raise EJvTFPrinterError.CreateRes(@RsECouldNotCreateADocumentBecauseA);
end;

procedure TJvTFPrinter.CreateLayout;
begin
  FPageLayout := TJvTFPrinterPageLayout.Create(Self);
end;

procedure TJvTFPrinter.DrawBody(aCanvas: TCanvas; ARect: TRect;
  PageNum: Integer);
begin
  if Assigned(FOnDrawBody) then
    FOnDrawBody(Self, aCanvas, ARect, PageNum);
end;

procedure TJvTFPrinter.DrawFooter(aCanvas: TCanvas; ARect: TRect;
  PageNum: Integer);
begin
  if Assigned(FOnDrawFooter) then
    FOnDrawFooter(Self, aCanvas, ARect, PageNum);
end;

procedure TJvTFPrinter.DrawHeader(aCanvas: TCanvas; ARect: TRect;
  PageNum: Integer);
begin
  if Assigned(FOnDrawHeader) then
    FOnDrawHeader(Self, aCanvas, ARect, PageNum);
end;

procedure TJvTFPrinter.FinishDoc;
var
  I: Integer;
  { wp --- to do
  aCanvas: TMetafileCanvas;
  }
  HeaderRect, FooterRect: TRect;
begin
  if Aborted then
    Exit;

  if State <> spsCreating then
    raise EJvTFPrinterError.CreateRes(@RsECouldNotFinishDocumentBecauseNo);

  FPageCount := FBodies.Count;
  FState := spsAssembling;
  try
    if Assigned(FOnAssembleProgress) then
      FOnAssembleProgress(Self, 0, FBodies.Count);

    if DirectPrint then
      Printer.EndDoc
    else
    begin
      GetHeaderFooterRects(HeaderRect, FooterRect);
      I := 0;
      while (I < FBodies.Count) and not Aborted do
      begin
        { wp --- to do ...
        aCanvas := TMetafileCanvas(FBodies.Objects[I]);

        try
          DrawHeader(aCanvas, HeaderRect, I + 1);
          DrawFooter(aCanvas, FooterRect, I + 1);
        finally
          aCanvas.Free;
          FBodies.Objects[I] := nil;
        end;
        }

        if Assigned(FOnAssembleProgress) then
          FOnAssembleProgress(Self, I + 1, FBodies.Count);

        Inc(I);
        Application.ProcessMessages;
      end;
    end;

    FBodies.Clear;
  finally
    FState := spsFinished;
  end;
end;

procedure TJvTFPrinter.FreeDoc;
begin
  while FBodies.Count > 0 do
  begin
    FBodies.Objects[0].Free;
    FBodies.Delete(0);
  end;

  while FPages.Count > 0 do
  begin
    FPages.Objects[0].Free;
    FPages.Delete(0);
  end;

  FState := spsNoDoc;
end;

function TJvTFPrinter.GetBodyHeight: Integer; // always in pixels
var
  PhysHeight, TopMarginPels, BottomMarginPels, HeaderPels, FooterPels: Integer;
begin
  { wp --- to do  **************** DONE ***************
  PhysHeight := Windows.GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
  }
  PhysHeight := Printer.PaperSize.Height;
  TopMarginPels := ConvertMeasure(PageLayout.MarginTop, Measure, pmPixels, False);
  BottomMarginPels := ConvertMeasure(PageLayout.MarginBottom, Measure, pmPixels, False);
  HeaderPels := ConvertMeasure(PageLayout.HeaderHeight, Measure, pmPixels, False);
  FooterPels := ConvertMeasure(PageLayout.FooterHeight, Measure, pmPixels, False);

  Result := PhysHeight - TopMarginPels - BottomMarginPels -
    HeaderPels - FooterPels;
end;

function TJvTFPrinter.GetBodyLeft: Integer; // always in pixels
begin
  Result := GetMarginOffset(1);
end;

function TJvTFPrinter.GetBodyTop: Integer; // always in pixels
begin
  Result := GetMarginOffset(2) +
    ConvertMeasure(PageLayout.HeaderHeight, Measure, pmPixels, False) + 1;
end;

function TJvTFPrinter.GetBodyWidth: Integer; // always in pixels
var
  PhysWidth, LeftMarginPels, RightMarginPels: Integer;
begin
  { wp --- to do  **************** DONE *****************
  PhysWidth := Windows.GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
  }
  PhysWidth := Printer.PaperSize.Width;
  LeftMarginPels := ConvertMeasure(PageLayout.MarginLeft, Measure, pmPixels, True);
  RightMarginPels := ConvertMeasure(PageLayout.MarginRight, Measure, pmPixels, True);

  Result := PhysWidth - LeftMarginPels - RightMarginPels;
end;

function TJvTFPrinter.GetDocDateTime: TDateTime;
begin
  if State = spsNoDoc then
    raise EJvTFPrinterError.CreateRes(@RsEDocumentDoesNotExist);

  Result := FDocDateTime;
end;

procedure TJvTFPrinter.GetHeaderFooterRects(out HeaderRect, FooterRect: TRect);
begin
  HeaderRect.Left := FMarginOffsets.Left;
  HeaderRect.Top := FMarginOffsets.Top;
  HeaderRect.Right := HeaderRect.Left + BodyWidth;
  HeaderRect.Bottom := HeaderRect.Top + ConvertMeasure(PageLayout.HeaderHeight,
    Measure, pmPixels, False);

  FooterRect.Left := HeaderRect.Left;
  FooterRect.Right := HeaderRect.Right;
  FooterRect.Top := BodyTop + BodyHeight;
  FooterRect.Bottom := FooterRect.Top + ConvertMeasure(PageLayout.FooterHeight,
    Measure, pmPixels, False);
end;

function TJvTFPrinter.GetMarginOffset(Index: Integer): Integer;
begin
  case Index of
    1:
      Result := FMarginOffsets.Left;
    2:
      Result := FMarginOffsets.Top;
    3:
      Result := FMarginOffsets.Right;
  else
    Result := FMarginOffsets.Bottom;
  end;
end;

function TJvTFPrinter.GetPage(Index: Integer): TBitmap;  // was: TMetafile;
begin
  if DirectPrint then
    raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesCannotBeAccessedIf);

  if State <> spsFinished then
    raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesAreInaccessibleUntil);
//  Result := TMetafile(FPages.Objects[Index]);
  Result := TBitmap(FPages.Objects[Index]);
end;

function TJvTFPrinter.GetPageCount: Integer;
begin
  case State of
    spsNoDoc:
      raise EJvTFPrinterError.CreateRes(@RsECouldNotRetrievePageCount);
    spsCreating:
      Result := FBodies.Count;
    spsAssembling:
      Result := FPageCount;
    spsFinished:
      Result := FPages.Count;
  else
    Result := -1;
  end;
end;

function TJvTFPrinter.GetUnprintable: TJvTFMargins;
var
  LeftMarg, TopMarg, WidthPaper, HeightPaper, WidthPrintable, HeightPrintable: Integer;
begin
  { wp --- to do   ----------- DONE ----------------
  LeftMarg := Windows.GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  TopMarg := Windows.GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  WidthPaper := Windows.GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
  HeightPaper := Windows.GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
  }
  LeftMarg := Printer.PaperSize.PaperRect.WorkRect.Left;
  TopMarg := Printer.PaperSize.PaperRect.WorkRect.Top;
  WidthPaper := Printer.PaperSize.Width;
  HeightPaper := Printer.PaperSize.Height;
  WidthPrintable := Printer.PageWidth;
  HeightPrintable := Printer.PageHeight;

  with Result do
  begin
    Left := LeftMarg;
    Top := TopMarg;
    Right := WidthPaper - WidthPrintable - LeftMarg;
    Bottom := HeightPaper - HeightPrintable - TopMarg;
  end;
end;

procedure TJvTFPrinter.InitializeMargins;
var
  I, Unprintable, NewMargin: Integer;
  Horz: Boolean;
begin
  for I := 1 to 4 do
  begin
    SetMarginOffset(I, 0);

    case I of
      1:
        Unprintable := GetUnprintable.Left;
      2:
        Unprintable := GetUnprintable.Top;
      3:
        Unprintable := GetUnprintable.Right;
    else
      Unprintable := GetUnprintable.Bottom;
    end;

    Horz := (I = 1) or (I = 3);
    NewMargin := ConvertMeasure(Unprintable, pmPixels, Measure, Horz);

    case I of
      1:
        PageLayout.FMargins.Left := NewMargin;
      2:
        PageLayout.FMargins.Top := NewMargin;
      3:
        PageLayout.FMargins.Right := NewMargin;
    else
      PageLayout.FMargins.Bottom := NewMargin;
    end;
  end;
end;

procedure TJvTFPrinter.MarginError;
begin
  if Assigned(FOnMarginError) then
    FOnMarginError(Self);
end;

procedure TJvTFPrinter.NewDoc;
begin
  FreeDoc;
  CreateDoc;
end;

procedure TJvTFPrinter.NewPage;
var
  aBitmap: TBitmap;    // wp: was Metafile, but this is not supported by Lazarus
  aCanvas: TCanvas;
  HeaderRect, FooterRect: TRect;
begin
  if Aborted then
    Exit;

  if DirectPrint then
  begin
    if PageCount > 0 then
      Printer.NewPage;
    aCanvas := Printer.Canvas;
    FPages.Add('');
  end
  else
  begin
    // Create a TBitmap for the page
    aBitmap := TBitmap.Create;
    aBitmap.SetSize(Printer.PaperSize.Width, Printer.PaperSize.Height);
    aBitmap.Canvas.Brush.Color := clWhite;
    aBitmap.Canvas.FillRect(0, 0, aBitmap.Width, aBitmap.Height);
    FPages.AddObject('', aBitmap);
    // Store the canvas in FBodies so we can retrieve it later to draw
    // the header and footer.
    aCanvas := aBitmap.Canvas;
    {
    // Create a TMetafile for the page
    aMetafile := TMetafile.Create;
    FPages.AddObject('', aMetafile);
    // Create a TMetafileCanvas as a canvas for the page.
    // Store the canvas in FBodies so we can retrieve it later to draw
    // the header and footer.
    aCanvas := TMetafileCanvas.Create(aMetafile, Printer.Handle);
    }
  end;
  FBodies.AddObject('', aCanvas);
  aCanvas.Font.PixelsPerInch := Printer.XDPI;
  FixFont(aCanvas.Font);
  {
  aCanvas.Font.PixelsPerInch := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  }

  LCLIntf.SetViewportOrgEx(aCanvas.Handle, BodyLeft, BodyTop, nil);
  DrawBody(aCanvas, Rect(BodyLeft, BodyTop, BodyWidth - BodyLeft,
    BodyHeight - BodyTop), FPages.Count);
  LCLIntf.SetViewPortOrgEx(aCanvas.Handle, 0, 0, nil);
  if DirectPrint then
  begin
    GetHeaderFooterRects(HeaderRect, FooterRect);
    DrawHeader(aCanvas, HeaderRect, PageCount);
    DrawFooter(aCanvas, FooterRect, PageCount);
  end;
end;

procedure TJvTFPrinter.Print;
var
  I: Integer;
begin
  if Aborted or DirectPrint then
    Exit;

  if State <> spsFinished then
    raise EJvTFPrinterError.CreateRes(@RsEOnlyAFinishedDocumentCanBePrinted);
  if PageCount = 0 then
    raise EJvTFPrinterError.CreateRes(@RsEThereAreNoPagesToPrint);

  if Assigned(FOnPrintProgress) then
    FOnPrintProgress(Self, 0, PageCount);
  Application.ProcessMessages;

  Printer.Title := Title;
  Printer.BeginDoc;

  if not Printer.Aborted then
    Printer.Canvas.Draw(0, 0, Pages[0]);

  if Assigned(FOnPrintProgress) then
    FOnPrintProgress(Self, 1, PageCount);
  Application.ProcessMessages;

  I := 1;
  while (I < PageCount) and not Printer.Aborted do
  begin
    if not Printer.Aborted then
      Printer.NewPage;
    if not Printer.Aborted then
      Printer.Canvas.Draw(0, 0, Pages[I]);
    Inc(I);
    if Assigned(FOnPrintProgress) then
      FOnPrintProgress(Self, I, PageCount);
    Application.ProcessMessages;
  end;

  if not Printer.Aborted then
    Printer.EndDoc;
end;

function TJvTFPrinter.PrinterToScreen(Value: Integer;
  Horizontal: Boolean): Integer;
var
  ScreenPPI, PrinterPPI: Integer;
begin
  { wp --- to do  ************* DONE ************
  ScreenPPI := Screen.PixelsPerInch;
  if Horizontal then
    PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX)
  else
    PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    }
  ScreenPPI := Screen.PixelsPerInch;
  if Horizontal then
    PrinterPPI := Printer.XDPI
  else
    PrinterPPI := Printer.YDPI;
  Result := Trunc(ScreenPPI / PrinterPPI * Value);
end;

procedure TJvTFPrinter.SaveDocToFiles(BaseFileName: TFileName);
{var
  I: Integer; }
begin
  if State <> spsFinished then
    raise EJvTFPrinterError.CreateRes(@RsEDocumentMustBeFinishedToSaveToFile);

  { wp --- to do
  for I := 0 to PageCount - 1 do
    Pages[I].SaveToFile(BaseFileName + '_' + IntToStr(I + 1) + '.emf');
    }
end;

function TJvTFPrinter.ScreenToPrinter(Value: Integer;
  Horizontal: Boolean): Integer;
var
  ScreenPPI, PrinterPPI: Integer;
begin
  ScreenPPI := Screen.PixelsPerInch;
  if Horizontal then
    PrinterPPI := Printer.XDPI
  else
    PrinterPPI := Printer.YDPI;
  { wp --- to do    *********** DONE ***********
  if Horizontal then
    PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX)
  else
    PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    }
  Result := Trunc(PrinterPPI / ScreenPPI * Value);
end;

procedure TJvTFPrinter.SetDirectPrint(Value: Boolean);
begin
  SetPropertyCheck;
  FDirectPrint := Value;
end;

procedure TJvTFPrinter.SetMarginOffset(Index, Value: Integer);
begin
  // Allow negative value...
  // SetMargin will catch that case and throw exception
  case Index of
    1:
      FMarginOffsets.Left := Value;
    2:
      FMarginOffsets.Top := Value;
    3:
      FMarginOffsets.Right := Value;
  else
    FMarginOffsets.Bottom := Value;
  end;
end;

procedure TJvTFPrinter.SetMeasure(Value: TJvTFPrinterMeasure);
begin
  try
    FConvertingProps := True;
    if Value <> FMeasure then
    begin
      PageLayout.FHeaderHeight := ConvertMeasure(PageLayout.FHeaderHeight,
        FMeasure, Value, False);
      PageLayout.FFooterHeight := ConvertMeasure(PageLayout.FFooterHeight,
        FMeasure, Value, False);

      PageLayout.FMargins.Left := ConvertMeasure(PageLayout.FMargins.Left,
        FMeasure, Value, True);
      PageLayout.FMargins.Right := ConvertMeasure(PageLayout.FMargins.Right,
        FMeasure, Value, True);
      PageLayout.FMargins.Top := ConvertMeasure(PageLayout.FMargins.Top,
        FMeasure, Value, False);
      PageLayout.FMargins.Bottom := ConvertMeasure(PageLayout.FMargins.Bottom,
        FMeasure, Value, False);
      FMeasure := Value;
    end;
  finally
    FConvertingProps := False;
  end;
end;

procedure TJvTFPrinter.SetPageLayout(Value: TJvTFPrinterPageLayout);
begin
  FPageLayout.Assign(Value);
end;

procedure TJvTFPrinter.SetPropertyCheck;
begin
  if (State <> spsNoDoc) and not ConvertingProps then
    raise EJvTFPrinterError.CreateRes(@RsEThisPropertyCannotBeChangedIfA);
end;

procedure TJvTFPrinter.SetTitle(const Value: string);
begin
  FTitle := Value;
end;

//=== { TJvTFPrinterPageLayout } =============================================

constructor TJvTFPrinterPageLayout.Create(aPrinter: TJvTFPrinter);
begin
  inherited Create;
  if not Assigned(aPrinter) then
    raise EJvTFPrinterError.CreateRes(@RsECouldNotCreateTJvTFPrinterPageLayou);

  FPrinter := aPrinter;
  FMargins.Left := 25;
  FMargins.Right := 25;
  FMargins.Top := 17;
  FMargins.Bottom := 63;
end;

procedure TJvTFPrinterPageLayout.Assign(Source: TPersistent);
var
  SourceMeas, DestMeas: TJvTFPrinterMeasure;
  WorkVal: Integer;
  SourceLayout: TJvTFPrinterPageLayout;
begin
  if (Source is TJvTFPrinterPageLayout) then
  begin
    if not Assigned(Printer) or not Assigned(TJvTFPrinterPageLayout(Source).Printer) then
      Exit; // raise?
    SourceLayout := TJvTFPrinterPageLayout(Source);
    SourceMeas := SourceLayout.Printer.Measure;
    DestMeas := Printer.Measure;

    WorkVal := SourceLayout.MarginLeft;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, True);
    SetMargin(1, WorkVal);

    WorkVal := SourceLayout.MarginTop;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
    SetMargin(2, WorkVal);

    WorkVal := SourceLayout.MarginRight;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, True);
    SetMargin(3, WorkVal);

    WorkVal := SourceLayout.MarginBottom;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
    SetMargin(4, WorkVal);

    WorkVal := SourceLayout.HeaderHeight;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
    SetHeaderHeight(WorkVal);

    WorkVal := SourceLayout.FooterHeight;
    WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
    SetFooterHeight(WorkVal);
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFPrinterPageLayout.Change;
begin
  // do nothing, leave to descendants
end;

function TJvTFPrinterPageLayout.GetMargin(Index: Integer): Integer;
begin
  case Index of
    1:
      Result := FMargins.Left;
    2:
      Result := FMargins.Top;
    3:
      Result := FMargins.Right;
  else
    Result := FMargins.Bottom;
  end;
end;

procedure TJvTFPrinterPageLayout.SetFooterHeight(Value: Integer);
var
  Check: Integer;
begin
  SetPropertyCheck;

  if Value < 0 then
    Value := 0;

  if Value <> FFooterHeight then
  begin
    Check := FFooterHeight;
    FFooterHeight := Value;
    if Printer.BodyHeight < 1 then
    begin
      FFooterHeight := Check;
      raise EJvTFPrinterError.CreateResFmt(@RsEInvalidFooterHeightd, [Value]);
    end
    else
      Change;
  end;
end;

procedure TJvTFPrinterPageLayout.SetHeaderHeight(Value: Integer);
var
  Check: Integer;
begin
  SetPropertyCheck;

  if Value < 0 then
    Value := 0;
  if Value <> FHeaderHeight then
  begin
    Check := FHeaderHeight;
    FHeaderHeight := Value;
    if Printer.BodyHeight < 1 then
    begin
      FHeaderHeight := Check;
      raise EJvTFPrinterError.CreateResFmt(@RsEInvalidHeaderHeightd, [Value]);
    end
    else
      Change;
  end;
end;

procedure TJvTFPrinterPageLayout.SetMargin(Index, Value: Integer);
var
  Unprintable, UserMarginPels, CurrMargin, NewMargin: Integer;
  Horz, Err: Boolean;
begin
  SetPropertyCheck;

  CurrMargin := GetMargin(Index);
  if Value <> CurrMargin then
  begin
    Horz := (Index = 1) or (Index = 3);
    case Index of
      1:
        Unprintable := Printer.GetUnprintable.Left;
      2:
        Unprintable := Printer.GetUnprintable.Top;
      3:
        Unprintable := Printer.GetUnprintable.Right;
    else
      Unprintable := Printer.GetUnprintable.Bottom;
    end;

    UserMarginPels := Printer.ConvertMeasure(Value, Printer.Measure,
      pmPixels, Horz);
    Printer.SetMarginOffset(Index, UserMarginPels - Unprintable);

    if Printer.GetMarginOffset(Index) >= 0 then
    begin
      Err := False;
      NewMargin := Value;
    end
    else
    begin
      Err := True;
      Printer.SetMarginOffset(Index, 0);
      NewMargin := Printer.ConvertMeasure(Unprintable, pmPixels,
        Printer.Measure, Horz);
    end;

    if not Err then
      case Index of
        1:
          FMargins.Left := NewMargin;
        2:
          FMargins.Top := NewMargin;
        3:
          FMargins.Right := NewMargin;
      else
        FMargins.Bottom := NewMargin;
      end
    else
      //SetMargin(Index, NewMargin);
      case Index of
        1:
          MarginLeft := NewMargin;
        2:
          MarginTop := NewMargin;
        3:
          MarginRight := NewMargin;
      else
        MarginBottom := NewMargin;
      end;

    if Err and Assigned(Printer) then
    begin
      Printer.UpdateDesigner;
      Printer.MarginError;
    end;

    Change;
  end;
end;

procedure TJvTFPrinterPageLayout.SetPropertyCheck;
begin
  Printer.SetPropertyCheck;
end;

//=== { TJvTFUniversalPrinter } ==============================================

procedure TJvTFUniversalPrinter.CreateDoc;
begin
  inherited CreateDoc;
end;

procedure TJvTFUniversalPrinter.FinishDoc;
begin
  inherited FinishDoc;
end;

procedure TJvTFUniversalPrinter.NewDoc;
begin
  inherited NewDoc;
end;

procedure TJvTFUniversalPrinter.NewPage;
begin
  inherited NewPage;
end;

//=== { TJvTFHintProps } =====================================================

constructor TJvTFHintProps.Create(AOwner: TJvTFControl);
begin
  inherited Create;
  FControl := AOwner;

  FHintColor := clDefault;
  FHintHidePause := -1;
  FHintPause := -1;
end;

procedure TJvTFHintProps.Assign(Source: TPersistent);
begin
  if Source is TJvTFHint then
  begin
    FHintColor := TJvTFHintProps(Source).HintColor;
    FHintHidePause := TJvTFHintProps(Source).HintHidePause;
    FHintPause := TJvTFHintProps(Source).HintPause;
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFHintProps.Change;
begin
  // do nothing
end;

procedure TJvTFHintProps.SetHintColor(Value: TColor);
begin
  if Value <> FHintColor then
  begin
    FHintColor := Value;
    Change;
  end;
end;

procedure TJvTFHintProps.SetHintHidePause(Value: Integer);
begin
  if Value < -1 then
    Value := -1;

  if Value <> FHintHidePause then
  begin
    FHintHidePause := Value;
    Change;
  end;
end;

procedure TJvTFHintProps.SetHintPause(Value: Integer);
begin
  if Value < -1 then
    Value := -1;

  if Value <> HintPause then
  begin
    FHintPause := Value;
    Change;
  end;
end;

//=== { TJvTFDWNames } =======================================================

constructor TJvTFDWNames.Create;
begin
  inherited Create;
  FSource := dwnsSysShort;
  FDWN_Sunday := 'S';
  FDWN_Monday := 'M';
  FDWN_Tuesday := 'T';
  FDWN_Wednesday := 'W';
  FDWN_Thursday := 'T';
  FDWN_Friday := 'F';
  FDWN_Saturday := 'S';
end;

procedure TJvTFDWNames.Assign(Source: TPersistent);
begin
  if Source is TJvTFDWNames then
  begin
    FDWN_Sunday := TJvTFDWNames(Source).DWN_Sunday;
    FDWN_Monday := TJvTFDWNames(Source).DWN_Monday;
    FDWN_Tuesday := TJvTFDWNames(Source).DWN_Tuesday;
    FDWN_Wednesday := TJvTFDWNames(Source).DWN_Wednesday;
    FDWN_Thursday := TJvTFDWNames(Source).DWN_Thursday;
    FDWN_Friday := TJvTFDWNames(Source).DWN_Friday;
    FDWN_Saturday := TJvTFDWNames(Source).DWN_Saturday;
    FSource := TJvTFDWNames(Source).Source;
    Change;
  end
  else
    inherited Assign(Source);
end;

procedure TJvTFDWNames.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TJvTFDWNames.GetDWN(Index: Integer): string;
begin
  case Index of
    1:
      Result := FDWN_Sunday;
    2:
      Result := FDWN_Monday;
    3:
      Result := FDWN_Tuesday;
    4:
      Result := FDWN_Wednesday;
    5:
      Result := FDWN_Thursday;
    6:
      Result := FDWN_Friday;
    7:
      Result := FDWN_Saturday;
  else
    Result := '';
  end;
end;

function TJvTFDWNames.GetDWName(DWIndex: Integer): string;
begin
  case Source of
    dwnsSysLong:
      Result := FormatSettings.LongDayNames[DWIndex];
    dwnsSysShort:
      Result := FormatSettings.ShortDayNames[DWIndex];
  else // dwnsCustom
    Result := GetDWN(DWIndex);
  end;
end;

procedure TJvTFDWNames.SetDWN(Index: Integer; const Value: string);
begin
  case Index of
    1:
      FDWN_Sunday := Value;
    2:
      FDWN_Monday := Value;
    3:
      FDWN_Tuesday := Value;
    4:
      FDWN_Wednesday := Value;
    5:
      FDWN_Thursday := Value;
    6:
      FDWN_Friday := Value;
    7:
      FDWN_Saturday := Value;
  end;

  if Source = dwnsCustom then
    Change;
end;

procedure TJvTFDWNames.SetSource(Value: TJvTFDWNameSource);
begin
  if Value <> FSource then
  begin
    FSource := Value;
    Change;
  end;
end;

//=== { TJvTFDateList } ======================================================

constructor TJvTFDateList.Create;
begin
  inherited Create;
  FList := TStringList.Create;
  FList.Sorted := True;
  FList.Duplicates := dupIgnore;
end;

destructor TJvTFDateList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TJvTFDateList.Add(ADate: TDate): Integer;
begin
  Result := FList.Add(IntToStr(Trunc(ADate)));
  Change;
end;

procedure TJvTFDateList.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvTFDateList.Clear;
begin
  FList.Clear;
  Change;
end;

function TJvTFDateList.Count: Integer;
begin
  Result := FList.Count;
end;

procedure TJvTFDateList.Delete(Index: Integer);
begin
  FList.Delete(Index);
  Change;
end;

function TJvTFDateList.GetDate(Index: Integer): TDate;
begin
  Result := StrToInt(FList[Index]);
end;

function TJvTFDateList.IndexOf(ADate: TDate): Integer;
begin
  Result := FList.IndexOf(IntToStr(Trunc(ADate)));
end;

//=== { TJvTFNavigator } =====================================================

//constructor TJvTFNavigator.Create(AOwner: TComponent);
//begin
//  inherited Create(AOwner);
//  FControls := TStringList.Create;
//end;
//
//destructor TJvTFNavigator.Destroy;
//begin
//  While ControlCount > 0 do
//    UnregisterControl(Controls[0]);
//  FControls.Free;
//
//  inherited Destroy;
//end;
//
//function TJvTFNavigator.ControlCount: Integer;
//begin
//  Result := FControls.Count;
//end;
//
//function TJvTFNavigator.GetControl(Index: Integer): TJvTFControl;
//begin
//  Result := TJvTFControl(FControls.Objects[Index]);
//end;
//
//procedure TJvTFNavigator.Navigate(aControl: TJvTFControl;
//  SchedNames: TStringList; Dates: TJvTFDateList);
//var
//  I: Integer;
//  Control: TJvTFControl;
//begin
//  If Navigating or not Assigned(aControl) Then
//    Exit;
//
//  If Assigned(FBeforeNavigate) Then
//    FBeforeNavigate(Self, aControl, SchedNames, Dates);
//
//  FNavigating := True;
//  Try
//    For I := 0 to ControlCount - 1 do
//      Begin
//        Control := Controls[I];
//        If Control <> aControl Then
//          //Controls[I].Notify(aControl, sncNavigate);
//          Control.Navigate(aControl, SchedNames, Dates);
//      End;
//  Finally
//    FNavigating := False;
//  End;
//
//  If Assigned(FAfterNavigate) Then
//    FAfterNavigate(Self, aControl, SchedNames, Dates);
//end;
//
//procedure TJvTFNavigator.RegisterControl(aControl: TJvTFControl);
//var
//  I: Integer;
//begin
//  I := FControls.IndexOfObject(aControl);
//  If I = -1 Then
//    FControls.AddObject('', aControl);
//end;
//
//procedure TJvTFNavigator.UnregisterControl(aControl: TJvTFControl);
//var
//  I: Integer;
//begin
//  I := FControls.IndexOfObject(aControl);
//  If I > -1 Then
//    FControls.Delete(I);
//end;


end.