CalLite: Initial commit

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

components/callite/demo2/testCalLite.lpi

@@ -0,0 +1,104 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testCalLite"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="callight_pkg"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="RunTimeTypeInfoControls"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testCalLite.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umaintestcallite.pp"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="uMainTestCalLite"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="calendarlite.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="CalendarLite"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="testCalLite"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/callite/demo2/testCalLite.lpr

@@ -0,0 +1,16 @@
+program testCalLite;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, Forms, uMainTestCalLite;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/callite/demo2/umaintestcallite.lfm

@@ -0,0 +1,177 @@
+object Form1: TForm1
+  Left = 536
+  Height = 845
+  Top = 72
+  Width = 648
+  Caption = 'Examples of the TCalendaLite  component'
+  ClientHeight = 845
+  ClientWidth = 648
+  Color = clWindow
+  Font.CharSet = ANSI_CHARSET
+  OnCreate = FormCreate
+  OnResize = FormResize
+  LCLVersion = '1.7'
+  object PSettings: TPanel
+    Left = 0
+    Height = 376
+    Top = 0
+    Width = 648
+    Align = alTop
+    ClientHeight = 376
+    ClientWidth = 648
+    TabOrder = 0
+    object cgOptions: TCheckGroup
+      Left = 24
+      Height = 296
+      Top = 40
+      Width = 185
+      AutoFill = True
+      Caption = 'Set calendar Options'
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.TopBottomSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      ClientHeight = 276
+      ClientWidth = 181
+      Items.Strings = (
+        'coBoldDayNames'
+        'coBoldHolidays'
+        'coBoldToday'
+        'coBoldTopRow'
+        'coBoldWeekend'
+        'coDayLine'
+        'coShowBorder'
+        'coShowHolidays'
+        'coShowTodayFrame'
+        'coShowTodayName'
+        'coShowTodayRow'
+        'coShowWeekend'
+        'coUseTopRowColors'
+      )
+      OnItemClick = cgOptionsItemClick
+      TabOrder = 0
+      Data = {
+        0D00000002020202020202020202020202
+      }
+    end
+    object cbUseHolidays: TCheckBox
+      Left = 239
+      Height = 19
+      Top = 40
+      Width = 169
+      Caption = 'Ignore OnGetHolidays event'
+      OnChange = cbUseHolidaysChange
+      TabOrder = 1
+    end
+    object LTitle: TLabel
+      Left = 28
+      Height = 15
+      Top = 8
+      Width = 318
+      Caption = 'Various calendar property settings can be changed below:'
+      Font.CharSet = ANSI_CHARSET
+      Font.Style = [fsBold]
+      ParentColor = False
+      ParentFont = False
+    end
+    object LWidth: TLabel
+      Left = 239
+      Height = 15
+      Top = 81
+      Width = 32
+      Caption = 'Width'
+      ParentColor = False
+    end
+    object seWidth: TSpinEdit
+      Left = 296
+      Height = 23
+      Top = 79
+      Width = 66
+      MaxValue = 430
+      MinValue = 120
+      OnChange = seWidthChange
+      TabOrder = 2
+      Value = 300
+    end
+    object seHeight: TSpinEdit
+      Left = 296
+      Height = 23
+      Top = 112
+      Width = 66
+      MaxValue = 250
+      MinValue = 120
+      OnChange = seHeightChange
+      TabOrder = 3
+      Value = 200
+    end
+    object lHeight: TLabel
+      Left = 239
+      Height = 15
+      Top = 112
+      Width = 36
+      Caption = 'Height'
+      ParentColor = False
+    end
+    object rgLanguage: TRadioGroup
+      Left = 239
+      Height = 160
+      Top = 176
+      Width = 180
+      AutoFill = True
+      Caption = 'Language to use'
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.TopBottomSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      ClientHeight = 140
+      ClientWidth = 176
+      ItemIndex = 0
+      Items.Strings = (
+        'English (default)'
+        'French'
+        'German'
+        'Hebrew'
+        'Spanish'
+      )
+      OnClick = rgLanguageClick
+      TabOrder = 4
+    end
+    object rgStartingDOW: TRadioGroup
+      Left = 440
+      Height = 192
+      Top = 40
+      Width = 176
+      AutoFill = True
+      Caption = 'Starting day of the week'
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.TopBottomSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      ClientHeight = 172
+      ClientWidth = 172
+      Items.Strings = (
+        'Sunday'
+        'Monday'
+        'Tuesday'
+        'Wednesday'
+        'Thursday'
+        'Friday'
+        'Saturday'
+      )
+      OnClick = rgStartingDOWClick
+      TabOrder = 5
+    end
+  end
+end

