jvtfmanager.pas

East make Tray Icon in delphi

    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;
    {$IFDEF VCL}
    function GetPage(Index: Integer): TMetafile;
    {$ENDIF VCL}
    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(var 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;
    {$IFDEF VCL}
    property Pages[Index: Integer]: TMetafile read GetPage;
    {$ENDIF VCL}
    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;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTFManager.pas,v $';
    Revision: '$Revision: 1.44 $';
    Date: '$Date: 2005/02/17 10:20:56 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF USEJVCL}
  JvConsts, JvResources,
  {$ENDIF USEJVCL}
  Dialogs, Forms;

{$IFNDEF USEJVCL}
resourcestring
  RsECouldNotCreateCustomImageMap = 'Could not create CustomImageMap.  ' +
    'Appointment not assigned';
  RsECouldNotCreateAppointmentObject = 'Could not create Appointment object.  ' +
    'ScheduleManager not assigned';
  RsEScheduleManagerNotificationFailedSc = 'ScheduleManager notification failed.  ScheduleManager not assigned';
  RsEScheduleNotificationFailed = 'Schedule notification failed.  ' +
    'Schedule not assigned';
  RsEInvalidStartAndEndTimes = 'Invalid start and end times';
  RsEInvalidStartAndEndDates = 'Invalid start and end dates';
  RsEAppointmentNotificationFailed = 'Appointment notification failed.  ' +
    'Appointment not assigned';
  RsECouldNotCreateNewAppointment = 'Could not create new appointment. ' +
    'Appointment with given ID already exists';
  RsEInvalidTriggerForRefreshControls = 'Invalid Trigger for RefreshControls';
  RsEInvalidScopeInReconcileRefresh = 'Invalid Scope in ReconcileRefresh';
  RsECouldNotRetrieveSchedule = 'Could not retrieve schedule.  ' +
    'ScheduleManager not assigned';
  RsECouldNotReleaseSchedule = 'Could not release schedule.  ' +
    'ScheduleManager not assigned';
  RsECouldNotCreateADocumentBecauseA = 'Could not create a document because a ' +
    'document already exists';
  RsECouldNotFinishDocumentBecauseNo = 'Could not finish document because no ' +
    'document has been created';
  RsEDocumentDoesNotExist = 'Document does not exist';
  RsEDocumentPagesCannotBeAccessedIf = 'Document pages cannot be accessed if ' +
    'printing directly to the printer';
  RsEDocumentPagesAreInaccessibleUntil = 'Document pages are inaccessible until ' +
    'the document has been finished';
  RsECouldNotRetrievePageCount = 'Could not retrieve page count ' +
    'because document does not exist';
  RsEOnlyAFinishedDocumentCanBePrinted = 'Only a finished document can be printed';
  RsEThereAreNoPagesToPrint = 'There are no pages to print';
  RsEDocumentMustBeFinishedToSaveToFile = 'Document must be Finished to save to file';
  RsEThisPropertyCannotBeChangedIfA = 'This property cannot be changed if a ' +
    'document exists';
  RsECouldNotCreateTJvTFPrinterPageLayou = 'Could not create TJvTFPrinterPageLayout ' +
    'because aPrinter must be assigned';
  RsEInvalidFooterHeightd = 'Invalid Footer Height (%d)';
  RsEInvalidHeaderHeightd = 'Invalid Header Height (%d)';
{$ENDIF !USEJVCL}

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;
var
  XOffset, YOffset: Integer;
begin
  XOffset := NewLeft - ARect.Left;
  YOffset := NewTop - ARect.Top;
  with Result do
  begin
    Left := ARect.Left + XOffset;
    Right := ARect.Right + XOffset;
    Top := ARect.Top + YOffset;
    Bottom := ARect.Bottom + YOffset;
  end;
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 := Integer(FMap.Objects[MapIndex]);
end;

procedure TJvTFCustomImageMap.SetImage(MapIndex, Value: Integer);
begin
  FMap.Objects[MapIndex] := TObject(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;