tvplanit: More efficient handling of holidays in fulldemo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8389 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/fulldemo/demomain.lfm

@@ -4,12 +4,13 @@ object MainForm: TMainForm
   Top = 134
   Width = 959
   Caption = 'Turbo Power VisualPlanIt Demo'
-  ClientHeight = 596
+  ClientHeight = 576
   ClientWidth = 959
   Menu = MainMenu1
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  LCLVersion = '2.3.0.0'
   object Panel1: TPanel
     Left = 125
     Height = 596
@@ -297,6 +298,7 @@ object MainForm: TMainForm
           AllDayEventAttributes.Font.Height = -12
           DateLabelFormat = 'dddd, mmmm dd, yyyy'
           DayHeadAttributes.Color = clBtnFace
+          DayHeadAttributes.DateFormat = 'ddddd'
           DayHeadAttributes.Font.Height = -13
           DrawingStyle = dsFlat
           EventFont.Height = -12

components/tvplanit/examples/fulldemo/demomain.pas

@@ -6,20 +6,17 @@ interface
 
 uses
  {$IFDEF UNIX}
-  clocale,
+  clocale,          // for localized day and month names in Unix/Linux
  {$ENDIF}
-  Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs,
+  Classes, fgl, SysUtils, FileUtil, 
+  PrintersDlgs, Forms, Controls, Graphics, Dialogs,
   ExtCtrls, StdCtrls, ComCtrls, LCLTranslator, Menus, Types, LCLVersion, Contnrs,
   CheckLst, VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid,
   VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData, VpPrtPrvDlg,
   VpPrtFmtDlg, VpBase;
 
 type
-  THoliday = class
+  THolidayList = specialize TFPGMap<TDateTime, string>;
-    Name: String;
-    Date: TDate;
-    constructor Create(AName: String; ADate: TDate);
-  end;
   
   { TMainForm }
 
@@ -140,11 +137,11 @@ type
     FVisibleDays: Integer;
     FResID: Integer;
     FLanguageDir: String;
-    FHolidays: TFPObjectList;
+    FHolidays: THolidayList;
-    FHolidaysYear: Integer;
     procedure CalcHolidays(AYear: Integer);
     procedure ConnectHandler(Sender: TObject);
     procedure CreateResourceGroup;
+    procedure DateChangedHandler(Sender: TObject; ADate: TDateTime);
     function GetlanguageDir: String;
     procedure PopulateLanguages;
     procedure PositionControls;
@@ -322,18 +319,12 @@ end;
 function GetFirstDayOfWeek(ALang: String): TVpDayType;
 // Don't know how to determine this from the OS
 begin
-   Unused(ALang);
+  Unused(ALang);
-   Result := dtSunday;
+  Result := dtSunday;
 end;
 
-constructor THoliday.Create(AName: String; ADate: TDate);
-begin
-  Name := AName;
-  Date := ADate;
-end;
-
-function Easter(AYear: integer): TDateTime;
 // Calculates the date of the Easter holiday
+function Easter(AYear: integer): TDateTime;
 var
   day, month: integer;
   a,b,c,d,e,m,n: integer;
@@ -397,42 +388,81 @@ begin
   UpdateOtherResourcesList;
 end;
 
+{ Calculates the date of some U.S. holidays for the specified year. }
 procedure TMainForm.CalcHolidays(AYear: Integer);
+
+  // If a federal holiday falls on a Saturday the preceding Friday is a holiday.
+  // If a federal holiday falls on a Sunday the following Monday is a holiday.
+  // https://www.officeholidays.com/countries/usa/2022
+  function InLieuHoliday(ADate: TDateTime): TDateTime;
+  var
+    wd: Integer;
+  begin
+    wd := DayOfTheWeek(ADate);
+    if wd = DaySaturday then 
+      Result := ADate - 1
+    else
+    if wd = DaySunday then
+      Result := ADate + 1
+    else
+      Result := ADate;
+  end;
+    
 var
-  d: TDate;
+  d, d1: TDate;
-  wd: Integer;
 begin
   FHolidays.Clear;
   
   // New Year
-  FHolidays.Add(THoliday.Create('New Year', EncodeDate(AYear, 1, 1)));
+  d := EncodeDate(AYear, 1, 1);
+  FHolidays.Add(d, 'New Year');
+  d1 := InLieuHoliday(d);
+  if d <> d1 then
+    FHolidays.Add(d1, 'New Year (in lieu)');
   
-  // Easter & related
+  // Easter & associated
   d := Easter(AYear);
-  FHolidays.Add(THoliday.Create('Good Friday', d-2));
+  FHolidays.Add(d-2, 'Good Friday');
-  FHolidays.Add(THoliday.Create('Easter', d));
+  FHolidays.Add(d, 'Easter Sunday');
-  FHolidays.Add(THoliday.Create('Whitsunday', d + 49));
+  FHolidays.Add(d+49, 'Whitsunday');
   
   // Independence day
   d := EncodeDate(AYear, 7, 4);
-  wd := DayOfTheWeek(d);
+  FHolidays.Add(d, 'Independence Day');
-  if wd = DaySaturday then 
+  d1 := InLieuHoliday(d);
-    d := d + 2
+  if d1 <> d then
-  else
+    FHolidays.Add(d1, 'Independence Day (in lieu)');
-  if wd = DaySunday then
-    d := d + 1;
-  FHolidays.Add(THoliday.Create('Indepencence Day (U.S.)', d));
   
-  // Labor Day 
+  // Labor Day (1st Monday in September)
-  d := EncodeDayOfWeekInMonth(AYear, 9, 1, DayMonday);  // 1st Monday in September
+  d := EncodeDayOfWeekInMonth(AYear, 9, 1, DayMonday);  
-  FHolidays.Add(THoliday.Create('Labor Day (U.S.)', d));
+  FHolidays.Add(d, 'Labor Day (U.S.)');
   
