{***********************************************************************************
*  CM2VIS_Calendar - Calendar Plugin for Coolmon 2                                   *
*  Copyright (C) 2007 Alch                                                         *
*                                                                                  *
*  This library is free software; you can redistribute it and/or                   *
*  modify it under the terms of the GNU Lesser General Public                      *
*  License as published by the Free Software Foundation; either                    *
*  version 2.1 of the License, or (at your option) any later version.              *
*                                                                                  *
*  This library is distributed in the hope that it will be useful,                 *
*  but WITHOUT ANY WARRANTY; without even the implied warranty of                  *
*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU               *
*  Lesser General Public License for more details.                                 *
*                                                                                  *
*  You should have received a copy of the GNU Lesser General Public                *
*  License along with this library; if not, write to the Free Software             *
*  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  *
*                                                                                  *
***********************************************************************************}

unit GenPlugServ;
{$WARN SYMBOL_PLATFORM OFF}

Interface

Uses
	Windows, ActiveX, Classes, ComObj, Graphics, SysUtils, ExtCtrls,
		CM2VISInterface, CM2AutoUpdateInterface, CM2EditorSupportInterface;

Type
	THotSpot = Record
		Rec: TRect;
		Date: TDateTime;
	end;
	THoliday = Record
		EntryID, Title, Location, Wav: String;
		AllDayEvent, ReminderSet: Boolean;
		sDate, eDate: TDateTime;
		MinsBefore: Integer;
	end;
	TReminder = Record
		EntryID, Text, Wav: String;
		TimeTill: Integer;
		Time: TDateTime;
	end;
	TCM2Calender = class(TComObject, ICM2VisPlug3, ICM2AutoUpdate, ICM2EditorSupportVis10)
	private
		DrawHandle: THandle;
		HotSpot: Array of THotSpot;
		Holiday: Array of THoliday;
		aReminder: TReminder;
		LastChecked: TDateTime;
		Timer: TTimer;
		fBMP: TBitmap;
		LastErrMsg, HolidayType, fStoreID, MonthFormat, mAlign, wAlign, HolidayICS: String;

		fLeft, fTop, fWidth, fHeight, pmBoxWidth, pmBoxHeight, BoxWidth, BoxHeight, fmBoxWidth, fmBoxHeight,
    RC, ShortDays, WeekStarts, Spacing, MonthSpacing, Months, MonthtoStart, MonthsAlign: Integer;
		DefaultFont, TodayFont, WeekdayFont, WeekendFont, TDFont, MonthFont, HolidayFont: TFont;

		BoxColor, TodayBoxColor, WeekdayBGColor, WeekendBoxColor, TDBoxColor, HBoxColor, EdgeColor,
    TodayEdgeColor, WeekendEdgeColor, TDEdgeColor, HEdgeColor, Background, DayofWeekColor, PMBoxColor,
    PMWeekendBoxColor, FMBoxColor, FMWeekendBoxColor, MonthBGColor : TColor;

		FixedRows, ShowBorders, ShowDays, FMO, CMO, ShowWeeks, ShowTD, ToolTips, Alch,
		ShowMonth, StartMonth, Fudge20, ShowHolidays, Visible, Reminders, FirstRun : Boolean;
		Function Weekday(j, size: Integer): String;
		Function UpcaseFirst(Str: String): String;
		procedure pICS;
		procedure pOutlook;
		procedure pReminder;
		procedure LoadReg;
		procedure OnTimer(Sender: TObject); virtual;
		Procedure DrawCalender;
	public
		Function Name(OUT Name: Pchar): HResult; stdcall;
		Function Version(OUT Version: word): HResult; stdcall;
		Function RequiredCoreVersion(OUT RCV: Word): HResult; stdcall;
		Function GetLastErrorMsg(OUT Msg: PChar): HResult; stdcall;
		Function GetInfoCount(OUT InfoCount: Integer): HResult; stdcall;
		Function GetInfo(Index: Integer; OUT InfoName: PChar; OUT InfoVar: PChar): HResult; stdcall;
		Function SetDC(CONST NewDC: THandle): HResult; stdcall;
		Function SetDimensions(Left, Top, Width, Height : Integer): HResult; stdcall;
		Function SetConfigString(NewConfigString: PChar): HResult; stdcall;
		Function Redraw: HResult; stdcall;
		Function Update(SensorStyle: Byte; NewString: PChar; NewValue: Double): HResult; stdcall;
		Function Init(PaintDC: THandle): HResult; stdcall;
		Function Terminating: HResult; stdcall;
		Function Setup: HResult; stdcall;
		Function OnEvent(Sender: Pchar; EventType: Byte; ModKeys: Byte; X, Y: Integer; OUT CallBack: PChar): HResult; stdcall;
		Function NotifyOnEvent(OUT EventList: Cardinal): HResult; stdcall;
		Function GetDefaultCount(OUT DefaultCount: Integer): HResult; stdcall;
		Function GetDefault(Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
		Function GetOptionalCount(OUT OptionalCount: Integer): HResult; stdcall;
		Function GetOptional(Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
		Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
		Function ObjIns(ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
	end;

const
	Class_CM2Calender: TGUID = '{33E81D93-4F75-4EF5-B7D8-504AB4CF6673}';
  RegPath = '\Software\The Coolmon Project\Calendar';

implementation

uses
	ComServ, CalPopup, CalSetup, Registry, DateUtils, OutlookXP, Filter, ICSClass, PluginTools;

{ TCM2Calender }

Function TCM2Calender.Name(out Name: PChar): HResult;
begin
	Name := 'Calendar';
	Result := S_OK;
end;

Function TCM2Calender.Version(out Version: word): HResult;
begin
	Version := 1732;
	Result := S_OK;
end;

Function TCM2Calender.UpdateFileURL(out URL: PChar): HResult;
begin
	URL := 'http://coolmon.blackstar.solar/update/plugins/visual/CM2Vis_Calendar.upd';
	Result := S_OK;
end;       

Function TCM2Calender.RequiredCoreVersion(out RCV: Word): HResult;
begin
	RCV := 0500;
	Result := S_OK;
End;

Function TCM2Calender.GetInfo(Index: Integer; Out InfoName, InfoVar: PChar): HResult;
begin
	Result := S_OK;
	Case Index of
		0: begin
      InfoName := 'Programmed By';
      InfoVar := 'Alch';
    end;
		1: begin
      InfoName := 'Created';
      InfoVar := 'May 27, 2004';
    end;
		2: begin
      InfoName := 'Last Updated';
      InfoVar := 'April 14, 2007';
    end;
		3: begin
      InfoName := 'Original Code By';
      InfoVar := 'M. Israelsen & C. Aaangel';
    end;
		4: begin
      InfoName := 'Copyright';
      InfoVar := '(C) Alch - 2007';
    end;
		5: begin
			InfoName := 'License';
			InfoVar := 'LGPL - GNU Lesser General Public License';
		end;  
		6: begin
			InfoName := 'Uses PNGImage v1.564';
			InfoVar := 'By Gustavo Daud - http://pngdelphi.sourceforge.net';
		end;
  else
    Result := E_FAIL;
    LastErrMsg := 'Info Index Out of Bounds';
	end;
End;

Function TCM2Calender.GetInfoCount(out InfoCount: Integer): HResult;
begin
	Result := S_OK;
	InfoCount := 7;
end;

Function TCM2Calender.Redraw: HResult;
Var
	Canvas: TCanvas;
begin
	Result := S_OK;
	If Not Visible then
		Exit;
	Canvas := TCanvas.Create;
	try
		Canvas.Handle := DrawHandle;
		DrawCalender;
		Canvas.Draw(fLeft, fTop, fBMP);
	finally
		FreeAndNil(Canvas);
	end;
End;

Procedure TCM2Calender.DrawCalender;
  function CheckWeekend(DayNum: Integer): Boolean;
  begin
    Result := False;
    Case WeekStarts of
      0: if (DayNum = 0) or (DayNum = 6) then
            Result := True;
      1: if (DayNum = 5) or (DayNum = 6) then
            Result := True;
    end;
  end;  
  function CheckHoliday(cDay: TDateTime): Boolean;
  var
    i: integer;
  begin
    Result := False;
    For i := 0 to Length(Holiday)-1 do
    begin
      If IsSameDay(cDay, Holiday[i].sDate) then
      begin
        Result := True;
        Exit;
      end;
      if Holiday[i].sDate > cDay then
        exit;
    end;
  end;
var
	aRect: TRect;
	fText: String;
	BC, WBC: TColor;
	IsWeekend, IsHoliday: Boolean;
	First, Current, CalStarts, cDay: TDateTime;
	DayNum, Rows, mWidth, mHeight, Offset, Week, WeekNum, tWidth, tHeight, wWidth,
	ms, i, BW, BH, Row, SD, th, tw, p1, p2, sw, swR, SM, f20, Msp, vMsp, maxBW, Mcsp: Integer;
begin
	sw := 0; swR := 0; Msp := 0; vMsp := 0; tWidth := 0;  //Declare Variables
  tHeight := 0; mWidth := 0; mHeight := 0; Mcsp := 0; f20 := 0; wWidth := 16;
	SetLength(HotSpot, 0);
  
	CalStarts := Date;
	If StartMonth then
	begin
		If (MonthtoStart >= -3) and (MonthtoStart <= -1) then
			CalStarts := IncMonth(Date, MonthToStart);
		If (MonthtoStart >= 1) and (MonthtoStart <= 12) then
			CalStarts := EncodeDate(CurrentYear, MonthtoStart, 1);
	end;
	If Months > 1 then
	begin
		If MonthsAlign = 0 then
			Msp := MonthSpacing
		else
			vMsp := MonthSpacing; 

		maxBW := BoxWidth;   //Biggest Box for Vertical Alignment
		If pmBoxWidth > maxBW then
			maxBW := pmBoxWidth;
		If fmBoxWidth > maxBW then
			maxBW := fmBoxWidth;
	end;
	If (WeekStarts = 0) and (DayOfWeek(Date) = 1) then
		WeekNum := WeekOf(Date + 1)
	else
		WeekNum := WeekOf(Date);
	If ShowWeeks then
		If wAlign = 'LEFT' then
			sw := wWidth
		else
			swR := wWidth;
	If ShowMonth then
		SM := 15
	else
		SM := 0;
	If ShowDays then
		SD := 15
	else
		SD := 0;

  with fBMP do
  begin
    Width := fWidth;
    Height := fHeight;
    Canvas.Brush.Color := Background;
    Canvas.FillRect(Bounds(0, 0, fWidth, fHeight));
    Canvas.Pen.Color := EdgeColor;
    Canvas.Font := DefaultFont;
  end;

	For ms := 0 to Months -1 do  // Month Loop
	begin
		Current := IncMonth(CalStarts, ms);
		First := StartOfTheMonth(Current);
		Case CompareDate(First, StartOfTheMonth(Date)) of
			-1: begin
				BW := pmBoxWidth;
				BH := pmBoxHeight;
				BC := pmBoxColor;
				WBC := pmWeekendBoxColor;
			end;
			1: begin
				BW := fmBoxWidth;
				BH := fmBoxHeight;
				BC := fmBoxColor;
				WBC := fmWeekendBoxColor;
			end;
    else
      BW := BoxWidth;
      BH := BoxHeight;
      BC := BoxColor;
      WBC := WeekendBoxColor;
		end;
		If (WeekStarts = 0) and (DayOfWeek(First) = 1) then
			Week := WeekOf(IncDay(First)) //Tomorrow
		else
			Week := WeekOf(First);
		If WeekStarts = 0 then  // Offset
			Offset := DayOfWeek(First)-1
		else
			Offset := DayOfTheWeek(First)-1;
		DayNum := 1 - offset;
		If (FMO and (ms = 0)) or (CMO and (MonthOf(Current) = MonthOf(Date))) then
			SD := 15;
		If FixedRows or (Offset + DaysinMonth(Current) > 35) then
			Rows := 6
		else
			If Offset + DaysinMonth(Current) < 29 then
			begin
				Rows := 4;
				If Fudge20 and (Months = 1) then
					f20 := (BH+Spacing)*2;
			end
				else
			begin
				Rows := 5;
				If Fudge20 and (Months = 1) then
					f20 := BH+Spacing;
			end;

		if Months > 1 then
			Case MonthsAlign of
				1: mHeight := (BH*Rows)+(Spacing*(Rows-1))+SM+SD;
				2: begin  
					mHeight := (BH*Rows)+(Spacing*(Rows-1))+SM+SD;
					Mcsp := ((maxBW*7)-(BW*7)) div 2;
				end;
				3: begin
					mHeight := (BH*Rows)+(Spacing*(Rows-1))+SM+SD;
					Mcsp := (maxBW*7)-(BW*7);
				end;
      else
        mWidth := (BW*7)+(Spacing*6)+sw+swR;
			end;
                
    with fBMP.Canvas do
    begin
		  If ShowMonth then
      begin
        Brush.Color := MonthBGColor;
        Font := MonthFont;
        fText := UpcaseFirst(FormatDateTime(MonthFormat, Current));
        tw := TextWidth(fText);
        th := TextHeight(fText);
        If th > SM then
          SM := th;
        FillRect(Bounds(tWidth +Mcsp, tHeight +f20, (BW*7)+(Spacing*6)+sw+swR, SM));
        p2 := (SM -th -2) div 2 +1 +f20 +tHeight;
        if Alch then
        begin
          p1 := ((BW*7)+(Spacing*6) -tw) div 2 +Mcsp +tWidth; 
          TextOut(p1, p2, fText);
          If MonthFont.Size > 6 then
            Font.Size := MonthFont.Size -2
          else
            Font.Size := 5;
          Font.Style := [];
          TextOut(p1 +tw +4, p2, FormatDateTime('yyyy', Current));
        end
          else
        begin
          If mAlign = 'LEFT' then
            p1 := 1 +sw +Mcsp +tWidth
          else If mAlign = 'CENTER' then
            p1 := ((BW*7)+(Spacing*6) +sw +swR -tw) div 2 +Mcsp +tWidth
          else
            p1 := (BW*7)+(Spacing*6) -tw -1 +sw +Mcsp +tWidth;
          TextOut(p1, p2, fText);
        end;
      end;
      If ShowDays or (FMO and (ms = 0)) or (CMO and (MonthOf(Current) = MonthOf(Date))) then
      begin
        Brush.Color := WeekdayBGColor;
        FillRect(Bounds(tWidth+sw+Mcsp, tHeight+SM+f20, (BW*7)+(Spacing*6), SD));
        for i := 0 + WeekStarts to 6 + WeekStarts do  // Show Days
        begin
          Font := WeekdayFont;
          If (MonthOf(Current) = MonthOf(Date)) and (i mod 7 = DayOfWeek(Date) -1) then
            Font.Color := DayofWeekColor;
          fText := UpcaseFirst(Weekday(i mod 7, ShortDays));
          th := TextHeight(fText);
          If th >= SD then
            SD := th;
          p1 := ((BW - TextWidth(fText)) div 2) + BW * (i-WeekStarts) +sw + Spacing*i +Mcsp +tWidth;
          p2 := (SD - th) div 2 +SM +f20 +tHeight;
          TextOut(p1, p2, fText);
        end;
      end;
      If ShowWeeks then  //Week Background
      begin
        If wAlign = 'LEFT' then
          p1 := Mcsp +tWidth
        else
          p1 := (BW*7) +(Spacing*6) +Mcsp +tWidth;
        Brush.Color := WeekdayBGColor;
        FillRect(Bounds(p1, tHeight +SM +f20, wWidth, (BH*Rows) + (Spacing*(Rows-1)) +SD));
      end;
    end; //With

    For Row := 0 to Rows -1 do  // Week loop
      with fBMP.Canvas do
      begin
        If ShowWeeks then
        begin
          Font := WeekdayFont;
          If (MonthOf(Current) = MonthOf(Date)) and (Week = WeekNum) then
            Font.Color := DayofWeekColor;
          If (MonthOf(Current) = 1) and (Week > WeeksInYear(IncYear(Current, -1))) then
            week := 1
          else If (MonthOf(Current) = 12) and ( Week > WeeksInYear(Current) ) then
            week := week mod WeeksInYear(Current);
          fText := IntToStr(Week);
          tw := TextWidth(fText);
          If tw >= wWidth then
            wWidth := tw +2;
          If wAlign = 'LEFT' then
            p1 := (wWidth - tw) div 2 +Mcsp +tWidth
          else
            p1 := (wWidth - tw) div 2 +(BW*7) + (Spacing*6) +Mcsp +tWidth;
          p2 := ((BH - TextHeight(fText)) div 2) +(BH*Row) +SD +SM +f20 +(Spacing*Row) +tHeight;
          Brush.Style := bsClear;
          TextOut(p1, p2, fText);
        end;

			  For i := 0 to 6 do  // Day loop
        begin
          IsWeekend := CheckWeekend(i);
          Brush.Style := bsSolid;
          aRect := Bounds((i*BW) +sw + (Spacing*i) +Mcsp +tWidth, (Row*BH) +SD +SM +f20 + (Spacing*Row) +tHeight, BW, BH);
          If (DayNum > 0) and (DayNum <= DaysinMonth(Current)) then
          begin
            cDay := EncodeDate(YearOf(Current), MonthOf(Current), DayNum);
            IsHoliday := CheckHoliday(cDay);
            if IsHoliday or IsToday(cDay) then
            begin
              SetLength(HotSpot, Length(HotSpot) +1);
              HotSpot[High(HotSpot)].Rec := aRect;
              HotSpot[High(HotSpot)].Date := cDay;
            end;
            If IsToday(cDay) then
            begin
              Pen.Color := TodayEdgeColor;
              Font := TodayFont;
              If IsWeekend and (TodayBoxColor = BC) then
                Brush.Color := WBC
              else
                Brush.Color := TodayBoxColor;
              If IsHoliday then
                Font.Style := TodayFont.Style + HolidayFont.Style;
            end else begin
              If IsHoliday then
              begin
                If IsWeekend and (HEdgeColor = EdgeColor) then
                  Pen.Color := WeekendEdgeColor
                else
                  Pen.Color := HEdgeColor;
                If IsWeekend and (HBoxColor = BC) then
                  Brush.Color := WBC
                else
                  Brush.Color := HBoxColor;
                Font := HolidayFont;
              end else begin
                If IsWeekend then
                begin
                  Pen.Color := WeekendEdgeColor;
                  Brush.Color := WBC;
                  Font := WeekendFont;
                end else begin
                  Pen.Color := EdgeColor;
                  Brush.Color := BC;
                  Font := DefaultFont;
                end;
              end;
            end;
            If Not ShowBorders then
              Pen.Color := Brush.Color;
            RoundRect(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom, RC, RC);
            fText := IntToStr(DayNum);
            p1 := (BW - TextWidth(fText)) div 2 + aRect.Left;
            p2 := (BH - TextHeight(fText)) div 2 + aRect.Top;
            TextOut(p1, p2, fText);
          end
            else If ShowTD then
          begin
            Brush.Color := TDBoxColor;
            If ShowBorders then
              Pen.Color := TDEdgeColor
            else
              Pen.Color := TDBoxColor;
            Font := TDFont;
            RoundRect(aRect.Left, aRect.Top, aRect.Right, aRect.Bottom, RC, RC);
            If DayNum <= 0 then  // Days of Previous Month
            begin
              fText := IntToStr(DaysinMonth(IncMonth(Current, -1)) + DayNum);
              p1 := (BW - TextWidth(fText)) div 2 + aRect.Left;
              p2 := (BH - TextHeight(fText)) div 2 + aRect.Top;
              TextOut(p1, p2, fText);
            end else begin
              fText := IntToStr(DayNum - DaysinMonth(Current));
              p1 := (BW - TextWidth(fText)) div 2 + aRect.Left;
              p2 := (BH - TextHeight(fText)) div 2 + aRect.Top;
              TextOut(p1, p2, fText);
            end;
          end;
          Inc(DayNum);
        end;  // Day loop
			  Inc(Week);
		end;   // Week loop
		If (FMO and (ms = 0)) or (CMO and (MonthOf(Current) = MonthOf(Date))) then
			SD := 0;
		tWidth := tWidth + mWidth + Msp;
		tHeight := tHeight + mHeight + vMsp;
	end; // Month loop
End;

Function TCM2Calender.UpcaseFirst(Str: String): String;
begin        
	Result := '';
	if Str <> '' then
		Result := UpperCase(Str[1]) + Copy(Str, 2, Length(Str));
end;

function TCM2Calender.Weekday(j, size: Integer): String;
begin
	Result := 'E';
	Case Size of
		1: Case j of
        0: Result := ShortDayNames[1][1];
        1: Result := ShortDayNames[2][1];
        2: Result := ShortDayNames[3][1];
        3: Result := ShortDayNames[4][1];
        4: Result := ShortDayNames[5][1];
        5: Result := ShortDayNames[6][1];
        6: Result := ShortDayNames[7][1];
      end;
		2: Case j of
        0: Result := Copy(ShortDayNames[1], 1, 2);
        1: Result := Copy(ShortDayNames[2], 1, 2);
        2: Result := Copy(ShortDayNames[3], 1, 2);
        3: Result := Copy(ShortDayNames[4], 1, 2);
        4: Result := Copy(ShortDayNames[5], 1, 2);
        5: Result := Copy(ShortDayNames[6], 1, 2);
        6: Result := Copy(ShortDayNames[7], 1, 2);
      end;
		3: Case j of
        0: Result := ShortDayNames[1];
        1: Result := ShortDayNames[2];
        2: Result := ShortDayNames[3];
        3: Result := ShortDayNames[4];
        4: Result := ShortDayNames[5];
        5: Result := ShortDayNames[6];
        6: Result := ShortDayNames[7];
      end;
	end;
end;

procedure TCM2Calender.pICS; 
var
	i, j, Diff: Integer;
  Y, M, D: Word;
	Freq: String;
	ICS: TICS;
  function GetFreq(Str: String): String;
  var
    tmp: String;
  begin
    Result := '';
    tmp := GetFilt(Str, 1, ';');
    if GetFilt(tmp, 1, '=') = 'FREQ' then
      Result := GetFilt(tmp, 2, '=');
  end;
  function GetInterval(Str: String): Integer;
  var
    tmp: String;
  begin
    Result := 1;
    tmp := GetFilt(Str, 2, ';');
    if GetFilt(tmp, 1, '=') = 'INTERVAL' then
      Result := StrToInt(GetFilt(tmp, 2, '='));
  end;
  function GetDay(S: String): Integer;
  const
    arDay: Array[1..7] of String = ('MO', 'TU', 'WE', 'TH', 'FR', 'SA', 'SU');
  var
    i: integer;
  begin
    Result := 0;
    for i := 1 to 7 do
      if S = arDay[i] then
      begin
        Result := i;
        Exit;
      end;
  end;
  procedure BubbleSort;
  var
    tmp: THoliday;
    i: Integer;
    NoChange: Boolean;
  begin       
    if Length(Holiday) < 2 then
      Exit;
    Repeat
      NoChange := True;
      for i := 0 to Length(Holiday)-2 do
        if Holiday[i].sDate > Holiday[i+1].sDate then
        begin
          NoChange := False;
          tmp := Holiday[i];
          Holiday[i] := Holiday[i+1];
          Holiday[i+1] := tmp;
        end;
    Until NoChange;
  end;  
  procedure RepYear(i, j, M, D: Integer);
  begin
    SetLength(Holiday, Length(Holiday) +1);
    Holiday[High(Holiday)].sDate := EncodeDate(CurrentYear +j, M, D);
    Holiday[High(Holiday)].Title := ICS[i].Summary;
    Holiday[High(Holiday)].AllDayEvent := True;
  end;
  procedure RepMonth(i, j, M: Integer; S: String);
  var
    W, D: Word;
    tDate: TDateTime;
  begin
    SetLength(Holiday, Length(Holiday) +1);
    If S[1] = '-' then
    begin
      W := StrToInt(S[2]) -1;
      D := GetDay(Copy(S, 3, 2));
      tDate := EndOfAMonth(CurrentYear +j, M);
      tDate := IncDay(tDate, -7 * W);
      While DayOfTheWeek(tDate) <> D do
        tDate := IncDay(tDate, -1);
    end else begin
      W := StrToInt(S[1]) -1;
      D := GetDay(Copy(S, 2, 2));
      tDate := StartOfAMonth(CurrentYear +j, M);
      tDate := IncDay(tDate, 7 * W);
      While DayOfTheWeek(tDate) <> D do
        tDate := IncDay(tDate);
    end;
    Holiday[High(Holiday)].sDate := tDate;
    Holiday[High(Holiday)].Title := ICS[i].Summary;
    Holiday[High(Holiday)].AllDayEvent := True;
  end;      
  function GetDate(DateStr: String): TDateTime;
  begin
    Result := EncodeDate(StrToInt(Copy(DateStr, 1, 4)), StrToInt(Copy(DateStr, 5, 2)), StrToInt(Copy(DateStr, 7, 2)));
  end;
begin
	if MinuteSpan(Now, LastChecked) < 1 then
		Exit;

	LastChecked := Now;

	ICS := TICS.Create;
  try
    If Not ICS.LoadFromFile(HolidayICS) then
    begin
      FreeAndNil(ICS);
      Exit;
    end;

    SetLength(Holiday, 0);
    For i := 0 to ICS.Count -1 do
    begin
      Y := StrToInt(Copy(ICS[i].DTStart, 1, 4));
      M := StrToInt(Copy(ICS[i].DTStart, 5, 2));
      D := StrToInt(Copy(ICS[i].DTStart, 7, 2));

      if ICS[i].RRule = '' then
      begin
        If ICS[i].RecurDefaultUnits = 'years' then
          Freq := 'YEARLY'
        else
          Freq := '';
      end
      else
        Freq := GetFreq(ICS[i].RRule);

      If Freq = 'YEARLY' then
      begin
        Case GetInterval(ICS[i].RRule) of
          1:
            Case M of
              1..2:
                for j := 0 to 1 do
                  RepYear(i, j, M, D);
              11..12:
                for j := -1 to 0 do
                  RepYear(i, j, M, D);
            else
              RepYear(i, 0, M, D);
            end;
          4: for j := 0 to 5 do
            begin
              if Y + (j * 4) <> CurrentYear then
                Case M of
                  1..2:
                    if Y + (j * 4) <> CurrentYear + 1 then
                      Continue;
                  11..12:
                    if Y + (j * 4) <> CurrentYear - 1 then
                      Continue;
                else
                    Continue;
                end;
              SetLength(Holiday, Length(Holiday) +1);
              Holiday[High(Holiday)].sDate := EncodeDate(Y + (j * 4), M, D);
              Holiday[High(Holiday)].Title := ICS[i].Summary;
              Holiday[High(Holiday)].AllDayEvent := True;
            end;
        end;
      end
        else if Freq = 'MONTHLY' then
      begin
        Case M of
          1..2:
          for j := 0 to 1 do
            RepMonth(i, j, M, GetFilt(ICS[i].RRule, 4, '='));
          11..12:
          for j := -1 to 0 do
            RepMonth(i, j, M, GetFilt(ICS[i].RRule, 4, '='));
        else
          RepMonth(i, 0, M, GetFilt(ICS[i].RRule, 4, '='));
        end;
      end
        else
      begin    
        if Y <> CurrentYear then
          Case M of
            1..2:
              if Y <> CurrentYear + 1 then
                Continue;
            11..12:
              if Y <> CurrentYear - 1 then
                Continue;
          else
            Continue;
          end;

        Diff := 0;
        if (ICS[i].DTEnd <> '') and (ICS[i].DTEnd[1] <> '-') then
          if (StrToInt(Copy(ICS[i].DTEnd,7,2)) <> D + 1) and (StrToInt(Copy(ICS[i].DTEnd,7,2)) <> D) then
          try
            Diff := DaysBetween(EncodeDate(Y, M, D), GetDate(ICS[i].DTEnd)) -1;
          except
            Diff := 0;
          end;

        for j := 0 to Diff do
        begin
          SetLength(Holiday, Length(Holiday) +1);
          Holiday[High(Holiday)].sDate := IncDay(EncodeDate(Y, M, D), j);
          Holiday[High(Holiday)].Title := ICS[i].Summary;
          Holiday[High(Holiday)].AllDayEvent := True;
        end;
      end;
    end;

    BubbleSort;
  finally
	  FreeAndNil(ICS);
  end;
end;

Procedure TCM2Calender.pOutlook;
const
  FileName = 'Calender.txt';
var
	Ol: TOutlookApplication;
	NmSpace: NameSpace;
	Calendar: MAPIFolder;
	Items: _Items;
	Appt: AppointmentItem;
	sFilter, sDate, eDate, Profile, Pass: String;
	txt: TextFile;
Begin
	if MinuteSpan(Now, LastChecked) < 1 then
		Exit;

	LastChecked := Now;
	If Months > 1 then
	begin
		sDate := FormatDateTime('ddddd h:mm ampm', StartOfAMonth(CurrentYear-1, 11));
		eDate := FormatDateTime('ddddd h:mm ampm', EndOfAMonth(CurrentYear+1, 2));
	end else begin
		sDate := FormatDateTime('ddddd h:mm ampm', StartOfTheMonth(Date));
		eDate := FormatDateTime('ddddd h:mm ampm', EndOfTheMonth(Date));
	end;

	try
		Ol := TOutlookApplication.Create(Nil);
		Ol.Connect;
		NmSpace := Ol.GetNamespace('MAPI');

    Profile := '';
    Pass := '';
		If FileExists(FileName) then
		try
			AssignFile(txt, FileName);
			Reset(txt);
      ReadLn(txt, Profile);
      ReadLn(txt, Pass);
    finally
      CloseFile(txt);
    end;

		NmSpace.Logon(Profile, Pass, False, False);
		Calendar := NmSpace.GetDefaultFolder(olFolderCalendar);
		fStoreID := Calendar.StoreID;

		Items := Calendar.Items;
		Items.Sort('[Start]', False);
		Items.IncludeRecurrences := True;
		sFilter := '([Start] > "' + sDate + '") And ([Start] < "' + eDate + '")';
		Items := Items.Restrict(sFilter);

    SetLength(Holiday, 0);
		Appt := Items.GetFirst as _AppointmentItem;
		while Appt <> Nil do
		begin
			SetLength(Holiday, Length(Holiday) +1);
      with Holiday[High(Holiday)] do
      begin
        EntryID := Appt.EntryID;
        Title := Appt.Subject;
        Location := Appt.Location;
        AllDayEvent := Appt.AllDayEvent;
        ReminderSet := Appt.ReminderSet;
        MinsBefore := Appt.ReminderMinutesBeforeStart;
        sDate := Appt.Start;
        eDate := Appt.End_;
        Wav := Appt.ReminderSoundFile;
      end;
			Appt := Items.GetNext as _AppointmentItem;
		end;
	finally
		Items := Nil;
		NmSpace.Logoff;
		Ol.Disconnect;
		FreeAndNil(Ol);
	end;

	if Reminders then
		pReminder;
End;

procedure TCM2Calender.pReminder;
var
	i: Integer;
	rTime: TDateTime;
begin
	for i := 0 to Length(Holiday)-1 do
		If Holiday[i].ReminderSet and (IsToday(Holiday[i].sDate) or IsToday(IncDay(Holiday[i].sDate, -1))) then
		begin
			rTime := IncMinute(Holiday[i].sDate, - Holiday[i].MinsBefore);
			if CompareDateTime(Now, rTime) < 0 then
			begin
				If Assigned(Timer) then
					Exit;

				With aReminder do
				begin
					EntryID := Holiday[i].EntryID;
					TimeTill := Holiday[i].MinsBefore;
					Wav := Holiday[i].Wav;
					Time := rTime;
					Text := FormatDateTime('h:mma/p', Holiday[i].sDate)+' - '+FormatDateTime('h:mma/p', Holiday[i].eDate)+' '+Holiday[i].Title;
					If Holiday[i].Location <> '' then
						Text := Text + ' (' + Holiday[i].Location + ')';
				end;
                                     
				Timer := TTimer.Create(Nil);
				Timer.Interval := 60 * 1000;
				Timer.OnTimer := OnTimer;
				Timer.Enabled := True;
			end;  
      Break;
		end;
end;

procedure TCM2Calender.OnTimer(Sender: TObject);
var
	Reminder: TPopup;
begin
	If IsToday(aReminder.Time) and (HourOf(Now) = HourOf(aReminder.Time))
		and (MinuteOF(Now) = MinuteOf(aReminder.Time)) then
	begin
		FreeAndNil(Timer);

		Reminder := TPopup.Create(Nil);
		with Reminder do
		try
			IsReminder := True;
			StoreID := fStoreID;
			EntryID := aReminder.EntryID;
      Title := aReminder.Text;
			TimeTill := aReminder.TimeTill;
			Wav := aReminder.Wav;
			Execute;
		finally
		  FreeAndNil(Reminder);
    end;

		aReminder.Time := 0;
		pReminder;
	end;
end;

Function TCM2Calender.OnEvent(Sender: PChar; EventType: Byte; ModKeys: Byte; X, Y: Integer; OUT CallBack: PChar): HResult;
var
	i, j: Integer;
	sTitle, str: String;
	sAppt: TStrings;
	ToolTip: TPopup;
begin
	Result := S_OK;
	if Not ToolTips then
		Exit;

	Case EventType of
		et_MouseDownLeft: begin
			for i := 0 to Length(HotSpot) -1 do
				if PtInRect(HotSpot[i].Rec, Point(X,Y)) then
				try
					If IsToday(HotSpot[i].Date) then
						sTitle := '[Today] ';
					str := UpcaseFirst(FormatDateTime('dddd | ', HotSpot[i].Date));
          sTitle := sTitle + str;
					str := UpcaseFirst(FormatDateTime('mmmm ', HotSpot[i].Date));
					sTitle := sTitle + str + FormatDateTime('d, yyyy', HotSpot[i].Date);
                             
          sAppt := TStringList.Create;
					for j := 0 to Length(Holiday)-1 do
					begin
						If IsSameDay(HotSpot[i].Date, Holiday[j].sDate) then
							If Holiday[j].AllDayEvent then
								sTitle := sTitle + ' - ' + Holiday[j].Title
              else
							begin
								str := FormatDateTime('h:mma/p', Holiday[j].sDate) + ' - ';
								str := str + FormatDateTime('h:mma/p', Holiday[j].eDate) + ' ' +  Holiday[j].Title;
								If Holiday[j].Location <> '' then
									str := str + ' (' + Holiday[j].Location + ')';
								sAppt.Add(str);
							end;
						If Holiday[j].sDate > HotSpot[i].Date then
							Break;
					end;

					ToolTip := TPopup.Create(Nil);
          with ToolTip do
          try
            Title := sTitle;
            Appt := sAppt;
            Execute;
					finally   
            FreeAndNil(sAppt);
						FreeAndNil(ToolTip);
					end;
          Break;
        except
          FreeAndNil(sAppt);
				end;  // if PtInRect(HotSpot[i].Rec, Point(X,Y))
		end;
		(*et_MouseUpRight: begin
			for i := 0 to Length(HotSpot) -1 do
      begin
				if PtInRect( HotSpot[i].Rec, Point(X,Y) ) then
				begin
					Appt := Calendar.Items.Add(olAppointmentItem);
					If Not IsToday(HotSpot[i].Date) then
						Appt.Start := HotSpot[i].Date;
					Appt.Display;
					break;
				end;
			end;
		end; *)
  else
    Result := E_FAIL;
    LastErrMsg := 'OnEvent EventType Out of Bounds';
	end;
end;

Function TCM2Calender.NotIfyOnEvent(OUT EventList: Cardinal): HResult;
begin
	Result := S_OK;
	EventList := noeMouseDownLeft; {+ noeMouseUpRight;}
end;

Function TCM2Calender.SetDC(const NewDC: THandle): HResult;
begin
	DrawHandle := NewDC;
	Result := S_OK;
End;

Function TCM2Calender.SetDimensions(Left, Top, Width, Height: Integer): HResult;
begin
	fLeft := Left;
	fTop := Top;
	fHeight := Height;
	fWidth := Width;
	Result := S_OK;
end;

Function TCM2Calender.Setup: HResult;
var
	Setup: TSetup;
begin
	Result := S_OK;
	try                
		Setup := TSetup.Create(nil);
		Setup.Execute;
	finally
		FreeAndNil(Setup);
	end;
end;

Function TCM2Calender.Terminating: HResult;
begin
	Result := S_OK;
  fBMP.Free;
  DefaultFont.Free;
  TodayFont.Free;
  WeekdayFont.Free;
  WeekendFont.Free;
  TDFont.Free;
  MonthFont.Free;
  HolidayFont.Free;
end;      

Function TCM2Calender.GetLastErrorMsg(out Msg: PChar): HResult;
begin          
	Result := S_OK;
	If LastErrMsg = '' then
		LastErrMsg := 'No Error Reported';

	Msg := PChar(LastErrMsg);
end;

Function TCM2Calender.Update(SensorStyle: Byte; NewString: PChar; NewValue: Double): HResult;
begin
	Result := S_OK;
	If ShowHolidays then
		if HolidayType = 'OUTLOOK' then
			pOutlook
		else if HolidayType = 'ICS' then
			pICS;
end;

Function TCM2Calender.GetDefault(Index: Integer; out Name, Value, Description: PChar): HResult;
begin
	Result := S_OK;
	Case Index of
		0: begin Name := 'BoxColor'; Value := '$8080FF'; Description := 'The Day Box Color'; end;
		1: begin Name := 'WeekendBoxColor'; Value := '$0080C0'; Description := 'Different Box Color for the Weekends'; end;
		2: begin Name := 'TodayBoxColor'; Value := '$FF8000'; Description := 'Color of the Today Box'; end;
		3: begin Name := 'Font'; Value := 'Arial,8,0000'; Description := 'The Default Font'; end;
		4: begin Name := 'FontColor'; Value := 'White'; Description := 'Text Color'; end;
		5: begin Name := 'EdgeColor'; Value := 'Navy'; Description := 'The Color of the Box Edges'; end;
		6: begin Name := 'Background'; Value := 'Silver'; Description := 'Background Color'; end;
		7: begin Name := 'BoxWidth'; Value := '20'; Description := 'The Width of the Boxes'; end;
		8: begin Name := 'BoxHeight'; Value := '20'; Description := 'The Height of the Boxes'; end;
		9: begin Name := 'RoundCorners'; Value := '0'; Description := 'Round the Corners of the Boxes'; end;
  else
    Result := E_FAIL;
    LastErrMsg := 'Default Index Out of Bounds';
	end;
End;

Function TCM2Calender.GetDefaultCount(out DefaultCount: Integer): HResult;
begin
	DefaultCount := 10;
	result := S_OK;
end;

Function TCM2Calender.GetOptional(Index: Integer; out Name, Value, Description: PChar): HResult;
begin
	Result := S_OK;
	Case Index of
		0: begin Name := 'Spacing'; Value := '0'; Description := 'Spacing of the Boxes'; end;
		1: begin Name := 'ShowBorders'; Value := 'True'; Description := 'Show Borders on Day Boxes'; end;
		2: begin Name := 'TodayEdgeColor'; Value := 'Black'; Description := 'Edge Color in the Today Box'; end;
		3: begin Name := 'TodayFont'; Value := 'Arial,8,0000'; Description := 'Font used in the Current Day'; end;
		4: begin Name := 'TodayFontColor'; Value := 'White'; Description := 'Font Color in the Current Day'; end;
		5: begin Name := 'WeekendEdgeColor'; Value := 'Black'; Description := 'Edge Color for the Weekends'; end;
		6: begin Name := 'WeekendFont'; Value := 'Arial,8,0000'; Description := 'Weekend Font'; end;
		7: begin Name := 'WeekendFontColor'; Value := 'White'; Description := 'Weekend Font Color'; end;
		8: begin Name := 'HBoxColor'; Value := '$FF8000'; Description := 'Holiday Box Color'; end;
		9: begin Name := 'HEdgeColor'; Value := 'Black'; Description := 'Edge Color for the Holidays'; end;
		10: begin Name := 'HolidayFont'; Value := 'Arial,8,0010'; Description := 'Holiday Font'; end;
		11: begin Name := 'HolidayFontColor'; Value := 'White'; Description := 'Holiday Font Color'; end;
		12: begin Name := 'ShowMonth'; Value := 'Center'; Description := 'Show Month on Top'; end;
		13: begin Name := 'MonthFormat'; Value := 'mmmm yyyy'; Description := 'Format to Display the Month'; end;
		14: begin Name := 'MonthBGColor'; Value := 'Silver'; Description := 'Background Color of Month Text'; end;
		15: begin Name := 'MonthFont'; Value := 'Arial,8,0000'; Description := 'Month Font'; end;
		16: begin Name := 'MonthFontColor'; Value := 'White'; Description := 'Month Font Color'; end;
		17: begin Name := 'ShowWeeks'; Value := 'Left'; Description := 'Show the Weeks of the Year'; end;
		18: begin Name := 'ShowDays'; Value := 'True'; Description := 'Show Days of the Week'; end;
		19: begin Name := 'ShortDays'; Value := '2'; Description := 'Number of Letters Representing each Day'; end;
		20: begin Name := 'WeekStarts'; Value := 'Sunday';Description := 'First Day of the Week'; end;
		21: begin Name := 'WeekdayFont'; Value := 'Arial,8,0000'; Description := 'Weekday Font'; end;
		22: begin Name := 'WeekdayFontColor'; Value := 'White'; Description := 'Weekday Font Color'; end;
		23: begin Name := 'DayofWeekColor'; Value := 'Blue'; Description := 'Font Color of the Day of Week'; end;
		24: begin Name := 'WeekdayBGColor'; Value := '$8080FF'; Description := 'The Weekday Background Color'; end;
		25: begin Name := 'ShowTrailingDays'; Value := 'False'; Description := 'Show the Days from Other Months'; end;
		26: begin Name := 'TDFont'; Value := 'Arial,7,0000'; Description := 'Font for the Other Months'; end;
		27: begin Name := 'TDFontColor'; Value := 'White'; Description := 'Font Color of the Other Months'; end;
		28: begin Name := 'TDBoxColor'; Value := '$8080FF'; Description := 'Box Color for the Other Months'; end;
		29: begin Name := 'TDEdgeColor'; Value := 'Black'; Description := 'Edge Color for the Other Months'; end;
		30: begin Name := 'Months'; Value := '1'; Description := 'Number of Months to Display'; end;
		31: begin Name := 'MonthsAlign'; Value := 'Horizontal';Description := 'Alignment of the Months'; end;
		32: begin Name := 'MonthSpacing'; Value := '5'; Description := 'Spacing Between Months'; end;
		33: begin Name := 'StartMonth'; Value := '0'; Description := 'Month to Start Drawing'; end;
		34: begin Name := 'PMBoxWidth'; Value := '18'; Description := 'BoxWidth of Months before Current'; end;
		35: begin Name := 'PMBoxHeight'; Value := '18'; Description := 'BoxHeight of Months before Current'; end;
		36: begin Name := 'PMBoxColor'; Value := '$8080FF'; Description := 'Box Color for the Other Months'; end;
		37: begin Name := 'PMWeekendBoxColor'; Value := '$8080FF'; Description := 'Box Color for the Other Months'; end;
		38: begin Name := 'FMBoxWidth'; Value := '18'; Description := 'BoxWidth of Months after Current'; end;
		39: begin Name := 'FMBoxHeight'; Value := '18'; Description := 'BoxHeight of Months after Current'; end;
		40: begin Name := 'FMBoxColor'; Value := '$8080FF'; Description := 'Box Color for the Other Months'; end;
		41: begin Name := 'FMWeekendBoxColor'; Value := '$8080FF'; Description := 'Box Color for the Other Months'; end;
		42: begin Name := 'FixedRows'; Value := 'False'; Description := 'Always Show 6 Rows'; end;
		43: begin Name := 'Fudge20'; Value := 'False'; Description := 'Add BoxHeight to keep Bottom of Calender Stationary'; end;
		44: begin Name := 'Visible'; Value := 'True'; Description := 'Show/Hide the Calender'; end;
  else
    Result := E_FAIL;
    LastErrMsg := 'Optional Index Out of Bounds';
	end;
End;

Function TCM2Calender.GetOptionalCount(out OptionalCount: Integer): HResult;
begin
	Result := S_OK;
	OptionalCount := 45;
End;

Function TCM2Calender.Init(PaintDC: THandle): HResult;
begin            
	Result := S_OK;
	DrawHandle := PaintDC;
	try
		fBMP := TBitmap.Create;
		DefaultFont := TFont.Create;
		TodayFont := TFont.Create;
		WeekdayFont := TFont.Create;
		WeekendFont := TFont.Create;
		TDFont := TFont.Create;
		MonthFont := TFont.Create;
		HolidayFont := TFont.Create;
	except
		Result := E_FAIL;
		LastErrMsg := 'Error in Init Function';
		Exit;
	end;
	DefaultFont.Color := clWhite;
	TodayFont.Color := clWhite;
	WeekendFont.Color := clWhite;
	WeekdayFont.Color := clWhite;
	TDFont.Color := clWhite;
	MonthFont.Color := clWhite;
	HolidayFont.Color := clWhite;
	HolidayFont.Style := [fsUnderline];
	Visible := True;
	ShowMonth := True;
	ShowDays := True;
	ShowBorders := True;
	ShowWeeks := True;
	BoxColor := StringToColor('$00FF8080');
	EdgeColor := clNavy;
	WeekendEdgeColor := clBlack;
	Background := clSilver;
	BoxWidth := 20;
	BoxHeight := 20;
	RC := 0;
	Spacing := 0;
	TodayBoxColor := StringToColor('$0000FF80');
	TodayEdgeColor := clBlack;
	DayofWeekColor := clBlue;
	WeekendBoxColor := StringToColor('$00C08000');
	WeekdayBGColor := StringToColor('$00FF8080');
	TDBoxColor := StringToColor('$00FF8080');
	TDEdgeColor := StringToColor('$00FF8080');
	HBoxColor := StringToColor('$000080FF');
	HEdgeColor := clBlack;
	MonthBGColor := clSilver;
	mAlign := 'CENTER';
	MonthFormat := 'mmmm yyyy';
	ShortDays := 2;
	Months := 1;
	MonthsAlign := 0;
	MonthSpacing := 5;
	PMBoxWidth := 18;
	PMBoxHeight := 18;
	PMBoxColor := StringToColor('$00FF8080');
	PMWeekendBoxColor := StringToColor('$00C08000');
	FMBoxWidth := 18;
	FMBoxHeight := 18;
	FMBoxColor := StringToColor('$00FF8080');
	FMWeekendBoxColor := StringToColor('$00C08000');
	wAlign := 'LEFT';
	WeekStarts := 0;
End;  

procedure TCM2Calender.LoadReg;
var
	Reg: TRegistry;
begin
	ShowHolidays := False;

	Reg := TRegistry.Create;
  with Reg do
	try
    if OpenKey(RegPath, False) then
		try
      if UpperCase(ReadString('ShowHolidays')) = 'TRUE' then
      begin
        ShowHolidays := True;
        HolidayType := UpperCase(ReadString('HolidayType'));
        HolidayICS := ReadString('HolidayICS');
      end;

      if UpperCase(ReadString('ToolTips')) = 'TRUE' then
        ToolTips := True
      else
        ToolTips := False;

      if UpperCase(ReadString('Reminders')) = 'TRUE' then
        Reminders := True
      else
        Reminders := False;
    finally
      CloseKey;
		end;
	finally
		Reg.Free;
	end;
end;

Function TCM2Calender.SetConfigString(NewConfigString: PChar): HResult;
var
	i: Integer;
	S, N, V : String;
begin
	Result := S_OK;
	if Not FirstRun then
	begin
		FirstRun := True;
		LoadReg;
	end;

	for i := 1 to CountFilt(NewConfigString, '|') do
	begin
		S := UpperCase(GetFilt(NewConfigString, i, '|'));
		N := GetFilt(S, 1, '=');
		V := GetFilt(S, 2, '=');
		if (N = '') or (V = '') then
			Continue;
                     
		If N = 'BACKGROUND' then
		begin
			Try
				Background := StringToTColor(V);
				WeekdayBGColor := Background;
				TDBoxColor := Background;
				TDEdgeColor := Background;
				MonthBGColor := Background;
			except
				Background := clSilver;
			end;
			Continue;
		end;
		If N = 'BOXWIDTH' then
		begin
			Try
				BoxWidth := StrToInt(V);
			except
				BoxWidth := 20;
			end;
			Continue;
		end;
		If N = 'BOXHEIGHT' then
		begin
			Try
				BoxHeight := StrToInt(V);
			Except
				BoxHeight := 20;
			end;
			Continue;
		end;
		If N = 'ROUNDCORNERS' then
		begin
			Try
				RC := StrToInt(V) mod 26;
			Except
				RC := 0;
			end;
			Continue;
		end;
		If N = 'SPACING' Then
		begin
			try
				Spacing := StrToInt(V) mod 26;
			except
				Spacing := 0;
			end;
			Continue;
		end;
		If N = 'BOXCOLOR' then
		begin
			Try
				BoxColor := StringToTColor(V);
				HBoxColor := BoxColor;
			except
				BoxColor := StringToColor('$00FF8080');
			end;
			Continue;
		end;
		If N = 'EDGECOLOR' then
		begin
			Try
				EdgeColor := StringToTColor(V);
				TodayEdgeColor := EdgeColor;
				HEdgeColor := EdgeColor;
			except
				EdgeColor := clNavy;
			end;
			Continue;
		end;
		If N = 'FONT' Then
		begin
			SetFont(V, DefaultFont);
			Continue;
		end;
		If N = 'FONTCOLOR' then
		begin
			Try
				DefaultFont.Color := StringToTColor(V);
			except
				DefaultFont.Color := clWhite;
			end;
			Continue;
		end;
		If N = 'WEEKENDBOXCOLOR' then
		begin
			Try
				WeekendBoxColor := StringToTColor(V);
			except
				WeekendBoxColor := StringToColor('$00C08000');
			end;
			Continue;
		end;
		If N = 'WEEKENDEDGECOLOR' then
		begin
			Try
				WeekendEdgeColor := StringToTColor(V);
			except
				WeekendEdgeColor := EdgeColor;
			end;
			Continue;
		end;
		If N = 'WEEKENDFONT' Then
		begin
			SetFont(V, WeekendFont);
			Continue;
		end;
		If N = 'WEEKENDFONTCOLOR' then
		begin
			Try
				WeekendFont.Color := StringToTColor(V);
			except
				WeekendFont.Color := clWhite;
			end;
			Continue;
		end;
		If N = 'TODAYBOXCOLOR' then
		begin
			Try
				TodayBoxColor := StringToTColor(V);
			except
				TodayBoxColor := StringToColor('$000080FF');
			end;
			Continue;
		end;
		If N = 'TODAYEDGECOLOR' then
		begin
			Try
				TodayEdgeColor := StringToTColor(V);
			except
				TodayEdgeColor := EdgeColor;
			end;
			Continue;
		end;
		If N = 'TODAYFONT' Then
		begin
			SetFont(V, TodayFont);
			Continue;
		end;
		If N = 'TODAYFONTCOLOR' then
		begin
			Try
				TodayFont.Color := StringToTColor(V);
			except
				TodayFont.Color := clWhite;
			end;  
			Continue;
		end;
		If N = 'WEEKDAYBGCOLOR' then
		begin
			Try
				WeekdayBGColor := StringToTColor(V);
			except
				WeekdayBGColor := StringToColor('$00FF8080');
			end;
			Continue;
		end;
		If N = 'WEEKDAYFONT' Then
		begin
			SetFont(V, WeekdayFont);
			Continue;
		end;
		If N = 'WEEKDAYFONTCOLOR' then
		begin
			Try
				WeekdayFont.Color := StringToTColor(V);
			except
				WeekdayFont.Color := clWhite;
			end;
			Continue;
		end;
		If N = 'DAYOFWEEKCOLOR' then
		begin
			Try
				DayofWeekColor := StringToTColor(V);
			except
				DayofWeekColor := clBlue;
			end;
			Continue;
		end;
		If N = 'TDBOXCOLOR' then
		begin
			Try
				TDBoxColor := StringToTColor(V);
			except
				TDBoxColor := Background;
			end;
			Continue;
		end;
		If N = 'TDEDGECOLOR' then
		begin
			Try
				TDEdgeColor := StringToTColor(V);
			except
				TDEdgeColor := EdgeColor;
			end;
			Continue;
		end;
		If N = 'TDFONT' Then
		begin
			SetFont(V, TDFont);
			Continue;
		end;
		If N = 'TDFONTCOLOR' then
		begin
			Try
				TDFont.Color := StringToTColor(V);
			except
				TDFont.Color := clWhite;
			end;  
			Continue;
		end;
		If N = 'MONTHBGCOLOR' then
		begin
			Try
				MonthBGColor := StringToTColor(V);
			except
				MonthBGColor := Background;
			end;
			Continue;
		end;
		If N = 'MONTHFONT' Then
		begin
			SetFont(V, MonthFont);
			Continue;
		end;
		If (N = 'MONTHFONTCOLOR') or (N = 'MFONTCOLOR') then
		begin
			Try
				MonthFont.Color := StringToTColor(V);
			except
				MonthFont.Color := clWhite;
			end;
			Continue;
		end;
		If N = 'HBOXCOLOR' then
		begin
			Try
				HBoxColor := StringToTColor(V);
			except
				HBoxColor := BoxColor;
			end;   
			Continue;
		end;
		If N = 'HEDGECOLOR' then
		begin
			Try
				HEdgeColor := StringToTColor(V);
			except
				HEdgeColor := EdgeColor;
			end;  
			Continue;
		end;
		If N = 'HOLIDAYFONT' Then
		begin
			SetFont(V, HolidayFont);
			Continue;
		end;
		If (N = 'HOLIDAYFONTCOLOR') or (N = 'HFONTCOLOR') then
		begin
			Try
				HolidayFont.Color := StringToTColor(V);
			except
				HolidayFont.Color := clWhite;
			end;
			Continue;
		end;
		If N = 'SHOWDAYS' Then
		begin           
      ShowDays := False;
      CMO := False;
      FMO := False;
			If (V = 'YES') or (V = 'TRUE') then
				ShowDays := True
			else
			begin
				If (V = 'FMO') then
					FMO := True;
				If (V = 'CMO') then
					CMO := True;
			end; 
			Continue;
		end;
		If N = 'SHOWMONTH' Then
		begin
			If (V = 'LEFT') or (V = 'CENTER') or (V = 'RIGHT') then
			begin
				ShowMonth := True;
				mAlign := V;
			end
				else
					ShowMonth := False;
			Continue;
		end;
		If N = 'MONTHFORMAT' Then
		begin
      Alch := False;
			If V = 'ALCH' then
			begin
				MonthFormat := 'mmmm';
				Alch := True;
			end
				else
				  MonthFormat := V;
			Continue;
		end;
		If N = 'SHOWTRAILINGDAYS' Then
		begin
			If (V = 'YES') or (V = 'TRUE') then
				ShowTD := True
			else
				ShowTD := False;
			Continue;
		end;
		If N = 'SHORTDAYS' Then
		begin
			try
				ShortDays := StrToInt(V);
				if (ShortDays < 1) or (ShortDays > 4) then
					ShortDays := 2;
			except
				ShortDays := 2;
			end;
			Continue;
		end;
		If N = 'MONTHS' Then
		begin
			try
				Months := StrToInt(v);
				if (Months < 1) or (Months > 6) then
					Months := 1;
			except
				Months := 1;
			end;
			Continue;
		end;
		If N = 'MONTHSALIGN' then
		begin
			If (V = 'VERTICALLEFT') or (V = 'LEFT') then
				MonthsAlign := 1
			else if (V = 'VERTICALCENTER') or (V = 'CENTER') then
				MonthsAlign := 2
			else if (V = 'VERTICALRIGHT') or (V = 'RIGHT') then
				MonthsAlign := 3
			else
				MonthsAlign := 0;
			Continue;
		end;
		If N = 'STARTMONTH' then
		begin
			If V = '0' then
				StartMonth := False
			else
			begin
				StartMonth := True;
				try
					MonthtoStart := StrToInt(V);
					if (MonthToStart < -3) or (MonthToStart > 12) then
						MonthToStart := 0;
				except
					MonthToStart := 0;
					StartMonth := False;
				end;
			end;
			Continue;
		end;
		If N = 'MONTHSPACING' Then
		begin
			try
				MonthSpacing := StrToInt(V) mod 51;
			except
				MonthSpacing := 5;
			end;
			Continue;
		end;
		If N = 'PMBOXWIDTH' then
		begin
			Try
				PMBoxWidth := StrToInt(V);
			except
				PMBoxWidth := 18;
			end; 
			Continue;
		end;
		If N = 'PMBOXHEIGHT' then
		begin
			Try
				PMBoxHeight := StrToInt(V);
			Except
				PMBoxHeight := 18;
			end;
			Continue;
		end;
		If N = 'PMBOXCOLOR' then
		begin
			Try
				PMBoxcolor := StringToTColor(V);
			except
				PMBoxColor := StringToTColor('$8080FF');
			end;
			Continue;
		end;
		If N = 'PMWEEKENDBOXCOLOR' then
		begin
			Try
				PMWeekendBoxColor := StringToTColor(V);
			except
				PMWeekendBoxColor := StringToTColor('$0080C0');
			end; 
			Continue;
		end;
		If N = 'FMBOXWIDTH' then
		begin
			Try
				FMBoxWidth := StrToInt(V);
			except
				FMBoxWidth := 18;
			end; 
			Continue;
		end;
		If N = 'FMBOXHEIGHT' then
		begin
			Try
				FMBoxHeight := StrToInt(V);
			Except
				FMBoxHeight := 18;
			end; 
			Continue;
		end;
		If N = 'FMBOXCOLOR' then
		begin
			Try
				FMBoxcolor := StringToTColor(V);
			except
				FMBoxColor := StringToColor('$00FF8080');
			end; 
			Continue;
		end;
		If N = 'FMWEEKENDBOXCOLOR' then
		begin
			Try
				FMWeekendBoxColor := StringToTColor(V);
			except
				FMWeekendBoxColor := StringToColor('$00C08000');
			end;
			Continue;
		end;
		If (N = 'SHOWBORDERS') or (N = 'BORDERS') or (N = 'EDGES') or (N = 'SHOWEDGES') Then
		begin
			If (V = 'YES') or (V = 'TRUE') then
				ShowBorders := True
			else
				ShowBorders := False;
			Continue;
		end;
		If (N = 'SHOWWEEKS') Then
		begin
      ShowWeeks := False;
			If (V = 'LEFT') or (V = 'RIGHT') or (V = 'YES') or (V = 'TRUE') then
			begin
				ShowWeeks := True;
				If V = 'RIGHT' then
					wAlign := V
				else
					wAlign := 'LEFT';
			end;
			Continue;
		end;
		If (N = 'FUDGE20') Then
		begin
			If (V = 'YES') or (V = 'TRUE') then
				Fudge20 := True
			else
				Fudge20 := False;
			Continue;
		end;
		If N = 'VISIBLE' Then
		begin
			If (V = 'YES') or (V = 'TRUE') then
				Visible := True
			else
				Visible := False;
			Continue;
		end;
		If (N = 'FIXEDROWS') or (N = 'FIXED') then
		begin
			If (V = 'YES') or (V = 'TRUE') Then
				FixedRows := True
			else
				FixedRows := False;
			Continue;
		end;
		If N = 'WEEKSTARTS' then
		begin
			If (V = 'SUNDAY') or (V = 'S') then
				WeekStarts := 0;
			If (V = 'MONDAY') or (V = 'M') then
				WeekStarts := 1;
			Continue;
		end;
	end;
end;

Function TCM2Calender.ObjIns(ParameterName: PChar; out ValueType: Byte; out ValueRange: PChar): HResult;
var
	N : string;
begin
	Result := S_OK;
	N := UpperCase(ParameterName);
	ValueType := vtUnknown;
	ValueRange := '';
	If N = 'FONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;    
	If N = 'FONTCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TODAYFONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;       
	If N = 'TODAYFONTCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'WEEKDAYFONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;    
	If N = 'WEEKDAYFONTCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'DAYOFWEEKCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'WEEKENDFONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;    
	If N = 'WEEKENDFONTCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TDFONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;         
	If N = 'TDFONTCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'HOLIDAYFONT'Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;
	If (N = 'HOLIDAYFONTCOLOR') or (N = 'HFONTCOLOR') then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'MONTHFONT' Then
	begin
		ValueType := vtFontEx;
		Exit;
	End;
	If (N = 'MONTHFONTCOLOR') or (N = 'MFONTCOLOR') then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'BACKGROUND' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'BOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'WEEKENDBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'PMBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'PMWEEKENDBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'FMBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'FMWEEKENDBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'WEEKDAYBGCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TODAYBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TDBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'EDGECOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TODAYEDGECOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'WEEKENDEDGECOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'TDEDGECOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;         
	If N = 'MONTHBGCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'HBOXCOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'HEDGECOLOR' then
	begin
		ValueType := vtColor;
		Exit;
	End;
	If N = 'MONTHS' Then
	begin
		ValueType := vtRange;
		ValueRange := '1|6';
		Exit;
	End;
	If N = 'STARTMONTH' Then
	begin
		ValueType := vtRange;
		ValueRange := '-3|12';
		Exit;
	End;
	If N = 'SHOWDAYS' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'True|FMO|CMO|False';
		Exit;
	End;
	If N = 'SHOWTRAILINGDAYS' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'True|False';
		Exit;
	End;
	If N = 'SHOWMONTH' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'Left|Center|Right|False';
		Exit;
	End;
	If N = 'MONTHFORMAT' Then
	begin
		ValueType := vtFixed;
		ValueRange := 'mmmm yyyy|mmmm|mmm yyyy|Alch';
		Exit;
	End;
	If N = 'SHORTDAYS' Then
	begin
		ValueType := vtFixed;
		ValueRange := '1|2|3';
		Exit;
	End;
	If N = 'MONTHSALIGN' Then
	begin
		ValueType := vtFixed;
		ValueRange := 'Horizontal|VerticalLeft|VerticalCenter|VerticalRight';
		Exit;
	End;
	If (N = 'SHOWBORDERS') or (N = 'BORDERS') or (N = 'EDGES') or (N = 'SHOWEDGES') Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'True|False';
		Exit;
	End;
	If N = 'SHOWWEEKS' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'Left|Right|False';
		Exit;
	End;
	If N = 'FUDGE20' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'True|False';
		Exit;
	End;
	If N = 'VISIBLE' Then
	Begin
		ValueType := vtFixed;
		ValueRange := 'True|False';
		Exit;
	End;
	If (N = 'FIXEDROWS') or (N = 'FIXED') then
	begin
		ValueType := vtFixed;
		ValueRange := 'True|False';
		Exit;
	End;
	If N = 'WEEKSTARTS' then
	begin
		ValueType := vtFixed;
		ValueRange := 'Sunday|Monday';
	End;
End;

Initialization
	TComObjectFactory.Create(ComServer, TCM2Calender, Class_CM2Calender,
		'CM2Calendar', 'Calendar For CM2', ciMultiInstance, tmApartment);
End.