components/callite/demo2/umaintestcallite.pp

@@ -0,0 +1,231 @@
+unit uMainTestCalLite;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, CalendarLite;
+//  Easysize;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    cbUseHolidays: TCheckBox;
+    cgOptions: TCheckGroup;
+    //FormResizer1: TFormResizer;
+    LTitle: TLabel;
+    LWidth: TLabel;
+    lHeight: TLabel;
+    PSettings: TPanel;
+    rgLanguage: TRadioGroup;
+    rgStartingDOW: TRadioGroup;
+    seWidth: TSpinEdit;
+    seHeight: TSpinEdit;
+    procedure cbUseHolidaysChange(Sender: TObject);
+    procedure cgOptionsItemClick(Sender: TObject; Index: integer);
+    procedure FormCreate(Sender: TObject);
+    procedure FormResize(Sender: TObject);
+    procedure rgLanguageClick(Sender: TObject);
+    procedure rgStartingDOWClick(Sender: TObject);
+    procedure seHeightChange(Sender: TObject);
+    procedure seWidthChange(Sender: TObject);
+  private
+    copyCal, demoCal: TCalendarLite;
+    FnoHolidays: boolean;
+    procedure RespondToDateChange(Sender: tObject);
+    procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer;  // wp
+      var Holidays: THolidays);
+  end;
+
+var
+  Form1: TForm1;
+
+
+implementation
+
+{$R *.lfm}
+
+function Easter(year:integer) : TDateTime;  // wp
+var
+  Day, Month    : integer;
+  a,b,c,d,e,m,n : integer;
+begin
+  case Year div 100 of
+    17    : begin m := 23; n := 3; end;
+    18    : begin m := 23; n := 4; end;
+    19,20 : begin m := 24; n := 5; end;
+    21    : begin m := 24; n := 6; end;
+    else    raise Exception.Create('Only years above 1700 supported.');
+  end;
+  a := Year mod 19;
+  b := Year mod 4;
+  c := Year mod 7;
+  d := (19*a + m) mod 30;
+  e := (2*b + 4*c + 6*d + n) mod 7;
+  day := 22 + d + e;
+  Month := 3;
+  if Day>31 then begin
+    Day := d + e - 9;
+    Month := 4;
+    if (d=28) and (e=6) and (a>10) then begin
+      if day=26 then day := 19;
+      if day=25 then day := 18;
+    end;
+  end;
+  result := EncodeDate(year, month, day);
+end;
+
+
+procedure TForm1.FormCreate(Sender: TObject);
+var opt: TCalOption;
+begin
+//  FormResizer1.InitializeForm;
+  demoCal:= TCalendarLite.Create(Self);
+  demoCal.Parent:= Self;
+  demoCal.Left:= 10;
+  demoCal.Top:= PSettings.Height + 10;
+  demoCal.Width := seWidth.Value;
+  demoCal.Height := seHeight.Value;
+  demoCal.OnGetHolidays := @GetHolidays;
+  demoCal.OnDateChange:= @RespondToDateChange;
+  FNoHolidays:= False;
+  for opt in demoCal.Options do
+   if (opt in demoCal.Options) then cgOptions.Checked[integer(opt)] := True;
+  seHeight.Value := demoCal.Height;
+  seWidth.Value:= demoCal.Width;
+  rgStartingDOW.ItemIndex:= integer(demoCal.StartingDayOfWeek)-1;
+
+  copyCal:= TCalendarLite.Create(Self);
+  copyCal.Parent := Self;
+  copyCal.Width := 270;
+  copyCal.Height := 205;
+  copyCal.Left := Width - copyCal.Width;
+  copyCal.Top := Height - copyCal.Height;
+  copyCal.Font.Name := 'Lucida Calligraphy';
+  copyCal.Colors.SelectedDateColor := clYellow;
+  copyCal.Colors.ArrowBorderColor := clYellow;
+  copyCal.Colors.ArrowColor := clYellow;
+  copyCal.Colors.TodayFrameColor := clWhite;
+  copyCal.Colors.BackgroundColor:= clGradientActiveCaption;
+  copyCal.StartingDayOfWeek:= dowSaturday;
+  copyCal.OnGetHolidays := @GetHolidays;
+  copyCal.Options := copyCal.Options + [coShowBorder,coUseTopRowColors,coDayLine];
+end;
+
+procedure TForm1.FormResize(Sender: TObject);
+begin
+//  FormResizer1.ResizeAll;
+end;
+
+procedure TForm1.rgLanguageClick(Sender: TObject);
+begin
+  case rgLanguage.ItemIndex of
+    0: demoCal.Languages := lgEnglish;
+    1: demoCal.Languages := lgFrench;
+    2: demoCal.Languages := lgGerman;
+    3: demoCal.Languages := lgHebrew;
+    4: demoCal.Languages := lgSpanish;
+  end;
+
+  {
+  case rgLanguage.ItemIndex of
+    0: begin
+        demoCal.DayNames := EnglishDays;
+        demoCal.MonthNames := EnglishMonths;
+        demoCal.DisplayTexts := DefaultDisplayText;
+        demoCal.BiDiMode:= bdLeftToRight;
+       end;
+    1: begin
+        demoCal.DayNames := FrenchDays;
+        demoCal.MonthNames := FrenchMonths;
+        demoCal.DisplayTexts := FrenchTexts;
+        demoCal.BiDiMode:= bdLeftToRight;
+       end;
+    2: begin
+        demoCal.DayNames := GermanDays;
+        demoCal.MonthNames := GermanMonths;
+        demoCal.DisplayTexts := GermamTexts;
+        demoCal.BiDiMode:= bdLeftToRight;
+       end;
+    3: begin
+        demoCal.DayNames := HebrewDays;
+        demoCal.MonthNames := HebrewMonths;
+        demoCal.DisplayTexts := HebrewTexts;
+        demoCal.BiDiMode:= bdRightToLeft;
+       end;
+    4: begin
+        demoCal.DayNames := SpanishDays;
+        demoCal.MonthNames := SpanishMonths;
+        demoCal.DisplayTexts := SpanishTexts;
+        demoCal.BiDiMode:= bdLeftToRight;
+       end;
+  end;
+  }
+end;
+
+procedure TForm1.rgStartingDOWClick(Sender: TObject);
+begin
+  demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex + 1);
+end;
+
+procedure TForm1.seHeightChange(Sender: TObject);
+begin
+  demoCal.Height := seHeight.Value;
+end;
+
+procedure TForm1.seWidthChange(Sender: TObject);
+begin
+  demoCal.Width := seWidth.Value;
+end;
+
+procedure TForm1.cbUseHolidaysChange(Sender: TObject);
+begin
+  FnoHolidays := not FnoHolidays;
+end;
+
+procedure TForm1.cgOptionsItemClick(Sender: TObject; Index: integer);
+var opt: TCalOption;
+begin
+  opt := TCalOption(Index);
+  if (opt in demoCal.Options) then
+    demoCal.Options := demoCal.Options - [opt]
+  else demoCal.Options := demoCal.Options + [opt];
+end;
+
+procedure TForm1.RespondToDateChange(Sender: tObject);
+begin
+  copyCal.Date:= TCalendarLite(Sender).Date;
+end;
+
+// wp
+procedure TForm1.GetHolidays(Sender: TObject; AMonth, AYear: Integer;
+  var Holidays: THolidays);
+var
+  d, m, y: Word;
+  e: TDate;
+begin
+  ClearHolidays(Holidays);
+  if not FNoHolidays then
+  begin
+    // Fixed holidays
+    case AMonth of
+      1: AddHoliday(1, Holidays);          // New Year
+     12: AddHoliday(25, Holidays);         // Christmas
+    end;
+    // Easter
+    e := Easter(AYear);
+    DecodeDate(e, y,m,d);
+    if m = AMonth then
+      AddHoliday(d, Holidays);
+    // Whit Sunday --> 49 days after easter
+    DecodeDate(e+49, y,m,d);
+    if m = AMonth then
+      AddHoliday(d, Holidays);
+  end;
+end;
+
+end.
+