From 49e3927ada79024100e3700e63f5242f8307157b Mon Sep 17 00:00:00 2001 From: zoran-vucenovic Date: Thu, 31 Oct 2013 14:02:19 +0000 Subject: [PATCH] Introducing a way to replace default LCL's calendar with some other calendar control git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2818 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../trunk/calendarcontrolwrapper.pas | 103 ++++++++++++ .../trunk/dbzvdatetimepicker.pas | 1 + .../trunk/lclcalendarwrapper.pas | 74 +++++++++ .../ZVDateTimeCtrls/trunk/zvdatetimectrls.lpk | 12 +- .../ZVDateTimeCtrls/trunk/zvdatetimectrls.pas | 15 +- .../trunk/zvdatetimepicker.pas | 146 +++++++++++------- .../trunk/zvdatetimepickerpropedit.pas | 1 + 7 files changed, 289 insertions(+), 63 deletions(-) create mode 100644 components/ZVDateTimeCtrls/trunk/calendarcontrolwrapper.pas create mode 100644 components/ZVDateTimeCtrls/trunk/lclcalendarwrapper.pas diff --git a/components/ZVDateTimeCtrls/trunk/calendarcontrolwrapper.pas b/components/ZVDateTimeCtrls/trunk/calendarcontrolwrapper.pas new file mode 100644 index 000000000..8713f4e8a --- /dev/null +++ b/components/ZVDateTimeCtrls/trunk/calendarcontrolwrapper.pas @@ -0,0 +1,103 @@ +{ +CalendarControlWrapper +- - - - - - - - - - - - - - - - - +Author: Zoran Vučenović + Зоран Вученовић + + This unit is part of ZVDateTimeCtrls package for Lazarus. + + By default, TZVDateTimePicker uses LCL's TCalendar to represent the +drop-down calendar, but you can use some other calendar control instead. + + In order to use another calendar control, you should "wrap" that control with +a CalendarControlWrapper. + + To be used by ZVDateTimePicker, the calendar control must at least provide +a way to determine whether the coordinates are on the date (when this control +gets clicked, we must decide if the date has just been chosen - then we should +respond by closing the drop-down form and setting the date from calendar to +ZVDateTimePicker - for example in LCL's TCalendar we will respond when the +calendar is clicked on date, but not when the user clicks in title area changing +months or years, then we let the user keep browsing the calendar). + + When creating new wrapper, there are four abstract methods which need to be +overriden. Please see the coments in code below. + +----------------------------------------------------------- +LICENCE +- - - - + Modified LGPL -- see the file COPYING.modifiedLGPL. + +----------------------------------------------------------- +NO WARRANTY +- - - - - - + There is no warranty whatsoever. + +----------------------------------------------------------- +BEST REGARDS TO LAZARUS COMMUNITY! +- - - - - - - - - - - - - - - - - - + I do hope the ZVDateTimeCtrls package will be useful. +} +unit CalendarControlWrapper; + +{$mode objfpc}{$H+} + +interface + +uses + Controls; + +type + + { TCalendarControlWrapper } + + TCalendarControlWrapper = class + private + FCalendarControl: TControl; + public + { There are four methods that derived classes should override: } + + { Should be overriden to just return the class of the calendar control. } + class function GetCalendarControlClass: TControlClass; virtual abstract; + + { Should be overriden to set the date in the calendar control. } + procedure SetDate(Date: TDate); virtual abstract; + + { Should be overriden to get the date from the calendar control. } + function GetDate: TDate; virtual abstract; + + { This function should return True if coordinates (X, Y) are on the date in + the calendar control (ZVDateTimePicker calls this function when the calendar + is clicked, to determine whether the drop-down calendar should return the + date or not). } + function AreCoordinatesOnDate(X, Y: Integer): Boolean; virtual abstract; + + function GetCalendarControl: TControl; + constructor Create; virtual; + destructor Destroy; override; + end; + + TCalendarControlWrapperClass = class of TCalendarControlWrapper; + +implementation + +{ TCalendarControlWrapper } + +function TCalendarControlWrapper.GetCalendarControl: TControl; +begin + Result := FCalendarControl; +end; + +constructor TCalendarControlWrapper.Create; +begin + FCalendarControl := GetCalendarControlClass.Create(nil); +end; + +destructor TCalendarControlWrapper.Destroy; +begin + FCalendarControl.Free; + inherited Destroy; +end; + +end. + diff --git a/components/ZVDateTimeCtrls/trunk/dbzvdatetimepicker.pas b/components/ZVDateTimeCtrls/trunk/dbzvdatetimepicker.pas index 27c4beaac..300b5dcab 100644 --- a/components/ZVDateTimeCtrls/trunk/dbzvdatetimepicker.pas +++ b/components/ZVDateTimeCtrls/trunk/dbzvdatetimepicker.pas @@ -62,6 +62,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Field: TField read GetField; + property CalendarWrapperClass; published { Published declarations } property DataField: string read GetDataField write SetDataField; diff --git a/components/ZVDateTimeCtrls/trunk/lclcalendarwrapper.pas b/components/ZVDateTimeCtrls/trunk/lclcalendarwrapper.pas new file mode 100644 index 000000000..824980528 --- /dev/null +++ b/components/ZVDateTimeCtrls/trunk/lclcalendarwrapper.pas @@ -0,0 +1,74 @@ +{ +LCLCalendarWrapper +- - - - - - - - - - - - - - - - - +Author: Zoran Vučenović + Зоран Вученовић + + This unit is part of ZVDateTimeCtrls package for Lazarus. + + TLCLCalendarWrapper is the default implementation of TCalendarControlWrapper +abstract class, used by ZVDateTimePicker. Wraps LCL's TCalendar. + +----------------------------------------------------------- +LICENCE +- - - - + Modified LGPL -- see the file COPYING.modifiedLGPL. + +----------------------------------------------------------- +NO WARRANTY +- - - - - - + There is no warranty whatsoever. + +----------------------------------------------------------- +BEST REGARDS TO LAZARUS COMMUNITY! +- - - - - - - - - - - - - - - - - - + I do hope the ZVDateTimeCtrls package will be useful. +} +unit LCLCalendarWrapper; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Controls, Calendar, CalendarControlWrapper; + +type + + { TLCLCalendarWrapper } + + TLCLCalendarWrapper = class(TCalendarControlWrapper) + public + class function GetCalendarControlClass: TControlClass; override; + procedure SetDate(Date: TDate); override; + function GetDate: TDate; override; + function AreCoordinatesOnDate(X, Y: Integer): Boolean; override; + end; + +implementation + +{ TLCLCalendarWrapper } + +class function TLCLCalendarWrapper.GetCalendarControlClass: TControlClass; +begin + Result := TCalendar; +end; + +procedure TLCLCalendarWrapper.SetDate(Date: TDate); +begin + TCalendar(GetCalendarControl).DateTime := Date; +end; + +function TLCLCalendarWrapper.GetDate: TDate; +begin + Result := TCalendar(GetCalendarControl).DateTime; +end; + +function TLCLCalendarWrapper.AreCoordinatesOnDate(X, Y: Integer): Boolean; +begin + Result := + TCalendar(GetCalendarControl).HitTest(Point(X, Y)) in [cpDate, cpNoWhere]; +end; + +end. + diff --git a/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.lpk b/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.lpk index 4862f3f49..1f3c9fb08 100644 --- a/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.lpk +++ b/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.lpk @@ -1,4 +1,4 @@ - + @@ -27,7 +27,7 @@ - + @@ -49,6 +49,14 @@ + + + + + + + + diff --git a/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.pas b/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.pas index b114ca831..652ce8bb0 100644 --- a/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.pas +++ b/components/ZVDateTimeCtrls/trunk/zvdatetimectrls.pas @@ -2,21 +2,22 @@ This source is only used to compile and install the package. } -unit ZVDateTimeCtrls; +unit ZVDateTimeCtrls; interface uses - ZVDateTimePicker, DBZVDateTimePicker, ZVDateTimePickerPropEdit, - ZVDateTimeControlsReg, LazarusPackageIntf; + ZVDateTimePicker, DBZVDateTimePicker, ZVDateTimePickerPropEdit, + ZVDateTimeControlsReg, CalendarControlWrapper, LCLCalendarWrapper, + LazarusPackageIntf; implementation -procedure Register; +procedure Register; begin - RegisterUnit('ZVDateTimeControlsReg', @ZVDateTimeControlsReg.Register); -end; + RegisterUnit('ZVDateTimeControlsReg', @ZVDateTimeControlsReg.Register); +end; initialization - RegisterPackage('ZVDateTimeCtrls', @Register); + RegisterPackage('ZVDateTimeCtrls', @Register); end. diff --git a/components/ZVDateTimeCtrls/trunk/zvdatetimepicker.pas b/components/ZVDateTimeCtrls/trunk/zvdatetimepicker.pas index 14d705aa1..e00bba965 100644 --- a/components/ZVDateTimeCtrls/trunk/zvdatetimepicker.pas +++ b/components/ZVDateTimeCtrls/trunk/zvdatetimepicker.pas @@ -45,8 +45,8 @@ uses {$ifdef unix} clocale, // needed to initialize default locale settings on Linux. {$endif} - Classes, SysUtils, Controls, LCLType, Graphics, Math, StdCtrls, - Buttons, ExtCtrls, Forms, Calendar, ComCtrls, Types, LMessages + Classes, SysUtils, Controls, LCLType, Graphics, Math, StdCtrls, Buttons, + ExtCtrls, Forms, ComCtrls, Types, LMessages, CalendarControlWrapper {$ifdef LCLGtk2}, LCLVersion{$endif} ; @@ -72,6 +72,9 @@ const So, this will be the down limit: } TheSmallestDate = TDateTime(-53780.0); // 1. okt. 1752. +var + DefaultCalendarWrapperClass: TCalendarControlWrapperClass = nil; + type TYMD = record Year, Month, Day: Word; @@ -84,8 +87,8 @@ type { Used by DateDisplayOrder property to determine the order to display date parts -- d-m-y, m-d-y or y-m-d. When ddoTryDefault is set, the actual order is determined from - ShortDateFormat global variable -- see coments above AdjustDateDisplayOrder - procedure } + ShortDateFormat global variable -- see coments above + AdjustEffectiveHideDateTimeParts procedure } TDateDisplayOrder = (ddoDMY, ddoMDY, ddoYMD, ddoTryDefault); TTimeDisplay = (tdHM, // hour and minute @@ -103,7 +106,10 @@ type TTextPart = 1..8; TDateTimePart = (dtpDay, dtpMonth, dtpYear, dtpHour, dtpMinute, dtpSecond, dtpMiliSec, dtpAMPM); - TDateTimeParts = set of dtpDay..dtpMiliSec; + TDateTimeParts = set of dtpDay..dtpMiliSec; // without AMPM, + // because this set type is used for HideDateTimeParts property, + // where hiding of AMPM part is tied to hiding of hour (and, of + // course, it makes a difference only when TimeFormat is set to tf12) TArrowShape = (asClassicSmaller, asClassicLarger, asModernSmaller, asModernLarger, asYetAnotherShape); @@ -116,6 +122,7 @@ type private FAutoAdvance: Boolean; FAutoButtonSize: Boolean; + FCalendarWrapperClass: TCalendarControlWrapperClass; FCascade: Boolean; FCenturyFrom, FEffectiveCenturyFrom: Word; FDateDisplayOrder: TDateDisplayOrder; @@ -178,6 +185,7 @@ type function GetTime: TTime; procedure SetArrowShape(const AValue: TArrowShape); procedure SetAutoButtonSize(AValue: Boolean); + procedure SetCalendarWrapperClass(AValue: TCalendarControlWrapperClass); procedure SetCenturyFrom(const AValue: Word); procedure SetChecked(const AValue: Boolean); procedure CheckTextEnabled; @@ -360,6 +368,8 @@ type read FAutoAdvance write FAutoAdvance default False; property HideDateTimeParts: TDateTimeParts read FHideDateTimeParts write SetHideDateTimeParts; + property CalendarWrapperClass: TCalendarControlWrapperClass + read FCalendarWrapperClass write SetCalendarWrapperClass; public constructor Create(AOwner: TComponent); override; @@ -380,6 +390,7 @@ type TZVDateTimePicker = class(TCustomZVDateTimePicker) public property DateTime; + property CalendarWrapperClass; published property ArrowShape; property ShowCheckBox; @@ -455,7 +466,8 @@ function IsNullDate(DT: TDateTime): Boolean; implementation -uses DateUtils; +uses + DateUtils, LCLCalendarWrapper; function NumberOfDaysInMonth(const Month, Year: Word): Word; begin @@ -481,17 +493,6 @@ begin (DT > SysUtils.MaxDateTime) or (DT < SysUtils.MinDateTime); end; -{ TCustomZVDateTimePicker } - -procedure TCustomZVDateTimePicker.SetChecked(const AValue: Boolean); -begin - if Assigned(FCheckBox) then - FCheckBox.Checked := AValue; - - CheckTextEnabled; - Invalidate; -end; - type { TDTCalendarForm } @@ -499,7 +500,7 @@ type TDTCalendarForm = class(TForm) private DTPicker: TCustomZVDateTimePicker; - Cal: TCalendar; + Cal: TCalendarControlWrapper; Shape: TShape; RememberedCalendarFormOrigin: TPoint; FClosing: Boolean; @@ -530,8 +531,6 @@ type published end; -{ TDTCalendarForm } - procedure TDTCalendarForm.SetClosingCalendarForm; begin if not FClosing then begin @@ -546,8 +545,8 @@ end; procedure TDTCalendarForm.AdjustCalendarFormSize; begin if not FClosing then begin - ClientWidth := Cal.Width + 2; - ClientHeight := Cal.Height + 2; + ClientWidth := Cal.GetCalendarControl.Width + 2; + ClientHeight := Cal.GetCalendarControl.Height + 2; Shape.SetBounds(0, 0, ClientWidth, ClientHeight); @@ -614,11 +613,11 @@ begin try if DTPicker.DateIsNull then begin // we'll set the time to 0.0 (midnight): - DTPicker.SetDateTime(Int(Cal.DateTime)); + DTPicker.SetDateTime(Int(Cal.GetDate)); end else if not EqualDateTime(Int(DTPicker.DateTime), - Int(Cal.DateTime)) then begin + Int(Cal.GetDate)) then begin // we'll change the date, but keep the time: - DTPicker.SetDateTime(ComposeDateTime(Cal.DateTime, DTPicker.DateTime)); + DTPicker.SetDateTime(ComposeDateTime(Cal.GetDate, DTPicker.DateTime)); end; finally Dec(DTPicker.FUserChanging); @@ -658,7 +657,7 @@ end; procedure TDTCalendarForm.CalendarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - if Cal.HitTest(Point(X, Y)) in [cpDate, cpNoWhere] then + if Cal.AreCoordinatesOnDate(X, Y) then CloseCalendarForm(True); end; @@ -707,10 +706,16 @@ begin inherited DoClose(CloseAction); end; +type + { To be able to access TControl's protected members, + we derive our class TDTControl from TControl: } + TDTControl = class(TControl); + constructor TDTCalendarForm.CreateNewDTCalendarForm(AOwner: TComponent; ADTPicker: TCustomZVDateTimePicker); var P: TPoint; + CalClass: TCalendarControlWrapperClass; begin inherited CreateNew(AOwner); @@ -723,21 +728,28 @@ begin if Assigned(DTPickersParentForm) then begin DTPickersParentForm.AddHandlerOnVisibleChanged(@VisibleOfParentChanged); DTPickersParentForm.FreeNotification(Self); - end; + PopupParent := DTPickersParentForm; + PopupMode := pmExplicit; + end else + PopupMode := pmAuto; P := Point(0, 0); - Cal := TCalendar.Create(nil); - Cal.ParentBiDiMode := True; - Cal.AutoSize := True; - Cal.GetPreferredSize(P.x, P.y); + if ADTPicker.FCalendarWrapperClass = nil then begin + if DefaultCalendarWrapperClass = nil then + CalClass := TLCLCalendarWrapper + else + CalClass := DefaultCalendarWrapperClass; + end else + CalClass := ADTPicker.FCalendarWrapperClass; - Cal.Align := alNone; + Cal := CalClass.Create; - Cal.SetBounds(1, 1, P.x, P.y); - Cal.TabStop := True; - - PopupMode := pmAuto; + Cal.GetCalendarControl.ParentBiDiMode := True; + Cal.GetCalendarControl.AutoSize := True; + Cal.GetCalendarControl.GetPreferredSize(P.x, P.y); + Cal.GetCalendarControl.Align := alNone; + Cal.GetCalendarControl.SetBounds(1, 1, P.x, P.y); SetBounds(-8000, -8000, P.x + 2, P.y + 2); RememberedCalendarFormOrigin := Point(-8000, -8000); @@ -749,23 +761,27 @@ begin Shape.Brush.Style := bsClear; if DTPicker.DateIsNull then - Cal.DateTime := Max(DTPicker.MinDate, Min(SysUtils.Date, DTPicker.MaxDate)) + Cal.SetDate(Max(DTPicker.MinDate, Min(SysUtils.Date, DTPicker.MaxDate))) else if DTPicker.DateTime < DTPicker.MinDate then // These "out of bounds" values - Cal.DateTime := DTPicker.MinDate // can happen when DateTime was set with + Cal.SetDate(DTPicker.MinDate) // can happen when DateTime was set with else if DTPicker.DateTime > DTPicker.MaxDate then // "SetDateTimeJumpMinMax" protected - Cal.DateTime := DTPicker.MaxDate // procedure (used in TDBZVDateTimePicker control). + Cal.SetDate(DTPicker.MaxDate) // procedure (used in TDBZVDateTimePicker control). else - Cal.DateTime := DTPicker.DateTime; + Cal.SetDate(DTPicker.Date); + + Cal.GetCalendarControl.OnResize := @CalendarResize; + TDTControl(Cal.GetCalendarControl).OnMouseUp := @CalendarMouseUp; + if Cal.GetCalendarControl is TWinControl then begin + TWinControl(Cal.GetCalendarControl).OnKeyDown := @CalendarKeyDown; + TWinControl(Cal.GetCalendarControl).TabStop := True; + TWinControl(Cal.GetCalendarControl).SetFocus; + end; - Cal.Parent := Self; Shape.Parent := Self; - - Cal.OnResize := @CalendarResize; - Cal.OnMouseUp := @CalendarMouseUp; - Cal.OnKeyDown := @CalendarKeyDown; - + Cal.GetCalendarControl.Parent := Self; + Cal.GetCalendarControl.BringToFront; end; destructor TDTCalendarForm.Destroy; @@ -775,9 +791,10 @@ begin DTPickersParentForm.RemoveAllHandlersOfObject(Self); if Assigned(Cal) then begin - Cal.OnResize := nil; - Cal.OnMouseUp := nil; - Cal.OnKeyDown := nil; + Cal.GetCalendarControl.OnResize := nil; + TDTControl(Cal.GetCalendarControl).OnMouseUp := nil; + if Cal.GetCalendarControl is TWinControl then + TWinControl(Cal.GetCalendarControl).OnKeyDown := nil; Cal.Free; Cal := nil; end; @@ -795,6 +812,17 @@ begin inherited Destroy; end; +{ TCustomZVDateTimePicker } + +procedure TCustomZVDateTimePicker.SetChecked(const AValue: Boolean); +begin + if Assigned(FCheckBox) then + FCheckBox.Checked := AValue; + + CheckTextEnabled; + Invalidate; +end; + procedure TCustomZVDateTimePicker.CheckTextEnabled; begin FTextEnabled := Self.Enabled and GetChecked; @@ -1728,13 +1756,11 @@ end; selection moves to left, otherwise to right. } procedure TCustomZVDateTimePicker.MoveSelectionLR(const ToLeft: Boolean); var - I: Integer; + I, SafetyTextPart: TTextPart; begin UpdateIfUserChangedText; - if FSelectedTextPart < Low(TTextPart) then - FSelectedTextPart := Low(TTextPart); - + SafetyTextPart := Low(TTextPart); I := FSelectedTextPart; repeat if ToLeft then begin @@ -1753,7 +1779,11 @@ begin in FEffectiveHideDateTimeParts) then FSelectedTextPart := I; - until I = FSelectedTextPart; + { Is it possible that all parts are hidden? Yes it is! + So we need to ensure that this doesn't loop forever. + When this insurance text part gets to high value, break } + Inc(SafetyTextPart); + until (I = FSelectedTextPart) or (SafetyTextPart >= High(TTextPart)); Invalidate; end; @@ -3096,6 +3126,13 @@ begin end; end; +procedure TCustomZVDateTimePicker.SetCalendarWrapperClass( + AValue: TCalendarControlWrapperClass); +begin + if FCalendarWrapperClass = AValue then Exit; + FCalendarWrapperClass := AValue; +end; + procedure TCustomZVDateTimePicker.SetCenturyFrom(const AValue: Word); begin if FCenturyFrom = AValue then Exit; @@ -3495,6 +3532,7 @@ begin AdjustEffectiveDateDisplayOrder; AdjustEffectiveHideDateTimeParts; + FCalendarWrapperClass := nil; SetDateMode(dmComboBox); end; diff --git a/components/ZVDateTimeCtrls/trunk/zvdatetimepickerpropedit.pas b/components/ZVDateTimeCtrls/trunk/zvdatetimepickerpropedit.pas index e10e684b7..37b05d106 100644 --- a/components/ZVDateTimeCtrls/trunk/zvdatetimepickerpropedit.pas +++ b/components/ZVDateTimeCtrls/trunk/zvdatetimepickerpropedit.pas @@ -247,6 +247,7 @@ begin DTP[I].DateSeparator := CallerZVDateTimePicker.DateSeparator; DTP[I].TrailingSeparator := CallerZVDateTimePicker.TrailingSeparator; DTP[I].AutoAdvance := CallerZVDateTimePicker.AutoAdvance; + DTP[I].CalendarWrapperClass := CallerZVDateTimePicker.CalendarWrapperClass; end; ZVDateTimePicker1.TextForNullDate := CallerZVDateTimePicker.TextForNullDate; ZVDateTimePicker1.TimeSeparator := CallerZVDateTimePicker.TimeSeparator;