jclschedule.pas

East make Tray Icon in delphi

    procedure MakeValidStamp(var Stamp: TTimeStamp); override;
    function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override;
  public
    constructor Create(const Controller: IUnknown);
    // IJclYearlySchedule
    function GetMonth: Cardinal;
    procedure SetMonth(Value: Cardinal);
    
    property Month: Cardinal read GetMonth write SetMonth;
  end;

constructor TYearlySchedule.Create(const Controller: IUnknown);
begin
  inherited Create(Controller);
  FMonth := 1;
end;

class function TYearlySchedule.RecurringType: TScheduleRecurringKind;
begin
  Result := srkYearly;
end;

function TYearlySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean;
var
  SYear, SMonth, SDay: Word;
  TYear, TMonth, TDay: Word;
begin
  JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
  JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
  Result := ((TYear - SYear) mod Integer(Interval) = 0) and (TMonth = Month) and
    ValidStampMonthIndex(TYear, TMonth, TDay);
end;

procedure TYearlySchedule.MakeValidStamp(var Stamp: TTimeStamp);
var
  SYear, SMonth, SDay: Word;
  TYear, TMonth, TDay: Word;
  YearDiff: Integer;
begin
  JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay);
  JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay);
  YearDiff := TYear - SYear;
  if YearDiff mod Integer(Interval) <> 0 then
  begin
    Inc(TYear, Integer(Interval) - (YearDiff mod Integer(Interval)));
    TMonth := Month;
    TDay := 1;
  end;
  MakeValidStampMonthIndex(TYear, TMonth, TDay);
  while DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date < Stamp.Date do
  begin
    Inc(TYear, Integer(Interval));
    TMonth := Month;
    TDay := 1;
    MakeValidStampMonthIndex(TYear, TMonth, TDay);
  end;
  Stamp.Date := DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date;
end;

function TYearlySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp;
begin
  Result := Stamp;
  MakeValidStamp(Result);
  if EqualTimeStamps(Stamp, Result) then
  begin
    // Time stamp has not been adjusted (it was valid). Determine the next time stamp
    Inc(Result.Date);
    MakeValidStamp(Result);    // Skip over unwanted days and months
  end;
end;

function TYearlySchedule.GetMonth: Cardinal;
begin
  CheckInterfaceAllowed;
  Result := FMonth;
end;

procedure TYearlySchedule.SetMonth(Value: Cardinal);
begin
  CheckInterfaceAllowed;
  if (Value < 1) or (Value > 12) then
    raise ESchedule.CreateRes(@RsScheduleMonthInRange);
  FMonth := Value;
end;

//=== { TSchedule } ==========================================================

type
  TSchedule = class(TInterfacedObject, IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule,
    IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule)
  private
    FStartDate: TTimeStamp;
    FRecurringType: TScheduleRecurringKind;
    FEndType: TScheduleEndKind;
    FEndDate: TTimeStamp;
    FEndCount: Cardinal;
    FDailyFreq: TDailyFreq;
    FDailySchedule: TDailySchedule;
    FWeeklySchedule: TWeeklySchedule;
    FMonthlySchedule: TMonthlySchedule;
    FYearlySchedule: TYearlySchedule;
  protected
    FTriggerCount: Cardinal;
    FDayCount: Cardinal;
    FLastEvent: TTimeStamp;

    function GetNextEventStamp(const From: TTimeStamp): TTimeStamp;

    property DailyFreq: TDailyFreq read FDailyFreq implements IJclScheduleDayFrequency;
    property DailySchedule: TDailySchedule read FDailySchedule implements IJclDailySchedule;
    property WeeklySchedule: TWeeklySchedule read FWeeklySchedule implements IJclWeeklySchedule;
    property MonthlySchedule: TMonthlySchedule read FMonthlySchedule implements IJclMonthlySchedule;
    property YearlySchedule: TYearlySchedule read FYearlySchedule implements IJclYearlySchedule;
  public
    constructor Create;
    destructor Destroy; override;

    // IJclSchedule
    function GetStartDate: TTimeStamp;
    function GetRecurringType: TScheduleRecurringKind;
    function GetEndType: TScheduleEndKind;
    function GetEndDate: TTimeStamp;
    function GetEndCount: Cardinal;
    procedure SetStartDate(const Value: TTimeStamp);
    procedure SetRecurringType(Value: TScheduleRecurringKind);
    procedure SetEndType(Value: TScheduleEndKind);
    procedure SetEndDate(const Value: TTimeStamp);
    procedure SetEndCount(Value: Cardinal);

    function TriggerCount: Cardinal;
    function DayCount: Cardinal;
    function LastTriggered: TTimeStamp;

    procedure InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
      LastDayCount: Cardinal);
    procedure Reset;
    function NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
    function NextEventFrom(const FromEvent: TTimeStamp;
      CountMissedEvent: Boolean = False): TTimeStamp;
    function NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;

    property StartDate: TTimeStamp read GetStartDate write SetStartDate;
    property RecurringType: TScheduleRecurringKind read GetRecurringType write SetRecurringType;
    property EndType: TScheduleEndKind read GetEndType write SetEndType;
    property EndDate: TTimeStamp read GetEndDate write SetEndDate;
    property EndCount: Cardinal read GetEndCount write SetEndCount;
  end;

