You've already forked lazarus-ccr
tvplanit: Refactor calculation of holidays in fulldemo
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8386 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -4,12 +4,12 @@ object MainForm: TMainForm
|
||||
Top = 134
|
||||
Width = 959
|
||||
Caption = 'Turbo Power VisualPlanIt Demo'
|
||||
ClientHeight = 576
|
||||
ClientHeight = 596
|
||||
ClientWidth = 959
|
||||
Menu = MainMenu1
|
||||
OnCloseQuery = FormCloseQuery
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '2.3.0.0'
|
||||
OnDestroy = FormDestroy
|
||||
object Panel1: TPanel
|
||||
Left = 125
|
||||
Height = 596
|
||||
@ -81,31 +81,21 @@ object MainForm: TMainForm
|
||||
Width = 357
|
||||
ShowHint = True
|
||||
ControlLink = VpControlLink1
|
||||
Color = clWindow
|
||||
ParentShowHint = False
|
||||
Align = alBottom
|
||||
TabStop = True
|
||||
TabOrder = 0
|
||||
DateLabelFormat = 'mmmm yyyy'
|
||||
DayHeadAttributes.Color = clBtnFace
|
||||
DayNameStyle = dsShort
|
||||
DrawingStyle = dsFlat
|
||||
EventDayStyle = [fsItalic]
|
||||
HeadAttributes.Font.Height = -13
|
||||
HeadAttributes.Font.Style = [fsItalic]
|
||||
HeadAttributes.Color = clBtnFace
|
||||
HolidayAttributes.Font.Color = clBlack
|
||||
KBNavigation = True
|
||||
SelectedDayColor = clRed
|
||||
ShowEvents = True
|
||||
ShowEventTime = False
|
||||
TimeFormat = tf12Hour
|
||||
TodayAttributes.Font.Color = clBlue
|
||||
TodayAttributes.Color = 16761024
|
||||
TodayAttributes.BorderPen.Color = clBlue
|
||||
TodayAttributes.BorderPen.Width = 3
|
||||
WeekendAttributes.Font.Color = clBlack
|
||||
WeekStartsOn = dtSunday
|
||||
OnHoliday = VpHoliday
|
||||
end
|
||||
object Splitter2: TSplitter
|
||||
@ -124,13 +114,10 @@ object MainForm: TMainForm
|
||||
Width = 357
|
||||
ShowHint = True
|
||||
ControlLink = VpControlLink1
|
||||
Color = clWindow
|
||||
Font.Height = -12
|
||||
ParentFont = False
|
||||
ParentShowHint = False
|
||||
Align = alClient
|
||||
ReadOnly = False
|
||||
TabStop = True
|
||||
TabOrder = 2
|
||||
AllDayEventAttributes.BackgroundColor = clBtnShadow
|
||||
AllDayEventAttributes.EventBorderColor = cl3DDkShadow
|
||||
@ -191,13 +178,8 @@ object MainForm: TMainForm
|
||||
001C000000C6FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
|
||||
005500000038FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
||||
}
|
||||
ShowResourceName = True
|
||||
LineColor = clGray
|
||||
GutterWidth = 5
|
||||
DateLabelFormat = 'dddddd'
|
||||
Granularity = gr30Min
|
||||
DefaultTopHour = h_07
|
||||
TimeFormat = tf12Hour
|
||||
WrapStyle = wsNoFlow
|
||||
OnHoliday = VpHoliday
|
||||
end
|
||||
@ -306,7 +288,6 @@ object MainForm: TMainForm
|
||||
Width = 472
|
||||
ShowHint = True
|
||||
ControlLink = VpControlLink1
|
||||
Color = clWindow
|
||||
Font.Height = -12
|
||||
ParentFont = False
|
||||
ParentShowHint = False
|
||||
@ -316,9 +297,7 @@ object MainForm: TMainForm
|
||||
AllDayEventAttributes.Font.Height = -12
|
||||
DateLabelFormat = 'dddd, mmmm dd, yyyy'
|
||||
DayHeadAttributes.Color = clBtnFace
|
||||
DayHeadAttributes.DateFormat = 'dddd mmmm, dd'
|
||||
DayHeadAttributes.Font.Height = -13
|
||||
DayHeadAttributes.Bordered = True
|
||||
DrawingStyle = dsFlat
|
||||
EventFont.Height = -12
|
||||
HeadAttributes.Font.Height = -13
|
||||
@ -326,11 +305,8 @@ object MainForm: TMainForm
|
||||
HeadAttributes.Color = clBtnFace
|
||||
LineColor = clGray
|
||||
Layout = wvlHorizontal
|
||||
TimeFormat = tf12Hour
|
||||
ShowEventTime = True
|
||||
WeekStartsOn = dtMonday
|
||||
Align = alClient
|
||||
TabStop = True
|
||||
TabOrder = 2
|
||||
OnHoliday = VpHoliday
|
||||
end
|
||||
@ -383,12 +359,9 @@ object MainForm: TMainForm
|
||||
Top = 27
|
||||
Width = 834
|
||||
ControlLink = VpControlLink1
|
||||
Color = clWindow
|
||||
ParentFont = False
|
||||
Align = alClient
|
||||
TabStop = True
|
||||
TabOrder = 1
|
||||
ReadOnly = False
|
||||
DisplayOptions.CheckBGColor = clWindow
|
||||
DisplayOptions.CheckColor = cl3DDkShadow
|
||||
DisplayOptions.CheckStyle = csCheck
|
||||
@ -404,7 +377,6 @@ object MainForm: TMainForm
|
||||
TaskHeadAttributes.Color = clSilver
|
||||
TaskHeadAttributes.Font.Style = [fsItalic]
|
||||
DrawingStyle = dsFlat
|
||||
ShowResourceName = True
|
||||
end
|
||||
end
|
||||
object Contacts: TPage
|
||||
@ -427,14 +399,10 @@ object MainForm: TMainForm
|
||||
Top = 0
|
||||
Width = 794
|
||||
ControlLink = VpControlLink1
|
||||
Color = clWindow
|
||||
ParentFont = False
|
||||
Align = alClient
|
||||
TabStop = True
|
||||
TabOrder = 1
|
||||
AllowInPlaceEditing = True
|
||||
BarWidth = 1
|
||||
BarColor = clSilver
|
||||
ColumnWidth = 200
|
||||
ContactHeadAttributes.Color = clSilver
|
||||
ContactHeadAttributes.Bordered = True
|
||||
|
||||
@ -9,13 +9,18 @@ uses
|
||||
clocale,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, StdCtrls, ComCtrls, LCLTranslator, Menus, Types, LCLVersion,
|
||||
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;
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
@ -109,6 +114,7 @@ type
|
||||
procedure DaysTrackBarChange(Sender: TObject);
|
||||
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure lbOtherResourcesClickCheck(Sender: TObject);
|
||||
procedure MnuAboutClick(Sender: TObject);
|
||||
procedure MnuEditPrintFormatsClick(Sender: TObject);
|
||||
@ -134,6 +140,9 @@ type
|
||||
FVisibleDays: Integer;
|
||||
FResID: Integer;
|
||||
FLanguageDir: String;
|
||||
FHolidays: TFPObjectList;
|
||||
FHolidaysYear: Integer;
|
||||
procedure CalcHolidays(AYear: Integer);
|
||||
procedure ConnectHandler(Sender: TObject);
|
||||
procedure CreateResourceGroup;
|
||||
function GetlanguageDir: String;
|
||||
@ -317,6 +326,12 @@ begin
|
||||
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
|
||||
var
|
||||
@ -382,6 +397,44 @@ begin
|
||||
UpdateOtherResourcesList;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CalcHolidays(AYear: Integer);
|
||||
var
|
||||
d: TDate;
|
||||
wd: Integer;
|
||||
begin
|
||||
FHolidays.Clear;
|
||||
|
||||
// New Year
|
||||
FHolidays.Add(THoliday.Create('New Year', EncodeDate(AYear, 1, 1)));
|
||||
|
||||
// Easter & related
|
||||
d := Easter(AYear);
|
||||
FHolidays.Add(THoliday.Create('Good Friday', d-2));
|
||||
FHolidays.Add(THoliday.Create('Easter', d));
|
||||
FHolidays.Add(THoliday.Create('Whitsunday', d + 49));
|
||||
|
||||
// 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));
|
||||
|
||||
// Labor Day
|
||||
d := EncodeDayOfWeekInMonth(AYear, 9, 1, DayMonday); // 1st Monday in September
|
||||
FHolidays.Add(THoliday.Create('Labor Day (U.S.)', d));
|
||||
|
||||
// Thanksgiving
|
||||
d := EncodeDayOfWeekInMonth(AYear, 11, 4, DayThursday); // 4th Thursday in November
|
||||
FHolidays.Add(THoliday.Create('Thanksgiving (U.S.)', d));
|
||||
|
||||
// Christmas
|
||||
FHolidays.Add(THoliday.Create('Christmas', EncodeDate(AYear, 12, 25)));
|
||||
end;
|
||||
|
||||
procedure TMainForm.Cb3DChange(Sender: TObject);
|
||||
var
|
||||
ds: TVpDrawingStyle;
|
||||
@ -521,6 +574,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FHolidays := TFPObjectList.Create;
|
||||
|
||||
PopulateLanguages;
|
||||
ReadIni;
|
||||
|
||||
@ -574,6 +629,11 @@ begin
|
||||
if Components[i] is TLabel then TLabel(Components[i]).Transparent := true;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FHolidays.Free;
|
||||
end;
|
||||
|
||||
procedure TMainForm.lbOtherResourcesClickCheck(Sender: TObject);
|
||||
var
|
||||
i, n: Integer;
|
||||
@ -1183,34 +1243,23 @@ end;
|
||||
procedure TMainForm.VpHoliday(Sender: TObject; ADate: TDateTime;
|
||||
var AHolidayName: String);
|
||||
var
|
||||
d,m,y: Word;
|
||||
tmp: Word;
|
||||
easterDate: TDate;
|
||||
i: Integer;
|
||||
holiday: THoliday;
|
||||
year: Integer;
|
||||
begin
|
||||
DecodeDate(ADate, y,m,d);
|
||||
if (d=1) and (m=1) then
|
||||
AHolidayName := 'New Year'
|
||||
else
|
||||
if (d = 25) and (m = 12) then
|
||||
AHolidayName := 'Christmas'
|
||||
else
|
||||
if m = 9 then begin
|
||||
tmp := 1;
|
||||
while DayOfWeek(EncodeDate(y, m, tmp)) <> 2 do inc(tmp);
|
||||
if tmp = d then
|
||||
AHolidayName := 'Labor Day (U.S.)'; // 1st Monday in September
|
||||
end
|
||||
else begin
|
||||
// Holidays depending on the date of Easter.
|
||||
easterDate := Easter(y);
|
||||
if ADate = easterDate - 2 then
|
||||
AHolidayName := 'Good Friday'
|
||||
else
|
||||
if ADate = easterDate then
|
||||
AHolidayName := 'Easter'
|
||||
else
|
||||
if ADate = easterDate + 49 then
|
||||
AHolidayName := 'Whitsunday'
|
||||
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;
|
||||
end;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user