-  // Thanksgiving
+  // Thanksgiving (4th Thursday in November)
-  d := EncodeDayOfWeekInMonth(AYear, 11, 4, DayThursday);  // 4th Thursday in November
+  d := EncodeDayOfWeekInMonth(AYear, 11, 4, DayThursday); 
-  FHolidays.Add(THoliday.Create('Thanksgiving (U.S.)', d));
+  FHolidays.Add(d, 'Thanksgiving (U.S.)');
   
   // Christmas
-  FHolidays.Add(THoliday.Create('Christmas', EncodeDate(AYear, 12, 25)));
+  d := EncodeDate(AYear, 12, 25);
+  FHolidays.Add(d, 'Christmas Day');
+  d1 := InLieuHoliday(d);
+  if d1 <> d then
+    FHolidays.Add(d1, 'Christmas Day (in lieu)');
+  
+  // Due to the off-days in the calendar, add also Christmas of the preceding
+  // and New Year of the following years
+  d := EncodeDate(AYear-1, 12, 25);   // -1 --> previous year
+  FHolidays.Add(d, 'Christmas Day');
+  d1 := InLieuHoliday(d);
+  if d1 <> d then
+    FHolidays.Add(d1, 'Christmas Day (in lieu)');
+  
+    // New Year
+  d := EncodeDate(AYear+1, 1, 1);   // +1 --> following year
+  FHolidays.Add(d, 'New Year');
+  d1 := InLieuHoliday(d);
+  if d <> d1 then
+    FHolidays.Add(d1, 'New Year (in lieu)');
+
 end;
 
 procedure TMainForm.Cb3DChange(Sender: TObject);
@@ -560,6 +590,14 @@ begin
   datastore.RefreshEvents;  // or: datastore.UpdateGroupEvents;
 end;
 
+procedure TMainForm.DateChangedHandler(Sender: TObject; ADate: TDateTime);
+var
+  year: Integer;
+begin
+  year := YearOf(ADate);
+  CalcHolidays(year);
+end;
+
 procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
 begin
   if CanClose then
@@ -574,7 +612,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
 var
   i: Integer;
 begin
-  FHolidays := TFPObjectList.Create;
+  FHolidays := THolidayList.Create;
+  FHolidays.Sorted := true;
   
   PopulateLanguages;
   ReadIni;
@@ -582,6 +621,7 @@ begin
   // Establish connection of datastore (resides in a datamodule) to all
   // dependent controls.
   VpControlLink1.Datastore := DemoDM.Datastore;
+  VpControlLink1.Datastore.OnDateChanged := @DateChangedHandler;
 
   with VpControlLink1.Datastore do begin
 
@@ -1243,24 +1283,10 @@ end;
 procedure TMainForm.VpHoliday(Sender: TObject; ADate: TDateTime;
   var AHolidayName: String);
 var
-  i: Integer;
+  idx: Integer;
-  holiday: THoliday;
-  year: Integer;
 begin
-  year := YearOf(ADate);
+  if FHolidays.Find(ADate, idx) then
-  if year <> FHolidaysYear then
+    AHolidayName := FHolidays.Data[idx];;
-  begin
-    FHolidaysYear := year;
-    CalcHolidays(year);
-  end;
-  for i := 0 to FHolidays.Count-1 do
-  begin
-    holiday := THoliday(FHolidays[i]);
-    if holiday.Date = ADate then begin
-      AHolidayName := holiday.Name;
-      exit;
-    end;
-  end;
 end;
 
 procedure TMainForm.ShowContacts;

components/tvplanit/source/vpbaseds.pas

@@ -263,6 +263,7 @@ type
     procedure SetEventTimerEnabled(Value: Boolean);
     procedure SetDayBuffer(Value: Integer);
     procedure SetRange(StartTime, EndTime: TDateTime);
+    procedure SetOnDateChanged(Value: TVpDateChangedEvent);
 
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure NotifyLinked;
@@ -352,7 +353,7 @@ type
     property OnConnect: TNotifyEvent
       read FOnConnect write FOnConnect;
     property OnDateChanged: TVpDateChangedEvent
-      read FOnDateChanged write FOnDateChanged;
+      read FOnDateChanged write SetOnDateChanged;
     property OnDisconnect: TNotifyEvent
       read FOnDisconnect write FOnDisconnect;
     property OnResourceChange: TVpResourceEvent
@@ -482,7 +483,6 @@ begin
     Color := clGray;
   end;
 
-  FActiveDate := Now;
   FDayBuffer := 31;  // One full month before and after the current date.
   FTimeRange.StartTime := Now - FDayBuffer;
   FTimeRange.EndTime := Now + FDayBuffer;
@@ -507,6 +507,8 @@ begin
   { enable the event timer }
   if not (csDesigning in ComponentState) then
     dsAlertTimer.Enabled := true;
+  
+  SetActiveDate(Now);  
 end;
 {=====}
 
@@ -1025,7 +1027,13 @@ begin
     FTimeRange.EndTime := trunc(EndTime) + 1;
   end;
 end;
-{=====}
+
+procedure TVpCustomDatastore.SetOnDateChanged(Value: TVpDateChangedEvent);
+begin
+  FOnDateChanged := Value;
+  if Assigned(FOnDateChanged) then
+    FOnDateChanged(Self, FActiveDate);
+end;
 
 procedure TVpCustomDatastore.PlaySound(const AWavFile: String;
   APlaySoundMode: TVpPlaySoundMode);