From a33255b5ebf64efcab2a40a886c1da49e766a1c1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 13 Aug 2022 16:09:29 +0000 Subject: [PATCH] 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 --- .../tvplanit/examples/fulldemo/demomain.lfm | 4 +- .../tvplanit/examples/fulldemo/demomain.pas | 140 +++++++++++------- components/tvplanit/source/vpbaseds.pas | 14 +- 3 files changed, 97 insertions(+), 61 deletions(-) diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index cd96d430e..948446ba5 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/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 diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index 6190c399b..3cf7f7cf9 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/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 - Name: String; - Date: TDate; - constructor Create(AName: String; ADate: TDate); - end; + THolidayList = specialize TFPGMap; { TMainForm } @@ -140,11 +137,11 @@ type FVisibleDays: Integer; FResID: Integer; FLanguageDir: String; - FHolidays: TFPObjectList; - FHolidaysYear: Integer; + FHolidays: THolidayList; 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); - Result := dtSunday; + Unused(ALang); + 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; - wd: Integer; + d, d1: TDate; 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(THoliday.Create('Easter', d)); - FHolidays.Add(THoliday.Create('Whitsunday', d + 49)); + FHolidays.Add(d-2, 'Good Friday'); + FHolidays.Add(d, 'Easter Sunday'); + FHolidays.Add(d+49, 'Whitsunday'); // Independence day d := EncodeDate(AYear, 7, 4); - wd := DayOfTheWeek(d); - if wd = DaySaturday then - d := d + 2 - else - if wd = DaySunday then - d := d + 1; - FHolidays.Add(THoliday.Create('Indepencence Day (U.S.)', d)); + FHolidays.Add(d, 'Independence Day'); + d1 := InLieuHoliday(d); + if d1 <> d then + FHolidays.Add(d1, 'Independence Day (in lieu)'); - // Labor Day - d := EncodeDayOfWeekInMonth(AYear, 9, 1, DayMonday); // 1st Monday in September - FHolidays.Add(THoliday.Create('Labor Day (U.S.)', d)); + // Labor Day (1st Monday in September) + d := EncodeDayOfWeekInMonth(AYear, 9, 1, DayMonday); + FHolidays.Add(d, 'Labor Day (U.S.)'); - // Thanksgiving - d := EncodeDayOfWeekInMonth(AYear, 11, 4, DayThursday); // 4th Thursday in November - FHolidays.Add(THoliday.Create('Thanksgiving (U.S.)', d)); + // Thanksgiving (4th Thursday in November) + d := EncodeDayOfWeekInMonth(AYear, 11, 4, DayThursday); + 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; - holiday: THoliday; - year: Integer; + idx: Integer; begin - year := YearOf(ADate); - if year <> FHolidaysYear then - 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; + if FHolidays.Find(ADate, idx) then + AHolidayName := FHolidays.Data[idx];; end; procedure TMainForm.ShowContacts; diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index bce9269f7..d17c4d7c6 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/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);