pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: More efficient handling of holidays in fulldemo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8389 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-13 16:09:29 +00:00
parent a2d1123b51
commit a33255b5eb
3 changed files with 97 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -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

140
components/tvplanit/examples/fulldemo/demomain.pas
View File

@ -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<TDateTime, string>;
{ 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;

14
components/tvplanit/source/vpbaseds.pas
View File

@ -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);