From 7ffd37fa20886bca2aab5b660437928bf827f545 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 3 Nov 2016 23:42:04 +0000 Subject: [PATCH] CalLite: Initial commit git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5312 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/callite/callight_pkg.lpk | 36 + components/callite/demo1/CalLiteTest.lpi | 85 ++ components/callite/demo1/CalLiteTest.lpr | 21 + components/callite/demo1/main.lfm | 58 + components/callite/demo1/main.pas | 115 ++ components/callite/demo2/testCalLite.lpi | 104 ++ components/callite/demo2/testCalLite.lpr | 16 + components/callite/demo2/umaintestcallite.lfm | 177 +++ components/callite/demo2/umaintestcallite.pp | 231 +++ components/callite/icon/TCALENDARLITE.PNG | Bin 0 -> 886 bytes components/callite/icon/icon-source.txt | 5 + components/callite/icon/make_lrs.bat | 1 + components/callite/source/calendarlite.pas | 1295 +++++++++++++++++ .../callite/source/calendarlite_icon.lrs | 38 + 14 files changed, 2182 insertions(+) create mode 100644 components/callite/callight_pkg.lpk create mode 100644 components/callite/demo1/CalLiteTest.lpi create mode 100644 components/callite/demo1/CalLiteTest.lpr create mode 100644 components/callite/demo1/main.lfm create mode 100644 components/callite/demo1/main.pas create mode 100644 components/callite/demo2/testCalLite.lpi create mode 100644 components/callite/demo2/testCalLite.lpr create mode 100644 components/callite/demo2/umaintestcallite.lfm create mode 100644 components/callite/demo2/umaintestcallite.pp create mode 100644 components/callite/icon/TCALENDARLITE.PNG create mode 100644 components/callite/icon/icon-source.txt create mode 100644 components/callite/icon/make_lrs.bat create mode 100644 components/callite/source/calendarlite.pas create mode 100644 components/callite/source/calendarlite_icon.lrs diff --git a/components/callite/callight_pkg.lpk b/components/callite/callight_pkg.lpk new file mode 100644 index 000000000..466557a01 --- /dev/null +++ b/components/callite/callight_pkg.lpk @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/callite/demo1/CalLiteTest.lpi b/components/callite/demo1/CalLiteTest.lpi new file mode 100644 index 000000000..a6fdadfda --- /dev/null +++ b/components/callite/demo1/CalLiteTest.lpi @@ -0,0 +1,85 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="callight_pkg"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="CalLiteTest.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="callite;C:\Lazarus\AviControls\;C:\Lazarus\AviControls\StickyStuff\"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf2Set"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="4"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + <Item4> + <Name Value="Exception"/> + </Item4> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/callite/demo1/CalLiteTest.lpr b/components/callite/demo1/CalLiteTest.lpr new file mode 100644 index 000000000..e2ea94a60 --- /dev/null +++ b/components/callite/demo1/CalLiteTest.lpr @@ -0,0 +1,21 @@ +program CalLiteTest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, main + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/callite/demo1/main.lfm b/components/callite/demo1/main.lfm new file mode 100644 index 000000000..0191474dc --- /dev/null +++ b/components/callite/demo1/main.lfm @@ -0,0 +1,58 @@ +object Form1: TForm1 + Left = 400 + Height = 272 + Top = 115 + Width = 256 + Caption = 'Form1' + ClientHeight = 272 + ClientWidth = 256 + Font.Height = -13 + Font.Name = 'Tahoma' + KeyPreview = True + OnCreate = FormCreate + OnResize = FormResize + Position = poScreenCenter + LCLVersion = '1.7' + object edtYear: TEdit + Left = 122 + Height = 18 + Top = 15 + Width = 38 + Alignment = taCenter + AutoSize = False + BorderStyle = bsNone + OnKeyDown = edtYearKeyDown + ParentColor = True + TabOrder = 1 + Text = 'Year' + end + object edtMonth: TEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edtYear + AnchorSideRight.Control = edtYear + Left = 84 + Height = 18 + Top = 15 + Width = 38 + Alignment = taCenter + Anchors = [akTop, akRight] + AutoSize = False + BorderStyle = bsNone + OnKeyDown = edtMonthKeyDown + ParentColor = True + TabOrder = 0 + Text = 'Month' + end + object Label1: TLabel + Left = 5 + Height = 30 + Top = 237 + Width = 246 + Align = alBottom + BorderSpacing.Around = 5 + Caption = 'Use Up/Down Arrows to change the Month/Year. Press and hold for long jumps.' + ParentColor = False + ParentFont = False + WordWrap = True + end +end diff --git a/components/callite/demo1/main.pas b/components/callite/demo1/main.pas new file mode 100644 index 000000000..61e9af0e2 --- /dev/null +++ b/components/callite/demo1/main.pas @@ -0,0 +1,115 @@ +unit main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + LclType, Buttons, StdCtrls, ComCtrls, Grids, DateUtils, CalendarLite; + +type + + { TForm1 } + + TForm1 = class(TForm) + edtYear: TEdit; + edtMonth: TEdit; + Label1: TLabel; + procedure btnCloseClick(Sender: TObject); + procedure edtYearKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure edtMonthKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormCreate(Sender: TObject); + procedure FormResize(Sender: TObject); + private + { private declarations } + CalendarLite1: TCalendarLite; + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + + +{ TForm1 } + +var + AYear: Integer; + AMonth: Integer; + MonthsList: TStringList; + +procedure TForm1.FormCreate(Sender: TObject); +var + I: Integer; +begin + CalendarLite1 := TCalendarLite.Create(self); + with CalendarLite1 do begin + Parent := self; + Left := 20; +// Height := 160; + Top := 40; + Width := self.Width - 2*Left; + Height := label1.Top - Top - 20; + ParentColor := false; + Date := 41574; + DisplayTexts := '"Today is",dd/mm/yyyy,"Holidays during","There are no holidays set for"'; + WeekendDays := [dowSaturday]; + Anchors := [akLeft, akTop, akRight, akBottom]; + end; + + MonthsList:= TStringList.Create; + for I:= 0 to 11 do begin + MonthsList.Add(AnsiToUTF8(ShortMonthNames[I+1])); + end; + + AYear:= YearOf(Now); + AMonth:= MonthOf(Now)-1; + edtYear.Caption := IntToStr(AYear); + edtMonth.Caption := MonthsList[AMonth]; +end; + +procedure TForm1.FormResize(Sender: TObject); +begin + edtMonth.Left := Width div 2 - edtMonth.Width - 2; + edtYear.Left := Width div 2 + 2; +end; + +procedure TForm1.btnCloseClick(Sender: TObject); +begin + FreeAndNil(MonthsList); + Close; +end; + +procedure TForm1.edtYearKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + case Key of + VK_Up : Inc(AYear); + VK_Down : Dec(AYear); + end; + edtYear.Caption := IntToStr(AYear); + CalendarLite1.Date := RecodeYear(CalendarLite1.Date,AYear); +end; + +procedure TForm1.edtMonthKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + case Key of + VK_Up : Inc(AMonth); + VK_Down : Dec(AMonth); + end; + case AMonth of + -1: AMonth := 11; + 12: AMonth := 0; + end; + edtMonth.Text:= MonthsList[AMonth]; + CalendarLite1.Date:= RecodeMonth(CalendarLite1.Date,AMonth+1); +end; + +end. + diff --git a/components/callite/demo2/testCalLite.lpi b/components/callite/demo2/testCalLite.lpi new file mode 100644 index 000000000..14dbc41b3 --- /dev/null +++ b/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> diff --git a/components/callite/demo2/testCalLite.lpr b/components/callite/demo2/testCalLite.lpr new file mode 100644 index 000000000..ec04b3575 --- /dev/null +++ b/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. + diff --git a/components/callite/demo2/umaintestcallite.lfm b/components/callite/demo2/umaintestcallite.lfm new file mode 100644 index 000000000..61a5cb5da --- /dev/null +++ b/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 diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp new file mode 100644 index 000000000..d56c07ff4 --- /dev/null +++ b/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. + diff --git a/components/callite/icon/TCALENDARLITE.PNG b/components/callite/icon/TCALENDARLITE.PNG new file mode 100644 index 0000000000000000000000000000000000000000..81ea0a4e9fb932bcf1664d7af9ee24c4f809545c GIT binary patch literal 886 zcmV-+1Bv{JP)<h;3K|Lk000e1NJLTq000;O000;W1^@s6;CDUv0000PbVXQnQ*UN; zcVTj606}DLVr3vnZDD6+Qe|Oed2z{QJOBU#7)eAyRCwB~RZB}8K@hH<nSCm8BWeNx z*MrK&7%{FSsI0nzf`&W}f;Zz|$R997e}M-fq97g<_ToiD4k{>w2nso@CahxA1w#@K zQP}rPr@CflvpYUAfh{O|+Uokgs;=r<cFY(s0Md`B!<;|DC4l-R!q}${xL&UE;f6AU z;5B~V6Ap`<*M)a>f~!qUThAE#1~%jhpC}T%QdE7@;-8p!4!IokuB<>T7K7eUD0ru@ zFKCD0f{&uW;rO^LY)V!?<K(Fn@MIExot?q%*ckX~Ye73dw}XGdhj~1JxK1KS>t`H1 zlYt!SgZ6f4XlQ`)iVE7>5vz|P%Ye8Joq%)7K*J1F)biO`a4s%FDjbI7@-qDH?1bvc z$!iG|tfSB8qi=yB;U01I42&3^nvucb&=7db${;Z_L#wv10J)kP_#crmgN%7aMhz5k zMS|p}5s9l{)ofmsDI5t9SD{Tn*O$D+A}|9KxlSt4!{8iBAq;DPND^I*@jppJa81)n zLLf<mtrHkA%Yr~H$RKub0Pok<=v&x2+S=e@Yb)*JCnpeDS|XtSPzdhU*ISCfMFw)7 z#mqp(3{1UMRRvE62H?f;Fx1!8!TRQA-d5)ILVtHRq|<49{JA1Op_(3OQ3jHTKBubr zAY5)Y+(tDcaygxOyB7(nD=Q&|J)cE_LO-ejW_F<lL}01G;qfti-P?oD(I||Lj1<|k z2%0Cb_(=sBNXA%|tyd)U=jkcL_V?i&=gWuHRRS|@BI+d0u1q$2=@kh~{;v$~H#d_W z#pCd1ZVp=TJJ8rjHbIa`B#6N3r(9A4Su>)#Ohh3?w4!UonXT<@n4O;|+cb`pCpcan z4-V$f3oNsXiZW0wkz_Ht=<Y5o;m`~B^nl;*r!%eCuG3RfMQ00r)uId-qo&a;1nV0c z@GcUemK?(9y0PC?n-7s{z?h2&3>S~~mzkuqtBceUl|2GoJw)&w|KKq8I2;Zd&!rH7 zB?x{9f)wYzBxCWQ+x-?wDENzZgxEJk0mO6l7%M9gzG%m!;Q1rK0AQyk%2*h))c^nh M07*qoM6N<$f_g`humAu6 literal 0 HcmV?d00001 diff --git a/components/callite/icon/icon-source.txt b/components/callite/icon/icon-source.txt new file mode 100644 index 000000000..6e404f59b --- /dev/null +++ b/components/callite/icon/icon-source.txt @@ -0,0 +1,5 @@ +The TCalendarLite palette icon is the image + + calendar-day.png + +of the Fugue Icons collection (http://p.yusukekamiyamane.com/) \ No newline at end of file diff --git a/components/callite/icon/make_lrs.bat b/components/callite/icon/make_lrs.bat new file mode 100644 index 000000000..e134d6b3e --- /dev/null +++ b/components/callite/icon/make_lrs.bat @@ -0,0 +1 @@ +lazres ..\source\calendarlite_icon.lrs TCALENDARLITE.PNG diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas new file mode 100644 index 000000000..df4a14f2e --- /dev/null +++ b/components/callite/source/calendarlite.pas @@ -0,0 +1,1295 @@ +{ TCalendarLite is a lightweight calendar component, a TGraphiccontrol + descendant, which is consequently not dependent on any widgetset. + It is not a fixed-size component, as are most calendars, but will align + and resize as needed + + Originator : H Page-Clark, 2013 + Contributions : Ariel Rodriguez, 2013 + Werner Pamler, 2013/2016 + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} + +unit CalendarLite; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, types, + menus; + +const + TopRow = 0; + DayRow = 1; + FirstDateRow = 2; + LastDateRow = 7; + LastCol = 7; + TodayRow = 8; + LastRow: word = 0; + DefCalHeight = 160; + DefCalWidth = 210; + DefMinHeight = 120; + DefMinWidth = 120; + DefaultDisplayText = 'Today is,dd/mm/yyyy,Holidays during,There are no holidays set for'; + DefTStyle: TTextStyle = (Alignment : taCenter; Layout : tlCenter; + SingleLine : True; Clipping : True; + ExpandTabs : False; ShowPrefix : False; + Wordbreak : False; Opaque : False; + SystemFont : False; RightToLeft: False; + EndEllipsis: False); + + //Ariel Rodriguez 12/09/2013 + EnglishDays = 'Sun,Mon,Tue,Wed,Thu,Fri,Sat'; + EnglishMonths = 'January,February,March,April,May,June,July,August,September,October,November,December'; + HebrewDays = 'א,ב,ג,ד,ה,ו,ש'; + HebrewMonths = ('ינואר,פברואר,מרץ,אפריל,מאי,יוני, יולי,אוגוסט,ספטמבר,אוקטובר,נובמבר,דצמבר'); + HebrewTexts = 'היום הוא,yyyy-mm-dd,במהלך החגים, אין חגים מוגדרים עבור'; + FrenchDays = 'dim,lun,mar,mer,jeu,ven,sm'; + FrenchMonths = 'janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre'; + FrenchTexts = 'Est aujourd''hui,yyyy/mm/dd,vacances pendant,Il n''y a pas de jours fériés fixés pour'; + GermanMonths = 'Januar,Februar,März,April,Mai,Juni,Juli,August,September,Oktober,November,Dezember'; + GermanDays = 'Son,Mon,Die,Mit,Don,Fre,Sam'; + GermamTexts = 'Heute ist,yyyy/mm/dd,Urlaub während,Es gibt keine Feiertage eingestellt für'; + SpanishDays = 'Dom,Lun,Mar,Mie,Jue,Vie,Sab'; + SpanishMonths = 'Enero,Febrero,Marzo,Abril,Mayo,Junio,Julio,Agosto,Septiembre,Octubre,Noviembre,Diciembre'; + SpanishTexts = 'Hoy es,dd/mm/yyyy,Dias de fiestas,No hay dias feriados establecidos para'; + //Ariel Rodriguez 12/09/2013 + +type + TCalendarLite = class; + + TColArray = array[1..LastCol] of word; + TRowArray = array of word; + + TArrowDirection = (adLeft, adRight); + TArrowhead = (ahSingle, ahDouble); + TArrowPoints = array[1..3] of TPoint; + + TDayOfWeek = (dowSunday=1, dowMonday=2, dowTuesday=3, dowWednesday=4, + dowThursday=5, dowFriday=6, dowSaturday=7); + TDaysOfWeek = set of TDayOfWeek; + + TDisplayText = (dtToday=0, dtTodayFormat=1, dtHolidaysDuring=2, dtNoHolidaysDuring=3); + + THolidays = DWord; + TGetHolidaysEvent = procedure (Sender: TObject; AMonth, AYear: Integer; + var Holidays: THolidays) of object; + + TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow, + coBoldWeekend, coDayLine, coShowBorder, coShowHolidays, + coShowTodayFrame, coShowTodayName, coShowTodayRow, + coShowWeekend, coUseTopRowColors); + TCalOptions = set of TCalOption; + TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013 + + + { TCalDrawer } + + TCalDrawer = class + private + FBoundsRect: TRect; + FCanvas: TCanvas; + FCellSize: TSize; + FColPositions: TColArray; + FOwner: TCalendarLite; + FRowPositions: TRowArray; + FStartDate: TDateTime; + FThisDay: word; + FThisMonth: word; + FThisYear: word; + FTStyle: TTextStyle; + procedure CalcSettings; + procedure ChangeDateTo(aCell: TSize); + procedure DrawArrow(aRect: TRect; aHead: TArrowhead; aDirn: TArrowDirection); + procedure DrawDayCells; + procedure DrawDayLabels; + procedure DrawTodayRow; + procedure DrawTopRow; + function GetCellAt(aPoint: TPoint): TSize; + function GetCellAtColRow(aCol, aRow: integer): TRect; + function GetColRowPosition(aCol, aRow: integer): TSize; + function GetLeftColIndex: Integer; + procedure GetMonthYearRects(var AMonthRect, AYearRect: TRect); + function GetRightColIndex: Integer; + procedure GotoDay(aDate: word); + procedure GotoMonth(AMonth: word); + procedure GotoToday; + procedure GotoYear(AYear: word); + procedure LeftClick; + procedure NextMonth; + procedure NextYear; + procedure PrevMonth; + procedure PrevYear; + procedure RightClick; + public + constructor Create(aCanvas: TCanvas); + procedure Draw; + end; + + + { TCalColors } + + TCalColors = class(TPersistent) + private + FOwner: TCalendarLite; + FColors: Array[0..12] of TColor; + function GetColor(AIndex: Integer): TColor; + procedure SetColor(AIndex: Integer; AValue: TColor); + public + constructor Create(AOwner: TCalendarLite); + published + property ArrowBorderColor: TColor index 0 read GetColor write SetColor default clSilver; + property ArrowColor: TColor index 1 read GetColor write SetColor default clSilver; + property BackgroundColor: TColor index 2 read GetColor write SetColor default clWhite; + property BorderColor: TColor index 3 read GetColor write SetColor default clSilver; + property DaylineColor: TColor index 4 read GetColor write SetColor default clSilver; + property HolidayColor: TColor index 5 read GetColor write SetColor default clRed; + property PastMonthColor: TColor index 6 read GetColor write SetColor default clSilver; + property SelectedDateColor: TColor index 7 read GetColor write SetColor default clMoneyGreen; + property TextColor: TColor index 8 read GetColor write SetColor default clBlack; + property TodayFrameColor: TColor index 9 read GetColor write SetColor default clLime; + property TopRowColor: TColor index 10 read GetColor write SetColor default clHighlight; + property TopRowTextColor: TColor index 11 read GetColor write SetColor default clHighlightText; + property WeekendColor: TColor index 12 read GetColor write SetColor default clRed; + end; + + + { TCalendarLite } + + TCalendarLite = class(TGraphicControl) + private + FCalDrawer: TCalDrawer; + FColors: TCalColors; + FDate: TDateTime; + FDayNames: TStringList; + FDisplayTexts: TStringList; + FMonthNames: TStringList; + FOnDateChange: TNotifyEvent; + FOnGetHolidays: TGetHolidaysEvent; + FOptions: TCalOptions; + FPopupMenu: TPopupMenu; + FStartingDayOfWeek: TDayOfWeek; + FWeekendDays: TDaysOfWeek; + FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013 + procedure DateChange; + function GetDayNames: String; + function GetDisplaytexts: String; + function GetMonthNames: String; + procedure HolidayMenuItemClicked(Sender: TObject); + procedure MonthMenuItemClicked(Sender: TObject); + procedure PopulateHolidayPopupMenu; + procedure PopulateMonthPopupMenu; + procedure PopulateYearPopupMenu; + procedure SetDate(AValue: TDateTime); + procedure SetDayNames(const AValue: String); + procedure SetDefaultDisplayTexts; + procedure SetDisplayTexts(AValue: String); + procedure SetMonthNames(const AValue: String); + procedure SetOptions(AValue: TCalOptions); + procedure SetStartingDayOfWeek(AValue: TDayOfWeek); + procedure SetWeekendDays(AValue: TDaysOfWeek); + procedure YearMenuItemClicked(Sender: TObject); + procedure SetLanguage(AValue: TLanguage); //Ariel Rodriguez 12/09/2013 + protected +// procedure CreateHandle; override; + class function GetControlClassDefaultSize: TSize; override; + function GetDayName(ADayOfWeek: TDayOfWeek): String; + function GetDisplayText(aTextIndex: TDisplayText): String; + function GetMonthName(AMonth: Integer): String; + procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; + procedure Paint; override; + public + constructor Create(anOwner: TComponent); override; + destructor Destroy; override; + published + property Anchors; + property Align; + property BiDiMode; + property BorderSpacing; + property Constraints; + property Font; + property Hint; + property ParentColor; + property ParentFont; + property ParentShowHint; + property ShowHint; + property Visible; + // new properties + property Colors: TCalColors read FColors; + property Date: TDateTime read FDate write SetDate; + property DayNames: String read GetDayNames write SetDayNames; + property DisplayTexts: String read GetDisplaytexts write SetDisplayTexts; + property MonthNames: String read GetMonthnames write SetMonthNames; + property Options: TCalOptions read FOptions write SetOptions + default [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, coShowTodayRow]; + property StartingDayOfWeek: TDayOfWeek read FStartingDayOfWeek + write SetStartingDayOfWeek default dowSunday; + property WeekendDays: TDaysOfWeek read FWeekendDays + write SetWeekendDays default [dowSunday]; + property Languages: TLanguage read FLanguage + write SetLanguage default lgEnglish; //Ariel Rodriguez 12/09/2013 + // new event properties + property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange; + property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays; + end; + +procedure ClearHolidays(var AHolidays: THolidays); +procedure AddHoliday(ADay: Integer; var AHolidays: THolidays); +function IsHoliday(ADay: Integer; AHolidays: THolidays): Boolean; + +procedure Register; //Ariel Rodriguez 12/09/2013 + +implementation + +uses + LazUTF8, dateutils, math; + + +{ Holiday helpers } + +{ Clears the per month holiday buffer } +procedure ClearHolidays(var AHolidays: DWord); +begin + AHolidays := 0; +end; + +{ Set bit for given day to mark the day as a holiday } +procedure AddHoliday(ADay: Integer; var AHolidays: DWord); +begin + AHolidays := DWord(1 shl ADay) or AHolidays; +end; + +{ Check if the bit for the given day is set in AHolidays } +function IsHoliday(ADay: Integer; AHolidays: THolidays): Boolean; +begin + Result := (AHolidays and DWord(1 shl ADay)) <> 0; +end; + + +{ TCalDrawer } + +constructor TCalDrawer.Create(aCanvas: TCanvas); +begin + inherited Create; + FCanvas:= aCanvas; + FTStyle:= DefTStyle; +end; + +procedure TCalDrawer.CalcSettings; +var + rem, i, cellWidths, totalSpace, cw, cellHeights, hSpc, + adjSpace, sp, borderh, borderv, ch, numRows: integer; + sz: TSize; + bit: integer=0; +begin + if (FOwner.BiDiMode = bdLeftToRight) then + FTStyle.RightToLeft:= False + else + FTStyle.RightToLeft:= True; + SetLength(FRowPositions, 0); + if (coShowTodayRow in FOwner.Options) then + LastRow := TodayRow + else + LastRow := LastDateRow; + SetLength(FRowPositions, LastRow+1); + + totalspace := Succ(LastCol)*3; + sz := Size(FBoundsRect); + cellWidths := sz.cx - totalSpace; + DivMod(cellWidths, LastCol, cw, rem); + FCellSize.cx := cw; + adjSpace := sz.cx - LastCol*cw; + DivMod(adjSpace, LastCol+1, hSpc, rem); + borderh := (rem div 2) + 1; + for i := Low(FColPositions) to High(FColPositions) do + case FOwner.BiDiMode = bdLeftToRight of + False : FColPositions[8-i]:= borderh + Pred(i)*cw + hSpc*i; + True : FColPositions[i]:= borderh + Pred(i)*cw + hSpc*i; + end; + case LastRow of + LastDateRow : totalSpace := 12; + TodayRow : totalSpace := 14; + end; + + cellHeights := sz.cy - totalSpace; + numRows := Succ(LastRow); + DivMod(cellHeights, numRows, ch, rem); + FCellSize.cy := ch; + adjSpace := sz.cy - numRows*ch; + DivMod(adjSpace, totalSpace, sp, rem); + rem := sz.cy - ch*numRows - totalSpace*sp; + borderv := rem div 3; + if (borderv = 0) then + bit := rem + 1; + rem := sp shl 1; + cw := bit + borderv + rem; + FRowPositions[TopRow] := cw; + inc(cw, rem); + FRowPositions[DayRow] := cw + ch; + for i := FirstDateRow to LastDateRow do + FRowPositions[i] := cw + i*ch + (i-1)*sp; + if (LastRow = TodayRow) then + FRowPositions[TodayRow] := FRowPositions[LastDateRow] + borderv + ch + rem; +end; + +procedure TCalDrawer.ChangeDateTo(aCell: TSize); +var + diff: integer; + newDate: TDateTime; + d, m, y: word; +begin + diff := aCell.cx + LastCol * (aCell.cy - 2); + newDate:= FStartDate + diff - 1; + FOwner.FDate := newDate; + FOwner.DateChange; + FCanvas.Brush.Color := FOwner.Colors.BackgroundColor; + FCanvas.FillRect(FBoundsRect); + Self.Draw; + DecodeDate(newDate, y, m, d); +end; + +procedure TCalDrawer.Draw; +begin + if not Assigned(FCanvas) then Exit; + DecodeDate(FOwner.FDate, FThisYear, FThisMonth, FThisDay); + CalcSettings; + DrawTopRow; + DrawDayLabels; + DrawDayCells; + DrawTodayRow; +end; + +procedure TCalDrawer.DrawArrow(aRect: TRect; aHead: TArrowhead; aDirn: TArrowDirection); +var + sz: TSize; + d, ox, oy, half: integer; + pts: TArrowPoints; +begin + if (FCanvas.Brush.Color <> FOwner.Colors.ArrowColor) then + FCanvas.Brush.Color:= FOwner.Colors.ArrowColor; + if (FCanvas.Pen.Color <> FOwner.Colors.ArrowBorderColor) then + FCanvas.Pen.Color := FOwner.Colors.ArrowBorderColor; + sz := Size(aRect); + d := Min(sz.cy, sz.cx) div 3; + half := d div 2; + ox := aRect.Left + (sz.cx - d) div 2; + oy := aRect.Top + (sz.cy - d) div 2; + case aHead of + ahSingle: + begin + case aDirn of + adLeft: + begin + pts[1]:= Point(ox+d, oy); + pts[2]:= Point(ox, oy+half); + pts[3]:= Point(ox+d, oy+d); + end; + adRight: + begin + pts[1]:= Point(ox, oy); + pts[2]:= Point(ox, oy+d); + pts[3]:= Point(ox+d, oy+half); + end; + end; + FCanvas.Polygon(pts); + end; + ahDouble: + case aDirn of + adLeft: + begin + pts[1]:= Point(ox+half-1, oy); + pts[2]:= Point(ox-1, oy+half); + pts[3]:= Point(ox+half-1, oy+d); + FCanvas.Polygon(pts); + pts[1]:= Point(ox+d, oy); + pts[2]:= Point(ox+half, oy+half); + pts[3]:= Point(ox+d, oy+d); + FCanvas.Polygon(pts); + end; + adRight: + begin + pts[1]:= Point(ox, oy); + pts[2]:= Point(ox+half, oy+half); + pts[3]:= Point(ox, oy+d); + FCanvas.Polygon(pts); + pts[1]:= Point(ox+half+1, oy); + pts[2]:= Point(ox+d+1, oy+half); + pts[3]:= Point(ox+half+1, oy+d); + FCanvas.Polygon(pts); + end; + end; + end; +end; + +procedure TCalDrawer.DrawDayCells; +var + r, c, startCol, startRow, startSpan: integer; + rec: TRect; + s: string; + dow, y, m, d: word; + partWeeks, remDays: integer; + dt, todayDate: TDateTime; + holidays: THolidays; +begin + todayDate := Date; + dow := DayOfWeek(FOwner.FDate); + c := dow - integer(FOwner.FStartingDayOfWeek); + if (c < 0) then Inc(c, 7); + startCol := Succ(c); + partweeks := FThisDay - startCol; + DivMod(partWeeks, 7, startRow, remDays); + if (remDays > 0) then Inc(startRow, 1); + startspan := startRow*7 + startCol - 1; + FStartDate := FOwner.FDate - startSpan; + dt := FStartDate; + ClearHolidays(holidays); + if Assigned(FOwner.FOnGetHolidays) then + FOwner.FOnGetHolidays(FOwner, FThisMonth, FThisYear, holidays); + for r:= FirstDateRow to LastDateRow do + for c:= Low(FColPositions) to High(FColPositions) do + begin + rec := GetCellAtColRow(c, r); + DecodeDate(dt, y, m, d); + case (m = FThisMonth) of + False: + begin + FCanvas.Font.Color:= FOwner.Colors.PastMonthColor; + FCanvas.Font.Style := []; + end; + True: + begin + FCanvas.Font.Color:= FOwner.Colors.TextColor; + FCanvas.Font.Style := []; + if (coShowHolidays in FOwner.Options) and IsHoliday(d, holidays) then + begin + FCanvas.Font.Color := FOwner.Colors.HolidayColor; + if coBoldHolidays in FOwner.Options then + FCanvas.Font.Style := [fsBold]; + end else + if (coShowWeekend in FOwner.Options) and + (TDayOfWeek(DayOfWeek(dt)) in FOwner.FWeekendDays) then + begin + FCanvas.Font.Color := FOwner.Colors.WeekendColor; + if coBoldWeekend in FOwner.Options then + FCanvas.Font.Style := [fsBold]; + end; + end; + end; + s := IntToStr(d); + if (dt = FOwner.FDate) then + begin + FCanvas.Brush.Color:= FOwner.FColors.SelectedDateColor; + FCanvas.FillRect(rec); + end + else + FCanvas.Brush.Color:= FOwner.Colors.BackgroundColor; + + FCanvas.TextRect(rec, 0, 0, s, FTStyle); + if (dt = todayDate) and (coShowTodayFrame in FOwner.Options) then + begin + FCanvas.Pen.Color:= FOwner.Colors.TodayFrameColor; + FCanvas.Pen.Width:= 2; + Inc(rec.Top); Inc(rec.Bottom); + FCanvas.Frame(rec); + FCanvas.Pen.Width:= 1; + end; + dt:= dt + 1; + end; // for c +end; + +procedure TCalDrawer.DrawDayLabels; +var + c, map: integer; + rec: TRect; + lbls: TWeekNameArray; +begin + FCanvas.Font.Color:= FOwner.Colors.TextColor; + if (coBoldDayNames in FOwner.Options) then + FCanvas.Font.Style := [fsBold] + else + FCanvas.Font.Style := []; + map := Integer(FOwner.FStartingDayOfWeek); + for c:= Low(TWeekNameArray) to High(TWeekNameArray) do + begin + if (map > High(TWeekNameArray)) then map := Low(TWeekNameArray); + lbls[c] := FOwner.GetDayName(TDayOfWeek(map)); + inc(map); + end; + for c:= Low(FColPositions) to High(FColPositions) do + begin + rec := GetCellAtColRow(c, DayRow); + FCanvas.TextRect(rec, 0, 0, lbls[c], FTStyle); + end; + if (coDayLine in FOwner.Options) then begin + rec := GetCellAtColRow(GetLeftColIndex, DayRow); + rec.Right := GetCellAtColRow(GetRightColIndex, DayRow).Right; + rec.Bottom := rec.Top; + FCanvas.Pen.Color := FOwner.Colors.DayLineColor; + FCanvas.Line(rec); + end; +end; + +procedure TCalDrawer.DrawTodayRow; +var + r1, r2: TRect; + w1, w2, w3, rem, halfRem: integer; + s: String; +begin + if (LastRow <> TodayRow) then Exit; + r1 := GetCellAtColRow(2, TodayRow); + + if coUseTopRowColors in FOwner.Options then begin + if (FCanvas.Font.Color <> FOwner.Colors.TopRowTextColor) + then FCanvas.Font.Color:= FOwner.Colors.TopRowTextColor; + FCanvas.Brush.Color := FOwner.Colors.TopRowColor; + FCanvas.FillRect(r1); + end else + if (FCanvas.Font.Color <> FOwner.Colors.TextColor) then + FCanvas.Font.Color:= FOwner.Colors.TextColor; + + s:= FOwner.GetDisplayText(dtToday); + if (coShowTodayName in FOwner.Options) then + s := Format('%s %s',[s, FOwner.GetDayName(TDayOfWeek(DayOfWeek(Date())))]); + AppendStr(s, ' ' + FormatDateTime(FOwner.GetDisplayText(dtTodayFormat), Date())); + w1 := FCanvas.TextWidth('aaa'); + w2 := FCanvas.TextWidth(' '); + w3 := FCanvas.TextWidth(s); + rem := Size(r1).cx - w1 - w2 - w3; + halfRem := rem div 2; + if (rem < 0) then + begin + Inc(r1.Left, halfRem); + Dec(r1.Right, halfRem); + rem := 0; + end; + r2:= r1; + + r1.Left := r1.Left + halfRem; + r1.Right := r1.Left + w1; + InflateRect(r1, 0, -FCellSize.cy div 5); + if (FCanvas.Pen.Color <> FOwner.Colors.TodayFrameColor) then + FCanvas.Pen.Color := FOwner.Colors.TodayFrameColor; + FCanvas.Pen.Width := 2; + FCanvas.Frame(r1); + FCanvas.Pen.Width := 1; + + r2.Left := r1.Right + w2; + r2.Right := r2.Left + w3 + 2; + if (coBoldToday in FOwner.Options) then + FCanvas.Font.Style := [fsBold] + else + FCanvas.Font.Style := []; + FCanvas.TextRect(r2, 0, 0, s, FTStyle); +end; + +procedure TCalDrawer.DrawTopRow; +var + r: TRect; + s: String; +begin + if coUseTopRowColors in FOwner.Options then begin + FCanvas.Font.Color:= FOwner.Colors.TopRowTextColor; + FCanvas.Brush.Color := FOwner.Colors.TopRowColor; + r := GetCellAtColRow(GetLeftColIndex, TopRow); + r.Right := GetCellAtColRow(GetRightColIndex, TopRow).Right; + FCanvas.FillRect(r); + end else + if (FCanvas.Font.Color <> FOwner.Colors.TextColor) then + FCanvas.Font.Color:= FOwner.Colors.TextColor; + if (coBoldTopRow in FOwner.Options) then + FCanvas.Font.Style := [fsBold] + else + FCanvas.Font.Style := []; + + case (FOwner.BiDiMode = bdLeftToRight) of + False: begin + r:= GetCellAtColRow(7, TopRow); DrawArrow(r, ahDouble, adLeft); + r:= GetCellAtColRow(6, TopRow); DrawArrow(r, ahSingle, adLeft); + r:= GetCellAtColRow(1, TopRow); DrawArrow(r, ahDouble, adRight); + r:= GetCellAtColRow(2, TopRow); DrawArrow(r, ahSingle, adRight); + r:= GetCellAtColRow(3, TopRow); + end; + True: begin + r:= GetCellAtColRow(1, TopRow); DrawArrow(r, ahDouble, adLeft); + r:= GetCellAtColRow(2, TopRow); DrawArrow(r, ahSingle, adLeft); + r:= GetCellAtColRow(7, TopRow); DrawArrow(r, ahDouble, adRight); + r:= GetCellAtColRow(6, TopRow); DrawArrow(r, ahSingle, adRight); + r:= GetCellAtColRow(3, TopRow); + end; + end; + s := FOwner.GetMonthName(FThisMonth) + ' ' + IntToStr(FThisYear); + FCanvas.TextRect(r, 0, 0, s, FTStyle); +end; + +function TCalDrawer.GetCellAt(aPoint: TPoint): TSize; +var + x: integer; +begin + case FOwner.BiDiMode <> bdLeftToRight of + False: + for x := Low(FColPositions) to High(FColPositions) do + if FColPositions[x] >= aPoint.x then + begin + Result.cx := x-1; + Break; + end else + Result.cx := LastCol; + True: + for x:= High(FColPositions) downto Low(FColPositions) do + if FColPositions[x] >= aPoint.x then + begin + Result.cx := x+1; + Break; + end else + Result.cx := 1; + end; + for x := 1 to High(FRowPositions) do + if FRowPositions[x] >= aPoint.y then + begin + Result.cy := x-1; + Break; + end + else + Result.cy := High(FRowPositions); +end; + +function TCalDrawer.GetCellAtColRow(aCol, aRow: integer): TRect; +var + sz: TSize; + mid, midmid, midhi, midmidhi, half, fraction: integer; +begin + sz := GetColRowPosition(aCol, aRow); + Result.Top := sz.cy; + Result.Bottom := Result.Top + FCellSize.cy; + half := FCellSize.cx div 2; + case aRow of + TopRow: + begin + case (FOwner.BiDiMode = bdLeftToRight) of + True: + begin // LeftToRight + mid := FColPositions[2] + half; + fraction := (mid - FColPositions[1]) div 2; + midmid := FColPositions[1] + fraction; + midhi := FColPositions[6] + half; + midmidhi := midhi + fraction; + end; + False: + begin // RightToLeft + mid := FColPositions[6] + half; + fraction := (mid - FColPositions[7]) div 2; + midmid := FColPositions[7] + fraction; + midhi := FColPositions[2] + half; + midmidhi := midhi + fraction; + aCol := 8 - aCol; + end; + end; + case aCol of + 1: + begin + Result.Left := sz.cx; + Result.Right := midmid; + end; + 2: + begin + Result.Left := midmid; + Result.Right := mid; + end; + 3..5: + begin + Result.Left := mid; + Result.Right := midhi; + end; + 6: + begin + Result.Right := midmidhi; + Result.Left := midhi; + end; + 7: + begin + Result.Left := midmidhi; + Result.Right := midmidhi + fraction; + end; + end; + end; + + TodayRow: + begin + Result.Left := GetColRowPosition(GetLeftColIndex, TodayRow).cx; + Result.Right := GetColRowPosition(GetRightColIndex, TodayRow).cx + FCellSize.cx; + end; + + else + Result.Left := sz.cx; + Result.Right := Result.Left + FCellSize.cx; + end; +end; + +function TCalDrawer.GetColRowPosition(aCol, aRow: integer): TSize; +begin + Result.cy:= FRowPositions[aRow]; + Result.cx:= FColPositions[aCol]; +end; + +function TCalDrawer.GetLeftColIndex: Integer; +begin + if FOwner.BiDiMode = bdLeftToRight then + Result := 1 + else + Result := 7; +end; + +procedure TCalDrawer.GetMonthYearRects(var AMonthRect, AYearRect: TRect); +var + sm, sy: string; + w: Integer; + r: TRect; +begin + AMonthRect := GetCellAtColRow(3, TopRow); + AYearRect := AMonthRect; + if (coBoldTopRow in FOwner.Options) then + FCanvas.Font.Style := [fsBold] + else + FCanvas.Font.Style := []; + sm := FOwner.GetMonthName(FThisMonth); + sy := IntToStr(FThisYear); + w := FCanvas.TextWidth(sm + ' ' + sy); + AMonthRect.Left := (FOwner.Width - w) div 2; + AMonthRect.Right := AMonthRect.Left + FCanvas.TextWidth(sm); + AYearRect.Right := (FOwner.Width + w) div 2; + AYearRect.Left := AYearRect.Right - FCanvas.TextWidth(sy); + if (FOwner.BiDiMode <> bdLeftToRight) then + begin + r := AMonthRect; + AMonthRect := AYearRect; + AYearRect := r; + end; +end; + +function TCalDrawer.GetRightColIndex: Integer; +begin + if FOwner.BiDiMode = bdLeftToRight then + Result := 7 + else + Result := 1; +end; + +procedure TCalDrawer.GotoDay(aDate: word); +begin + FOwner.FDate := aDate; + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.GotoMonth(AMonth: word); +var + d: TDate; +begin + if not TryEncodeDate(FThisYear, AMonth, FThisDay, d) then // Feb 29 in leap year! + d := EncodeDate(FThisYear, AMonth, FThisDay); + FOwner.FDate := d; + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.GotoToday; +begin + FOwner.FDate:= Date(); + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.GotoYear(AYear: word); +var + d: TDate; +begin + if not TryEncodeDate(AYear, FThisMonth, FThisDay, d) then // Feb 29 in leap year! + d := EncodeDate(AYear, FThisMonth, FThisDay); + FOwner.FDate := d; + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.LeftClick; +var + p, ppopup: TPoint; + cell: TSize; + Rm, Ry: TRect; +begin + p := FOwner.ScreenToClient(Mouse.CursorPos); + cell := GetCellAt(p); + case cell.cy of + TopRow: + case cell.cx of + 1: PrevYear; + 2: PrevMonth; + 3..5: + begin + GetMonthYearRects(Rm, Ry); + if PtInRect(Rm, p) then begin + FOwner.PopulateMonthPopupMenu; + ppopup := FOwner.ClientToScreen(Point(Rm.Left, Rm.Bottom)); + FOwner.FPopupMenu.PopUp(ppopup.x, ppopup.y); + end; + if PtInRect(Ry, p) then begin + FOwner.PopulateYearPopupMenu; + ppopup := FOwner.ClientToScreen(Point(Ry.Left, Ry.Bottom)); + FOwner.FPopupMenu.Popup(ppopup.x, ppopup.y); + end; + end; + 6: NextMonth; + 7: NextYear; + end; + DayRow: ; + FirstDateRow..LastDateRow : + ChangeDateTo(cell); + else + GotoToday; + end; +end; + +procedure TCalDrawer.NextMonth; +begin + FOwner.FDate := IncMonth(FOwner.FDate, 1); + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.NextYear; +begin + FOwner.FDate := IncYear(FOwner.FDate, 1); + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.PrevMonth; +begin + FOwner.FDate := IncMonth(FOwner.FDate, -1); + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.PrevYear; +begin + FOwner.FDate := IncYear(FOwner.FDate, -1); + FOwner.DateChange; + FOwner.Invalidate; +end; + +procedure TCalDrawer.RightClick; +begin + if Assigned(FOwner.FOnGetHolidays) then + begin + FOwner.PopulateHolidayPopupMenu; + FOwner.FPopupMenu.PopUp(Mouse.CursorPos.x, Mouse.CursorPos.y); + end; +end; + + +{ TCalColors } + +constructor TCalColors.Create(AOwner: TCalendarLite); +begin + inherited Create; + FOwner := AOwner; + FColors[0] := clSilver; // ArrowBorderColor: clSilver; + FColors[1] := clSilver; // ArrowColor: clSilver; + FColors[2] := clWhite; // BackgroundColor: clWhite; + FColors[3] := clSilver; // BorderColor: clSilver; + FColors[4] := clSilver; // DaylineColor: clSilver; + FColors[5] := clRed; // HolidayColor: clRed; + FColors[6] := clSilver; // PastMonthColor: clSilver; + FColors[7] := clMoneyGreen; // SelectedDateColor: clMoneyGreen; + FColors[8] := clBlack; // TextColor: clBlack; + FColors[9] := clGray; // TodayFrameColor: clGray; + FColors[10] := clHighlight; // TopRowColor: clHighlight; + FColors[11] := clHighlightText; // TopRowTextColor: clHighlightText; + FColors[12] := clRed; // WeekendColor: clRed; +end; + +function TCalColors.GetColor(AIndex: Integer): TColor; +begin + Result := FColors[AIndex]; +end; + +procedure TCalColors.SetColor(AIndex: Integer; AValue: TColor); +begin + if FColors[AIndex] = AValue then exit; + FColors[AIndex] := AValue; + FOwner.Invalidate; +end; + + +{ TCalendarLite } + +constructor TCalendarLite.Create(anOwner: TComponent); +begin + inherited Create(anOwner); + FColors := TCalColors.Create(self); + FDate:= SysUtils.Date; + Color:= clWhite; + FStartingDayOfWeek:= dowSunday; + with GetControlClassDefaultSize do + SetInitialBounds(0, 0, cx, cy); + Constraints.MinHeight := DefMinHeight; + Constraints.MinWidth := DefMinWidth; + Canvas.Brush.Style:= bsSolid; + FDayNames := TStringList.Create; + FMonthNames := TStringList.Create; + FDisplayTexts := TStringList.Create; + FDisplayTexts.StrictDelimiter := True; + FDisplayTexts.Delimiter:= ','; + SetDefaultDisplayTexts; + FPopupMenu := TPopupMenu.Create(Self); + FCalDrawer:= TCalDrawer.Create(Canvas); + FCalDrawer.FOwner:= Self; + FWeekendDays := [dowSunday, dowSaturday]; + FOptions := [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, + coShowTodayRow]; + FLanguage := lgEnglish; //Ariel Rodriguez 12/09/2013 +end; + +destructor TCalendarLite.Destroy; +begin + FreeAndNil(FDayNames); + FreeAndNil(FMonthNames); + FreeAndNil(FDisplayTexts); + FreeAndNil(FColors); + SetLength(FCalDrawer.FRowPositions, 0); + FreeAndNil(FCalDrawer); + inherited Destroy; +end; + +procedure TCalendarLite.DateChange; +begin + if Assigned(FOnDateChange) then + FOnDateChange(Self); +end; + +class function TCalendarLite.GetControlClassDefaultSize: TSize; +begin + Result.cx := DefCalWidth; + Result.cy := DefCalHeight; +end; + +function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String; +begin + Result := SysToUTF8(DefaultFormatSettings.ShortDayNames[integer(ADayOfWeek)]); + if Pred(integer(ADayOfWeek)) < FDayNames.Count then + Result := FDayNames[Pred(integer(ADayOfWeek))]; +end; + +function TCalendarLite.GetDayNames: String; +begin + Result := FDayNames.CommaText; +end; + +function TCalendarLite.GetDisplayText(aTextIndex: TDisplayText): String; +begin + Result := FDisplayTexts[Integer(aTextIndex)]; +end; + +function TCalendarLite.GetDisplayTexts: String; +begin + Result := FDisplayTexts.CommaText; +end; + +function TCalendarLite.GetMonthName(AMonth: Integer): String; +begin + Result := SysToUTF8(DefaultFormatSettings.LongMonthNames[AMonth]); + if pred(AMonth) < FMonthnames.Count then + Result := FMonthNames[pred(AMonth)]; +end; + +function TCalendarLite.GetMonthNames: String; +begin + Result := FMonthNames.CommaText; +end; + +procedure TCalendarLite.HolidayMenuItemClicked(Sender: TObject); +begin + FCalDrawer.GotoDay(TMenuItem(Sender).Tag); +end; + +procedure TCalendarLite.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseDown(Button, Shift, X, Y); + case Button of + mbLeft : FCalDrawer.LeftClick; + mbRight : FCalDrawer.RightClick; + end; +end; + +procedure TCalendarLite.MonthMenuItemClicked(Sender: TObject); +begin + FCalDrawer.GotoMonth(TMenuItem(Sender).Tag); +end; + +procedure TCalendarLite.Paint; +var + r: TRect; +begin + if Assigned(FCalDrawer) then + begin + if ParentColor then + Colors.BackgroundColor := Parent.Color; + if ParentFont then + begin + if (Parent.Font <> FCalDrawer.FCanvas.Font) + then FCalDrawer.FCanvas.Font := Parent.Font + else if (Canvas.Font.Color <> Colors.TextColor) + then FColors.TextColor := Canvas.Font.Color; + end; + + case (BiDiMode = bdLeftToRight) of + False: if not FCalDrawer.FTStyle.RightToLeft then + FCalDrawer.FTStyle.RightToLeft := True; + True : if FCalDrawer.FTStyle.RightToLeft then + FCalDrawer.FTStyle.RightToLeft := False; + end; + + Canvas.Brush.Color:= Colors.BackGroundColor; + Canvas.FillRect(ClientRect); + if (coShowBorder in FOptions) then + begin + if (Canvas.Pen.Color <> FColors.BorderColor) then + Canvas.Pen.Color := FColors.BorderColor; + Canvas.Frame(ClientRect); + end; + + r:= ClientRect; + if (coShowBorder in FOptions) then InflateRect(r, -1, -1); + FCalDrawer.FBoundsRect:= r; + FCalDrawer.Draw; + end; + + inherited Paint; +end; + +procedure TCalendarLite.PopulateHolidayPopupMenu; +var + item: TMenuItem; + m, d, dayCount: Integer; + population: integer = 0; + hols: THolidays; + dt: TDateTime; +begin + with FPopupMenu.Items do begin + Clear; + item:= TMenuItem.Create(Self); + item.Caption:= Format('%s %d', [GetDisplayText(dtHolidaysDuring), FCalDrawer.FThisYear]); + Add(item); + item:= TMenuItem.Create(Self); + item.Caption:= '-'; + Add(item); + for m:= 1 to 12 do + begin + ClearHolidays(hols); + FOnGetHolidays(Self, m, FCalDrawer.FThisYear, hols); + dayCount:= DaysInAMonth(FCalDrawer.FThisYear, m); + d := 1; + repeat + if IsHoliday(d, hols) then + begin + item := TMenuItem.Create(Self); + inc(population); + item.Caption:= IntToStr(d) + ' ' + GetMonthName(m); + if (m = FCalDrawer.FThisMonth) then + item.Checked := True; + dt := EncodeDate(FCalDrawer.FThisYear, m, d); + item.Tag := trunc(dt); + item.OnClick := @HolidayMenuItemClicked; + Add(item); + end; + inc(d) + until d > dayCount; + end; + Items[0].Enabled := (population <> 0); + if not Items[0].Enabled then + Items[0].Caption := Format('%s %d', [GetDisplayText(dtNoHolidaysDuring), FCalDrawer.FThisYear]); + end; +end; + +procedure TCalendarLite.PopulateMonthPopupMenu; +var + m: Integer; + item: TMenuItem; +begin + with FPopupMenu.Items do begin + Clear; + for m := 1 to 12 do + begin + item := TMenuItem.Create(self); + item.Caption := GetMonthName(m); + item.OnClick := @MonthMenuItemClicked; + item.Tag := m; + if m = FCalDrawer.FThisMonth then + item.Checked := true; + Add(item); + end; + end; +end; + +procedure TCalendarLite.PopulateYearPopupMenu; +var + y: Integer; + item: TMenuItem; +begin + with FPopupMenu.Items do begin + Clear; + for y := FCalDrawer.FThisYear - 10 to FCalDrawer.FThisYear + 10 do + begin + item := TMenuItem.Create(self); + item.Caption := IntToStr(y); + item.OnClick := @YearMenuItemClicked; + item.Tag := y; + if y = FCalDrawer.FThisYear then + item.Checked := true; + if (FCalDrawer.FThisDay = 29) and (FCalDrawer.FThisMonth = 2) and not IsLeapYear(y) + then item.Enabled:= False; + Add(item); + end; + end; +end; + +procedure TCalendarLite.SetDate(AValue: TDateTime); +begin + if FDate = AValue then Exit; + FDate := AValue; + DateChange; + Invalidate; +end; + +procedure TCalendarLite.SetDayNames(const AValue: String); +begin + FDayNames.CommaText := AValue; + Invalidate; +end; + +procedure TCalendarLite.SetDefaultDisplayTexts; +begin + FDisplayTexts.CommaText := DefaultDisplayText; +end; + +procedure TCalendarLite.SetDisplayTexts(AValue: String); +begin + FDisplayTexts.CommaText := AValue; + Invalidate; +end; + +//Ariel Rodriguez 12/09/2013 +procedure TCalendarLite.SetLanguage(AValue : TLanguage); +begin + if FLanguage = AValue then Exit; + FLanguage := AValue; + + case FLanguage of + lgEnglish: begin + DayNames := EnglishDays; + MonthNames := EnglishMonths; + DisplayTexts := DefaultDisplayText; + BiDiMode:= bdLeftToRight; + end; + lgFrench: begin + DayNames := FrenchDays; + MonthNames := FrenchMonths; + DisplayTexts := FrenchTexts; + BiDiMode:= bdLeftToRight; + end; + lgGerman: begin + DayNames := GermanDays; + MonthNames := GermanMonths; + DisplayTexts := GermamTexts; + BiDiMode:= bdLeftToRight; + end; + lgHebrew: begin + DayNames := HebrewDays; + MonthNames := HebrewMonths; + DisplayTexts := HebrewTexts; + BiDiMode:= bdRightToLeft; + end; + lgSpanish: begin + DayNames := SpanishDays; + MonthNames := SpanishMonths; + DisplayTexts := SpanishTexts; + BiDiMode:= bdLeftToRight; + end; + end; + + Invalidate; +end; + +//Ariel Rodriguez 12/09/2013 +procedure TCalendarLite.SetMonthNames(const AValue: String); +begin + FMonthNames.CommaText := AValue; + Invalidate; +end; + +procedure TCalendarLite.SetStartingDayOfWeek(AValue: TDayOfWeek); +begin + if FStartingDayOfWeek = AValue then Exit; + FStartingDayOfWeek := AValue; + Invalidate; +end; + +procedure TCalendarLite.SetOptions(AValue: TCalOptions); +begin + if FOptions = AValue then Exit; + FOptions := AValue; + case (coShowTodayRow in FOptions) of + False: if LastRow <> LastDateRow then LastRow := LastDateRow; + True : if LastRow <> TodayRow then LastRow := TodayRow; + end; + if Length(FCalDrawer.FRowPositions) <> LastRow+1 then + SetLength(FCalDrawer.FRowPositions, LastRow+1); + Invalidate; +end; + +procedure TCalendarLite.SetWeekendDays(AValue: TDaysOfWeek); +begin + if FWeekendDays = AValue then Exit; + FWeekendDays := AValue; + Invalidate; +end; + +procedure TCalendarLite.YearMenuItemClicked(Sender: TObject); +begin + FCalDrawer.GotoYear(TMenuItem(Sender).Tag); +end; + +//Ariel Rodriguez 12/09/2013 +procedure Register; +begin + {$I calendarlite_icon.lrs} + RegisterComponents('Misc', [TCalendarLite]); +end; +//Ariel Rodriguez 12/09/2013 + +end. diff --git a/components/callite/source/calendarlite_icon.lrs b/components/callite/source/calendarlite_icon.lrs new file mode 100644 index 000000000..5d711188d --- /dev/null +++ b/components/callite/source/calendarlite_icon.lrs @@ -0,0 +1,38 @@ +LazarusResources.Add('TCALENDARLITE','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#25'tEXtSoftware'#0'Adobe ImageReadyq'#201'e<'#0#0#3#24'IDATx'#218#172'U' + +'KK'#28'A'#16#174#158#153'}*q#j'#2#1#215#131#202#198#24'1'#174'$'#168#172#186 + +#130#130#134'<'#14#130'7'#227'_'#200#31'0D'#127#129#7'!'#162' '#30#19#246#226 + +'EC'#14'*('#132#8#10'9'#172'&'#172'b'#212#5'C'#18#15'Q'#216#247'L'#167#186'f' + +'f'#179';>2'#129'-({'#218#234#250#190#170#174#234'Zv'#204#24'0'#0#210#143#168 + +#195#156'?'#194'%'#128#250'%'#194#216#167#14#184'^'#174#242#225#134'2'#131 + +#224'5~'#223#19#14#139#156#215#133'wv'#130#171'MM['#207#24#251#6'6'#228#10 + +#159'('#18#188'RT}'#211#226#159#152'x'#14#185#28#244#174#172'@,'#22#131#222 + +'P(x'#167#175'/h'#135#224#130#143#162#192#225#248#184',lJV?'#227#228#169#20 + +#240'd'#18'~'#157#157#193#238#216#24#248'jkA;?'#183#131#127#193#135'y<'#128 + +#184'N"H'#235'g'#28'<'#147#129#28#234#131#246'vhhh'#128#242#138#10#218#219#17 + +#171#143'"'#203#128#184#14#157#128's'#202'@'#195#12'T'#212#242#217'Yp..B*'#28 + +#134#228#242'2'#252#238#236#132#234#201#201'k'#9#20#172#163#207#231#163'o' + +#129'!'#225#30'q'#245#12#140#24#157#154#145#193#225#208#16'x'#203#202' 13C' + +#171#182#176#0#185#154#26#248#31#145'1'#131#140'yEF'#13#20'qE'#130#228#166#17 + +#137#171'`'#213'l^'#149')'#28#9#16'W'#161'M@'#215#151#188#196'"0'#3#20#185'N' + +'*'#209#195#224#28'J!'#12'k'#128'H'#18']'#141#241'?ICpM'#211'JB I'#132#173#19 + +#24'1'#203#130'@-'#200' vp'#0#239#215#214#232'['#216':'#218#218#224'ak+'#237 + +#227''''''#16'YZ"'#160#254'P'#8#238#214#215'['#138#192'E'#6'r'#158#197#204'@' + +#197#12'L'#189'UU'#5'O'#7#6#224#197#240'0'#212#215#213#193#250#230'f'#222'V' + +#230#245'B'#127'w7'#164#211'i|'#252#185'"?'#161#154#30'hQ'#6#146#136'>'#167 + +#170#249' \n7'#220'F5#r9'#157'y'#187#23#9#170'++!'#133'='#159'E'#130'B?'#170 + +#1'fv'#161#6'D`'#169#193#225#241'1|'#221#219#131#207#209'('#140#142#140#20 + +#217#179#8#154''''#176#248'I'#5#25'H'#198'X'#149#173'W$'#244#231#233')'#196 + +#246#247#225#28#231#203#135#213'U'#2'3m"'#234'$'#206#174'L6{'#233#21#9'L'#254 + +#175#12#238'77'#147#30#197#227#240'fn'#14'Z'#240';'#208#216'H6A'#144'H$'#136 + +#192#234#167'\R'#3'Y3'#162#186'LD!E'#180#162'k'#196#153#173#237'm'#152#157 + +#159''''#219'4'#142#148'''8^'#30#15#14#230#207#11','#179#139#138'2P-'#145'd1' + +#186#232#238'.,'#225#208#11#247#244#128#223#239#167'3'#173#216#174#211'SSEg' + +#11'}'#213#162#12#24#163#166#209','#4#235#27#27#240'.'#18#161#150#28#194#232 + +#186#177#223'U'#155#15#145'j'#192#152#139#8#12#23#143#246#151#153#164#179#171 + +#139#212#18#149'='#2']=D'#240#29#255#224'0'#246'8'#28#14#26#207#165#16#129'%' + +#8'~'#8#130#20#231#190'$c'#241#160#219#253#22'J('#248#139'v'#132#216'7D'#1 + +#196's'#245#24'++'#17#190'h'#199#164#224#249'#'#192#0'`'#167'&'#202'X'#24#179 + +#213#0#0#0#0'IEND'#174'B`'#130 +]);