1 {
2 TDateTimePicker control for Lazarus
3 - - - - - - - - - - - - - - - - - - -
4 Author: Zoran Vučenović, January and February 2010
5         Зоран Вученовић, јануар и фебруар 2010.
6 
7    This unit is part of DateTimeCtrls package for Lazarus.
8 
9    Delphi's Visual Component Library (VCL) has a control named TDateTimePicker,
10 which I find very useful for editing dates. Lazarus Component Library (LCL),
11 however, does not have this control, because VCL wraps native Windows control
12 and it seems that such control does not exist on other platforms. Given that
13 LCL is designed to be platform independent, it could not use native Win control.
14    Instead, for editing dates LCL has a control named TDateEdit, but I prefer
15 the VCL's TDateTimePicker.
16    Therefore, I tried to create a custom control which would resemble VCL's
17 TDateTimePicker as much as possible, but not to rely on native Windows control.
18 
19    This TDateTimePicker control does not use native Win control. It has been
20 tested on Windows with win32/64 and qt widgetsets, as well as on Linux with
21 qt and gtk2 widgetsets.
22 
23 -----------------------------------------------------------
24 LICENCE
25 - - - -
26    Modified LGPL -- see the file COPYING.modifiedLGPL.
27 
28 -----------------------------------------------------------
29 NO WARRANTY
30 - - - - - -
31    There is no warranty whatsoever.
32 
33 -----------------------------------------------------------
34 BEST REGARDS TO LAZARUS COMMUNITY!
35 - - - - - - - - - - - - - - - - - -
36    I do hope this control will be useful.
37 }
38 unit DateTimePicker;
39 
40 {$mode objfpc}{$H+}
41 
42 interface
43 
44 uses
45   {$ifdef unix}
46   clocale, // needed to initialize default locale settings on Linux.
47   {$endif}
48   Classes, SysUtils, Controls, LCLType, Graphics, Math, Buttons,
49   ExtCtrls, Forms, ComCtrls, Types, LMessages, LazUTF8, LCLIntf,
50   LCLProc, Themes, CalControlWrapper;
51 
52 const
53   { We will deal with the NullDate value the special way. It will be especially
54     useful for dealing with null values from database. }
55   NullDate = TDateTime(1.7e+308);
56 
57   { The biggest date a user can enter. }
58   TheBiggestDate = TDateTime(2958465.0); // 31. dec. 9999.
59 
60   { The smallest date a user can enter.
61     Note:
62       TCalendar does not accept smaller dates then 14. sep. 1752 on Windows OS
63       (see the implementation of TCustomCalendar.SetDateTime).
64       In Delphi help it is documented that Windows controls act weird with dates
65       older than 24. sep. 1752. Actually, TCalendar control has problems to show
66       dates before 1. okt. 1752. (try putting one calendar on the form, run the
67       application and see what september 1752. looks like).
68       Let's behave uniformely as much as
69       possible -- we won't allow dates before 1. okt. 1752. on any OS (who cares
70       about those).
71       So, this will be the down limit:  }
72   TheSmallestDate = TDateTime(-53780.0); // 1. okt. 1752.
73 
74 var
75   DefaultCalendarWrapperClass: TCalendarControlWrapperClass = nil;
76 
77 type
78   TYMD = record
79     Year, Month, Day: Word;
80   end;
81 
82   THMSMs = record
83     Hour, Minute, Second, MiliSec: Word;
84   end;
85 
86   { Used by DateDisplayOrder property to determine the order to display date
87     parts -- d-m-y, m-d-y or y-m-d.
88     When ddoTryDefault is set, the actual order is determined from
89     ShortDateFormat global variable -- see comments above
90     AdjustEffectiveDateDisplayOrder procedure }
91   TDateDisplayOrder = (ddoDMY, ddoMDY, ddoYMD, ddoTryDefault);
92 
93   TTimeDisplay = (tdHM,   // hour and minute
94                   tdHMS,  // hour, minute and second
95                   tdHMSMs // hour, minute, second and milisecond
96                   );
97 
98   TTimeFormat = (tf12, // 12 hours format, with am/pm string
99                  tf24  // 24 hours format
100                  );
101 
102   { TDateTimeKind determines if we should display date, time or both: }
103   TDateTimeKind = (dtkDate, dtkTime, dtkDateTime);
104 
105   TTextPart = 1..8;
106   TDateTimePart = (dtpDay, dtpMonth, dtpYear, dtpHour, dtpMinute,
107                                 dtpSecond, dtpMiliSec, dtpAMPM);
108   TDateTimeParts = set of dtpDay..dtpMiliSec; // without AMPM,
109            // because this set type is used for HideDateTimeParts property,
110            // where hiding of AMPM part is tied to hiding of hour (and, of
111            // course, it makes a difference only when TimeFormat is set to tf12)
112 
113   TArrowShape = (asClassicSmaller, asClassicLarger, asModernSmaller,
114     asModernLarger, asYetAnotherShape, asTheme);
115 
116   TDTDateMode = (dmComboBox, dmUpDown, dmNone);
117 
118   { calendar alignment - left or right,
119     dtaDefault means it is determined by BiDiMode }
120   TDTCalAlignment = (dtaLeft, dtaRight, dtaDefault);
121 
122   TDateTimePickerOption = (
123     dtpoDoChangeOnSetDateTime, // The OnChange handler will be called also when
124                                // date/time is programatically changed.
125     dtpoEnabledIfUnchecked, // Enable the date time picker if the checkbox is unchecked.
126     dtpoAutoCheck, // Auto-check an unchecked checkbox when DateTime is changed
127                    // (makes sense only if dtpoEnabledIfUnchecked is set).
128     dtpoFlatButton, // Use flat button for calender picker.
129     dtpoResetSelection // When the control receives focus, the selection is always
130        // in the first part (the control does not remember which part was previously selected).
131     );
132 
133   TDateTimePickerOptions = set of TDateTimePickerOption;
134 
135   { TCustomDateTimePicker }
136 
137   TCustomDateTimePicker = class(TCustomControl)
138   private const
139     cDefOptions = [];
140     cCheckBoxBorder = 3;
141   private
142     FAlignment: TAlignment;
143     FAutoAdvance: Boolean;
144     FAutoButtonSize: Boolean;
145     FCalAlignment: TDTCalAlignment;
146     FCalendarWrapperClass: TCalendarControlWrapperClass;
147     FCascade: Boolean;
148     FCenturyFrom, FEffectiveCenturyFrom: Word;
149     FChecked: Boolean;
150     FDateDisplayOrder: TDateDisplayOrder;
151     FHideDateTimeParts: TDateTimeParts;
152     FEffectiveHideDateTimeParts: set of TDateTimePart;
153     FKind: TDateTimeKind;
154     FLeadingZeros: Boolean;
155     FMonthNames: String;
156     FMonthNamesArray: TMonthNameArray;
157     FNullInputAllowed: Boolean;
158     FDateTime: TDateTime;
159     FDateSeparator: String;
160     FReadOnly: Boolean;
161     FMaxDate, FMinDate: TDate;
162     FShowMonthNames: Boolean;
163     FTextForNullDate: TCaption;
164     FTimeSeparator: String;
165     FTimeDisplay: TTimeDisplay;
166     FTimeFormat: TTimeFormat;
167     FTrailingSeparator: Boolean;
168     FUseDefaultSeparators: Boolean;
169     FUserChangedText: Boolean;
170     FYearPos, FDayPos, FMonthPos: 1..3;
171     FTextPart: array[1..3] of String;
172     FTimeText: array[dtpHour..dtpAMPM] of String;
173     FUserChanging: Integer;
174     FDigitWidth: Integer;
175     FTextHeight: Integer;
176     FSeparatorWidth: Integer;
177     FSepNoSpaceWidth: Integer;
178     FShowCheckBox: Boolean;
179     FMouseInCheckBox: Boolean;
180     FTimeSeparatorWidth: Integer;
181     FMonthWidth: Integer;
182     FNullMonthText: String;
183     FSelectedTextPart: TTextPart;
184     FRecalculatingTextSizesNeeded: Boolean;
185     FJumpMinMax: Boolean;
186     FAMPMWidth: Integer;
187     FDateWidth: Integer;
188     FTimeWidth: Integer;
189     FTextWidth: Integer;
190     FArrowShape: TArrowShape;
191     FDateMode: TDTDateMode;
192     FTextEnabled: Boolean;
193     FUpDown: TCustomUpDown;
194     FOnChange: TNotifyEvent;
195     FOnCheckBoxChange: TNotifyEvent;
196     FOnChangeHandlers: TMethodList;
197     FOnCheckBoxChangeHandlers: TMethodList;
198     FOnDropDown: TNotifyEvent;
199     FOnCloseUp: TNotifyEvent;
200     FEffectiveDateDisplayOrder: TDateDisplayOrder;
201 
202     FArrowButton: TCustomSpeedButton;
203     FCalendarForm: TCustomForm;
204     FDoNotArrangeControls: Boolean;
205     FConfirmedDateTime: TDateTime;
206     FNoEditingDone: Integer;
207     FAllowDroppingCalendar: Boolean;
208     FCorrectedDTP: TDateTimePart;
209     FCorrectedValue: Word;
210     FSkipChangeInUpdateDate: Integer;
211     FOptions: TDateTimePickerOptions;
212 
AreSeparatorsStorednull213     function AreSeparatorsStored: Boolean;
GetCheckednull214     function GetChecked: Boolean;
GetDatenull215     function GetDate: TDate;
GetDateTimenull216     function GetDateTime: TDateTime;
GetDroppedDownnull217     function GetDroppedDown: Boolean;
GetTimenull218     function GetTime: TTime;
219     procedure SetAlignment(AValue: TAlignment);
220     procedure SetArrowShape(const AValue: TArrowShape);
221     procedure SetAutoButtonSize(AValue: Boolean);
222     procedure SetCalAlignment(AValue: TDTCalAlignment);
223     procedure SetCalendarWrapperClass(AValue: TCalendarControlWrapperClass);
224     procedure SetCenturyFrom(const AValue: Word);
225     procedure SetChecked(const AValue: Boolean);
226     procedure CheckTextEnabled;
227     procedure SetDateDisplayOrder(const AValue: TDateDisplayOrder);
228     procedure SetDateMode(const AValue: TDTDateMode);
229     procedure SetHideDateTimeParts(AValue: TDateTimeParts);
230     procedure SetKind(const AValue: TDateTimeKind);
231     procedure SetLeadingZeros(const AValue: Boolean);
232     procedure SetMonthNames(AValue: String);
233     procedure SetNullInputAllowed(const AValue: Boolean);
234     procedure SetDate(const AValue: TDate);
235     procedure SetDateTime(const AValue: TDateTime);
236     procedure SetDateSeparator(const AValue: String);
237     procedure SetMaxDate(const AValue: TDate);
238     procedure SetMinDate(const AValue: TDate);
239     procedure SetReadOnly(const AValue: Boolean);
240     procedure SetShowCheckBox(const AValue: Boolean);
241     procedure SetShowMonthNames(AValue: Boolean);
242     procedure SetTextForNullDate(const AValue: TCaption);
243     procedure SetTime(const AValue: TTime);
244     procedure SetTimeSeparator(const AValue: String);
245     procedure SetTimeDisplay(const AValue: TTimeDisplay);
246     procedure SetTimeFormat(const AValue: TTimeFormat);
247     procedure SetTrailingSeparator(const AValue: Boolean);
248     procedure SetUseDefaultSeparators(const AValue: Boolean);
249 
250     procedure RecalculateTextSizesIfNeeded;
GetHMSMsnull251     function GetHMSMs(const NowIfNull: Boolean = False): THMSMs;
GetYYYYMMDDnull252     function GetYYYYMMDD(const TodayIfNull: Boolean = False;
253                                const WithCorrection: Boolean = False): TYMD;
254     procedure SetHour(const AValue: Word);
255     procedure SetMiliSec(const AValue: Word);
256     procedure SetMinute(const AValue: Word);
257     procedure SetSecond(const AValue: Word);
258     procedure SetSeparators(const DateSep, TimeSep: String);
259     procedure SetDay(const AValue: Word);
260     procedure SetMonth(const AValue: Word);
261     procedure SetYear(const AValue: Word);
262     procedure SetYYYYMMDD(const AValue: TYMD);
263     procedure SetHMSMs(const AValue: THMSMs);
264     procedure UpdateIfUserChangedText;
GetSelectedTextnull265     function GetSelectedText: String;
266     procedure AdjustSelection;
267     procedure AdjustEffectiveCenturyFrom;
268     procedure AdjustEffectiveDateDisplayOrder;
269     procedure AdjustEffectiveHideDateTimeParts;
270     procedure SelectDateTimePart(const DateTimePart: TDateTimePart);
271     procedure MoveSelectionLR(const ToLeft: Boolean);
272     procedure DestroyCalendarForm;
273     procedure UpdateShowArrowButton;
274     procedure DestroyUpDown;
275     procedure DestroyArrowBtn;
276     procedure ArrowMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
277                                             {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
278     procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
279     procedure SetFocusIfPossible;
280     procedure AutoResizeButton;
281     procedure CheckAndApplyKey(const Key: Char);
282     procedure CheckAndApplyKeyCode(var Key: Word; const ShState: TShiftState);
283     procedure SetOptions(const aOptions: TDateTimePickerOptions);
284 
285   protected
286     procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
287     procedure WMSize(var Message: TLMSize); message LM_SIZE;
288 
GetControlClassDefaultSizenull289     class function GetControlClassDefaultSize: TSize; override;
290 
291     procedure ConfirmChanges; virtual;
292     procedure UndoChanges; virtual;
293 
294     procedure DropDownCalendarForm;
295 
GetCheckBoxRectnull296     function GetCheckBoxRect(IgnoreRightToLeft: Boolean = False): TRect;
GetDateTimePartFromTextPartnull297     function GetDateTimePartFromTextPart(TextPart: TTextPart): TDateTimePart;
GetSelectedDateTimePartnull298     function GetSelectedDateTimePart: TDateTimePart;
299     procedure FontChanged(Sender: TObject); override;
GetTextOriginnull300     function GetTextOrigin(IgnoreRightToLeft: Boolean = False): TPoint;
301     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
302     procedure KeyPress(var Key: char); override;
303     procedure SelectTextPartUnderMouse(XMouse: Integer);
304     procedure MouseLeave; override;
305     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
306     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
DoMouseWheelnull307     function DoMouseWheel({%H-}Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
308     procedure UpdateDate(const CallChangeFromSetDateTime: Boolean = False); virtual;
309     procedure DoEnter; override;
310     procedure DoExit; override;
311     procedure Click; override;
312     procedure DblClick; override;
313     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
314     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
315     procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
316     procedure CalculatePreferredSize(var PreferredWidth,
317                   PreferredHeight: integer; {%H-}WithThemeSpace: Boolean); override;
318     procedure SetBiDiMode(AValue: TBiDiMode); override;
319 
320     procedure IncreaseCurrentTextPart;
321     procedure DecreaseCurrentTextPart;
322     procedure IncreaseMonth;
323     procedure IncreaseYear;
324     procedure IncreaseDay;
325     procedure DecreaseMonth;
326     procedure DecreaseYear;
327     procedure DecreaseDay;
328     procedure IncreaseHour;
329     procedure IncreaseMinute;
330     procedure IncreaseSecond;
331     procedure IncreaseMiliSec;
332     procedure DecreaseHour;
333     procedure DecreaseMinute;
334     procedure DecreaseSecond;
335     procedure DecreaseMiliSec;
336     procedure ChangeAMPM;
337 
338     procedure SelectDay;
339     procedure SelectMonth;
340     procedure SelectYear;
341     procedure SelectHour;
342     procedure SelectMinute;
343     procedure SelectSecond;
344     procedure SelectMiliSec;
345     procedure SelectAMPM;
346 
347     procedure SetEnabled(Value: Boolean); override;
348     procedure SetAutoSize(Value: Boolean); override;
349     procedure CreateWnd; override;
350     procedure SetDateTimeJumpMinMax(const AValue: TDateTime);
351     procedure ArrangeCtrls; virtual;
352     procedure Change; virtual;
353     procedure CheckBoxChange; virtual;
354     procedure DoDropDown; virtual;
355     procedure DoCloseUp; virtual;
356     procedure DoAutoCheck; virtual;
357     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
358       const AXProportion, AYProportion: Double); override;
359 
360     procedure AddHandlerOnChange(const AOnChange: TNotifyEvent;
361       AsFirst: Boolean = False); virtual;
362     procedure AddHandlerOnCheckBoxChange(const AOnCheckBoxChange: TNotifyEvent;
363       AsFirst: Boolean = False); virtual;
364     procedure RemoveHandlerOnChange(AOnChange: TNotifyEvent); virtual;
365     procedure RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange: TNotifyEvent); virtual;
366 
367     property BorderStyle default bsSingle;
368     property AutoSize default True;
369     property TabStop default True;
370     property ParentColor default False;
371     property CenturyFrom: Word
372              read FCenturyFrom write SetCenturyFrom;
373     property DateDisplayOrder: TDateDisplayOrder
374              read FDateDisplayOrder write SetDateDisplayOrder default ddoTryDefault;
375     property MaxDate: TDate
376              read FMaxDate write SetMaxDate;
377     property MinDate: TDate
378              read FMinDate write SetMinDate;
379     property DateTime: TDateTime read GetDateTime write SetDateTime;
380     property TrailingSeparator: Boolean
381              read FTrailingSeparator write SetTrailingSeparator;
382     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
383     property LeadingZeros: Boolean read FLeadingZeros write SetLeadingZeros;
384     property TextForNullDate: TCaption
385              read FTextForNullDate write SetTextForNullDate nodefault;
386     property NullInputAllowed: Boolean
387              read FNullInputAllowed write SetNullInputAllowed default True;
388     property OnChange: TNotifyEvent read FOnChange write FOnChange;
389     property OnCheckBoxChange: TNotifyEvent
390              read FOnCheckBoxChange write FOnCheckBoxChange;
391     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
392     property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
393     property ShowCheckBox: Boolean
394              read FShowCheckBox write SetShowCheckBox default False;
395     property Checked: Boolean read GetChecked write SetChecked default True;
396     property ArrowShape: TArrowShape
397              read FArrowShape write SetArrowShape default asTheme;
398     property Kind: TDateTimeKind
399              read FKind write SetKind;
400     property DateSeparator: String
401              read FDateSeparator write SetDateSeparator stored AreSeparatorsStored;
402     property TimeSeparator: String
403              read FTimeSeparator write SetTimeSeparator stored AreSeparatorsStored;
404     property UseDefaultSeparators: Boolean
405              read FUseDefaultSeparators write SetUseDefaultSeparators;
406     property TimeFormat: TTimeFormat read FTimeFormat write SetTimeFormat;
407     property TimeDisplay: TTimeDisplay read FTimeDisplay write SetTimeDisplay;
408     property Time: TTime read GetTime write SetTime;
409     property Date: TDate read GetDate write SetDate;
410     property DateMode: TDTDateMode read FDateMode write SetDateMode;
411     property Cascade: Boolean read FCascade write FCascade default False;
412     property AutoButtonSize: Boolean
413              read FAutoButtonSize write SetAutoButtonSize default False;
414     property AutoAdvance: Boolean
415              read FAutoAdvance write FAutoAdvance default True;
416     property HideDateTimeParts: TDateTimeParts
417              read FHideDateTimeParts write SetHideDateTimeParts;
418     property CalendarWrapperClass: TCalendarControlWrapperClass
419              read FCalendarWrapperClass write SetCalendarWrapperClass;
420     property MonthNames: String read FMonthNames write SetMonthNames;
421     property ShowMonthNames: Boolean
422              read FShowMonthNames write SetShowMonthNames default False;
423     property DroppedDown: Boolean read GetDroppedDown;
424     property CalAlignment: TDTCalAlignment read FCalAlignment write SetCalAlignment default dtaDefault;
425     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
426     property Options: TDateTimePickerOptions read FOptions write SetOptions default cDefOptions;
427   public
428     constructor Create(AOwner: TComponent); override;
429     destructor Destroy; override;
DateIsNullnull430     function DateIsNull: Boolean;
431     procedure SelectDate;
432     procedure SelectTime;
433     procedure SendExternalKey(const aKey: Char);
434     procedure SendExternalKeyCode(const Key: Word);
435     procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
436 
437     procedure Paint; override;
438     procedure EditingDone; override;
439 
440   published
441     //
442   end;
443 
444   {TDateTimePicker}
445 
446   TDateTimePicker = class(TCustomDateTimePicker)
447   public
448     procedure AddHandlerOnChange(const AOnChange: TNotifyEvent; AsFirst: Boolean = False
449       ); override;
450     procedure AddHandlerOnCheckBoxChange(const AOnCheckBoxChange: TNotifyEvent;
451       AsFirst: Boolean = False); override;
452     procedure RemoveHandlerOnChange(AOnChange: TNotifyEvent); override;
453     procedure RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange: TNotifyEvent); override;
454   public
455     property DateTime;
456     property CalendarWrapperClass;
457     property DroppedDown;
458   published
459     property ArrowShape;
460     property ShowCheckBox;
461     property Checked;
462     property CenturyFrom;
463     property DateDisplayOrder;
464     property MaxDate;
465     property MinDate;
466     property ReadOnly;
467     property AutoSize;
468     property Font;
469     property ParentFont;
470     property TabOrder;
471     property TabStop;
472     property BorderStyle;
473     property BorderSpacing;
474     property Enabled;
475     property Color;
476     property ParentColor;
477     property DateSeparator;
478     property TrailingSeparator;
479     property TextForNullDate;
480     property LeadingZeros;
481     property ShowHint;
482     property ParentShowHint;
483     property Align;
484     property Anchors;
485     property Constraints;
486     property Cursor;
487     property PopupMenu;
488     property Visible;
489     property NullInputAllowed;
490     property Kind;
491     property TimeSeparator;
492     property TimeFormat;
493     property TimeDisplay;
494     property DateMode;
495     property Date;
496     property Time;
497     property UseDefaultSeparators;
498     property Cascade;
499     property AutoButtonSize;
500     property AutoAdvance;
501     property HideDateTimeParts;
502     property BiDiMode;
503     property ParentBiDiMode;
504     property MonthNames;
505     property ShowMonthNames;
506     property CalAlignment;
507     property Alignment;
508     property Options;
509 // events:
510     property OnChange;
511     property OnCheckBoxChange;
512     property OnDropDown;
513     property OnCloseUp;
514     property OnChangeBounds;
515     property OnClick;
516     property OnContextPopup;
517     property OnDblClick;
518     property OnEditingDone;
519     property OnEnter;
520     property OnExit;
521     property OnKeyDown;
522     property OnKeyPress;
523     property OnKeyUp;
524     property OnMouseDown;
525     property OnMouseEnter;
526     property OnMouseLeave;
527     property OnMouseMove;
528     property OnMouseUp;
529     property OnMouseWheel;
530     property OnMouseWheelDown;
531     property OnMouseWheelUp;
532     property OnResize;
533     property OnShowHint;
534     property OnUTF8KeyPress;
535   end;
536 
EqualDateTimenull537 function EqualDateTime(const A, B: TDateTime): Boolean;
IsNullDatenull538 function IsNullDate(DT: TDateTime): Boolean;
539 
540 implementation
541 
542 uses
543   DateUtils, LCLCalWrapper;
544 
545 const
546   DefaultUpDownWidth = 15;
547   DefaultArrowButtonWidth = DefaultUpDownWidth + 2;
548 
NumberOfDaysInMonthnull549 function NumberOfDaysInMonth(const Month, Year: Word): Word;
550 begin
551   Result := 0;
552   if Month in [1..12] then
553     Result := MonthDays[IsLeapYear(Year), Month];
554 end;
555 
556 { EqualDateTime
557   --------------
558   Returns True when two dates are equal or both are null }
EqualDateTimenull559 function EqualDateTime(const A, B: TDateTime): Boolean;
560 begin
561   if IsNullDate(A) then
562     Result := IsNullDate(B)
563   else
564     Result := (not IsNullDate(B)) and (A = B);
565 end;
566 
IsNullDatenull567 function IsNullDate(DT: TDateTime): Boolean;
568 begin
569   Result := IsNan(DT) or IsInfinite(DT) or
570             (DT > SysUtils.MaxDateTime) or (DT < SysUtils.MinDateTime);
571 end;
572 
573 type
574 
575   { TDTUpDown }
576 
577 { The two buttons contained by UpDown control are never disabled in original
578   UpDown class. This class is defined here to override this behaviour. }
579   TDTUpDown = class(TCustomUpDown)
580   private
581     DTPicker: TCustomDateTimePicker;
582   protected
583     procedure SetEnabled(Value: Boolean); override;
584     procedure CalculatePreferredSize(var PreferredWidth,
585                   PreferredHeight: integer; WithThemeSpace: Boolean); override;
586     procedure WndProc(var Message: TLMessage); override;
587   end;
588 
589   { TDTSpeedButton }
590 
591   TDTSpeedButton = class(TCustomSpeedButton)
592   private
593     DTPicker: TCustomDateTimePicker;
594   protected
595     procedure CalculatePreferredSize(var PreferredWidth,
596                   PreferredHeight: integer; WithThemeSpace: Boolean); override;
597     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
598       override;
599   public
600     procedure Paint; override;
601   end;
602 
603   { TDTCalendarForm }
604 
605   TDTCalendarForm = class(TForm)
606   private
607     DTPicker: TCustomDateTimePicker;
608     Cal: TCalendarControlWrapper;
609     Shape: TShape;
610     RememberedCalendarFormOrigin: TPoint;
611     FClosing: Boolean;
612     DTPickersParentForm: TCustomForm;
613 
614     procedure SetClosingCalendarForm;
615     procedure AdjustCalendarFormSize;
616     procedure AdjustCalendarFormScreenPosition;
617     procedure CloseCalendarForm(const AndSetTheDate: Boolean = False);
618 
619     procedure CalendarResize(Sender: TObject);
620     procedure CalendarClick(Sender: TObject);
621     procedure VisibleOfParentChanged(Sender: TObject);
622 
623   protected
624     procedure Deactivate; override;
625     procedure DoShow; override;
626     procedure DoClose(var CloseAction: TCloseAction); override;
627     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
628     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
629 
630     procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
631   public
632     constructor CreateNewDTCalendarForm(AOwner: TComponent;
633                   ADTPicker: TCustomDateTimePicker);
634     destructor Destroy; override;
635   published
636   end;
637 
638 { TDateTimePicker }
639 
640 procedure TDateTimePicker.AddHandlerOnChange(const AOnChange: TNotifyEvent;
641   AsFirst: Boolean);
642 begin
643   inherited AddHandlerOnChange(AOnChange, AsFirst);
644 end;
645 
646 procedure TDateTimePicker.AddHandlerOnCheckBoxChange(
647   const AOnCheckBoxChange: TNotifyEvent; AsFirst: Boolean);
648 begin
649   inherited AddHandlerOnCheckBoxChange(AOnCheckBoxChange, AsFirst);
650 end;
651 
652 procedure TDateTimePicker.RemoveHandlerOnChange(AOnChange: TNotifyEvent);
653 begin
654   inherited RemoveHandlerOnChange(AOnChange);
655 end;
656 
657 procedure TDateTimePicker.RemoveHandlerOnCheckBoxChange(
658   AOnCheckBoxChange: TNotifyEvent);
659 begin
660   inherited RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange);
661 end;
662 
663 procedure TDTCalendarForm.SetClosingCalendarForm;
664 begin
665   if not FClosing then begin
666     FClosing := True;
667 
668     if Assigned(DTPicker) and (DTPicker.FCalendarForm = Self) then
669       DTPicker.FCalendarForm := nil;
670 
671   end;
672 end;
673 
674 procedure TDTCalendarForm.AdjustCalendarFormSize;
675 begin
676   if not FClosing then begin
677     ClientWidth := Cal.GetCalendarControl.Width + 2;
678     ClientHeight := Cal.GetCalendarControl.Height + 2;
679 
680     Shape.SetBounds(0, 0, ClientWidth, ClientHeight);
681 
682     AdjustCalendarFormScreenPosition;
683 
684   end;
685 end;
686 
687 procedure TDTCalendarForm.AdjustCalendarFormScreenPosition;
688 var
689   M: TMonitor;
690   R: TRect;
691   P: TPoint;
692   H, W: Integer;
693 begin
694   H := Height;
695   W := Width;
696 
697   if (DTPicker.CalAlignment = dtaRight) or
698         ((DTPicker.CalAlignment = dtaDefault) and IsRightToLeft) then
699     P := DTPicker.ControlToScreen(Point(DTPicker.Width - W, DTPicker.Height))
700   else
701     P := DTPicker.ControlToScreen(Point(0, DTPicker.Height));
702 
703   M := Screen.MonitorFromWindow(DTPicker.Handle);
704 
705   R := M.WorkareaRect;
706   // WorkareaRect sometimes is not implemented (gtk2?). Depends on widgetset
707   // and window manager or something like that. Then it returns (0,0,0,0) and
708   // the best we can do is use BoundsRect instead:
709   if (R.Right <= R.Left) or (R.Bottom <= R.Top) then
710     R := M.BoundsRect;
711 
712   if P.y > R.Bottom - H then
713     P.y := P.y - H - DTPicker.Height;
714 
715   if P.y < R.Top then
716     P.y := R.Top;
717 
718   if P.x > R.Right - W then
719     P.x := R.Right - W;
720 
721   if P.x < R.Left then
722     P.x := R.Left;
723 
724   if (P.x <> RememberedCalendarFormOrigin.x)
725             or (P.y <> RememberedCalendarFormOrigin.y) then begin
726     SetBounds(P.x, P.y, W, H);
727     RememberedCalendarFormOrigin := P;
728   end;
729 
730 end;
731 
732 procedure TDTCalendarForm.CloseCalendarForm(const AndSetTheDate: Boolean);
733 begin
734   if not FClosing then
735     try
736       SetClosingCalendarForm;
737       Visible := False;
738 
739       if Assigned(DTPicker) and DTPicker.IsVisible then begin
740 
741         if AndSetTheDate then begin
742           Inc(DTPicker.FUserChanging);
743           try
744             DTPicker.SetDate(Cal.GetDate);
745             DTPicker.DoAutoCheck;
746           finally
747             Dec(DTPicker.FUserChanging);
748           end;
749         end;
750 
751         if Screen.ActiveCustomForm = Self then
752           DTPicker.SetFocusIfPossible;
753 
754         DTPicker.DoCloseUp;
755       end;
756 
757     finally
758       Release;
759     end;
760 
761 end;
762 
763 procedure TDTCalendarForm.KeyDown(var Key: Word; Shift: TShiftState);
764 var
765   ApplyTheDate: Boolean;
766 
767 begin
768   inherited KeyDown(Key, Shift);
769 
770   case Key of
771 
772     VK_ESCAPE, VK_RETURN, VK_SPACE, VK_TAB:
773       if Cal.InMonthView then begin
774         ApplyTheDate := Key in [VK_RETURN, VK_SPACE];
775         Key := 0;
776         CloseCalendarForm(ApplyTheDate);
777       end;
778 
779     VK_UP:
780       if Shift = [ssAlt] then begin
781         Key := 0;
782         CloseCalendarForm;
783       end;
784 
785     // Suppress Alt (not doing so can produce SIGSEGV on Win widgetset ?!)
786     VK_MENU, VK_LMENU, VK_RMENU:
787       Key := 0;
788 
789   end;
790 
791 end;
792 
793 procedure TDTCalendarForm.CalendarResize(Sender: TObject);
794 begin
795   AdjustCalendarFormSize;
796 end;
797 
798 procedure TDTCalendarForm.CalendarClick(Sender: TObject);
799 var
800   P: TPoint;
801 begin
802   P := Cal.GetCalendarControl.ScreenToClient(Mouse.CursorPos);
803   if Cal.AreCoordinatesOnDate(P.x, P.y) then
804      CloseCalendarForm(True);
805 
806 end;
807 
808 { This procedure is added to list of "visible change handlers" of DTPicker's
809   parent form, so that hiding of DTPicker's parent form does not leave the
810   calendar form visible. }
811 procedure TDTCalendarForm.VisibleOfParentChanged(Sender: TObject);
812 begin
813   SetClosingCalendarForm;
814   Release;
815 end;
816 
817 procedure TDTCalendarForm.WMActivate(var Message: TLMActivate);
818 var
819   PP: HWND;
820 begin
821   inherited WMActivate(Message);
822 
823   PP := LCLIntf.GetParent(Handle);
824   if PP <> 0 then
825     SendMessage(PP, LM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
826 end;
827 
828 procedure TDTCalendarForm.Notification(AComponent: TComponent;
829   Operation: TOperation);
830 begin
831   inherited Notification(AComponent, Operation);
832 
833   if (AComponent = DTPickersParentForm) and (Operation = opRemove) then
834     DTPickersParentForm := nil;
835 
836 end;
837 
838 procedure TDTCalendarForm.Deactivate;
839 begin
840   inherited Deactivate;
841 
842   CloseCalendarForm;
843 end;
844 
845 procedure TDTCalendarForm.DoShow;
846 begin
847   if not FClosing then begin
848     inherited DoShow;
849 
850     AdjustCalendarFormSize;
851     DTPicker.DoDropDown; // calls OnDropDown event handler
852   end;
853 end;
854 
855 procedure TDTCalendarForm.DoClose(var CloseAction: TCloseAction);
856 begin
857   SetClosingCalendarForm;
858   CloseAction := caFree;
859 
860   inherited DoClose(CloseAction);
861 end;
862 
863 constructor TDTCalendarForm.CreateNewDTCalendarForm(AOwner: TComponent;
864   ADTPicker: TCustomDateTimePicker);
865 var
866   P: TPoint;
867   CalClass: TCalendarControlWrapperClass;
868 begin
869   inherited CreateNew(AOwner);
870 
871   ADTPicker.FAllowDroppingCalendar := False;
872   FClosing := False;
873 
874   DTPicker := ADTPicker;
875   BiDiMode := DTPicker.BiDiMode;
876   DTPickersParentForm := GetParentForm(DTPicker);
877   if Assigned(DTPickersParentForm) then begin
878     DTPickersParentForm.AddHandlerOnVisibleChanged(@VisibleOfParentChanged);
879     DTPickersParentForm.FreeNotification(Self);
880     PopupParent := DTPickersParentForm;
881     PopupMode := pmExplicit;
882   end else
883     PopupMode := pmAuto;
884 
885   P := Point(0, 0);
886 
887   if ADTPicker.FCalendarWrapperClass = nil then begin
888     if DefaultCalendarWrapperClass = nil then
889       CalClass := TLCLCalendarWrapper
890     else
891       CalClass := DefaultCalendarWrapperClass;
892   end else
893     CalClass := ADTPicker.FCalendarWrapperClass;
894 
895   Cal := CalClass.Create;
896 
897   Cal.GetCalendarControl.ParentBiDiMode := True;
898   Cal.GetCalendarControl.AutoSize := True;
899   Cal.GetCalendarControl.GetPreferredSize(P.x, P.y);
900   Cal.GetCalendarControl.Align := alNone;
901   Cal.GetCalendarControl.SetBounds(1, 1, P.x, P.y);
902 
903   SetBounds(-8000, -8000, P.x + 2, P.y + 2);
904   RememberedCalendarFormOrigin := Point(-8000, -8000);
905 
906   ShowInTaskBar := stNever;
907   BorderStyle := bsNone;
908 
909   Shape := TShape.Create(nil);
910   Shape.Brush.Style := bsClear;
911 
912   if DTPicker.DateIsNull then
913     Cal.SetDate(Max(DTPicker.MinDate, Min(SysUtils.Date, DTPicker.MaxDate)))
914 
915   else if DTPicker.DateTime < DTPicker.MinDate then // These "out of bounds" values
916     Cal.SetDate(DTPicker.MinDate)      // can happen when DateTime was set with
917   else if DTPicker.DateTime > DTPicker.MaxDate then // "SetDateTimeJumpMinMax" protected
918     Cal.SetDate(DTPicker.MaxDate)      // procedure (used in TDBDateTimePicker control).
919 
920   else
921     Cal.SetDate(DTPicker.Date);
922 
923   Cal.GetCalendarControl.OnResize := @CalendarResize;
924   Cal.GetCalendarControl.OnClick := @CalendarClick;
925   if Cal.GetCalendarControl is TWinControl then begin
926     TWinControl(Cal.GetCalendarControl).TabStop := True;
927     TWinControl(Cal.GetCalendarControl).SetFocus;
928   end;
929   Self.KeyPreview := True;
930 
931   Shape.Parent := Self;
932   Cal.GetCalendarControl.Parent := Self;
933   Cal.GetCalendarControl.BringToFront;
934 end;
935 
936 destructor TDTCalendarForm.Destroy;
937 begin
938   SetClosingCalendarForm;
939 
940   if Assigned(DTPickersParentForm) then
941     DTPickersParentForm.RemoveAllHandlersOfObject(Self);
942 
943   FreeAndNil(Cal);
944   FreeAndNil(Shape);
945 
946   if Assigned(DTPicker) then begin
947     if Screen.ActiveControl = DTPicker then
948       DTPicker.Invalidate;
949 
950     if DTPicker.FCalendarForm = nil then
951       DTPicker.FAllowDroppingCalendar := True;
952 
953   end;
954 
955   inherited Destroy;
956 end;
957 
958 { TCustomDateTimePicker }
959 
960 procedure TCustomDateTimePicker.SetChecked(const AValue: Boolean);
961 begin
962   if (FChecked = AValue) or not FShowCheckBox then
963     Exit;
964   FChecked := AValue;
965 
966   CheckBoxChange;
967   CheckTextEnabled;
968   Invalidate;
969 end;
970 
971 procedure TCustomDateTimePicker.CheckTextEnabled;
972 begin
973   FTextEnabled := Self.Enabled and ((dtpoEnabledIfUnchecked in Options) or GetChecked);
974 
975   if Assigned(FArrowButton) then
976     FArrowButton.Enabled := FTextEnabled;
977 
978   if Assigned(FUpDown) then
979     FUpDown.Enabled := FTextEnabled;
980 end;
981 
982 procedure TCustomDateTimePicker.SetDateDisplayOrder(
983   const AValue: TDateDisplayOrder);
984 var
985   PreviousEffectiveDDO: TDateDisplayOrder;
986 begin
987   if FDateDisplayOrder <> AValue then begin
988     PreviousEffectiveDDO := FEffectiveDateDisplayOrder;
989     FDateDisplayOrder := AValue;
990     AdjustEffectiveDateDisplayOrder;
991     if FEffectiveDateDisplayOrder <> PreviousEffectiveDDO then begin
992       AdjustSelection;
993       UpdateDate;
994     end;
995   end;
996 end;
997 
998 procedure TCustomDateTimePicker.SetDateMode(const AValue: TDTDateMode);
999 begin
1000   FDateMode := AValue;
1001   UpdateShowArrowButton;
1002 end;
1003 
1004 procedure TCustomDateTimePicker.SetHideDateTimeParts(AValue: TDateTimeParts);
1005 begin
1006   if FHideDateTimeParts <> AValue then begin
1007     FHideDateTimeParts := AValue;
1008     AdjustEffectiveHideDateTimeParts;
1009   end;
1010 end;
1011 
1012 procedure TCustomDateTimePicker.SetKind(const AValue: TDateTimeKind);
1013 begin
1014   if FKind <> AValue then begin
1015     FKind := AValue;
1016     AdjustEffectiveHideDateTimeParts;
1017   end;
1018 end;
1019 
1020 procedure TCustomDateTimePicker.SetLeadingZeros(const AValue: Boolean);
1021 begin
1022   if FLeadingZeros = AValue then Exit;
1023 
1024   FLeadingZeros := AValue;
1025   UpdateDate;
1026 end;
1027 
1028 procedure TCustomDateTimePicker.SetMonthNames(AValue: String);
1029 var
1030   I, N, LenMNSep: Integer;
1031   MonthNamesSeparator: String;
1032 
1033 begin
1034   if FMonthNames <> AValue then begin
1035     AValue := TrimRight(AValue);
1036     FMonthNames := AValue;
1037 
1038     if CompareText(AValue, 'SHORT') = 0 then
1039       for I := Low(TMonthNameArray) to High(TMonthNameArray) do
1040         FMonthNamesArray[I] := AnsiToUtf8(DefaultFormatSettings.ShortMonthNames[I])
1041     else begin
1042       N := 0;
1043       if Length(AValue) >= 24 then begin
1044         MonthNamesSeparator := UTF8Copy(AValue, 1, 1);
1045         LenMNSep := Length(MonthNamesSeparator);
1046         if LenMNSep > 0 then begin
1047           Delete(AValue, 1, LenMNSep);
1048 
1049           while N < 12 do begin
1050             I := Pos(MonthNamesSeparator, AValue);
1051             if I <= 1 then begin
1052               if (I = 0) and (N = 11) and (Length(AValue) > 0) then begin
1053                 Inc(N);
1054                 FMonthNamesArray[N] := AValue;
1055               end;
1056 
1057               Break;
1058             end;
1059 
1060             Inc(N);
1061             Dec(I);
1062             FMonthNamesArray[N] := Copy(AValue, 1, I);
1063             Delete(AValue, 1, I + LenMNSep);
1064           end;
1065 
1066         end;
1067       end;
1068 
1069       if N < 12 then
1070         for I := Low(TMonthNameArray) to High(TMonthNameArray) do
1071           FMonthNamesArray[I] := AnsiToUtf8(DefaultFormatSettings.LongMonthNames[I]);
1072     end;
1073 
1074     if FShowMonthNames and
1075               not (dtpMonth in FEffectiveHideDateTimeParts) then begin
1076       FRecalculatingTextSizesNeeded := True;
1077       UpdateDate;
1078     end;
1079   end;
1080 end;
1081 
1082 procedure TCustomDateTimePicker.SetNullInputAllowed(const AValue: Boolean);
1083 begin
1084   FNullInputAllowed := AValue;
1085 end;
1086 
1087 procedure TCustomDateTimePicker.SetOptions(
1088   const aOptions: TDateTimePickerOptions);
1089 begin
1090   if FOptions = aOptions then Exit;
1091   FOptions := aOptions;
1092 
1093   if FArrowButton <> nil then
1094     FArrowButton.Flat := dtpoFlatButton in Options;
1095 
1096   if FUpDown <> nil then
1097     TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options;
1098 
1099   CheckTextEnabled;
1100   Invalidate;
1101 end;
1102 
1103 procedure TCustomDateTimePicker.SetDate(const AValue: TDate);
1104 begin
1105   if IsNullDate(AValue) then
1106     DateTime := NullDate
1107   else if DateIsNull then
1108     DateTime := Int(AValue)
1109   else
1110     DateTime := ComposeDateTime(AValue, FDateTime);
1111 end;
1112 
1113 procedure TCustomDateTimePicker.SetDateTime(const AValue: TDateTime);
1114 begin
1115   if not EqualDateTime(AValue, FDateTime) then begin
1116     if IsNullDate(AValue) then
1117       FDateTime := NullDate
1118     else
1119       FDateTime := AValue;
1120 
1121     UpdateDate(dtpoDoChangeOnSetDateTime in FOptions);
1122   end else
1123     UpdateDate;
1124 
1125 end;
1126 
1127 procedure TCustomDateTimePicker.SetDateSeparator(const AValue: String);
1128 begin
1129   SetSeparators(AValue, FTimeSeparator);
1130 end;
1131 
1132 procedure TCustomDateTimePicker.SetMaxDate(const AValue: TDate);
1133 begin
1134   if not IsNullDate(AValue) then begin
1135 
1136     if AValue > TheBiggestDate then
1137       FMaxDate := TheBiggestDate
1138     else if AValue <= FMinDate then
1139       FMaxDate := FMinDate
1140     else
1141       FMaxDate := Int(AValue);
1142 
1143     if not DateIsNull then
1144       if FMaxDate < GetDate then
1145         SetDate(FMaxDate);
1146 
1147     AdjustEffectiveCenturyFrom;
1148   end;
1149 end;
1150 
1151 procedure TCustomDateTimePicker.SetMinDate(const AValue: TDate);
1152 begin
1153   if not IsNullDate(AValue) then begin
1154 
1155     if AValue < TheSmallestDate then
1156       FMinDate := TheSmallestDate
1157     else if AValue >= FMaxDate then
1158       FMinDate := FMaxDate
1159     else
1160       FMinDate := Int(AValue);
1161 
1162     if not DateIsNull then
1163       if FMinDate > GetDate then
1164         SetDate(FMinDate);
1165 
1166     AdjustEffectiveCenturyFrom;
1167   end;
1168 end;
1169 
1170 procedure TCustomDateTimePicker.SetReadOnly(const AValue: Boolean);
1171 begin
1172   if FReadOnly <> AValue then begin
1173     if AValue then
1174       ConfirmChanges;
1175 
1176     FReadOnly := AValue;
1177   end;
1178 end;
1179 
1180 procedure TCustomDateTimePicker.SetShowCheckBox(const AValue: Boolean);
1181 begin
1182   if FShowCheckBox = AValue then
1183     Exit;
1184 
1185   FShowCheckBox := AValue;
1186   ArrangeCtrls;
1187 end;
1188 
1189 procedure TCustomDateTimePicker.SetShowMonthNames(AValue: Boolean);
1190 begin
1191   if FShowMonthNames <> AValue then begin
1192     FShowMonthNames := AValue;
1193     if not (dtpMonth in FEffectiveHideDateTimeParts) then begin
1194       FRecalculatingTextSizesNeeded := True;
1195       UpdateDate;
1196     end;
1197   end;
1198 end;
1199 
1200 procedure TCustomDateTimePicker.SetTextForNullDate(const AValue: TCaption);
1201 begin
1202   if FTextForNullDate = AValue then
1203     Exit;
1204 
1205   FTextForNullDate := AValue;
1206   if DateIsNull then
1207     Invalidate;
1208 end;
1209 
1210 procedure TCustomDateTimePicker.SetTime(const AValue: TTime);
1211 begin
1212   if IsNullDate(AValue) then
1213     DateTime := NullDate
1214   else if DateIsNull then
1215     DateTime := ComposeDateTime(Max(Min(SysUtils.Date, MaxDate), MinDate), AValue)
1216   else
1217     DateTime := ComposeDateTime(FDateTime, AValue);
1218 end;
1219 
1220 procedure TCustomDateTimePicker.SetTimeSeparator(const AValue: String);
1221 begin
1222   SetSeparators(FDateSeparator, AValue);
1223 end;
1224 
1225 procedure TCustomDateTimePicker.SetTimeDisplay(const AValue: TTimeDisplay);
1226 begin
1227   if FTimeDisplay <> AValue then begin
1228     FTimeDisplay:= AValue;
1229     AdjustEffectiveHideDateTimeParts;
1230   end;
1231 end;
1232 
1233 procedure TCustomDateTimePicker.SetTimeFormat(const AValue: TTimeFormat);
1234 begin
1235   if FTimeFormat <> AValue then begin
1236     FTimeFormat := AValue;
1237     AdjustEffectiveHideDateTimeParts;
1238   end;
1239 end;
1240 
1241 procedure TCustomDateTimePicker.SetTrailingSeparator(const AValue: Boolean);
1242 begin
1243   if FTrailingSeparator <> AValue then begin
1244     FTrailingSeparator := AValue;
1245     FRecalculatingTextSizesNeeded := True;
1246     UpdateIfUserChangedText;
1247     Invalidate;
1248   end;
1249 end;
1250 
1251 procedure TCustomDateTimePicker.SetUseDefaultSeparators(const AValue: Boolean);
1252 begin
1253   if FUseDefaultSeparators <> AValue then begin
1254     if AValue then begin
1255       SetSeparators(DefaultFormatSettings.DateSeparator,
1256                       DefaultFormatSettings.TimeSeparator);
1257         // Note that here, in SetSeparators procedure,
1258         // the field FUseDefaultSeparators is set to False.
1259     end;
1260     // Therefore, the following line must NOT be moved above.
1261     FUseDefaultSeparators := AValue;
1262   end;
1263 end;
1264 
1265 { RecalculateTextSizesIfNeeded
1266  --------------------------------
1267   In this procedure we measure text and store the values in the following
1268   fields: FDateWidth, FTimeWidth, FTextWidth, FTextHeigth, FDigitWidth,
1269   FSeparatorWidth, FTimeSeparatorWidth, FSepNoSpaceWidth. These fields are used
1270   in calculating our preffered size and when painting.
1271   The procedure is called internally when needed (when properties which
1272   influence the appearence change). }
1273 procedure TCustomDateTimePicker.RecalculateTextSizesIfNeeded;
1274 const
1275   NullMonthChar = 'x';
1276 var
1277   C: Char;
1278   N, J: Integer;
1279   S: String;
1280   I: TDateTimePart;
1281   DateParts, TimeParts: Integer;
1282 begin
1283   if HandleAllocated and FRecalculatingTextSizesNeeded then begin
1284     FRecalculatingTextSizesNeeded := False;
1285 
1286     FDigitWidth := 0;
1287     for C := '0' to '9' do begin
1288       N := Canvas.GetTextWidth(C);
1289       if N > FDigitWidth then
1290         FDigitWidth := N;
1291     end;
1292 
1293     DateParts := 0;
1294     FSepNoSpaceWidth := 0;
1295     FSeparatorWidth := 0;
1296     FMonthWidth := 0;
1297     FDateWidth := 0;
1298     FNullMonthText := '';
1299     S := '';
1300     if FKind in [dtkDate, dtkDateTime] then begin
1301 
1302       for I := dtpDay to dtpYear do
1303         if not (I in FEffectiveHideDateTimeParts) then begin
1304           Inc(DateParts);
1305           if I = dtpYear then begin
1306             FDateWidth := FDateWidth + 4 * FDigitWidth;
1307           end else if (I = dtpMonth) and FShowMonthNames then begin
1308             FMonthWidth := FDigitWidth; // Minimal MonthWidth is DigitWidth.
1309             for J := Low(TMonthNameArray) to High(TMonthNameArray) do begin
1310               N := Canvas.GetTextWidth(FMonthNamesArray[J]);
1311               if N > FMonthWidth then
1312                 FMonthWidth := N;
1313             end;
1314 
1315             N := Canvas.GetTextWidth(NullMonthChar);
1316             if N > 0 then begin
1317               N := (FMonthWidth - 1) div N + 1;
1318               if N > 1 then begin
1319                 FNullMonthText := StringOfChar(NullMonthChar, N);
1320                 N := Canvas.TextFitInfo(FNullMonthText, FMonthWidth);
1321                 if N > 1 then
1322                   SetLength(FNullMonthText, N);
1323               end;
1324             end;
1325             if N <= 1 then
1326               FNullMonthText := NullMonthChar;
1327 
1328             FDateWidth := FDateWidth + FMonthWidth;
1329           end else
1330             FDateWidth := FDateWidth + 2 * FDigitWidth;
1331 
1332         end;
1333 
1334       if DateParts > 0 then begin
1335         if FTrailingSeparator then begin
1336           FSepNoSpaceWidth := Canvas.GetTextWidth(TrimRight(FDateSeparator));
1337           Inc(FDateWidth, FSepNoSpaceWidth);
1338         end;
1339 
1340         if DateParts > 1 then begin
1341           FSeparatorWidth := Canvas.GetTextWidth(FDateSeparator);
1342           S := FDateSeparator;
1343 
1344           FDateWidth := FDateWidth + (DateParts - 1) * FSeparatorWidth;
1345         end;
1346       end;
1347 
1348     end;
1349 
1350     TimeParts := 0;
1351     FTimeWidth := 0;
1352     FAMPMWidth := 0;
1353     FTimeSeparatorWidth := 0;
1354     if FKind in [dtkTime, dtkDateTime] then begin
1355 
1356       for I := dtpHour to dtpMiliSec do
1357         if not (I in FEffectiveHideDateTimeParts) then begin
1358           Inc(TimeParts);
1359 
1360           if I = dtpMiliSec then
1361             FTimeWidth := FTimeWidth + 3 * FDigitWidth
1362           else
1363             FTimeWidth := FTimeWidth + 2 * FDigitWidth;
1364 
1365         end;
1366 
1367       if TimeParts > 1 then begin
1368         FTimeSeparatorWidth := Canvas.GetTextWidth(FTimeSeparator);
1369         S := S + FTimeSeparator;
1370         FTimeWidth := FTimeWidth + (TimeParts - 1) * FTimeSeparatorWidth;
1371       end;
1372 
1373       if not (dtpAMPM in FEffectiveHideDateTimeParts) then begin
1374         S := S + 'APM';
1375         FAMPMWidth := Max(Canvas.TextWidth('AM'), Canvas.TextWidth('PM'));
1376         FTimeWidth := FTimeWidth + FDigitWidth + FAMPMWidth;
1377       end;
1378 
1379     end;
1380 
1381     FTextWidth := FDateWidth + FTimeWidth;
1382     if (DateParts > 0) and (TimeParts > 0) then
1383       FTextWidth := FTextWidth + 2 * FDigitWidth;
1384 
1385     FTextHeight := Canvas.GetTextHeight('0123456789' + S);
1386 
1387   end;
1388 end;
1389 
TCustomDateTimePicker.GetHMSMsnull1390 function TCustomDateTimePicker.GetHMSMs(const NowIfNull: Boolean): THMSMs;
1391 begin
1392   if DateIsNull then begin
1393     if NowIfNull then
1394       DecodeTime(SysUtils.Time, Result.Hour, Result.Minute, Result.Second, Result.MiliSec)
1395     else
1396       Result := Default(THMSMs);
1397   end else
1398     DecodeTime(FDateTime, Result.Hour, Result.Minute, Result.Second, Result.MiliSec);
1399 end;
1400 
GetYYYYMMDDnull1401 function TCustomDateTimePicker.GetYYYYMMDD(const TodayIfNull: Boolean;
1402   const WithCorrection: Boolean): TYMD;
1403 begin
1404   if DateIsNull then begin
1405     if TodayIfNull then
1406       DecodeDate(SysUtils.Date, Result.Year, Result.Month, Result.Day)
1407     else
1408       Result := Default(TYMD);
1409   end else begin
1410     DecodeDate(FDateTime, Result.Year, Result.Month, Result.Day);
1411     if WithCorrection and (FCorrectedValue > 0) then begin
1412       case FCorrectedDTP of
1413         dtpDay:
1414           Result.Day := FCorrectedValue;
1415         dtpMonth:
1416           Result.Month := FCorrectedValue;
1417         dtpYear:
1418           Result.Year := FCorrectedValue;
1419       otherwise
1420       end;
1421     end;
1422   end;
1423 end;
1424 
1425 procedure TCustomDateTimePicker.SetHour(const AValue: Word);
1426 var
1427   HMSMs: THMSMs;
1428 begin
1429   SelectHour;
1430 
1431   HMSMs := GetHMSMs(True);
1432   HMSMs.Hour := AValue;
1433 
1434   SetHMSMs(HMSMs);
1435 end;
1436 
1437 procedure TCustomDateTimePicker.SetMiliSec(const AValue: Word);
1438 var
1439   HMSMs: THMSMs;
1440 begin
1441   SelectMiliSec;
1442 
1443   HMSMs := GetHMSMs(True);
1444   HMSMs.MiliSec := AValue;
1445 
1446   SetHMSMs(HMSMs);
1447 end;
1448 
1449 procedure TCustomDateTimePicker.SetMinute(const AValue: Word);
1450 var
1451   HMSMs: THMSMs;
1452 begin
1453   SelectMinute;
1454 
1455   HMSMs := GetHMSMs(True);
1456   HMSMs.Minute := AValue;
1457 
1458   SetHMSMs(HMSMs);
1459 end;
1460 
1461 procedure TCustomDateTimePicker.SetSecond(const AValue: Word);
1462 var
1463   HMSMs: THMSMs;
1464 begin
1465   SelectSecond;
1466 
1467   HMSMs := GetHMSMs(True);
1468   HMSMs.Second := AValue;
1469 
1470   SetHMSMs(HMSMs);
1471 end;
1472 
1473 procedure TCustomDateTimePicker.SetSeparators(const DateSep, TimeSep: String);
1474 var
1475   SeparatorsChanged: Boolean;
1476 begin
1477   FUseDefaultSeparators := False;
1478   SeparatorsChanged := False;
1479 
1480   if FDateSeparator <> DateSep then begin
1481     FDateSeparator := DateSep;
1482     SeparatorsChanged := True;
1483   end;
1484 
1485   if FTimeSeparator <> TimeSep then begin
1486     FTimeSeparator := TimeSep;
1487     SeparatorsChanged := True;
1488   end;
1489 
1490   if SeparatorsChanged then begin
1491     FRecalculatingTextSizesNeeded := True;
1492     Invalidate;
1493   end;
1494 
1495 end;
1496 
1497 procedure TCustomDateTimePicker.SetDay(const AValue: Word);
1498 var
1499   YMD: TYMD;
1500 begin
1501   SelectDay;
1502   YMD := GetYYYYMMDD(True, True);
1503 
1504   YMD.Day := AValue;
1505   SetYYYYMMDD(YMD);
1506 end;
1507 
1508 procedure TCustomDateTimePicker.SetMonth(const AValue: Word);
1509 var
1510   YMD: TYMD;
1511   N: Word;
1512 begin
1513   SelectMonth;
1514   YMD := GetYYYYMMDD(True, True);
1515 
1516   YMD.Month := AValue;
1517 
1518   N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
1519   if YMD.Day > N then
1520     YMD.Day := N;
1521 
1522   SetYYYYMMDD(YMD);
1523 end;
1524 
1525 procedure TCustomDateTimePicker.SetYear(const AValue: Word);
1526 var
1527   YMD: TYMD;
1528 begin
1529   SelectYear;
1530 
1531   YMD := GetYYYYMMDD(True, True);
1532   YMD.Year := AValue;
1533   if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
1534     YMD.Day := 28;
1535 
1536   SetYYYYMMDD(YMD);
1537 end;
1538 
1539 procedure TCustomDateTimePicker.SetYYYYMMDD(const AValue: TYMD);
1540 var
1541   D: TDateTime;
1542 begin
1543   if TryEncodeDate(AValue.Year, AValue.Month, AValue.Day, D) then
1544     SetDate(D)
1545   else
1546     UpdateDate;
1547 end;
1548 
1549 procedure TCustomDateTimePicker.SetHMSMs(const AValue: THMSMs);
1550 var
1551   T: TDateTime;
1552 begin
1553   if TryEncodeTime(AValue.Hour, AValue.Minute,
1554                                   AValue.Second, AValue.MiliSec, T) then
1555     SetTime(T)
1556   else
1557     UpdateDate;
1558 end;
1559 
1560 procedure TCustomDateTimePicker.UpdateIfUserChangedText;
1561 var
1562   W: Word;
1563   S: String;
1564 begin
1565   if FUserChangedText then begin
1566     Inc(FUserChanging);
1567     try
1568       FUserChangedText := False;
1569       S := Trim(GetSelectedText);
1570 
1571       if FSelectedTextPart = 8 then begin
1572         W := GetHMSMs().Hour;
1573         if upCase(S[1]) = 'A' then begin
1574           if W >= 12 then
1575             Dec(W, 12);
1576         end else begin
1577           if W < 12 then
1578             Inc(W, 12);
1579         end;
1580         SetHour(W);
1581         FSelectedTextPart := 8;
1582 
1583       end else begin
1584         W := StrToInt(S);
1585         case GetSelectedDateTimePart of
1586           dtpYear:
1587             begin
1588               if Length(S) <= 2 then begin
1589                 // If user entered the year in two digit format (or even only
1590                 // one digit), we will set the year according to the CenturyFrom
1591                 // property (We actually use FEffectiveCenturyFrom field, which
1592                 // is adjusted to take care of MinDate and MaxDate properties,
1593                 // besides CenturyFrom).
1594                 if W >= (FEffectiveCenturyFrom mod 100) then
1595                   W := W + 100 * (FEffectiveCenturyFrom div 100)
1596                 else
1597                   W := W + 100 * (FEffectiveCenturyFrom div 100 + 1);
1598 
1599               end;
1600               SetYear(W);
1601             end;
1602 
1603           dtpDay:
1604             SetDay(W);
1605 
1606           dtpMonth:
1607             SetMonth(W);
1608 
1609           dtpHour:
1610             begin
1611               if FTimeFormat = tf12 then begin
1612                 if GetHMSMs().Hour < 12 then begin
1613                   if W = 12 then
1614                     SetHour(0)
1615                   else
1616                     SetHour(W);
1617                 end else begin
1618                   if W = 12 then
1619                     SetHour(W)
1620                   else
1621                     SetHour(W + 12);
1622                 end;
1623               end else
1624                 SetHour(W);
1625             end;
1626 
1627           dtpMinute:
1628             SetMinute(W);
1629 
1630           dtpSecond:
1631             SetSecond(W);
1632 
1633           dtpMiliSec:
1634             SetMiliSec(W);
1635 
1636         otherwise
1637         end;
1638 
1639       end;
1640 
1641     finally
1642       FCorrectedValue := 0;
1643       Dec(FUserChanging);
1644     end;
1645   end;
1646 end;
1647 
TCustomDateTimePicker.GetSelectedTextnull1648 function TCustomDateTimePicker.GetSelectedText: String;
1649 begin
1650   if FSelectedTextPart <= 3 then
1651     Result := FTextPart[FSelectedTextPart]
1652   else
1653     Result := FTimeText[TDateTimePart(FSelectedTextPart - 1)];
1654 end;
1655 
1656 procedure TCustomDateTimePicker.AdjustSelection;
1657 begin
1658   if GetSelectedDateTimePart in FEffectiveHideDateTimeParts then
1659     MoveSelectionLR(False);
1660 end;
1661 
1662 procedure TCustomDateTimePicker.AdjustEffectiveCenturyFrom;
1663 var
1664   Y1, Y2, M, D: Word;
1665 begin
1666   DecodeDate(FMinDate, Y1, M, D);
1667 
1668   if Y1 > FCenturyFrom then
1669     FEffectiveCenturyFrom := Y1 // If we use CenturyFrom which is set to value
1670          // below MinDate's year, then when user enters two digit year, the
1671          // DateTime would automatically be set to MinDate value, even though
1672          // we perhaps allow same two-digit year in following centuries. It
1673          // would be less user friendly.
1674          // This is therefore better.
1675 
1676   else begin
1677     DecodeDate(FMaxDate, Y2, M, D);
1678 
1679     if Y2 < 100 then
1680       Y2 := 0
1681     else
1682       Dec(Y2, 99); // -- We should not use CenturyFrom if it is set to value
1683        // greater then MaxDate's year minus 100 years.
1684        // For example:
1685        // if CenturyFrom = 1941 and MaxDate = 31.12.2025, then if user enters
1686        // Year 33, we could not set the year to 2033 anyway, because of MaxDate
1687        // limit. Note that if we just leave CenturyFrom to effectively remain as
1688        // is, then in case of our example the DateTime would be automatically
1689        // reduced to MaxDate value. Setting the year to 1933 is rather expected
1690        // behaviour, so our internal field FEffectiveCenturyFrom should be 1926.
1691 
1692     // Therefore:
1693     if Y2 < FCenturyFrom then
1694       FEffectiveCenturyFrom := Max(Y1, Y2)
1695     else
1696       FEffectiveCenturyFrom := FCenturyFrom; // -- FCenturyFrom has passed all
1697                    // our tests, so we'll really use it without any correction.
1698   end;
1699 end;
1700 
1701 { AdjustEffectiveDateDisplayOrder procedure
1702  -------------------------------------------
1703   If date display order ddoTryDefault is set, then we will decide which
1704   display order to use according to ShortDateFormat global variable. This
1705   procedure tries to achieve that by searching through short date format string,
1706   to see which letter comes first -- d, m or y. When it finds any of these
1707   characters, it assumes that date order should be d-m-y, m-d-y, or y-m-d
1708   respectively. If the search through ShortDateFormat is unsuccessful by any
1709   chance, we try the same with LongDateFormat global variable. If we don't
1710   succeed again, we'll assume y-m-d order.  }
1711 procedure TCustomDateTimePicker.AdjustEffectiveDateDisplayOrder;
1712 var
1713   S: String;
1714   I, J, Le: Integer;
1715   InQuoteChar: Char;
1716 begin
1717   if FDateDisplayOrder = ddoTryDefault then begin
1718     S := DefaultFormatSettings.ShortDateFormat;
1719     FEffectiveDateDisplayOrder := ddoTryDefault;
1720 
1721     repeat
1722       InQuoteChar := Chr(0);
1723       Le := Length(S);
1724 
1725       I := 0;
1726       while I < Le do begin
1727         Inc(I);
1728         if InQuoteChar = Chr(0) then begin
1729           case S[I] of
1730             '''', '"':
1731               InQuoteChar := S[I];
1732             'D', 'd':
1733               begin
1734                 { If 3 or more "d"-s are standing together, then it's day
1735                   of week, but here we are interested in day of month.
1736                   So, we have to see what is following:  }
1737                 J := I + 1;
1738                 while (J <= Le) and (upCase(S[J]) = 'D') do
1739                   Inc(J);
1740 
1741                 if J <= I + 2 then begin
1742                   FEffectiveDateDisplayOrder := ddoDMY;
1743                   Break;
1744                 end;
1745 
1746                 I := J - 1;
1747               end;
1748             'M', 'm':
1749               begin
1750                 FEffectiveDateDisplayOrder := ddoMDY;
1751                 Break;
1752               end;
1753             'Y', 'y':
1754               begin
1755                 FEffectiveDateDisplayOrder := ddoYMD;
1756                 Break;
1757               end;
1758           end;
1759         end else
1760           if S[I] = InQuoteChar then
1761             InQuoteChar := Chr(0);
1762 
1763       end;
1764 
1765       if FEffectiveDateDisplayOrder = ddoTryDefault then begin
1766         { We couldn't decide with ShortDateFormat, let's try with
1767           LongDateFormat now. }
1768         S := DefaultFormatSettings.LongDateFormat;
1769         { But now we must set something to be default. This ensures that the
1770           repeat loop breaks next time. If we don't find anything in
1771           LongDateFormat, we'll leave with y-m-d order. }
1772         FEffectiveDateDisplayOrder := ddoYMD;
1773 
1774       end else
1775         Break;
1776 
1777     until False;
1778 
1779   end else
1780     FEffectiveDateDisplayOrder := FDateDisplayOrder;
1781 
1782   case FEffectiveDateDisplayOrder of
1783     ddoDMY:
1784       begin
1785         FDayPos := 1;
1786         FMonthPos := 2;
1787         FYearPos := 3;
1788       end;
1789     ddoMDY:
1790       begin
1791         FDayPos := 2;
1792         FMonthPos := 1;
1793         FYearPos := 3;
1794       end;
1795   otherwise
1796     FDayPos := 3;
1797     FMonthPos := 2;
1798     FYearPos := 1;
1799   end;
1800 
1801 end;
1802 
1803 procedure TCustomDateTimePicker.AdjustEffectiveHideDateTimeParts;
1804 var
1805   I: TDateTimePart;
1806   PreviousEffectiveHideDateTimeParts: set of TDateTimePart;
1807 begin
1808   PreviousEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts;
1809   FEffectiveHideDateTimeParts := [];
1810 
1811   for I := Low(TDateTimeParts) to High(TDateTimeParts) do
1812     if I in FHideDateTimeParts then
1813       Include(FEffectiveHideDateTimeParts, I);
1814 
1815   if FKind = dtkDate then
1816     FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
1817                        [dtpHour, dtpMinute, dtpSecond, dtpMiliSec, dtpAMPM]
1818   else begin
1819     if FKind = dtkTime then
1820       FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
1821                             [dtpDay, dtpMonth, dtpYear];
1822 
1823     case FTimeDisplay of
1824       tdHM:
1825         FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
1826                             [dtpSecond, dtpMiliSec];
1827       tdHMS:
1828         FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
1829                                         [dtpMiliSec];
1830     otherwise
1831     end;
1832 
1833     if (FTimeFormat = tf24) or (dtpHour in FEffectiveHideDateTimeParts) then
1834       Include(FEffectiveHideDateTimeParts, dtpAMPM);
1835   end;
1836 
1837   if FEffectiveHideDateTimeParts
1838                           <> PreviousEffectiveHideDateTimeParts then begin
1839     AdjustSelection;
1840     FRecalculatingTextSizesNeeded := True;
1841     UpdateShowArrowButton;
1842     UpdateDate;
1843   end;
1844 end;
1845 
1846 procedure TCustomDateTimePicker.SelectDateTimePart(
1847   const DateTimePart: TDateTimePart);
1848 begin
1849   if not (DateTimePart in FEffectiveHideDateTimeParts) then begin
1850     case DateTimePart of
1851       dtpDay:
1852         FSelectedTextPart := FDayPos;
1853       dtpMonth:
1854         FSelectedTextPart := FMonthPos;
1855       dtpYear:
1856         FSelectedTextPart := FYearPos;
1857     else
1858       FSelectedTextPart := 1 + Ord(DateTimePart);
1859     end;
1860 
1861     Invalidate;
1862   end;
1863 end;
1864 
1865 procedure TCustomDateTimePicker.DestroyCalendarForm;
1866 begin
1867   if Assigned(FCalendarForm) then begin
1868     TDTCalendarForm(FCalendarForm).FClosing := True;
1869     FCalendarForm.Release;
1870     FCalendarForm := nil;
1871   end;
1872 end;
1873 
TCustomDateTimePicker.GetControlClassDefaultSizenull1874 class function TCustomDateTimePicker.GetControlClassDefaultSize: TSize;
1875 begin
1876   Result.cx := 102;
1877   Result.cy := 23;
1878 end;
1879 
1880 procedure TCustomDateTimePicker.ConfirmChanges;
1881 begin
1882   UpdateIfUserChangedText;
1883   FConfirmedDateTime := FDateTime;
1884 end;
1885 
1886 procedure TCustomDateTimePicker.UndoChanges;
1887 begin
1888   if FDateTime = FConfirmedDateTime then begin
1889     Inc(FSkipChangeInUpdateDate); // prevents calling Change in UpdateDate,
1890     try  // but UpdateDate should be called anyway, because user might have
1891          // changed text on screen and it should be updated to what it was.
1892       UpdateDate;
1893     finally
1894       Dec(FSkipChangeInUpdateDate);
1895     end;
1896   end else begin
1897     FDateTime := FConfirmedDateTime;
1898     UpdateDate;
1899   end;
1900 
1901 end;
1902 
1903 { GetDateTimePartFromTextPart function
1904  -----------------------------------------------
1905   Returns part of date/time from the position (1-8). }
TCustomDateTimePicker.GetDateTimePartFromTextPartnull1906 function TCustomDateTimePicker.GetDateTimePartFromTextPart(
1907   TextPart: TTextPart): TDateTimePart;
1908 begin
1909   Result := TDateTimePart(TextPart - 1);
1910 
1911   case FEffectiveDateDisplayOrder of
1912     ddoMDY:
1913       if Result = dtpDay then
1914         Result := dtpMonth
1915       else if Result = dtpMonth then
1916         Result := dtpDay;
1917     ddoYMD:
1918       if Result = dtpDay then
1919         Result := dtpYear
1920       else if Result = dtpYear then
1921         Result := dtpDay;
1922   otherwise
1923   end;
1924 end;
1925 
1926 { GetSelectedDateTimePart function
1927  ---------------------------------
1928   Returns part of date/time which is currently selected. }
GetSelectedDateTimePartnull1929 function TCustomDateTimePicker.GetSelectedDateTimePart: TDateTimePart;
1930 begin
1931   Result := GetDateTimePartFromTextPart(FSelectedTextPart);
1932 end;
1933 
1934 procedure TCustomDateTimePicker.FontChanged(Sender: TObject);
1935 begin
1936   FRecalculatingTextSizesNeeded := True;
1937   inherited FontChanged(Sender);
1938 end;
1939 
TCustomDateTimePicker.GetCheckBoxRectnull1940 function TCustomDateTimePicker.GetCheckBoxRect(
1941   IgnoreRightToLeft: Boolean): TRect;
1942 var
1943   Details: TThemedElementDetails;
1944   CSize: TSize;
1945 
1946 begin
1947   Details := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
1948   CSize := ThemeServices.GetDetailSize(Details);
1949   CSize.cx := ScaleScreenToFont(CSize.cx);
1950   CSize.cy := ScaleScreenToFont(CSize.cy);
1951 
1952   if IsRightToLeft and not IgnoreRightToLeft then begin
1953     Result.Right := ClientWidth - (BorderSpacing.InnerBorder + BorderWidth);
1954     Result.Left := Result.Right - CSize.cx;
1955   end else begin
1956     Result.Left := BorderSpacing.InnerBorder + BorderWidth;
1957     Result.Right := Result.Left + CSize.cx;
1958   end;
1959   Result.Top := (ClientHeight - CSize.cy) div 2;
1960   Result.Bottom := Result.Top + CSize.cy;
1961 end;
1962 
1963 { GetTextOrigin
1964  ---------------
1965   Returns upper left corner of the rectangle where the text is written.
1966   Also used in calculating our preffered size. }
GetTextOriginnull1967 function TCustomDateTimePicker.GetTextOrigin(IgnoreRightToLeft: Boolean
1968   ): TPoint;
1969 
1970 var
1971   Re: TRect;
1972   B: Integer;
1973   XL, XR: Integer;
1974   AuxAlignment: TAlignment;
1975 begin
1976   B := BorderSpacing.InnerBorder + BorderWidth;
1977   Result.y := B;
1978 
1979   if IgnoreRightToLeft or AutoSize then
1980     AuxAlignment := taLeftJustify
1981   else begin
1982     AuxAlignment := FAlignment;
1983     if IsRightToLeft then begin
1984       case AuxAlignment of
1985         taRightJustify:
1986           AuxAlignment := taLeftJustify;
1987         taLeftJustify:
1988           AuxAlignment := taRightJustify;
1989       otherwise
1990       end;
1991     end;
1992   end;
1993 
1994   if FShowCheckBox then begin
1995     Re := GetCheckBoxRect(IgnoreRightToLeft);
1996     InflateRect(Re, Scale96ToFont(cCheckBoxBorder), 0);
1997     XL := Re.Right;
1998     XR := Re.Left;
1999   end else begin
2000     XL := B;
2001     XR := ClientWidth - B;
2002   end;
2003 
2004   if Assigned(FUpDown) then
2005     B := B + FUpDown.Width
2006   else if Assigned(FArrowButton) then
2007     B := B + FArrowButton.Width;
2008 
2009   if IgnoreRightToLeft or not IsRightToLeft then begin
2010     XR := ClientWidth - B;
2011   end else begin
2012     XL := B;
2013   end;
2014 
2015   case AuxAlignment of
2016     taRightJustify:
2017       Result.x := XR - FTextWidth;
2018     taCenter:
2019       Result.x := (XL + XR - FTextWidth) div 2;
2020     taLeftJustify:
2021       Result.x := XL;
2022   end;
2023 
2024 end;
2025 
2026 { MoveSelectionLR
2027  -----------------
2028   Moves selection to left or to right. If parameter ToLeft is true, then the
2029   selection moves to left, otherwise to right. }
2030 procedure TCustomDateTimePicker.MoveSelectionLR(const ToLeft: Boolean);
2031 var
2032   I, SafetyTextPart: TTextPart;
2033 begin
2034   UpdateIfUserChangedText;
2035 
2036   SafetyTextPart := Low(TTextPart);
2037   I := FSelectedTextPart;
2038   repeat
2039     if ToLeft then begin
2040       if I <= Low(TTextPart) then
2041         I := High(TTextPart)
2042       else
2043         Dec(I);
2044     end else begin
2045       if I >= High(TTextPart) then
2046         I := Low(TTextPart)
2047       else
2048         Inc(I);
2049     end;
2050 
2051     if not (GetDateTimePartFromTextPart(I) in FEffectiveHideDateTimeParts) then
2052       FSelectedTextPart := I;
2053 
2054     { Is it possible that all parts are hidden? Yes it is!
2055       So we need to ensure that this doesn't loop forever.
2056       When this insurance text part gets to high value, break }
2057     Inc(SafetyTextPart);
2058   until (I = FSelectedTextPart) or (SafetyTextPart >= High(TTextPart));
2059 end;
2060 
2061 procedure TCustomDateTimePicker.KeyDown(var Key: Word; Shift: TShiftState);
2062 begin
2063   Inc(FUserChanging);
2064   try
2065     if FTextEnabled then
2066       inherited KeyDown(Key, Shift); // calls OnKeyDown event
2067 
2068     CheckAndApplyKeyCode(Key, Shift);
2069   finally
2070     Dec(FUserChanging);
2071   end;
2072 
2073 end;
2074 
2075 procedure TCustomDateTimePicker.KeyPress(var Key: char);
2076 begin
2077   if FTextEnabled then begin
2078     Inc(FUserChanging);
2079     try
2080       inherited KeyPress(Key);
2081 
2082       CheckAndApplyKey(Key);
2083     finally
2084       Dec(FUserChanging);
2085     end;
2086 
2087   end;
2088 end;
2089 
2090 { SelectTextPartUnderMouse
2091  --------------------------
2092   This procedure determines which text part (date or time part -- day, month,
2093   year, hour, minute...) should be selected in response to mouse message.
2094   Used in MouseDown and DoMouseWheel methods. }
2095 procedure TCustomDateTimePicker.SelectTextPartUnderMouse(XMouse: Integer);
2096 var
2097   I, M, NX: Integer;
2098   InTime: Boolean;
2099 
2100 begin
2101   UpdateIfUserChangedText;
2102   SetFocusIfPossible;
2103 
2104   if Focused then begin
2105 // Calculating mouse position inside text
2106 //       in order to select date part under mouse cursor.
2107     NX := XMouse - GetTextOrigin.x;
2108 
2109     InTime := False;
2110     if FTimeWidth > 0 then begin
2111       if FDateWidth > 0 then begin
2112         if NX >= FDateWidth + FDigitWidth then begin
2113           InTime := True;
2114           NX := NX - FDateWidth - 2 * FDigitWidth;
2115         end;
2116       end else
2117         InTime := True;
2118     end;
2119 
2120     if InTime then begin
2121       FSelectedTextPart := 8;
2122 
2123       if (dtpAMPM in FEffectiveHideDateTimeParts) or
2124             (NX < FTimeWidth - FAMPMWidth - FDigitWidth div 2) then begin
2125         FSelectedTextPart := 7;
2126         I := 4;
2127         M := FTimeSeparatorWidth div 2;
2128         while I <= 6 do begin
2129           if not (GetDateTimePartFromTextPart(I)
2130                         in FEffectiveHideDateTimeParts) then begin
2131             Inc(M, 2 * FDigitWidth);
2132             if M > NX then begin
2133               FSelectedTextPart := I;
2134               Break;
2135             end;
2136 
2137             Inc(M, FTimeSeparatorWidth);
2138           end;
2139           Inc(I);
2140         end;
2141       end;
2142 
2143     end else if FDateWidth > 0 then begin
2144 
2145       FSelectedTextPart := 3;
2146       I := 1;
2147       M := FSeparatorWidth div 2;
2148       while I <= 2 do begin
2149         if not (GetDateTimePartFromTextPart(I)
2150                       in FEffectiveHideDateTimeParts) then begin
2151           if I = FYearPos then
2152             Inc(M, 4 * FDigitWidth)
2153           else if (I = FMonthPos) and FShowMonthNames then
2154             Inc(M, FMonthWidth)
2155           else
2156             Inc(M, 2 * FDigitWidth);
2157 
2158           if M > NX then begin
2159             FSelectedTextPart := I;
2160             Break;
2161           end;
2162 
2163           Inc(M, FSeparatorWidth);
2164         end;
2165 
2166         Inc(I);
2167       end;
2168 
2169     end;
2170 
2171     if GetSelectedDateTimePart in FEffectiveHideDateTimeParts then
2172       MoveSelectionLR(True);
2173 
2174     Invalidate;
2175 //-------------------------------------------------------
2176   end;
2177 end;
2178 
2179 procedure TCustomDateTimePicker.MouseDown(Button: TMouseButton;
2180   Shift: TShiftState; X, Y: Integer);
2181 begin
2182   if ShowCheckBox and PtInRect(GetCheckBoxRect, Point(X, Y)) then
2183     Checked := not Checked
2184   else if FTextEnabled then
2185     SelectTextPartUnderMouse(X);
2186 
2187   SetFocusIfPossible;
2188   inherited MouseDown(Button, Shift, X, Y);
2189 end;
2190 
2191 procedure TCustomDateTimePicker.MouseLeave;
2192 begin
2193   inherited MouseLeave;
2194   if FShowCheckBox and FMouseInCheckBox then
2195   begin
2196     FMouseInCheckBox := False;
2197     Invalidate;
2198   end;
2199 end;
2200 
2201 procedure TCustomDateTimePicker.MouseMove(Shift: TShiftState; X, Y: Integer);
2202 begin
2203   inherited MouseMove(Shift, X, Y);
2204 
2205   if ShowCheckBox and (FMouseInCheckBox xor PtInRect(GetCheckBoxRect, Point(X, Y))) then begin
2206     FMouseInCheckBox := not FMouseInCheckBox;
2207     Invalidate;
2208   end;
2209 
2210 end;
2211 
TCustomDateTimePicker.DoMouseWheelnull2212 function TCustomDateTimePicker.DoMouseWheel(Shift: TShiftState;
2213   WheelDelta: Integer; MousePos: TPoint): Boolean;
2214 begin
2215   Result := False;
2216   if FTextEnabled then begin
2217 
2218     SelectTextPartUnderMouse(MousePos.x);
2219     if not FReadOnly then begin
2220       Inc(FUserChanging);
2221       try
2222         if WheelDelta < 0 then
2223           DecreaseCurrentTextPart
2224         else
2225           IncreaseCurrentTextPart;
2226 
2227         Result := True;
2228       finally
2229         Dec(FUserChanging);
2230       end;
2231     end;
2232   end;
2233 end;
2234 
2235 procedure TCustomDateTimePicker.CalculatePreferredSize(var PreferredWidth,
2236   PreferredHeight: integer; WithThemeSpace: Boolean);
2237 var
2238   TextOrigin: TPoint;
2239 
2240 begin
2241   RecalculateTextSizesIfNeeded;
2242   TextOrigin := GetTextOrigin(True);
2243 
2244   PreferredHeight := 2 * TextOrigin.y + FTextHeight + Height - ClientHeight;
2245 
2246   // We must use TextOrigin's x + y (x is, of course, left margin, but not right
2247   // margin if check box is shown. However, y, which is top margin, always
2248   // equals right margin).
2249   PreferredWidth := TextOrigin.x + TextOrigin.y
2250     + FTextWidth + Width - ClientWidth;
2251 
2252   if Assigned(FUpDown) then
2253     Inc(PreferredWidth, FUpDown.Width)
2254   else if Assigned(FArrowButton) then
2255     Inc(PreferredWidth, FArrowButton.Width);
2256 
2257 end;
2258 
2259 procedure TCustomDateTimePicker.SetBiDiMode(AValue: TBiDiMode);
2260 begin
2261   inherited SetBiDiMode(AValue);
2262   ArrangeCtrls;
2263 end;
2264 
2265 procedure TCustomDateTimePicker.IncreaseCurrentTextPart;
2266 begin
2267   if DateIsNull then begin
2268     if FSelectedTextPart <= 3 then
2269       SetDateTime(SysUtils.Date)
2270     else
2271       SetDateTime(SysUtils.Now);
2272 
2273   end else begin
2274     case GetSelectedDateTimePart of
2275       dtpDay: IncreaseDay;
2276       dtpMonth: IncreaseMonth;
2277       dtpYear: IncreaseYear;
2278       dtpHour: IncreaseHour;
2279       dtpMinute: IncreaseMinute;
2280       dtpSecond: IncreaseSecond;
2281       dtpMiliSec: IncreaseMiliSec;
2282       dtpAMPM: ChangeAMPM;
2283     end;
2284   end;
2285 end;
2286 
2287 procedure TCustomDateTimePicker.DecreaseCurrentTextPart;
2288 begin
2289   if DateIsNull then begin
2290     if FSelectedTextPart <= 3 then
2291       SetDateTime(SysUtils.Date)
2292     else
2293       SetDateTime(SysUtils.Now);
2294 
2295   end else begin
2296     case GetSelectedDateTimePart of
2297       dtpDay: DecreaseDay;
2298       dtpMonth: DecreaseMonth;
2299       dtpYear: DecreaseYear;
2300       dtpHour: DecreaseHour;
2301       dtpMinute: DecreaseMinute;
2302       dtpSecond: DecreaseSecond;
2303       dtpMiliSec: DecreaseMiliSec;
2304       dtpAMPM: ChangeAMPM;
2305     end;
2306   end;
2307 end;
2308 
2309 procedure TCustomDateTimePicker.IncreaseMonth;
2310 var
2311   YMD: TYMD;
2312   N: Word;
2313 begin
2314   SelectMonth;
2315 
2316   YMD := GetYYYYMMDD(True);
2317 
2318   if YMD.Month >= 12 then begin
2319     YMD.Month := 1;
2320     if Cascade then
2321       Inc(YMD.Year);
2322   end else
2323     Inc(YMD.Month);
2324 
2325   N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
2326   if YMD.Day > N then
2327     YMD.Day := N;
2328 
2329   SetYYYYMMDD(YMD);
2330 end;
2331 
2332 procedure TCustomDateTimePicker.IncreaseYear;
2333 var
2334   YMD: TYMD;
2335 begin
2336   SelectYear;
2337   YMD := GetYYYYMMDD(True);
2338 
2339   Inc(YMD.Year);
2340   if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
2341     YMD.Day := 28;
2342 
2343   SetYYYYMMDD(YMD);
2344 end;
2345 
2346 procedure TCustomDateTimePicker.IncreaseDay;
2347 var
2348   YMD: TYMD;
2349 begin
2350   SelectDay;
2351   if Cascade then begin
2352     if DateIsNull then
2353       SetDate(IncDay(SysUtils.Date))
2354     else
2355       SetDateTime(IncDay(FDateTime));
2356   end else begin
2357     YMD := GetYYYYMMDD(True);
2358 
2359     if YMD.Day >= NumberOfDaysInMonth(YMD.Month, YMD.Year) then
2360       YMD.Day := 1
2361     else
2362       Inc(YMD.Day);
2363 
2364     SetYYYYMMDD(YMD);
2365   end;
2366 end;
2367 
2368 procedure TCustomDateTimePicker.DecreaseMonth;
2369 var
2370   YMD: TYMD;
2371   N: Word;
2372 begin
2373   SelectMonth;
2374 
2375   YMD := GetYYYYMMDD(True);
2376 
2377   if YMD.Month <= 1 then begin
2378     YMD.Month := 12;
2379     if Cascade then
2380       Dec(YMD.Year);
2381   end else
2382     Dec(YMD.Month);
2383 
2384   N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
2385   if YMD.Day > N then
2386     YMD.Day := N;
2387 
2388   SetYYYYMMDD(YMD);
2389 end;
2390 
2391 procedure TCustomDateTimePicker.DecreaseYear;
2392 var
2393   YMD: TYMD;
2394 begin
2395   SelectYear;
2396   YMD := GetYYYYMMDD(True);
2397   Dec(YMD.Year);
2398   if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
2399     YMD.Day := 28;
2400   SetYYYYMMDD(YMD);
2401 end;
2402 
2403 procedure TCustomDateTimePicker.DecreaseDay;
2404 var
2405   YMD: TYMD;
2406 begin
2407   SelectDay;
2408   if Cascade then begin
2409     if DateIsNull then
2410       SetDate(IncDay(SysUtils.Date, -1))
2411     else
2412       SetDateTime(IncDay(FDateTime, -1));
2413   end else begin
2414     YMD := GetYYYYMMDD(True);
2415 
2416     if YMD.Day <= 1 then
2417       YMD.Day := NumberOfDaysInMonth(YMD.Month, YMD.Year)
2418     else
2419       Dec(YMD.Day);
2420 
2421     SetYYYYMMDD(YMD);
2422   end;
2423 end;
2424 
2425 procedure TCustomDateTimePicker.IncreaseHour;
2426 var
2427   HMSMs: THMSMs;
2428 begin
2429   SelectHour;
2430   if Cascade then begin
2431     if DateIsNull then
2432       SetDateTime(IncHour(SysUtils.Now))
2433     else
2434       SetDateTime(IncHour(FDateTime));
2435   end else begin
2436     HMSMs := GetHMSMs(True);
2437 
2438     if HMSMs.Hour >= 23 then
2439       HMSMs.Hour := 0
2440     else
2441       Inc(HMSMs.Hour);
2442 
2443     SetHMSMs(HMSMs);
2444   end;
2445 end;
2446 
2447 procedure TCustomDateTimePicker.IncreaseMinute;
2448 var
2449   HMSMs: THMSMs;
2450 begin
2451   SelectMinute;
2452   if Cascade then begin
2453     if DateIsNull then
2454       SetDateTime(IncMinute(SysUtils.Now))
2455     else
2456       SetDateTime(IncMinute(FDateTime));
2457   end else begin
2458     HMSMs := GetHMSMs(True);
2459 
2460     if HMSMs.Minute >= 59 then
2461       HMSMs.Minute := 0
2462     else
2463       Inc(HMSMs.Minute);
2464 
2465     SetHMSMs(HMSMs);
2466   end;
2467 end;
2468 
2469 procedure TCustomDateTimePicker.IncreaseSecond;
2470 var
2471   HMSMs: THMSMs;
2472 begin
2473   SelectSecond;
2474   if Cascade then begin
2475     if DateIsNull then
2476       SetDateTime(IncSecond(SysUtils.Now))
2477     else
2478       SetDateTime(IncSecond(FDateTime));
2479   end else begin
2480     HMSMs := GetHMSMs(True);
2481 
2482     if HMSMs.Second >= 59 then
2483       HMSMs.Second := 0
2484     else
2485       Inc(HMSMs.Second);
2486 
2487     SetHMSMs(HMSMs);
2488   end;
2489 end;
2490 
2491 procedure TCustomDateTimePicker.IncreaseMiliSec;
2492 var
2493   HMSMs: THMSMs;
2494 begin
2495   SelectMiliSec;
2496   if Cascade then begin
2497     if DateIsNull then
2498       SetDateTime(IncMilliSecond(SysUtils.Now))
2499     else
2500       SetDateTime(IncMilliSecond(FDateTime));
2501   end else begin
2502     HMSMs := GetHMSMs(True);
2503 
2504     if HMSMs.MiliSec >= 999 then
2505       HMSMs.MiliSec := 0
2506     else
2507       Inc(HMSMs.MiliSec);
2508 
2509     SetHMSMs(HMSMs);
2510   end;
2511 end;
2512 
2513 procedure TCustomDateTimePicker.DecreaseHour;
2514 var
2515   HMSMs: THMSMs;
2516 begin
2517   SelectHour;
2518   if Cascade then begin
2519     if DateIsNull then
2520       SetDateTime(IncHour(SysUtils.Now, -1))
2521     else
2522       SetDateTime(IncHour(FDateTime, -1));
2523   end else begin
2524     HMSMs := GetHMSMs(True);
2525 
2526     if HMSMs.Hour <= 0 then
2527       HMSMS.Hour := 23
2528     else
2529       Dec(HMSMs.Hour);
2530 
2531     SetHMSMs(HMSMs);
2532   end;
2533 end;
2534 
2535 procedure TCustomDateTimePicker.DecreaseMinute;
2536 var
2537   HMSMs: THMSMs;
2538 begin
2539   SelectMinute;
2540   if Cascade then begin
2541     if DateIsNull then
2542       SetDateTime(IncMinute(SysUtils.Now, -1))
2543     else
2544       SetDateTime(IncMinute(FDateTime, -1));
2545   end else begin
2546     HMSMs := GetHMSMs(True);
2547 
2548     if HMSMs.Minute <= 0 then
2549       HMSMs.Minute := 59
2550     else
2551       Dec(HMSMs.Minute);
2552 
2553     SetHMSMs(HMSMs);
2554   end;
2555 end;
2556 
2557 procedure TCustomDateTimePicker.DecreaseSecond;
2558 var
2559   HMSMs: THMSMs;
2560 begin
2561   SelectSecond;
2562   if Cascade then begin
2563     if DateIsNull then
2564       SetDateTime(IncSecond(SysUtils.Now, -1))
2565     else
2566       SetDateTime(IncSecond(FDateTime, -1));
2567   end else begin
2568     HMSMs := GetHMSMs(True);
2569 
2570     if HMSMs.Second <= 0 then
2571       HMSMs.Second := 59
2572     else
2573       Dec(HMSMs.Second);
2574 
2575     SetHMSMs(HMSMs);
2576   end;
2577 end;
2578 
2579 procedure TCustomDateTimePicker.DecreaseMiliSec;
2580 var
2581   HMSMs: THMSMs;
2582 begin
2583   SelectMiliSec;
2584   if Cascade then begin
2585     if DateIsNull then
2586       SetDateTime(IncMilliSecond(SysUtils.Now, -1))
2587     else
2588       SetDateTime(IncMilliSecond(FDateTime, -1));
2589   end else begin
2590     HMSMs := GetHMSMs(True);
2591 
2592     if HMSMs.MiliSec <= 0 then
2593       HMSMs.MiliSec := 999
2594     else
2595       Dec(HMSMs.MiliSec);
2596 
2597     SetHMSMs(HMSMs);
2598   end;
2599 end;
2600 
2601 procedure TCustomDateTimePicker.ChangeAMPM;
2602 var
2603   HMSMs: THMSMs;
2604 begin
2605   SelectAMPM;
2606   HMSMs := GetHMSMs(True);
2607 
2608   if HMSMs.Hour >= 12 then
2609     Dec(HMSMS.Hour, 12)
2610   else
2611     Inc(HMSMS.Hour, 12);
2612 
2613   SetHMSMs(HMSMs);
2614 end;
2615 
2616 procedure TCustomDateTimePicker.UpdateDate(const CallChangeFromSetDateTime: Boolean);
2617 var
2618   W: Array[1..3] of Word;
2619   WT: Array[dtpHour..dtpAMPM] of Word;
2620   DTP: TDateTimePart;
2621 begin
2622   FCorrectedValue := 0;
2623 
2624   FUserChangedText := False;
2625 
2626   if not (DateIsNull or FJumpMinMax) then begin
2627     if Int(FDateTime) > FMaxDate then
2628       FDateTime := ComposeDateTime(FMaxDate, FDateTime);
2629 
2630     if FDateTime < FMinDate then
2631       FDateTime := ComposeDateTime(FMinDate, FDateTime);
2632   end;
2633 
2634   if (FSkipChangeInUpdateDate = 0) then begin
2635    // we'll skip the next part if called from UndoChanges
2636    // and in recursive calls which could be made through calling Change
2637     Inc(FSkipChangeInUpdateDate);
2638     try
2639       if (FUserChanging > 0) // the change is caused by user interaction
2640           or CallChangeFromSetDateTime // call from SetDateTime with option dtpoDoChangeOnSetDateTime
2641       then
2642         try
2643           Change;
2644         except
2645           UndoChanges;
2646           raise;
2647         end;
2648 
2649       if FUserChanging = 0 then
2650         FConfirmedDateTime := FDateTime;
2651 
2652     finally
2653       Dec(FSkipChangeInUpdateDate);
2654     end;
2655   end;
2656 
2657   if DateIsNull then begin
2658     if dtpYear in FEffectiveHideDateTimeParts then
2659       FTextPart[FYearPos] := ''
2660     else
2661       FTextPart[FYearPos] := '0000';
2662 
2663     if dtpMonth in FEffectiveHideDateTimeParts then
2664       FTextPart[FMonthPos] := ''
2665     else
2666       FTextPart[FMonthPos] := '00';
2667 
2668     if dtpDay in FEffectiveHideDateTimeParts then
2669       FTextPart[FDayPos] := ''
2670     else
2671       FTextPart[FDayPos] := '00';
2672 
2673     for DTP := dtpHour to dtpAMPM do begin
2674       if DTP in FEffectiveHideDateTimeParts then
2675         FTimeText[DTP] := ''
2676       else if DTP = dtpAMPM then
2677         FTimeText[DTP] := 'XX'
2678       else if DTP = dtpMiliSec then
2679         FTimeText[DTP] := '999'
2680       else
2681         FTimeText[DTP] := '99';
2682     end;
2683 
2684   end else begin
2685     DecodeDate(FDateTime, W[3], W[2], W[1]);
2686 
2687     if dtpYear in FEffectiveHideDateTimeParts then
2688       FTextPart[FYearPos] := ''
2689     else if FLeadingZeros then
2690       FTextPart[FYearPos] := RightStr('000' + IntToStr(W[3]), 4)
2691     else
2692       FTextPart[FYearPos] := IntToStr(W[3]);
2693 
2694     if dtpMonth in FEffectiveHideDateTimeParts then
2695       FTextPart[FMonthPos] := ''
2696     else if FShowMonthNames then
2697       FTextPart[FMonthPos] := FMonthNamesArray[W[2]]
2698     else if FLeadingZeros then
2699       FTextPart[FMonthPos] := RightStr('0' + IntToStr(W[2]), 2)
2700     else
2701       FTextPart[FMonthPos] := IntToStr(W[2]);
2702 
2703     if dtpDay in FEffectiveHideDateTimeParts then
2704       FTextPart[FDayPos] := ''
2705     else if FLeadingZeros then
2706       FTextPart[FDayPos] := RightStr('0' + IntToStr(W[1]), 2)
2707     else
2708       FTextPart[FDayPos] := IntToStr(W[1]);
2709 
2710     DecodeTime(FDateTime, WT[dtpHour], WT[dtpMinute], WT[dtpSecond], WT[dtpMiliSec]);
2711 
2712     if dtpAMPM in FEffectiveHideDateTimeParts then
2713       FTimeText[dtpAMPM] := ''
2714     else begin
2715       if WT[dtpHour] < 12 then begin
2716         FTimeText[dtpAMPM] := 'AM';
2717         if WT[dtpHour] = 0 then
2718           WT[dtpHour] := 12;
2719       end else begin
2720         FTimeText[dtpAMPM] := 'PM';
2721         if WT[dtpHour] > 12 then
2722           Dec(WT[dtpHour], 12);
2723       end;
2724     end;
2725 
2726     for DTP := dtpHour to dtpMiliSec do begin
2727       if DTP in FEffectiveHideDateTimeParts then
2728         FTimeText[DTP] := ''
2729       else if (DTP = dtpHour) and (not FLeadingZeros) then
2730         FTimeText[DTP] := IntToStr(WT[dtpHour])
2731       else if DTP = dtpMiliSec then
2732         FTimeText[DTP] := RightStr('00' + IntToStr(WT[DTP]), 3)
2733       else
2734         FTimeText[DTP] := RightStr('0' + IntToStr(WT[DTP]), 2);
2735 
2736     end;
2737 
2738   end;
2739 
2740   if HandleAllocated then
2741     Invalidate;
2742 end;
2743 
2744 procedure TCustomDateTimePicker.DoEnter;
2745 begin
2746   if dtpoResetSelection in Options then begin
2747     FSelectedTextPart := High(TTextPart);
2748     MoveSelectionLR(False);
2749   end;
2750 
2751   inherited DoEnter;
2752   Invalidate;
2753 end;
2754 
2755 procedure TCustomDateTimePicker.DoExit;
2756 begin
2757   inherited DoExit;
2758   Invalidate;
2759 end;
2760 
2761 procedure TCustomDateTimePicker.Click;
2762 begin
2763   if FTextEnabled then
2764     inherited Click;
2765 end;
2766 
2767 procedure TCustomDateTimePicker.DblClick;
2768 begin
2769   if FTextEnabled then
2770     inherited DblClick;
2771 end;
2772 
2773 procedure TCustomDateTimePicker.MouseUp(Button: TMouseButton;
2774   Shift: TShiftState; X, Y: Integer);
2775 begin
2776   if FTextEnabled then
2777     inherited MouseUp(Button, Shift, X, Y);
2778 end;
2779 
2780 procedure TCustomDateTimePicker.KeyUp(var Key: Word; Shift: TShiftState);
2781 begin
2782   if FTextEnabled then
2783     inherited KeyUp(Key, Shift);
2784 end;
2785 
2786 procedure TCustomDateTimePicker.UTF8KeyPress(var UTF8Key: TUTF8Char);
2787 begin
2788   if FTextEnabled then
2789     inherited UTF8KeyPress(UTF8Key);
2790 end;
2791 
2792 procedure TCustomDateTimePicker.SelectDay;
2793 begin
2794   SelectDateTimePart(dtpDay);
2795 end;
2796 
2797 procedure TCustomDateTimePicker.SelectMonth;
2798 begin
2799   SelectDateTimePart(dtpMonth);
2800 end;
2801 
2802 procedure TCustomDateTimePicker.SelectYear;
2803 begin
2804   SelectDateTimePart(dtpYear);
2805 end;
2806 
2807 procedure TCustomDateTimePicker.SendExternalKey(const aKey: Char);
2808 var
2809   K: Word;
2810 begin
2811   if FTextEnabled then begin
2812     if aKey in ['n', 'N'] then begin
2813       K := VK_N;
2814       CheckAndApplyKeyCode(K, []);
2815     end else
2816       CheckAndApplyKey(aKey);
2817   end;
2818 end;
2819 
2820 procedure TCustomDateTimePicker.SendExternalKeyCode(const Key: Word);
2821 var
2822   Ch: Char;
2823   K: Word;
2824 begin
2825   if Key in [Ord('0')..Ord('9'), Ord('a'), Ord('A'), Ord('p'), Ord('P')] then begin
2826     if FTextEnabled then begin
2827       Ch := Char(Key);
2828       CheckAndApplyKey(Ch);
2829     end;
2830   end else begin
2831     K := Key;
2832     CheckAndApplyKeyCode(K, []);
2833   end;
2834 
2835 end;
2836 
2837 procedure TCustomDateTimePicker.RemoveAllHandlersOfObject(AnObject: TObject);
2838 begin
2839   inherited RemoveAllHandlersOfObject(AnObject);
2840 
2841   if Assigned(FOnChangeHandlers) then
2842     FOnChangeHandlers.RemoveAllMethodsOfObject(AnObject);
2843 
2844   if Assigned(FOnCheckBoxChangeHandlers) then
2845     FOnCheckBoxChangeHandlers.RemoveAllMethodsOfObject(AnObject);
2846 end;
2847 
2848 procedure TCustomDateTimePicker.SelectHour;
2849 begin
2850   SelectDateTimePart(dtpHour);
2851 end;
2852 
2853 procedure TCustomDateTimePicker.SelectMinute;
2854 begin
2855   SelectDateTimePart(dtpMinute);
2856 end;
2857 
2858 procedure TCustomDateTimePicker.SelectSecond;
2859 begin
2860   SelectDateTimePart(dtpSecond);
2861 end;
2862 
2863 procedure TCustomDateTimePicker.SelectMiliSec;
2864 begin
2865   SelectDateTimePart(dtpMiliSec);
2866 end;
2867 
2868 procedure TCustomDateTimePicker.SelectAMPM;
2869 begin
2870   SelectDateTimePart(dtpAMPM);
2871 end;
2872 
2873 procedure TCustomDateTimePicker.SetEnabled(Value: Boolean);
2874 begin
2875   if GetEnabled <> Value then begin
2876     inherited SetEnabled(Value);
2877     CheckTextEnabled;
2878     Invalidate;
2879   end;
2880 end;
2881 
2882 procedure TCustomDateTimePicker.SetAutoSize(Value: Boolean);
2883 begin
2884   if AutoSize <> Value then begin
2885     if Value then
2886       InvalidatePreferredSize;
2887 
2888     inherited SetAutoSize(Value);
2889   end;
2890 end;
2891 
2892 // I had to override CreateWnd, because in design time on Linux Lazarus crashes
2893 // if we try to do anchoring of child controls in constructor.
2894 // Therefore, I needed to ensure that controls anchoring does not take place
2895 // before CreateWnd has done. So, I moved all anchoring code to a procedure
2896 // ArrangeCtrls and introduced a boolean field FDoNotArrangeControls which
2897 // prevents that code from executing before CreateWnd.
2898 //!!! Later, I simplified the arranging procedure, so maybe it can be done now
2899 //    before window creation is done. It's better to leave this delay system,
2900 //    anyway -- we might change anchoring code again for some reason.
2901 procedure TCustomDateTimePicker.CreateWnd;
2902 begin
2903   inherited CreateWnd;
2904 
2905   if FDoNotArrangeControls then begin { This field is set to True in constructor.
2906     Its purpose is to prevent control anchoring until this point. That's because
2907     on Linux Lazarus crashes when control is dropped on form in designer if
2908     particular anchoring code executes before CreateWnd has done its job. }
2909     FDoNotArrangeControls := False;
2910     ArrangeCtrls;
2911   end;
2912 end;
2913 
2914 procedure TCustomDateTimePicker.SetDateTimeJumpMinMax(const AValue: TDateTime);
2915 begin
2916   FJumpMinMax := True;
2917   try
2918     SetDateTime(AValue);
2919   finally
2920     FJumpMinMax := False;
2921   end;
2922 end;
2923 
2924 procedure TCustomDateTimePicker.ArrangeCtrls;
2925 var
2926   C: TControl;
2927 begin
2928   if not FDoNotArrangeControls then begin //Read the note above CreateWnd procedure.
2929     DisableAlign;
2930     try
2931       if Assigned(FUpDown) then
2932         C := FUpDown
2933       else
2934         C := FArrowButton; // might be nil.
2935 
2936       if Assigned(C) then begin
2937         if IsRightToLeft then
2938           C.Align := alLeft
2939         else
2940           C.Align := alRight;
2941 
2942         C.BringToFront;
2943       end;
2944 
2945       CheckTextEnabled;
2946       InvalidatePreferredSize;
2947       AdjustSize;
2948 
2949       Invalidate;
2950     finally
2951       EnableAlign;
2952     end;
2953   end;
2954 end;
2955 
2956 procedure TCustomDateTimePicker.Change;
2957 begin
2958   if Assigned(FOnChange) then
2959     FOnChange(Self);
2960   if FOnChangeHandlers <> nil then
2961     FOnChangeHandlers.CallNotifyEvents(Self);
2962 end;
2963 
2964 procedure TCustomDateTimePicker.SelectDate;
2965 begin
2966   if (FSelectedTextPart > 3)
2967           or (GetSelectedDateTimePart in FEffectiveHideDateTimeParts) then
2968     FSelectedTextPart := 1;
2969 
2970   AdjustSelection;
2971 
2972   Invalidate;
2973 end;
2974 
2975 procedure TCustomDateTimePicker.SelectTime;
2976 begin
2977   if (FSelectedTextPart < 4)
2978           or (GetSelectedDateTimePart in FEffectiveHideDateTimeParts) then
2979     FSelectedTextPart := 4;
2980 
2981   AdjustSelection;
2982 
2983   Invalidate;
2984 end;
2985 
2986 procedure TCustomDateTimePicker.Paint;
2987 var
2988   I, M, N, K, L: Integer;
2989   DD: Array[1..8] of Integer;
2990   R: TRect;
2991   SelectStep: 0..8;
2992   TextStyle: TTextStyle;
2993   DTP: TDateTimePart;
2994   S: String;
2995 
2996 const
2997   CheckStates: array[Boolean, Boolean, Boolean] of TThemedButton = (
2998     ((tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedDisabled),
2999      (tbCheckBoxCheckedDisabled, tbCheckBoxCheckedDisabled)),
3000     ((tbCheckBoxUncheckedNormal, tbCheckBoxUncheckedHot),
3001      (tbCheckBoxCheckedNormal, tbCheckBoxCheckedHot)));
3002 
3003 begin
3004   if ClientRectNeedsInterfaceUpdate then // In Qt widgetset, this solves the
3005     DoAdjustClientRectChange;           // problem of dispositioned client rect.
3006 
3007   if FRecalculatingTextSizesNeeded then begin
3008     if AutoSize then begin
3009       InvalidatePreferredSize;
3010       AdjustSize;
3011     end;
3012 
3013     RecalculateTextSizesIfNeeded;
3014   end;
3015 
3016   TextStyle := Canvas.TextStyle;
3017 
3018   Canvas.Brush.Style := bsSolid;
3019   Canvas.Brush.Color := Color;
3020   Canvas.FillRect(ClientRect);
3021 
3022   R.TopLeft := GetTextOrigin;
3023   if not AutoSize then
3024     R.Top := (ClientHeight - FTextHeight) div 2;
3025 
3026   R.Bottom := R.Top + FTextHeight;
3027 
3028   TextStyle.Layout := tlCenter;
3029   TextStyle.Wordbreak := False;
3030   TextStyle.Opaque := False;
3031   TextStyle.RightToLeft := IsRightToLeft;
3032 
3033   if DateIsNull and (FTextForNullDate <> '')
3034                        and (not (FTextEnabled and Focused)) then begin
3035 
3036     if IsRightToLeft then begin
3037       TextStyle.Alignment := taRightJustify;
3038       R.Right := R.Left + FTextWidth;
3039       R.Left := 0;
3040     end else begin
3041       TextStyle.Alignment := taLeftJustify;
3042       R.Right := Width;
3043     end;
3044 
3045     if FTextEnabled then
3046       Canvas.Font.Color := Font.Color
3047     else
3048       Canvas.Font.Color := clGrayText;
3049 
3050     Canvas.TextRect(R, R.Left, R.Top, FTextForNullDate, TextStyle);
3051 
3052   end else begin
3053     TextStyle.Alignment := taRightJustify;
3054 
3055     SelectStep := 0;
3056     if FTextEnabled then begin
3057       Canvas.Font.Color := Font.Color;
3058       if Focused then
3059         SelectStep := FSelectedTextPart;
3060     end else begin
3061       Canvas.Font.Color := clGrayText;
3062     end;
3063 
3064     if dtpYear in FEffectiveHideDateTimeParts then begin
3065       DD[FYearPos] := 0;
3066       M := 4;
3067       L := 0;
3068     end else begin
3069       DD[FYearPos] := 4 * FDigitWidth;
3070       M := FYearPos;
3071       L := FYearPos;
3072     end;
3073 
3074     if dtpMonth in FEffectiveHideDateTimeParts then
3075       DD[FMonthPos] := 0
3076     else begin
3077       if FShowMonthNames then
3078         DD[FMonthPos] := FMonthWidth
3079       else
3080         DD[FMonthPos] := 2 * FDigitWidth;
3081 
3082       if FMonthPos < M then
3083         M := FMonthPos;
3084 
3085       if FMonthPos > L then
3086         L := FMonthPos;
3087 
3088     end;
3089 
3090     if dtpDay in FEffectiveHideDateTimeParts then
3091       DD[FDayPos] := 0
3092     else begin
3093       DD[FDayPos] := 2 * FDigitWidth;
3094       if FDayPos < M then
3095         M := FDayPos;
3096       if FDayPos > L then
3097         L := FDayPos;
3098     end;
3099 
3100     N := L;
3101     K := 0;
3102     for DTP := dtpHour to dtpAMPM do begin
3103       I := Ord(DTP) + 1;
3104       if DTP in FEffectiveHideDateTimeParts then
3105         DD[I] := 0
3106       else if DTP = dtpAMPM then begin
3107         DD[I] := FAMPMWidth;
3108         N := I;
3109       end else begin
3110         if DTP = dtpMiliSec then
3111           DD[I] := 3 * FDigitWidth
3112         else
3113           DD[I] := 2 * FDigitWidth;
3114 
3115         K := I;
3116       end;
3117     end;
3118 
3119     if N < K then
3120       N := K;
3121 
3122     for I := M to N do begin
3123       if DD[I] <> 0 then begin
3124 
3125         R.Right := R.Left + DD[I];
3126         if I <= 3 then begin
3127           if (I = FMonthPos) and FShowMonthNames then begin
3128             TextStyle.Alignment := taCenter;
3129             if DateIsNull then
3130               S := FNullMonthText
3131             else
3132               S := FTextPart[I];
3133           end else
3134             S := FTextPart[I];
3135 
3136         end else
3137           S := FTimeText[TDateTimePart(I - 1)];
3138 
3139         if I = SelectStep then begin
3140           TextStyle.Opaque := True;
3141           Canvas.Brush.Color := clHighlight;
3142           Canvas.Font.Color := clHighlightText;
3143 
3144           Canvas.TextRect(R, R.Left, R.Top, S, TextStyle);
3145 
3146           TextStyle.Opaque := False;
3147           Canvas.Brush.Color := Color;
3148           Canvas.Font.Color := Self.Font.Color;
3149         end else
3150           Canvas.TextRect(R, R.Left, R.Top, S, TextStyle);
3151 
3152         TextStyle.Alignment := taRightJustify;
3153         R.Left := R.Right;
3154 
3155         if I < L then begin
3156           R.Right := R.Left + FSeparatorWidth;
3157           if not ((I = FMonthPos) and FShowMonthNames) then
3158             Canvas.TextRect(R, R.Left, R.Top, FDateSeparator, TextStyle);
3159         end else if I > L then begin
3160           if I = K then begin
3161             R.Right := R.Left + FDigitWidth;
3162           end else if I < K then begin
3163             R.Right := R.Left + FTimeSeparatorWidth;
3164             Canvas.TextRect(R, R.Left, R.Top, FTimeSeparator, TextStyle);
3165           end;
3166         end else begin
3167           if FTrailingSeparator then begin
3168             R.Right := R.Left + FSepNoSpaceWidth;
3169             Canvas.TextRect(R, R.Left, R.Top,
3170                                       TrimRight(FDateSeparator), TextStyle);
3171           end;
3172           if FTimeWidth > 0 then
3173             R.Right := R.Right + 2 * FDigitWidth;
3174 
3175         end;
3176         R.Left := R.Right;
3177       end;
3178     end;
3179 
3180   end;
3181 
3182   if ShowCheckBox then
3183     ThemeServices.DrawElement(Canvas.Handle,
3184       ThemeServices.GetElementDetails(CheckStates[Enabled, Checked, FMouseInCheckBox]),
3185       GetCheckBoxRect);
3186 
3187   inherited Paint;
3188 end;
3189 
3190 procedure TCustomDateTimePicker.EditingDone;
3191 begin
3192   if FNoEditingDone <= 0 then begin
3193     ConfirmChanges;
3194 
3195     inherited EditingDone;
3196   end;
3197 end;
3198 
3199 procedure TCustomDateTimePicker.ArrowMouseDown(Sender: TObject;
3200   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
3201 begin
3202   SetFocusIfPossible;
3203 
3204   if FAllowDroppingCalendar then
3205     DropDownCalendarForm
3206   else begin
3207     DestroyCalendarForm;
3208     FAllowDroppingCalendar := True;
3209   end;
3210 
3211 end;
3212 
3213 procedure TCustomDateTimePicker.UpDownClick(Sender: TObject;
3214   Button: TUDBtnType);
3215 begin
3216   SetFocusIfPossible;
3217 
3218   if not FReadOnly then begin
3219     Inc(FUserChanging);
3220     try
3221       if Button = btNext then
3222         IncreaseCurrentTextPart
3223       else
3224         DecreaseCurrentTextPart;
3225     finally
3226       Dec(FUserChanging);
3227     end;
3228   end;
3229 end;
3230 
3231 procedure TCustomDateTimePicker.DoDropDown;
3232 begin
3233   if Assigned(FOnDropDown) then
3234     FOnDropDown(Self);
3235 end;
3236 
3237 procedure TCustomDateTimePicker.DoCloseUp;
3238 begin
3239   if Assigned(FOnCloseUp) then
3240     FOnCloseUp(Self);
3241 end;
3242 
TCustomDateTimePicker.GetCheckednull3243 function TCustomDateTimePicker.GetChecked: Boolean;
3244 begin
3245   Result := (not FShowCheckBox) or FChecked;
3246 end;
3247 
TCustomDateTimePicker.AreSeparatorsStorednull3248 function TCustomDateTimePicker.AreSeparatorsStored: Boolean;
3249 begin
3250   Result := not FUseDefaultSeparators;
3251 end;
3252 
GetDatenull3253 function TCustomDateTimePicker.GetDate: TDate;
3254 begin
3255   if DateIsNull then
3256     Result := NullDate
3257   else
3258     Result := Int(FDateTime);
3259 end;
3260 
TCustomDateTimePicker.GetDateTimenull3261 function TCustomDateTimePicker.GetDateTime: TDateTime;
3262 begin
3263   if DateIsNull then
3264     Result := NullDate
3265   else
3266     Result := FDateTime;
3267 end;
3268 
GetDroppedDownnull3269 function TCustomDateTimePicker.GetDroppedDown: Boolean;
3270 begin
3271   Result := Assigned(FCalendarForm);
3272 end;
3273 
TCustomDateTimePicker.GetTimenull3274 function TCustomDateTimePicker.GetTime: TTime;
3275 begin
3276   if DateIsNull then
3277     Result := NullDate
3278   else
3279     Result := Abs(Frac(FDateTime));
3280 end;
3281 
3282 procedure TCustomDateTimePicker.SetAlignment(AValue: TAlignment);
3283 begin
3284   if FAlignment <> AValue then begin
3285     FAlignment := AValue;
3286     Invalidate;
3287   end;
3288 end;
3289 
3290 procedure TCustomDateTimePicker.SetArrowShape(const AValue: TArrowShape);
3291 begin
3292   if FArrowShape = AValue then Exit;
3293 
3294   FArrowShape := AValue;
3295   if FArrowButton <> nil then
3296     FArrowButton.Invalidate;
3297 end;
3298 
3299 procedure TCustomDateTimePicker.SetAutoButtonSize(AValue: Boolean);
3300 begin
3301   if FAutoButtonSize <> AValue then begin
3302     FAutoButtonSize := AValue;
3303 
3304     if AValue then
3305       AutoResizeButton
3306     else begin
3307       if Assigned(FUpDown) then
3308         FUpDown.Width := Scale96ToFont(DefaultUpDownWidth)
3309       else if Assigned(FArrowButton) then
3310         FArrowButton.Width := Scale96ToFont(DefaultArrowButtonWidth);
3311     end;
3312 
3313   end;
3314 end;
3315 
3316 procedure TCustomDateTimePicker.SetCalAlignment(AValue: TDTCalAlignment);
3317 begin
3318   if FCalAlignment = AValue then Exit;
3319   FCalAlignment := AValue;
3320 end;
3321 
3322 procedure TCustomDateTimePicker.SetCalendarWrapperClass(
3323   AValue: TCalendarControlWrapperClass);
3324 begin
3325   if FCalendarWrapperClass = AValue then Exit;
3326   FCalendarWrapperClass := AValue;
3327 end;
3328 
3329 procedure TCustomDateTimePicker.SetCenturyFrom(const AValue: Word);
3330 begin
3331   if FCenturyFrom = AValue then Exit;
3332 
3333   FCenturyFrom := AValue;
3334   AdjustEffectiveCenturyFrom;
3335 end;
3336 
3337 procedure TCustomDateTimePicker.CheckBoxChange;
3338 begin
3339   if Assigned(FOnCheckBoxChange) then
3340     FOnCheckBoxChange(Self);
3341 
3342   if FOnCheckBoxChangeHandlers <> nil then
3343     FOnCheckBoxChangeHandlers.CallNotifyEvents(Self);
3344 end;
3345 
3346 procedure TCustomDateTimePicker.SetFocusIfPossible;
3347 var
3348   F: TCustomForm;
3349 
3350 begin
3351   Inc(FNoEditingDone);
3352   try
3353     F := GetParentForm(Self);
3354 
3355     if Assigned(F) and F.CanFocus and CanTab then
3356       SetFocus;
3357 
3358   finally
3359     Dec(FNoEditingDone);
3360   end;
3361 end;
3362 
3363 procedure TCustomDateTimePicker.AutoResizeButton;
3364 begin
3365   if Assigned(FArrowButton) then
3366     FArrowButton.Width := MulDiv(ClientHeight, 9, 10)
3367   else if Assigned(FUpDown) then
3368     FUpDown.Width := MulDiv(ClientHeight, 79, 100);
3369 end;
3370 
3371 procedure TCustomDateTimePicker.CheckAndApplyKey(const Key: Char);
3372 var
3373   S: String;
3374   DTP: TDateTimePart;
3375   N, L: Integer;
3376   YMD: TYMD;
3377   HMSMs: THMSMs;
3378   D, T: TDateTime;
3379   Finished, ForceChange: Boolean;
3380 
3381 begin
3382   FCorrectedValue := 0;
3383   if not FReadOnly then begin
3384     Finished := False;
3385     ForceChange := False;
3386 
3387     if FSelectedTextPart = 8 then begin
3388       case upCase(Key) of
3389         'A': S := 'AM';
3390         'P': S := 'PM';
3391       else
3392         Finished := True;
3393       end;
3394       ForceChange := True;
3395 
3396     end else if Key in ['0'..'9'] then begin
3397 
3398       DTP := GetSelectedDateTimePart;
3399 
3400       if DTP = dtpYear then
3401         N := 4
3402       else if DTP = dtpMiliSec then
3403         N := 3
3404       else
3405         N := 2;
3406 
3407       S := Trim(GetSelectedText);
3408       if FUserChangedText and (Length(S) < N) then
3409         S := S + Key
3410       else
3411         S := Key;
3412 
3413       if Length(S) >= N then begin
3414 
3415         L := StrToInt(S);
3416         if DTP < dtpHour then begin
3417           YMD := GetYYYYMMDD(True);
3418           case DTP of
3419             dtpDay:
3420               YMD.Day := L;
3421             dtpMonth:
3422               YMD.Month := L;
3423           otherwise
3424             YMD.Year := L;
3425           end;
3426 
3427           if AutoAdvance and (YMD.Day <= 31) and
3428               (YMD.Day > NumberOfDaysInMonth(YMD.Month, YMD.Year)) then begin
3429             FCorrectedDTP := dtpAMPM;
3430             case DTP of
3431               dtpDay:
3432                 case FEffectiveDateDisplayOrder of
3433                   ddoDMY:
3434                     FCorrectedDTP := dtpMonth;
3435                   ddoMDY:
3436                     FCorrectedDTP := dtpYear;
3437                 otherwise
3438                 end;
3439 
3440               dtpMonth:
3441                 case FEffectiveDateDisplayOrder of
3442                   ddoDMY:
3443                     FCorrectedDTP := dtpYear;
3444                 otherwise
3445                   FCorrectedDTP := dtpDay;
3446                   FCorrectedValue := NumberOfDaysInMonth(YMD.Month, YMD.Year);
3447                   YMD.Day := FCorrectedValue;
3448                 end;
3449 
3450             otherwise
3451               if (FEffectiveDateDisplayOrder = ddoYMD) and (YMD.Month = 2)
3452                     and (YMD.Day = 29) and not IsLeapYear(YMD.Year) then
3453                 FCorrectedDTP := dtpMonth;
3454             end;
3455 
3456             case FCorrectedDTP of
3457               dtpMonth:
3458                 begin
3459                   FCorrectedValue := YMD.Month + 1;
3460                   YMD.Month := FCorrectedValue;
3461                 end;
3462               dtpYear:
3463                 if (YMD.Day = 29) and (YMD.Month = 2) then begin
3464                   FCorrectedValue := ((YMD.Year + 3) div 4) * 4;
3465                   if (FCorrectedValue mod 100 = 0) and (FCorrectedValue mod 400 <> 0) then
3466                     FCorrectedValue := FCorrectedValue + 4;
3467                   YMD.Year := FCorrectedValue;
3468                 end;
3469             otherwise
3470             end;
3471 
3472           end;
3473 
3474           if TryEncodeDate(YMD.Year, YMD.Month, YMD.Day, D)
3475                     and (D >= MinDate) and (D <= MaxDate) then
3476             ForceChange := True
3477           else if N = 4 then begin
3478             UpdateDate;
3479             Finished := True;
3480           end else
3481             S := Key;
3482 
3483         end else begin
3484           if (DTP = dtpHour) and (FTimeFormat = tf12) then begin
3485             if not (L in [1..12]) then
3486               S := Key
3487             else
3488               ForceChange := True;
3489 
3490           end else begin
3491 
3492             HMSMs := GetHMSMs(True);
3493             case DTP of
3494               dtpHour: HMSMs.Hour := L;
3495               dtpMinute: HMSMs.Minute := L;
3496               dtpSecond: HMSMs.Second := L;
3497               dtpMiliSec: HMSMs.MiliSec := L;
3498             otherwise
3499             end;
3500 
3501             if not TryEncodeTime(HMSMs.Hour, HMSMs.Minute, HMSMs.Second,
3502                                          HMSMs.MiliSec, T) then
3503               S := Key
3504             else
3505               ForceChange := True;
3506 
3507           end;
3508         end;
3509 
3510       end;
3511     end else
3512       Finished := True;
3513 
3514     if (not Finished) and (GetSelectedText <> S) then begin
3515       if (not FUserChangedText) and DateIsNull then begin
3516         Inc(FSkipChangeInUpdateDate); // do not call Change here
3517         try
3518           if FSelectedTextPart <= 3 then
3519             DateTime := SysUtils.Date
3520           else
3521             DateTime := SysUtils.Now;
3522         finally
3523           Dec(FSkipChangeInUpdateDate);
3524         end;
3525       end;
3526 
3527       if (not FLeadingZeros) and (FSelectedTextPart <= 4) then
3528         while (Length(S) > 1) and (S[1] = '0') do
3529           Delete(S, 1, 1);
3530 
3531       if FSelectedTextPart <= 3 then
3532         FTextPart[FSelectedTextPart] := S
3533       else
3534         FTimeText[TDateTimePart(FSelectedTextPart - 1)] := S;
3535 
3536       FUserChangedText := True;
3537 
3538       if ForceChange then begin
3539         if FAutoAdvance then begin
3540           MoveSelectionLR(False);
3541           Invalidate;
3542         end else
3543           UpdateIfUserChangedText;
3544       end else
3545         Invalidate;
3546 
3547       DoAutoCheck;
3548     end;
3549 
3550     FCorrectedValue := 0;
3551   end;
3552 
3553 end;
3554 
3555 procedure TCustomDateTimePicker.CheckAndApplyKeyCode(var Key: Word;
3556   const ShState: TShiftState);
3557 var
3558   K: Word;
3559 begin
3560   if (Key = VK_SPACE) then begin
3561     if ShowCheckBox then
3562       Checked := not Checked;
3563 
3564   end else if FTextEnabled then begin
3565 
3566     case Key of
3567       VK_LEFT, VK_RIGHT, VK_OEM_COMMA, VK_OEM_PERIOD, VK_DIVIDE,
3568           VK_OEM_MINUS, VK_SEPARATOR, VK_DECIMAL, VK_SUBTRACT:
3569         begin
3570           K := Key;
3571           Key := 0;
3572           MoveSelectionLR(K = VK_LEFT);
3573           Invalidate;
3574         end;
3575       VK_UP:
3576         begin
3577           Key := 0;
3578           UpdateIfUserChangedText;
3579           if not FReadOnly then
3580           begin
3581             IncreaseCurrentTextPart;
3582             DoAutoCheck;
3583           end;
3584         end;
3585       VK_DOWN:
3586         begin
3587           Key := 0;
3588           if (ShState = [ssAlt]) and Assigned(FArrowButton) then
3589             DropDownCalendarForm
3590           else begin
3591             UpdateIfUserChangedText;
3592             if not FReadOnly then
3593             begin
3594               DecreaseCurrentTextPart;
3595               DoAutoCheck;
3596             end;
3597           end;
3598         end;
3599       VK_RETURN:
3600         if not FReadOnly then
3601           EditingDone;
3602 
3603       VK_ESCAPE:
3604         if not FReadOnly then begin
3605           UndoChanges;
3606           EditingDone;
3607         end;
3608       VK_N:
3609         if (not FReadOnly) and FNullInputAllowed then
3610           SetDateTime(NullDate);
3611     end;
3612 
3613   end;
3614 
3615 end;
3616 
3617 procedure TCustomDateTimePicker.WMKillFocus(var Message: TLMKillFocus);
3618 begin
3619   // On Qt it seems that WMKillFocus happens even when focus jumps to some other
3620   // form. This behaviour differs from win and gtk 2 (where it happens only when
3621   // focus jumps to other control on the same form) and we should prevent it at
3622   // least for our calendar, because it triggers EditingDone.
3623   if Screen.ActiveCustomForm <> FCalendarForm then
3624     inherited WMKillFocus(Message);
3625 end;
3626 
3627 procedure TCustomDateTimePicker.WMSize(var Message: TLMSize);
3628 begin
3629   inherited WMSize(Message);
3630 
3631   if FAutoButtonSize then
3632     AutoResizeButton;
3633 end;
3634 
3635 procedure TCustomDateTimePicker.DropDownCalendarForm;
3636 begin
3637   if FAllowDroppingCalendar and FTextEnabled and Assigned(FArrowButton) then
3638     if not (FReadOnly or Assigned(FCalendarForm)
3639                       or (csDesigning in ComponentState))
3640     then begin
3641       FCalendarForm := TDTCalendarForm.CreateNewDTCalendarForm(nil, Self);
3642       FCalendarForm.Show;
3643     end;
3644 end;
3645 
3646 { TDTUpDown }
3647 
3648 { When our UpDown control gets enabled/disabled, the two its buttons' Enabled
3649   property is set accordingly. }
3650 procedure TDTUpDown.SetEnabled(Value: Boolean);
3651 
3652   procedure SetEnabledForAllChildren(AWinControl: TWinControl);
3653   var
3654     I: Integer;
3655     C: TControl;
3656   begin
3657     for I := 0 to AWinControl.ControlCount - 1 do begin
3658       C := AWinControl.Controls[I];
3659       C.Enabled := Value;
3660 
3661       if C is TWinControl then
3662         SetEnabledForAllChildren(TWinControl(C));
3663 
3664     end;
3665   end;
3666 
3667 begin
3668   inherited SetEnabled(Value);
3669 
3670   SetEnabledForAllChildren(Self);
3671 end;
3672 
3673 { Our UpDown control is always alligned, but setting its PreferredHeight
3674   uncoditionally to 1 prevents the UpDown to mess with our PreferredHeight.
3675   The problem is that if we didn't do this, when our Height is greater than
3676   really preffered, UpDown prevents it to be set correctly when we set AutoSize
3677   to True. }
3678 procedure TDTUpDown.CalculatePreferredSize(var PreferredWidth, PreferredHeight:
3679   integer; WithThemeSpace: Boolean);
3680 begin
3681   inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
3682     WithThemeSpace);
3683 
3684   PreferredHeight := 1;
3685 end;
3686 
3687 { We don't want to let EditingDone event to fire each time up-down buttons get
3688   clicked. That is why WndProc is overriden. }
3689 procedure TDTUpDown.WndProc(var Message: TLMessage);
3690 begin
3691   if ((Message.msg >= LM_MOUSEFIRST) and (Message.msg <= LM_MOUSELAST))
3692       or ((Message.msg >= LM_MOUSEFIRST2) and (Message.msg <= LM_MOUSELAST2)) then begin
3693 
3694     Inc(DTPicker.FNoEditingDone);
3695     try
3696       inherited WndProc(Message);
3697     finally
3698       Dec(DTPicker.FNoEditingDone);
3699     end
3700 
3701   end else
3702     inherited WndProc(Message);
3703 
3704 end;
3705 
3706 { TDTSpeedButton }
3707 
3708 { See the comment above TDTUpDown.CalculatePreferredSize }
3709 procedure TDTSpeedButton.CalculatePreferredSize(var PreferredWidth,
3710   PreferredHeight: integer; WithThemeSpace: Boolean);
3711 begin
3712   inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
3713     WithThemeSpace);
3714 
3715   PreferredHeight := 1;
3716 end;
3717 
3718 { Prevent EditingDone to fire whenever the SpeedButton gets clicked }
3719 procedure TDTSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
3720   Y: Integer);
3721 begin
3722   Inc(DTPicker.FNoEditingDone);
3723   try
3724     inherited MouseDown(Button, Shift, X, Y);
3725   finally
3726     Dec(DTPicker.FNoEditingDone);
3727   end;
3728 end;
3729 
3730 procedure TDTSpeedButton.Paint;
3731 
3732   procedure DrawThemedDropDownArrow;
3733   var
3734     Details: TThemedElementDetails;
3735     ArrowState: TThemedToolBar;
3736     ASize: TSize;
3737     ARect: TRect;
3738   begin
3739     if Enabled then
3740       ArrowState := ttbSplitButtonDropDownNormal
3741     else
3742       ArrowState := ttbSplitButtonDropDownDisabled;
3743     Details := ThemeServices.GetElementDetails(ArrowState);
3744     ASize := ThemeServices.GetDetailSize(Details);
3745     ARect := Rect(0, 0, Width, Height);
3746     InflateRect(ARect, -(ARect.Right - ARect.Left - ASize.cx) div 2, 0);
3747     ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
3748   end;
3749 
3750 const
3751   ArrowColor = TColor($8D665A);
3752 
3753 var
3754   X, Y: Integer;
3755 
3756 begin
3757   inherited Paint;
3758 
3759   if DTPicker.FArrowShape = asTheme then
3760     DrawThemedDropDownArrow
3761   else begin
3762   // First I ment to put arrow images in a lrs file. In my opinion, however, that
3763   // wouldn't be an elegant option for so simple shapes.
3764 
3765     Canvas.Brush.Style := bsSolid;
3766     Canvas.Pen.Color := ArrowColor;
3767     Canvas.Brush.Color := Canvas.Pen.Color;
3768 
3769     X := (Width - 9) div 2;
3770     Y := (Height - 6) div 2;
3771 
3772     { Let's draw shape of the arrow on the button: }
3773     case DTPicker.FArrowShape of
3774       asClassicLarger:
3775         { triangle: }
3776         Canvas.Polygon([Point(X + 0, Y + 1), Point(X + 8, Y + 1),
3777                                                         Point(X + 4, Y + 5)]);
3778       asClassicSmaller:
3779         { triangle -- smaller variant:  }
3780         Canvas.Polygon([Point(X + 1, Y + 2), Point(X + 7, Y + 2),
3781                                                         Point(X + 4, Y + 5)]);
3782       asModernLarger:
3783         { modern: }
3784         Canvas.Polygon([Point(X + 0, Y + 1), Point(X + 1, Y + 0),
3785                           Point(X + 4, Y + 3), Point(X + 7, Y + 0), Point(X + 8, Y + 1), Point(X + 4, Y + 5)]);
3786       asModernSmaller:
3787         { modern -- smaller variant:    }
3788         Canvas.Polygon([Point(X + 1, Y + 2), Point(X + 2, Y + 1),
3789                           Point(X + 4, Y + 3), Point(X + 6, Y + 1), Point(X + 7, Y + 2), Point(X + 4, Y + 5)]);
3790     otherwise // asYetAnotherShape:
3791       { something in between, not very pretty:  }
3792       Canvas.Polygon([Point(X + 0, Y + 1), Point(X + 1, Y + 0),
3793             Point(X + 2, Y + 1), Point(X + 6, Y + 1),Point(X + 7, Y + 0), Point(X + 8, Y + 1), Point(X + 4, Y + 5)]);
3794     end;
3795 
3796   end;
3797 end;
3798 
3799 procedure TCustomDateTimePicker.UpdateShowArrowButton;
3800 
3801   procedure CreateArrowBtn;
3802   begin
3803     if not Assigned(FArrowButton) then begin
3804       DestroyCalendarForm;
3805       DestroyUpDown;
3806 
3807       FArrowButton := TDTSpeedButton.Create(Self);
3808       FArrowButton.ControlStyle := FArrowButton.ControlStyle +
3809                                             [csNoFocus, csNoDesignSelectable];
3810       FArrowButton.Flat := dtpoFlatButton in Options;
3811       TDTSpeedButton(FArrowButton).DTPicker := Self;
3812       FArrowButton.SetBounds(0, 0, Scale96ToFont(DefaultArrowButtonWidth), 1);
3813 
3814       FArrowButton.Parent := Self;
3815       FAllowDroppingCalendar := True;
3816 
3817       TDTSpeedButton(FArrowButton).OnMouseDown := @ArrowMouseDown;
3818 
3819     end;
3820   end;
3821 
3822   procedure CreateUpDown;
3823   begin
3824     if not Assigned(FUpDown) then begin
3825       DestroyArrowBtn;
3826 
3827       FUpDown := TDTUpDown.Create(Self);
3828       FUpDown.ControlStyle := FUpDown.ControlStyle +
3829                                      [csNoFocus, csNoDesignSelectable];
3830 
3831       TDTUpDown(FUpDown).DTPicker := Self;
3832       TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options;
3833 
3834       FUpDown.SetBounds(0, 0, Scale96ToFont(DefaultUpDownWidth), 1);
3835 
3836       FUpDown.Parent := Self;
3837 
3838       TDTUpDown(FUPDown).OnClick := @UpDownClick;
3839 
3840     end;
3841   end;
3842 
3843 var
3844   ReallyShowArrowButton: Boolean;
3845 
3846 begin
3847   if FDateMode = dmNone then begin
3848     DestroyArrowBtn;
3849     DestroyUpDown;
3850 
3851   end else begin
3852     ReallyShowArrowButton := (FDateMode = dmComboBox) and
3853                           not (dtpDay in FEffectiveHideDateTimeParts);
3854 
3855     if (ReallyShowArrowButton <> Assigned(FArrowButton)) or
3856                        (Assigned(FArrowButton) = Assigned(FUpDown)) then begin
3857       DisableAlign;
3858       try
3859         if ReallyShowArrowButton then
3860           CreateArrowBtn
3861         else
3862           CreateUpDown;
3863 
3864         ArrangeCtrls;
3865 
3866       finally
3867         EnableAlign;
3868       end;
3869     end;
3870 
3871   end;
3872 end;
3873 
3874 procedure TCustomDateTimePicker.DestroyUpDown;
3875 begin
3876   if Assigned(FUpDown) then begin
3877     TDTUpDown(FUPDown).OnClick := nil;
3878     FreeAndNil(FUpDown);
3879   end;
3880 end;
3881 
3882 procedure TCustomDateTimePicker.DoAutoCheck;
3883 begin
3884   if dtpoAutoCheck in Options then
3885     SetChecked(True);
3886 end;
3887 
3888 procedure TCustomDateTimePicker.DoAutoAdjustLayout(
3889   const AMode: TLayoutAdjustmentPolicy;
3890   const AXProportion, AYProportion: Double);
3891 begin
3892   inherited;
3893   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
3894   begin
3895     if (not FAutoButtonSize) then begin
3896       if Assigned(FArrowButton) then
3897         FArrowButton.Width := Scale96ToFont(DefaultArrowButtonWidth);
3898       if Assigned(FUpDown) then
3899         FUpDown.Width := Scale96ToFont(DefaultUpdownWidth);
3900     end;
3901   end;
3902 end;
3903 
3904 procedure TCustomDateTimePicker.DestroyArrowBtn;
3905 begin
3906   if Assigned(FArrowButton) then begin
3907     TDTSpeedButton(FArrowButton).OnMouseDown := nil;
3908     DestroyCalendarForm;
3909     FreeAndNil(FArrowButton);
3910   end;
3911 end;
3912 
3913 constructor TCustomDateTimePicker.Create(AOwner: TComponent);
3914 var
3915   I: Integer;
3916   DTP: TDateTimePart;
3917 begin
3918   inherited Create(AOwner);
3919 
3920   with GetControlClassDefaultSize do
3921     SetInitialBounds(0, 0, cx, cy);
3922 
3923   FAlignment := taLeftJustify;
3924   FCalAlignment := dtaDefault;
3925   FCorrectedDTP := dtpAMPM;
3926   FCorrectedValue := 0;
3927   FSkipChangeInUpdateDate := 0;
3928   FNoEditingDone := 0;
3929   FArrowShape := asTheme;
3930   FAllowDroppingCalendar := True;
3931   FChecked := True;
3932 
3933   FOnDropDown := nil;
3934   FOnCloseUp := nil;
3935 
3936   ParentColor := False;
3937   FArrowButton := nil;
3938   FUpDown := nil;
3939 
3940   FKind := dtkDate;
3941   FNullInputAllowed := True;
3942   FOptions := cDefOptions;
3943 
3944   { Thanks to Luiz Américo for this:
3945     Lazarus ignores empty string when saving to lrs. Therefore, the problem
3946     is, when TextForNullDate is set to an empty string and after the project
3947     is saved and opened again, then, this property gets default value NULL
3948     instead of empty string. The following condition seems to be a workaround
3949     for this. }
3950   {$if fpc_fullversion < 030200}
3951   // This hack is no more needed since FPC 3.2 (see bug report 31985)
3952   if (AOwner = nil) or not (csReading in Owner.ComponentState) then
3953   {$endif}
3954     FTextForNullDate := 'NULL';
3955 
3956   FCenturyFrom := 1941;
3957   FRecalculatingTextSizesNeeded := True;
3958   FOnChange := nil;
3959   FOnChangeHandlers := nil;
3960   FOnCheckBoxChange := nil;
3961   FOnCheckBoxChangeHandlers := nil;
3962   FSeparatorWidth := 0;
3963   FSepNoSpaceWidth := 0;
3964   FDigitWidth := 0;
3965   FTimeSeparatorWidth := 0;
3966   FAMPMWidth := 0;
3967   FDateWidth := 0;
3968   FTimeWidth := 0;
3969   FTextWidth := 0;
3970   FTextHeight := 0;
3971   FMonthWidth := 0;
3972   FHideDateTimeParts := [];
3973   FShowMonthNames := False;
3974   FNullMonthText := '';
3975 
3976   for I := Low(FTextPart) to High(FTextPart) do
3977     FTextPart[I] := '';
3978 
3979   for DTP := dtpHour to dtpAMPM do
3980     FTimeText[DTP] := '';
3981 
3982   FTimeDisplay := tdHMS;
3983   FTimeFormat := tf24;
3984 
3985   FLeadingZeros := True;
3986   FUserChanging := 0;
3987   FReadOnly := False;
3988   FDateTime := SysUtils.Now;
3989   FConfirmedDateTime := FDateTime;
3990   FMinDate := TheSmallestDate;
3991   FMaxDate := TheBiggestDate;
3992   FTrailingSeparator := False;
3993   FDateDisplayOrder := ddoTryDefault;
3994   FSelectedTextPart := 1;
3995   FUseDefaultSeparators := True;
3996   FDateSeparator := DefaultFormatSettings.DateSeparator;
3997   FTimeSeparator := DefaultFormatSettings.TimeSeparator;
3998   FEffectiveCenturyFrom := FCenturyFrom;
3999   FJumpMinMax := False;
4000 
4001   ParentColor := False;
4002   TabStop := True;
4003   BorderWidth := 2;
4004   BorderStyle := bsSingle;
4005   ParentFont := True;
4006   AutoSize := True;
4007 
4008   FTextEnabled := True;
4009   FCalendarForm := nil;
4010   FDoNotArrangeControls := True;
4011   FCascade := False;
4012   FAutoButtonSize := False;
4013   FAutoAdvance := True;
4014   FCalendarWrapperClass := nil;
4015   FEffectiveHideDateTimeParts := [];
4016 
4017   AdjustEffectiveDateDisplayOrder;
4018   AdjustEffectiveHideDateTimeParts;
4019 
4020   SetMonthNames('Long');
4021   SetDateMode(dmComboBox);
4022 end;
4023 
4024 procedure TCustomDateTimePicker.AddHandlerOnChange(
4025   const AOnChange: TNotifyEvent; AsFirst: Boolean);
4026 begin
4027   if FOnChangeHandlers = nil then
4028     FOnChangeHandlers := TMethodList.Create;
4029   FOnChangeHandlers.Add(TMethod(AOnChange), not AsFirst);
4030 end;
4031 
4032 procedure TCustomDateTimePicker.AddHandlerOnCheckBoxChange(
4033   const AOnCheckBoxChange: TNotifyEvent; AsFirst: Boolean);
4034 begin
4035   if FOnCheckBoxChangeHandlers = nil then
4036     FOnCheckBoxChangeHandlers := TMethodList.Create;
4037   FOnCheckBoxChangeHandlers.Add(TMethod(AOnCheckBoxChange), not AsFirst);
4038 end;
4039 
4040 procedure TCustomDateTimePicker.RemoveHandlerOnChange(AOnChange: TNotifyEvent);
4041 begin
4042   if Assigned(FOnChangeHandlers) then
4043     FOnChangeHandlers.Remove(TMethod(AOnChange));
4044 end;
4045 
4046 procedure TCustomDateTimePicker.RemoveHandlerOnCheckBoxChange(
4047   AOnCheckBoxChange: TNotifyEvent);
4048 begin
4049   if Assigned(FOnCheckBoxChangeHandlers) then
4050     FOnCheckBoxChangeHandlers.Remove(TMethod(AOnCheckBoxChange));
4051 end;
4052 
4053 destructor TCustomDateTimePicker.Destroy;
4054 begin
4055   FDoNotArrangeControls := True;
4056   DestroyArrowBtn;
4057   DestroyUpDown;
4058   SetShowCheckBox(False);
4059   FOnChangeHandlers.Free;
4060   FOnCheckBoxChangeHandlers.Free;
4061 
4062   inherited Destroy;
4063 end;
4064 
TCustomDateTimePicker.DateIsNullnull4065 function TCustomDateTimePicker.DateIsNull: Boolean;
4066 begin
4067   Result := IsNullDate(FDateTime);
4068 end;
4069 
4070 end.
4071