jclschedule.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ 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/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclSchedule.pas.                                                            }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel Bestebroer.                                 }
{ Portions created Marcel Bestebroer are Copyright (C) Marcel Bestebroer. All rights reserved.     }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Marcel Bestebroer (marcelb)                                                                    }
{   Robert Rossmair (rrossmair)                                                                    }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains scheduler classes.                                                            }
{                                                                                                  }
{ Unit owner: Marcel Bestebroer                                                                    }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/08 08:33:17 $
// For history see end of file

unit JclSchedule;

{$I jcl.inc}

interface

uses
  SysUtils,
  JclBase;

type
  TScheduleRecurringKind = (srkOneShot, srkDaily, srkWeekly, srkMonthly, srkYearly);
  TScheduleEndKind = (sekNone, sekDate, sekTriggerCount, sekDayCount);
  TScheduleWeekDay = (swdMonday, swdTuesday, swdWednesday, swdThursday, swdFriday, swdSaturday,
    swdSunday);
  TScheduleWeekDays = set of TScheduleWeekDay;
  TScheduleIndexKind = (sikNone, sikDay, sikWeekDay, sikWeekendDay, sikMonday, sikTuesday,
    sikWednesday, sikThursday, sikFriday, sikSaturday, sikSunday);

const
  sivFirst = 1;
  sivSecond = 2;
  sivThird = 3;
  sivFourth = 4;
  sivLast = -1;

type
  // Forwards
  IJclSchedule = interface;
  IJclDailySchedule = interface;
  IJclWeeklySchedule = interface;
  IJclMonthlySchedule = interface;
  IJclYearlySchedule = interface;

  ESchedule = class(EJclError);

  IJclSchedule = interface(IUnknown)
    ['{1CC54450-7F84-4F27-B1C1-418C451DAD80}']
    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;

  IJclScheduleDayFrequency = interface(IUnknown)
    ['{6CF37F0D-56F4-4AE6-BBCA-7B9DFE60F50D}']
    function GetStartTime: Cardinal;
    function GetEndTime: Cardinal;
    function GetInterval: Cardinal;
    procedure SetStartTime(Value: Cardinal);
    procedure SetEndTime(Value: Cardinal);
    procedure SetInterval(Value: Cardinal);

    property StartTime: Cardinal read GetStartTime write SetStartTime;
    property EndTime: Cardinal read GetEndTime write SetEndTime;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

  IJclDailySchedule = interface(IUnknown)
    ['{540E22C5-BE14-4539-AFB3-E24A67C58D8A}']
    function GetEveryWeekDay: Boolean;
    function GetInterval: Cardinal;
    procedure SetEveryWeekDay(Value: Boolean);
    procedure SetInterval(Value: Cardinal);

    property EveryWeekDay: Boolean read GetEveryWeekDay write SetEveryWeekDay;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

  IJclWeeklySchedule = interface(IUnknown)
    ['{73F15D99-C6A1-4526-8DE3-A2110E099BBC}']
    function GetDaysOfWeek: TScheduleWeekDays;
    function GetInterval: Cardinal;
    procedure SetDaysOfWeek(Value: TScheduleWeekDays);
    procedure SetInterval(Value: Cardinal);

    property DaysOfWeek: TScheduleWeekDays read GetDaysOfWeek write SetDaysOfWeek;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

  IJclMonthlySchedule = interface(IUnknown)
    ['{705E17FC-83E6-4385-8D2D-17013052E9B3}']
    function GetIndexKind: TScheduleIndexKind;
    function GetIndexValue: Integer;
    function GetDay: Cardinal;
    function GetInterval: Cardinal;
    procedure SetIndexKind(Value: TScheduleIndexKind);
    procedure SetIndexValue(Value: Integer);
    procedure SetDay(Value: Cardinal);
    procedure SetInterval(Value: Cardinal);

    property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind;
    property IndexValue: Integer read GetIndexValue write SetIndexValue;
    property Day: Cardinal read GetDay write SetDay;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

  IJclYearlySchedule = interface(IUnknown)
    ['{3E5303B0-FFA0-495A-96BB-14A718A01C1B}']
    function GetIndexKind: TScheduleIndexKind;
    function GetIndexValue: Integer;
    function GetDay: Cardinal;
    function GetMonth: Cardinal;
    function GetInterval: Cardinal;
    procedure SetIndexKind(Value: TScheduleIndexKind);
    procedure SetIndexValue(Value: Integer);
    procedure SetDay(Value: Cardinal);
    procedure SetMonth(Value: Cardinal);
    procedure SetInterval(Value: Cardinal);

    property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind;
    property IndexValue: Integer read GetIndexValue write SetIndexValue;
    property Day: Cardinal read GetDay write SetDay;
    property Month: Cardinal read GetMonth write SetMonth;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