constructor TSchedule.Create;
var
  InitialStamp: TTimeStamp;
begin
  inherited Create;
  FDailyFreq := TDailyFreq.Create(Self);
  FDailySchedule := TDailySchedule.Create(Self);
  FWeeklySchedule := TWeeklySchedule.Create(Self);
  FMonthlySchedule := TMonthlySchedule.Create(Self);
  FYearlySchedule := TYearlySchedule.Create(Self);
  InitialStamp := DateTimeToTimeStamp(Now);
  InitialStamp.Time := 1000 * (InitialStamp.Time div 1000); // strip of milliseconds
  StartDate := InitialStamp;
  EndType := sekNone;
  RecurringType := srkOneShot;
end;

destructor TSchedule.Destroy;
begin
  FreeAndNil(FYearlySchedule);
  FreeAndNil(FMonthlySchedule);
  FreeAndNil(FWeeklySchedule);
  FreeAndNil(FDailySchedule);
  FreeAndNil(FDailyFreq);
  inherited Destroy;
end;

function TSchedule.GetNextEventStamp(const From: TTimeStamp): TTimeStamp;
var
  UseFrom: TTimeStamp;
begin
  Result := NullStamp;
  UseFrom := From;
  if (From.Date = 0) or (From.Date < StartDate.Date) then
  begin
    UseFrom := StartDate;
    Dec(UseFrom.Time);
  end;
  case RecurringType of
    srkOneShot:
      if TriggerCount = 0 then
        Result := StartDate;
    srkDaily:
      begin
        Result := DailyFreq.NextValidStamp(UseFrom);
        if IsNullTimeStamp(Result) then
        begin
          Result.Date := UseFrom.Date;
          Result.Time := DailyFreq.StartTime;
          Result := DailySchedule.NextValidStamp(Result);
        end
        else
          DailySchedule.MakeValidStamp(Result);
      end;
    srkWeekly:
      begin
        Result := DailyFreq.NextValidStamp(UseFrom);
        if IsNullTimeStamp(Result) then
        begin
          Result.Date := UseFrom.Date;
          Result.Time := DailyFreq.StartTime;
          Result := WeeklySchedule.NextValidStamp(Result);
        end
        else
          WeeklySchedule.MakeValidStamp(Result);
      end;
    srkMonthly:
      begin
        Result := DailyFreq.NextValidStamp(UseFrom);
        if IsNullTimeStamp(Result) then
        begin
          Result.Date := UseFrom.Date;
          Result.Time := DailyFreq.StartTime;
          Result := MonthlySchedule.NextValidStamp(Result);
        end
        else
          MonthlySchedule.MakeValidStamp(Result);
      end;
    srkYearly:
      begin
        Result := DailyFreq.NextValidStamp(UseFrom);
        if IsNullTimeStamp(Result) then
        begin
          Result.Date := UseFrom.Date;
          Result.Time := DailyFreq.StartTime;
          Result := YearlySchedule.NextValidStamp(Result);
        end
        else
          YearlySchedule.MakeValidStamp(Result);
      end;
  end;
  if CompareTimeStamps(Result, UseFrom) < 0 then
    Result := NullStamp;
  if not IsNullTimeStamp(Result) then
  begin
    if ((EndType = sekDate) and (CompareTimeStamps(Result, EndDate) > 0)) or
        ((EndType = sekDayCount) and (DayCount = EndCount) and (UseFrom.Date <> Result.Date)) or
        ((EndType = sekTriggerCount) and (TriggerCount = EndCount)) then
      Result := NullStamp
    else
    begin
      Inc(FTriggerCount);
      if (UseFrom.Date <> Result.Date) or (DayCount = 0) then
        Inc(FDayCount);
      FLastEvent := Result;
    end;
  end;
