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

components/tvplanit/examples/fulldemo/demomain.lfm

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

components/tvplanit/examples/fulldemo/demomain.pas

@@ -9,12 +9,17 @@ 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 }
 
@@ -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;
+  i: Integer;
-  tmp: Word;
+  holiday: THoliday;
-  easterDate: TDate;
+  year: Integer;
 begin
-  DecodeDate(ADate, y,m,d);
+  year := YearOf(ADate);
-  if (d=1) and (m=1) then
+  if year <> FHolidaysYear then
-    AHolidayName := 'New Year'
+  begin
-  else
+    FHolidaysYear := year;
-  if (d = 25) and (m = 12) then
+    CalcHolidays(year);
-    AHolidayName := 'Christmas'
+  end;
-  else
+  for i := 0 to FHolidays.Count-1 do
-  if m = 9 then begin
+  begin
-    tmp := 1;
+    holiday := THoliday(FHolidays[i]);
-    while DayOfWeek(EncodeDate(y, m, tmp)) <> 2 do inc(tmp);
+    if holiday.Date = ADate then begin
-    if tmp = d then
+      AHolidayName := holiday.Name;
-      AHolidayName := 'Labor Day (U.S.)';  // 1st Monday in September
+      exit;
-  end
+    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'
   end;
 end;