function CreateSchedule: IJclSchedule;
function NullStamp: TTimeStamp;
function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64;
function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean;
function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean;

implementation

uses
  JclDateTime, JclResources;  

{$IFNDEF RTL140_UP}

const
  S_OK    = $00000000;
  E_NOINTERFACE = HRESULT($80004002);

type
  TAggregatedObject = class
  private
    FController: Pointer;
    function GetController: IUnknown;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(Controller: IUnknown);
    property Controller: IUnknown read GetController;
  end;

  TContainedObject = class(TAggregatedObject, IUnknown)
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  end;

//=== { TAggregatedObject } ==================================================

constructor TAggregatedObject.Create(Controller: IUnknown);
begin
  FController := Pointer(Controller);
end;

function TAggregatedObject.GetController: IUnknown;
begin
  Result := IUnknown(FController);
end;

function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := IUnknown(FController).QueryInterface(IID, Obj);
end;

function TAggregatedObject._AddRef: Integer;
begin
  Result := IUnknown(FController)._AddRef;
end;

function TAggregatedObject._Release: Integer; stdcall;
begin
  Result := IUnknown(FController)._Release;
end;

//=== { TContainedObject } ===================================================

function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
end;

{$ENDIF ~RTL140_UP}

// Utility functions
function NullStamp: TTimeStamp;
begin
  Result.Date := 0;
  Result.Time := -1;
end;

function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64;
begin
  if Stamp1.Date < Stamp2.Date then
    Result := -1
  else
  if Stamp1.Date = Stamp2.Date then
  begin
    if Stamp1.Time < Stamp2.Time then
      Result := -1
    else
    if Stamp1.Time = Stamp2.Time then
      Result := 0
    else // If Stamp1.Time > Stamp2.Time then
      Result := 1;
  end
  else // if Stamp1.Date > Stamp2.Date then
    Result := 1;
//  Result := Int64(Stamp1) - Int64(Stamp2);
end;

function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean;
begin
  Result := CompareTimeStamps(Stamp1, Stamp2) = 0;
end;

function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean;
begin
  Result := CompareTimeStamps(NullStamp, Stamp) = 0;
end;

function TimeStampDOW(const Stamp: TTimeStamp): Integer;
begin
  Result := (Stamp.Date - 1) mod 7 + 1
end;

function ISODayOfWeek(DateTime: TDateTime): Integer;
begin
  Result := (DayOfWeek(DateTime - 2 + 7) mod 7) + 1;
end;

function FirstWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
begin
  DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1));
  if DOW > 5 then
  begin
    Result := 9 - DOW;
    DOW := 1;
  end
  else
    Result := 1;
end;

function LastWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
begin
  DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))));
  if DOW > 5 then
  begin
    Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (DOW - 5);
    DOW := 5;
  end
  else
    Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1));
end;

function FirstWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
begin
  DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1));
  if DOW < 6 then
  begin
    Result := 7 - DOW;
    DOW := 6;
  end
  else
    Result := 1;
end;

function LastWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer;
begin
  DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1))));
  if DOW < 6 then
  begin
    Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - DOW;
    DOW := 7;
  end
  else
    Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1));
end;

function FirstWeekDay(const Year, Month: Integer): Integer;
var
  Dummy: Integer;
begin
  Result := FirstWeekDayPrim(Year, Month, Dummy);
end;

function LastWeekDay(const Year, Month: Integer): Integer;
var
  Dummy: Integer;
begin
  Result := LastWeekDayPrim(Year, Month, Dummy);
end;

function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer;
var
  DOW: Integer;
begin
  if Index > 0 then
    Result := FirstWeekDayPrim(Year, Month, DOW)
  else
  if Index < 0 then
    Result := LastWeekDayPrim(Year, Month, DOW)
  else
    Result := 0;
  if Index > 1 then                   // n-th weekday from start of month
  begin
    Dec(Index);
    if DOW > 1 then                   // adjust to first monday
    begin
      if Index < (5 - DOW) then
      begin
        Inc(Result, Index);
        Index := 0;
      end
      else
      begin
        Dec(Index, 6 - DOW);
        Inc(Result, 8 - DOW);
      end;
    end;
    Result := Result + (7 * (Index div 5)) + (Index mod 5);
  end
  else
  if Index < -1 then             // n-th weekday from end of month
  begin
    Index := Abs(Index) - 1;
    if DOW < 5 then                   // adjust to last friday
    begin
      if Index < DOW then
      begin
        Dec(Result, Index);
        Index := 0;
      end
      else
      begin
        Dec(Index, DOW);
        Dec(Result, DOW + 2);
      end;
    end;