end;

function TSchedule.GetStartDate: TTimeStamp;
begin
  Result := FStartDate;
end;

function TSchedule.GetRecurringType: TScheduleRecurringKind;
begin
  Result := FRecurringType;
end;

function TSchedule.GetEndType: TScheduleEndKind;
begin
  Result := FEndType;
end;

function TSchedule.GetEndDate: TTimeStamp;
begin
  Result := FEndDate;
end;

function TSchedule.GetEndCount: Cardinal;
begin
  Result := FEndCount;
end;

procedure TSchedule.SetStartDate(const Value: TTimeStamp);
begin
  FStartDate := Value;
end;

procedure TSchedule.SetRecurringType(Value: TScheduleRecurringKind);
begin
  FRecurringType := Value;
end;

procedure TSchedule.SetEndType(Value: TScheduleEndKind);
begin
  FEndType := Value;
end;

procedure TSchedule.SetEndDate(const Value: TTimeStamp);
begin
  FEndDate := Value;
end;

procedure TSchedule.SetEndCount(Value: Cardinal);
begin
  FEndCount := Value;
end;

function TSchedule.TriggerCount: Cardinal;
begin
  Result := FTriggerCount;
end;

function TSchedule.DayCount: Cardinal;
begin
  Result := FDayCount;
end;

function TSchedule.LastTriggered: TTimeStamp;
begin
  Result := FLastEvent;
end;

procedure TSchedule.InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount,
  LastDayCount: Cardinal);
begin
  FLastEvent := LastTriggerStamp;
  FTriggerCount := LastTriggerCount;
  FDayCount := LastDayCount;
end;

procedure TSchedule.Reset;
begin
  FLastEvent := NullStamp;
  FTriggerCount := 0;
  FDayCount := 0;
end;

function TSchedule.NextEvent(CountMissedEvents: Boolean = False): TTimeStamp;
begin
  Result := NextEventFrom(FLastEvent, CountMissedEvents);
end;

function TSchedule.NextEventFrom(const FromEvent: TTimeStamp;
  CountMissedEvent: Boolean = False): TTimeStamp;
begin
  if CountMissedEvent then
  begin
    Result := FLastEvent;
    repeat
      Result := GetNextEventStamp(Result);
    until IsNullTimeStamp(Result) or (CompareTimeStamps(FromEvent, Result) <= 0);
  end
  else
    Result := GetNextEventStamp(FromEvent);
end;

function TSchedule.NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp;
begin
  Result := NextEventFrom(DateTimeToTimeStamp(Now), CountMissedEvents);
end;

function CreateSchedule: IJclSchedule;
begin
  Result := TSchedule.Create;
end;

// History:

// $Log: JclSchedule.pas,v $
// Revision 1.13  2005/03/08 08:33:17  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.12  2005/02/24 16:34:40  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.11  2004/10/17 22:30:27  mthoma
// file header update
//
// Revision 1.10  2004/10/12 18:29:52  rrossmair
// cleanup
//
// Revision 1.9  2004/08/01 05:52:12  marquardt
// move constructors/destructors
//
// Revision 1.8  2004/07/28 18:00:51  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.7  2004/06/16 07:30:28  marquardt
// added tilde to all IFNDEF ENDIFs, inherited qualified
//
// Revision 1.6  2004/06/14 06:24:52  marquardt
// style cleaning IFDEF
//
// Revision 1.5  2004/05/05 00:09:59  mthoma
// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary,
//

end.