mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 09:39:43 +01:00
4005 lines
106 KiB
ObjectPascal
4005 lines
106 KiB
ObjectPascal
{
|
|
TDateTimePicker control for Lazarus
|
|
- - - - - - - - - - - - - - - - - - -
|
|
Author: Zoran Vučenović, January and February 2010
|
|
Зоран Вученовић, јануар и фебруар 2010.
|
|
|
|
This unit is part of DateTimeCtrls package for Lazarus.
|
|
|
|
Delphi's Visual Component Library (VCL) has a control named TDateTimePicker,
|
|
which I find very useful for editing dates. Lazarus Component Library (LCL),
|
|
however, does not have this control, because VCL wraps native Windows control
|
|
and it seems that such control does not exist on other platforms. Given that
|
|
LCL is designed to be platform independent, it could not use native Win control.
|
|
Instead, for editing dates LCL has a control named TDateEdit, but I prefer
|
|
the VCL's TDateTimePicker.
|
|
Therefore, I tried to create a custom control which would resemble VCL's
|
|
TDateTimePicker as much as possible, but not to rely on native Windows control.
|
|
|
|
This TDateTimePicker control does not use native Win control. It has been
|
|
tested on Windows with win32/64 and qt widgetsets, as well as on Linux with
|
|
qt and gtk2 widgetsets.
|
|
|
|
-----------------------------------------------------------
|
|
LICENCE
|
|
- - - -
|
|
Modified LGPL -- see the file COPYING.modifiedLGPL.
|
|
|
|
-----------------------------------------------------------
|
|
NO WARRANTY
|
|
- - - - - -
|
|
There is no warranty whatsoever.
|
|
|
|
-----------------------------------------------------------
|
|
BEST REGARDS TO LAZARUS COMMUNITY!
|
|
- - - - - - - - - - - - - - - - - -
|
|
I do hope this control will be useful.
|
|
}
|
|
unit DateTimePicker;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef unix}
|
|
clocale, // needed to initialize default locale settings on Linux.
|
|
{$endif}
|
|
Classes, SysUtils, Controls, LCLType, Graphics, Math, StdCtrls, Buttons,
|
|
ExtCtrls, Forms, ComCtrls, Types, LMessages, Calendar, LazUTF8, LCLIntf,
|
|
LCLProc, Themes, CalControlWrapper;
|
|
|
|
const
|
|
{ We will deal with the NullDate value the special way. It will be especially
|
|
useful for dealing with null values from database. }
|
|
NullDate = TDateTime(Math.MaxDouble);
|
|
|
|
{ The biggest date a user can enter. }
|
|
TheBiggestDate = TDateTime(2958465.0); // 31. dec. 9999.
|
|
|
|
{ The smallest date a user can enter.
|
|
Note:
|
|
TCalendar does not accept smaller dates then 14. sep. 1752 on Windows OS
|
|
(see the implementation of TCustomCalendar.SetDateTime).
|
|
In Delphi help it is documented that Windows controls act weird with dates
|
|
older than 24. sep. 1752. Actually, TCalendar control has problems to show
|
|
dates before 1. okt. 1752. (try putting one calendar on the form, run the
|
|
application and see what september 1752. looks like).
|
|
Let's behave uniformely as much as
|
|
possible -- we won't allow dates before 1. okt. 1752. on any OS (who cares
|
|
about those).
|
|
So, this will be the down limit: }
|
|
TheSmallestDate = TDateTime(-53780.0); // 1. okt. 1752.
|
|
|
|
var
|
|
DefaultCalendarWrapperClass: TCalendarControlWrapperClass = nil;
|
|
|
|
type
|
|
TYMD = record
|
|
Year, Month, Day: Word;
|
|
end;
|
|
|
|
THMSMs = record
|
|
Hour, Minute, Second, MiliSec: Word;
|
|
end;
|
|
|
|
{ Used by DateDisplayOrder property to determine the order to display date
|
|
parts -- d-m-y, m-d-y or y-m-d.
|
|
When ddoTryDefault is set, the actual order is determined from
|
|
ShortDateFormat global variable -- see coments above
|
|
AdjustEffectiveDateDisplayOrder procedure }
|
|
TDateDisplayOrder = (ddoDMY, ddoMDY, ddoYMD, ddoTryDefault);
|
|
|
|
TTimeDisplay = (tdHM, // hour and minute
|
|
tdHMS, // hour, minute and second
|
|
tdHMSMs // hour, minute, second and milisecond
|
|
);
|
|
|
|
TTimeFormat = (tf12, // 12 hours format, with am/pm string
|
|
tf24 // 24 hours format
|
|
);
|
|
|
|
{ TDateTimeKind determines if we should display date, time or both: }
|
|
TDateTimeKind = (dtkDate, dtkTime, dtkDateTime);
|
|
|
|
TTextPart = 1..8;
|
|
TDateTimePart = (dtpDay, dtpMonth, dtpYear, dtpHour, dtpMinute,
|
|
dtpSecond, dtpMiliSec, dtpAMPM);
|
|
TDateTimeParts = set of dtpDay..dtpMiliSec; // without AMPM,
|
|
// because this set type is used for HideDateTimeParts property,
|
|
// where hiding of AMPM part is tied to hiding of hour (and, of
|
|
// course, it makes a difference only when TimeFormat is set to tf12)
|
|
|
|
TArrowShape = (asClassicSmaller, asClassicLarger, asModernSmaller,
|
|
asModernLarger, asYetAnotherShape, asTheme);
|
|
|
|
TDTDateMode = (dmComboBox, dmUpDown, dmNone);
|
|
|
|
{ calendar alignment - left or right,
|
|
dtaDefault means it is determined by BiDiMode }
|
|
TDTCalAlignment = (dtaLeft, dtaRight, dtaDefault);
|
|
|
|
TDateTimePickerOption = (
|
|
dtpoDoChangeOnSetDateTime, dtpoEnabledIfUnchecked, dtpoAutoCheck, dtpoFlatButton);
|
|
TDateTimePickerOptions = set of TDateTimePickerOption;
|
|
|
|
{ TCustomDateTimePicker }
|
|
|
|
TCustomDateTimePicker = class(TCustomControl)
|
|
private const
|
|
cDefOptions = [];
|
|
private
|
|
FAutoAdvance: Boolean;
|
|
FAutoButtonSize: Boolean;
|
|
FCalAlignment: TDTCalAlignment;
|
|
FCalendarWrapperClass: TCalendarControlWrapperClass;
|
|
FCascade: Boolean;
|
|
FCenturyFrom, FEffectiveCenturyFrom: Word;
|
|
FDateDisplayOrder: TDateDisplayOrder;
|
|
FHideDateTimeParts: TDateTimeParts;
|
|
FEffectiveHideDateTimeParts: set of TDateTimePart;
|
|
FKind: TDateTimeKind;
|
|
FLeadingZeros: Boolean;
|
|
FMonthNames: String;
|
|
FMonthNamesArray: TMonthNameArray;
|
|
FNullInputAllowed: Boolean;
|
|
FDateTime: TDateTime;
|
|
FDateSeparator: String;
|
|
FReadOnly: Boolean;
|
|
FMaxDate, FMinDate: TDate;
|
|
FShowMonthNames: Boolean;
|
|
FTextForNullDate: TCaption;
|
|
FTimeSeparator: String;
|
|
FTimeDisplay: TTimeDisplay;
|
|
FTimeFormat: TTimeFormat;
|
|
FTrailingSeparator: Boolean;
|
|
FUseDefaultSeparators: Boolean;
|
|
FUserChangedText: Boolean;
|
|
FYearPos, FDayPos, FMonthPos: 1..3;
|
|
FTextPart: array[1..3] of String;
|
|
FTimeText: array[dtpHour..dtpAMPM] of String;
|
|
FUserChanging: Integer;
|
|
FDigitWidth: Integer;
|
|
FTextHeight: Integer;
|
|
FSeparatorWidth: Integer;
|
|
FSepNoSpaceWidth: Integer;
|
|
FTimeSeparatorWidth: Integer;
|
|
FMonthWidth: Integer;
|
|
FNullMonthText: String;
|
|
FSelectedTextPart: TTextPart;
|
|
FRecalculatingTextSizesNeeded: Boolean;
|
|
FJumpMinMax: Boolean;
|
|
FAMPMWidth: Integer;
|
|
FDateWidth: Integer;
|
|
FTimeWidth: Integer;
|
|
FTextWidth: Integer;
|
|
FArrowShape: TArrowShape;
|
|
FDateMode: TDTDateMode;
|
|
FTextEnabled: Boolean;
|
|
FCheckBox: TCheckBox;
|
|
FUpDown: TCustomUpDown;
|
|
FOnChange: TNotifyEvent;
|
|
FOnCheckBoxChange: TNotifyEvent;
|
|
FOnChangeHandlers: TMethodList;
|
|
FOnCheckBoxChangeHandlers: TMethodList;
|
|
FOnDropDown: TNotifyEvent;
|
|
FOnCloseUp: TNotifyEvent;
|
|
FEffectiveDateDisplayOrder: TDateDisplayOrder;
|
|
|
|
FArrowButton: TCustomSpeedButton;
|
|
FCalendarForm: TCustomForm;
|
|
FDoNotArrangeControls: Boolean;
|
|
FConfirmedDateTime: TDateTime;
|
|
FNoEditingDone: Integer;
|
|
FAllowDroppingCalendar: Boolean;
|
|
FCorrectedDTP: TDateTimePart;
|
|
FCorrectedValue: Word;
|
|
FSkipChangeInUpdateDate: Integer;
|
|
FOptions: TDateTimePickerOptions;
|
|
|
|
function AreSeparatorsStored: Boolean;
|
|
function GetChecked: Boolean;
|
|
function GetDate: TDate;
|
|
function GetDateTime: TDateTime;
|
|
function GetDroppedDown: Boolean;
|
|
function GetShowCheckBox: Boolean;
|
|
function GetTime: TTime;
|
|
procedure SetArrowShape(const AValue: TArrowShape);
|
|
procedure SetAutoButtonSize(AValue: Boolean);
|
|
procedure SetCalAlignment(AValue: TDTCalAlignment);
|
|
procedure SetCalendarWrapperClass(AValue: TCalendarControlWrapperClass);
|
|
procedure SetCenturyFrom(const AValue: Word);
|
|
procedure SetChecked(const AValue: Boolean);
|
|
procedure CheckTextEnabled;
|
|
procedure SetDateDisplayOrder(const AValue: TDateDisplayOrder);
|
|
procedure SetDateMode(const AValue: TDTDateMode);
|
|
procedure SetHideDateTimeParts(AValue: TDateTimeParts);
|
|
procedure SetKind(const AValue: TDateTimeKind);
|
|
procedure SetLeadingZeros(const AValue: Boolean);
|
|
procedure SetMonthNames(AValue: String);
|
|
procedure SetNullInputAllowed(const AValue: Boolean);
|
|
procedure SetDate(const AValue: TDate);
|
|
procedure SetDateTime(const AValue: TDateTime);
|
|
procedure SetDateSeparator(const AValue: String);
|
|
procedure SetMaxDate(const AValue: TDate);
|
|
procedure SetMinDate(const AValue: TDate);
|
|
procedure SetReadOnly(const AValue: Boolean);
|
|
procedure SetShowCheckBox(const AValue: Boolean);
|
|
procedure SetShowMonthNames(AValue: Boolean);
|
|
procedure SetTextForNullDate(const AValue: TCaption);
|
|
procedure SetTime(const AValue: TTime);
|
|
procedure SetTimeSeparator(const AValue: String);
|
|
procedure SetTimeDisplay(const AValue: TTimeDisplay);
|
|
procedure SetTimeFormat(const AValue: TTimeFormat);
|
|
procedure SetTrailingSeparator(const AValue: Boolean);
|
|
procedure SetUseDefaultSeparators(const AValue: Boolean);
|
|
|
|
function GetHour: Word;
|
|
function GetMiliSec: Word;
|
|
function GetMinute: Word;
|
|
function GetSecond: Word;
|
|
procedure RecalculateTextSizesIfNeeded;
|
|
function GetDay: Word;
|
|
function GetMonth: Word;
|
|
function GetYear: Word;
|
|
function GetHMSMs(const NowIfNull: Boolean = False): THMSMs;
|
|
function GetYYYYMMDD(const TodayIfNull: Boolean = False;
|
|
const WithCorrection: Boolean = False): TYMD;
|
|
procedure SetHour(const AValue: Word);
|
|
procedure SetMiliSec(const AValue: Word);
|
|
procedure SetMinute(const AValue: Word);
|
|
procedure SetSecond(const AValue: Word);
|
|
procedure SetSeparators(const DateSep, TimeSep: String);
|
|
procedure SetDay(const AValue: Word);
|
|
procedure SetMonth(const AValue: Word);
|
|
procedure SetYear(const AValue: Word);
|
|
procedure SetYYYYMMDD(const AValue: TYMD);
|
|
procedure SetHMSMs(const AValue: THMSMs);
|
|
procedure UpdateIfUserChangedText;
|
|
function GetSelectedText: String;
|
|
procedure AdjustSelection;
|
|
procedure AdjustEffectiveCenturyFrom;
|
|
procedure AdjustEffectiveDateDisplayOrder;
|
|
procedure AdjustEffectiveHideDateTimeParts;
|
|
procedure SelectDateTimePart(const DateTimePart: TDateTimePart);
|
|
procedure MoveSelectionLR(const ToLeft: Boolean);
|
|
procedure DestroyCalendarForm;
|
|
procedure DropDownCalendarForm;
|
|
procedure UpdateShowArrowButton;
|
|
procedure DestroyUpDown;
|
|
procedure DestroyArrowBtn;
|
|
procedure ArrowMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
|
|
procedure CheckBoxChange(Sender: TObject);
|
|
procedure SetFocusIfPossible;
|
|
procedure AutoResizeButton;
|
|
procedure CheckAndApplyKey(const Key: Char);
|
|
procedure CheckAndApplyKeyCode(var Key: Word);
|
|
procedure SetOptions(const aOptions: TDateTimePickerOptions);
|
|
|
|
protected
|
|
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
|
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
|
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
|
|
procedure ConfirmChanges; virtual;
|
|
procedure UndoChanges; virtual;
|
|
|
|
function GetDateTimePartFromTextPart(TextPart: TTextPart): TDateTimePart;
|
|
function GetSelectedDateTimePart: TDateTimePart;
|
|
procedure FontChanged(Sender: TObject); override;
|
|
function GetTextOrigin(IgnoreRightToLeft: Boolean = False): TPoint;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: char); override;
|
|
procedure SelectTextPartUnderMouse(XMouse: Integer);
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
|
|
procedure UpdateDate(const CallChangeFromSetDateTime: Boolean = False); virtual;
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
procedure Click; override;
|
|
procedure DblClick; override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
procedure SetBiDiMode(AValue: TBiDiMode); override;
|
|
|
|
procedure IncreaseCurrentTextPart;
|
|
procedure DecreaseCurrentTextPart;
|
|
procedure IncreaseMonth;
|
|
procedure IncreaseYear;
|
|
procedure IncreaseDay;
|
|
procedure DecreaseMonth;
|
|
procedure DecreaseYear;
|
|
procedure DecreaseDay;
|
|
procedure IncreaseHour;
|
|
procedure IncreaseMinute;
|
|
procedure IncreaseSecond;
|
|
procedure IncreaseMiliSec;
|
|
procedure DecreaseHour;
|
|
procedure DecreaseMinute;
|
|
procedure DecreaseSecond;
|
|
procedure DecreaseMiliSec;
|
|
procedure ChangeAMPM;
|
|
|
|
procedure SelectDay;
|
|
procedure SelectMonth;
|
|
procedure SelectYear;
|
|
procedure SelectHour;
|
|
procedure SelectMinute;
|
|
procedure SelectSecond;
|
|
procedure SelectMiliSec;
|
|
procedure SelectAMPM;
|
|
|
|
procedure SetEnabled(Value: Boolean); override;
|
|
procedure SetAutoSize(Value: Boolean); override;
|
|
procedure CreateWnd; override;
|
|
procedure SetDateTimeJumpMinMax(const AValue: TDateTime);
|
|
procedure ArrangeCtrls; virtual;
|
|
procedure Change; virtual;
|
|
procedure CheckBoxChange; virtual;
|
|
procedure DoDropDown; virtual;
|
|
procedure DoCloseUp; virtual;
|
|
procedure DoAutoCheck; virtual;
|
|
|
|
procedure AddHandlerOnChange(const AOnChange: TNotifyEvent;
|
|
AsFirst: Boolean = False); virtual;
|
|
procedure AddHandlerOnCheckBoxChange(const AOnCheckBoxChange: TNotifyEvent;
|
|
AsFirst: Boolean = False); virtual;
|
|
procedure RemoveHandlerOnChange(AOnChange: TNotifyEvent); virtual;
|
|
procedure RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange: TNotifyEvent); virtual;
|
|
|
|
property BorderStyle default bsSingle;
|
|
property AutoSize default True;
|
|
property TabStop default True;
|
|
property ParentColor default False;
|
|
property CenturyFrom: Word
|
|
read FCenturyFrom write SetCenturyFrom;
|
|
property DateDisplayOrder: TDateDisplayOrder
|
|
read FDateDisplayOrder write SetDateDisplayOrder default ddoTryDefault;
|
|
property MaxDate: TDate
|
|
read FMaxDate write SetMaxDate;
|
|
property MinDate: TDate
|
|
read FMinDate write SetMinDate;
|
|
property DateTime: TDateTime read GetDateTime write SetDateTime;
|
|
property TrailingSeparator: Boolean
|
|
read FTrailingSeparator write SetTrailingSeparator;
|
|
property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
|
|
property LeadingZeros: Boolean read FLeadingZeros write SetLeadingZeros;
|
|
property TextForNullDate: TCaption
|
|
read FTextForNullDate write SetTextForNullDate;
|
|
property NullInputAllowed: Boolean
|
|
read FNullInputAllowed write SetNullInputAllowed default True;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnCheckBoxChange: TNotifyEvent
|
|
read FOnCheckBoxChange write FOnCheckBoxChange;
|
|
property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
|
|
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
|
|
property ShowCheckBox: Boolean
|
|
read GetShowCheckBox write SetShowCheckBox default False;
|
|
property Checked: Boolean read GetChecked write SetChecked default True;
|
|
property ArrowShape: TArrowShape
|
|
read FArrowShape write SetArrowShape default asTheme;
|
|
property Kind: TDateTimeKind
|
|
read FKind write SetKind;
|
|
property DateSeparator: String
|
|
read FDateSeparator write SetDateSeparator stored AreSeparatorsStored;
|
|
property TimeSeparator: String
|
|
read FTimeSeparator write SetTimeSeparator stored AreSeparatorsStored;
|
|
property UseDefaultSeparators: Boolean
|
|
read FUseDefaultSeparators write SetUseDefaultSeparators;
|
|
property TimeFormat: TTimeFormat read FTimeFormat write SetTimeFormat;
|
|
property TimeDisplay: TTimeDisplay read FTimeDisplay write SetTimeDisplay;
|
|
property Time: TTime read GetTime write SetTime;
|
|
property Date: TDate read GetDate write SetDate;
|
|
property DateMode: TDTDateMode read FDateMode write SetDateMode;
|
|
property Cascade: Boolean read FCascade write FCascade default False;
|
|
property AutoButtonSize: Boolean
|
|
read FAutoButtonSize write SetAutoButtonSize default False;
|
|
property AutoAdvance: Boolean
|
|
read FAutoAdvance write FAutoAdvance default True;
|
|
property HideDateTimeParts: TDateTimeParts
|
|
read FHideDateTimeParts write SetHideDateTimeParts;
|
|
property CalendarWrapperClass: TCalendarControlWrapperClass
|
|
read FCalendarWrapperClass write SetCalendarWrapperClass;
|
|
property MonthNames: String read FMonthNames write SetMonthNames;
|
|
property ShowMonthNames: Boolean
|
|
read FShowMonthNames write SetShowMonthNames default False;
|
|
property DroppedDown: Boolean read GetDroppedDown;
|
|
property CalAlignment: TDTCalAlignment read FCalAlignment write SetCalAlignment default dtaDefault;
|
|
property Options: TDateTimePickerOptions read FOptions write SetOptions default cDefOptions;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function DateIsNull: Boolean;
|
|
procedure SelectDate;
|
|
procedure SelectTime;
|
|
procedure SendExternalKey(const aKey: Char);
|
|
procedure SendExternalKeyCode(const Key: Word);
|
|
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
|
|
|
|
procedure Paint; override;
|
|
procedure EditingDone; override;
|
|
|
|
published
|
|
//
|
|
end;
|
|
|
|
{TDateTimePicker}
|
|
|
|
TDateTimePicker = class(TCustomDateTimePicker)
|
|
public
|
|
procedure AddHandlerOnChange(const AOnChange: TNotifyEvent; AsFirst: Boolean = False
|
|
); override;
|
|
procedure AddHandlerOnCheckBoxChange(const AOnCheckBoxChange: TNotifyEvent;
|
|
AsFirst: Boolean = False); override;
|
|
procedure RemoveHandlerOnChange(AOnChange: TNotifyEvent); override;
|
|
procedure RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange: TNotifyEvent); override;
|
|
public
|
|
property DateTime;
|
|
property CalendarWrapperClass;
|
|
property DroppedDown;
|
|
published
|
|
property ArrowShape;
|
|
property ShowCheckBox;
|
|
property Checked;
|
|
property CenturyFrom;
|
|
property DateDisplayOrder;
|
|
property MaxDate;
|
|
property MinDate;
|
|
property ReadOnly;
|
|
property AutoSize;
|
|
property Font;
|
|
property ParentFont;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property BorderStyle;
|
|
property BorderSpacing;
|
|
property Enabled;
|
|
property Color;
|
|
property ParentColor;
|
|
property DateSeparator;
|
|
property TrailingSeparator;
|
|
property TextForNullDate;
|
|
property LeadingZeros;
|
|
property ShowHint;
|
|
property ParentShowHint;
|
|
property Align;
|
|
property Anchors;
|
|
property Constraints;
|
|
property Cursor;
|
|
property PopupMenu;
|
|
property Visible;
|
|
property NullInputAllowed;
|
|
property Kind;
|
|
property TimeSeparator;
|
|
property TimeFormat;
|
|
property TimeDisplay;
|
|
property DateMode;
|
|
property Date;
|
|
property Time;
|
|
property UseDefaultSeparators;
|
|
property Cascade;
|
|
property AutoButtonSize;
|
|
property AutoAdvance;
|
|
property HideDateTimeParts;
|
|
property BiDiMode;
|
|
property ParentBiDiMode;
|
|
property MonthNames;
|
|
property ShowMonthNames;
|
|
property CalAlignment;
|
|
property Options;
|
|
// events:
|
|
property OnChange;
|
|
property OnCheckBoxChange;
|
|
property OnDropDown;
|
|
property OnCloseUp;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnEditingDone;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
function EqualDateTime(const A, B: TDateTime): Boolean;
|
|
function IsNullDate(DT: TDateTime): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
DateUtils, LCLCalWrapper;
|
|
|
|
function NumberOfDaysInMonth(const Month, Year: Word): Word;
|
|
begin
|
|
Result := 0;
|
|
if Month in [1..12] then
|
|
Result := MonthDays[IsLeapYear(Year), Month];
|
|
end;
|
|
|
|
{ EqualDateTime
|
|
--------------
|
|
Returns True when two dates are equal or both are null }
|
|
function EqualDateTime(const A, B: TDateTime): Boolean;
|
|
begin
|
|
if IsNullDate(A) then
|
|
Result := IsNullDate(B)
|
|
else
|
|
Result := (not IsNullDate(B)) and (A = B);
|
|
end;
|
|
|
|
function IsNullDate(DT: TDateTime): Boolean;
|
|
begin
|
|
Result := IsNan(DT) or IsInfinite(DT) or
|
|
(DT > SysUtils.MaxDateTime) or (DT < SysUtils.MinDateTime);
|
|
end;
|
|
|
|
type
|
|
|
|
{ TDTUpDown }
|
|
|
|
{ The two buttons contained by UpDown control are never disabled in original
|
|
UpDown class. This class is defined here to override this behaviour. }
|
|
TDTUpDown = class(TCustomUpDown)
|
|
private
|
|
DTPicker: TCustomDateTimePicker;
|
|
protected
|
|
procedure SetEnabled(Value: Boolean); override;
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
procedure WndProc(var Message: TLMessage); override;
|
|
end;
|
|
|
|
{ TDTSpeedButton }
|
|
|
|
TDTSpeedButton = class(TCustomSpeedButton)
|
|
private
|
|
DTPicker: TCustomDateTimePicker;
|
|
protected
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
override;
|
|
public
|
|
procedure Paint; override;
|
|
end;
|
|
|
|
{ TDTCalendarForm }
|
|
|
|
TDTCalendarForm = class(TForm)
|
|
private
|
|
DTPicker: TCustomDateTimePicker;
|
|
Cal: TCalendarControlWrapper;
|
|
Shape: TShape;
|
|
RememberedCalendarFormOrigin: TPoint;
|
|
FClosing: Boolean;
|
|
DTPickersParentForm: TCustomForm;
|
|
|
|
procedure SetClosingCalendarForm;
|
|
procedure AdjustCalendarFormSize;
|
|
procedure AdjustCalendarFormScreenPosition;
|
|
procedure CloseCalendarForm(const AndSetTheDate: Boolean = False);
|
|
|
|
procedure CalendarKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure CalendarResize(Sender: TObject);
|
|
procedure CalendarClick(Sender: TObject);
|
|
procedure VisibleOfParentChanged(Sender: TObject);
|
|
|
|
protected
|
|
procedure Deactivate; override;
|
|
procedure DoShow; override;
|
|
procedure DoClose(var CloseAction: TCloseAction); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
|
|
public
|
|
constructor CreateNewDTCalendarForm(AOwner: TComponent;
|
|
ADTPicker: TCustomDateTimePicker);
|
|
destructor Destroy; override;
|
|
published
|
|
end;
|
|
|
|
{ TDateTimePicker }
|
|
|
|
procedure TDateTimePicker.AddHandlerOnChange(const AOnChange: TNotifyEvent;
|
|
AsFirst: Boolean);
|
|
begin
|
|
inherited AddHandlerOnChange(AOnChange, AsFirst);
|
|
end;
|
|
|
|
procedure TDateTimePicker.AddHandlerOnCheckBoxChange(
|
|
const AOnCheckBoxChange: TNotifyEvent; AsFirst: Boolean);
|
|
begin
|
|
inherited AddHandlerOnCheckBoxChange(AOnCheckBoxChange, AsFirst);
|
|
end;
|
|
|
|
procedure TDateTimePicker.RemoveHandlerOnChange(AOnChange: TNotifyEvent);
|
|
begin
|
|
inherited RemoveHandlerOnChange(AOnChange);
|
|
end;
|
|
|
|
procedure TDateTimePicker.RemoveHandlerOnCheckBoxChange(
|
|
AOnCheckBoxChange: TNotifyEvent);
|
|
begin
|
|
inherited RemoveHandlerOnCheckBoxChange(AOnCheckBoxChange);
|
|
end;
|
|
|
|
procedure TDTCalendarForm.SetClosingCalendarForm;
|
|
begin
|
|
if not FClosing then begin
|
|
FClosing := True;
|
|
|
|
if Assigned(DTPicker) and (DTPicker.FCalendarForm = Self) then
|
|
DTPicker.FCalendarForm := nil;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.AdjustCalendarFormSize;
|
|
begin
|
|
if not FClosing then begin
|
|
ClientWidth := Cal.GetCalendarControl.Width + 2;
|
|
ClientHeight := Cal.GetCalendarControl.Height + 2;
|
|
|
|
Shape.SetBounds(0, 0, ClientWidth, ClientHeight);
|
|
|
|
AdjustCalendarFormScreenPosition;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.AdjustCalendarFormScreenPosition;
|
|
var
|
|
M: TMonitor;
|
|
R: TRect;
|
|
P: TPoint;
|
|
H, W: Integer;
|
|
begin
|
|
H := Height;
|
|
W := Width;
|
|
|
|
if (DTPicker.CalAlignment = dtaRight) or
|
|
((DTPicker.CalAlignment = dtaDefault) and IsRightToLeft) then
|
|
P := DTPicker.ControlToScreen(Point(DTPicker.Width - W, DTPicker.Height))
|
|
else
|
|
P := DTPicker.ControlToScreen(Point(0, DTPicker.Height));
|
|
|
|
M := Screen.MonitorFromWindow(DTPicker.Handle);
|
|
|
|
R := M.WorkareaRect;
|
|
// WorkareaRect sometimes is not implemented (gtk2?). Depends on widgetset
|
|
// and window manager or something like that. Then it returns (0,0,0,0) and
|
|
// the best we can do is use BoundsRect instead:
|
|
if (R.Right <= R.Left) or (R.Bottom <= R.Top) then
|
|
R := M.BoundsRect;
|
|
|
|
if P.y > R.Bottom - H then
|
|
P.y := P.y - H - DTPicker.Height;
|
|
|
|
if P.y < R.Top then
|
|
P.y := R.Top;
|
|
|
|
if P.x > R.Right - W then
|
|
P.x := R.Right - W;
|
|
|
|
if P.x < R.Left then
|
|
P.x := R.Left;
|
|
|
|
if (P.x <> RememberedCalendarFormOrigin.x)
|
|
or (P.y <> RememberedCalendarFormOrigin.y) then begin
|
|
SetBounds(P.x, P.y, W, H);
|
|
RememberedCalendarFormOrigin := P;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDTCalendarForm.CloseCalendarForm(const AndSetTheDate: Boolean);
|
|
begin
|
|
if not FClosing then
|
|
try
|
|
SetClosingCalendarForm;
|
|
Visible := False;
|
|
|
|
if Assigned(DTPicker) and DTPicker.IsVisible then begin
|
|
|
|
if AndSetTheDate then begin
|
|
Inc(DTPicker.FUserChanging);
|
|
try
|
|
if DTPicker.DateIsNull then begin
|
|
// we'll set the time to 0.0 (midnight):
|
|
DTPicker.SetDateTime(Int(Cal.GetDate));
|
|
end else if not EqualDateTime(Int(DTPicker.DateTime),
|
|
Int(Cal.GetDate)) then begin
|
|
// we'll change the date, but keep the time:
|
|
DTPicker.SetDateTime(ComposeDateTime(Cal.GetDate, DTPicker.DateTime));
|
|
end;
|
|
DTPicker.DoAutoCheck;
|
|
finally
|
|
Dec(DTPicker.FUserChanging);
|
|
end;
|
|
end;
|
|
|
|
if Screen.ActiveCustomForm = Self then
|
|
DTPicker.SetFocusIfPossible;
|
|
|
|
DTPicker.DoCloseUp;
|
|
end;
|
|
|
|
finally
|
|
Release;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDTCalendarForm.CalendarKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (not(Cal.GetCalendarControl is TCustomCalendar))
|
|
or (TCustomCalendar(Cal.GetCalendarControl).GetCalendarView = cvMonth) then
|
|
case Key of
|
|
VK_ESCAPE:
|
|
CloseCalendarForm;
|
|
|
|
VK_RETURN, VK_SPACE:
|
|
CloseCalendarForm(True);
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.CalendarResize(Sender: TObject);
|
|
begin
|
|
AdjustCalendarFormSize;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.CalendarClick(Sender: TObject);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
P := Cal.GetCalendarControl.ScreenToClient(Mouse.CursorPos);
|
|
if Cal.AreCoordinatesOnDate(P.x, P.y) then
|
|
CloseCalendarForm(True);
|
|
|
|
end;
|
|
|
|
{ This procedure is added to list of "visible change handlers" of DTPicker's
|
|
parent form, so that hiding of DTPicker's parent form does not leave the
|
|
calendar form visible. }
|
|
procedure TDTCalendarForm.VisibleOfParentChanged(Sender: TObject);
|
|
begin
|
|
SetClosingCalendarForm;
|
|
Release;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.WMActivate(var Message: TLMActivate);
|
|
var
|
|
PP: HWND;
|
|
begin
|
|
inherited;
|
|
|
|
PP := LCLIntf.GetParent(Handle);
|
|
if (PP<>0) then
|
|
SendMessage(PP, LM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
|
|
end;
|
|
|
|
procedure TDTCalendarForm.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
|
|
if (AComponent = DTPickersParentForm) and (Operation = opRemove) then
|
|
DTPickersParentForm := nil;
|
|
|
|
end;
|
|
|
|
procedure TDTCalendarForm.Deactivate;
|
|
begin
|
|
inherited Deactivate;
|
|
|
|
CloseCalendarForm;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.DoShow;
|
|
begin
|
|
if not FClosing then begin
|
|
inherited DoShow;
|
|
|
|
AdjustCalendarFormSize;
|
|
DTPicker.DoDropDown; // calls OnDropDown event handler
|
|
end;
|
|
end;
|
|
|
|
procedure TDTCalendarForm.DoClose(var CloseAction: TCloseAction);
|
|
begin
|
|
SetClosingCalendarForm;
|
|
CloseAction := caFree;
|
|
|
|
inherited DoClose(CloseAction);
|
|
end;
|
|
|
|
constructor TDTCalendarForm.CreateNewDTCalendarForm(AOwner: TComponent;
|
|
ADTPicker: TCustomDateTimePicker);
|
|
var
|
|
P: TPoint;
|
|
CalClass: TCalendarControlWrapperClass;
|
|
begin
|
|
inherited CreateNew(AOwner);
|
|
|
|
ADTPicker.FAllowDroppingCalendar := False;
|
|
FClosing := False;
|
|
|
|
DTPicker := ADTPicker;
|
|
BiDiMode := DTPicker.BiDiMode;
|
|
DTPickersParentForm := GetParentForm(DTPicker);
|
|
if Assigned(DTPickersParentForm) then begin
|
|
DTPickersParentForm.AddHandlerOnVisibleChanged(@VisibleOfParentChanged);
|
|
DTPickersParentForm.FreeNotification(Self);
|
|
end;
|
|
PopupMode := pmAuto;
|
|
|
|
P := Point(0, 0);
|
|
|
|
if ADTPicker.FCalendarWrapperClass = nil then begin
|
|
if DefaultCalendarWrapperClass = nil then
|
|
CalClass := TLCLCalendarWrapper
|
|
else
|
|
CalClass := DefaultCalendarWrapperClass;
|
|
end else
|
|
CalClass := ADTPicker.FCalendarWrapperClass;
|
|
|
|
Cal := CalClass.Create;
|
|
|
|
Cal.GetCalendarControl.ParentBiDiMode := True;
|
|
Cal.GetCalendarControl.AutoSize := True;
|
|
Cal.GetCalendarControl.GetPreferredSize(P.x, P.y);
|
|
Cal.GetCalendarControl.Align := alNone;
|
|
Cal.GetCalendarControl.SetBounds(1, 1, P.x, P.y);
|
|
|
|
SetBounds(-8000, -8000, P.x + 2, P.y + 2);
|
|
RememberedCalendarFormOrigin := Point(-8000, -8000);
|
|
|
|
ShowInTaskBar := stNever;
|
|
BorderStyle := bsNone;
|
|
|
|
Shape := TShape.Create(nil);
|
|
Shape.Brush.Style := bsClear;
|
|
|
|
if DTPicker.DateIsNull then
|
|
Cal.SetDate(Max(DTPicker.MinDate, Min(SysUtils.Date, DTPicker.MaxDate)))
|
|
|
|
else if DTPicker.DateTime < DTPicker.MinDate then // These "out of bounds" values
|
|
Cal.SetDate(DTPicker.MinDate) // can happen when DateTime was set with
|
|
else if DTPicker.DateTime > DTPicker.MaxDate then // "SetDateTimeJumpMinMax" protected
|
|
Cal.SetDate(DTPicker.MaxDate) // procedure (used in TDBDateTimePicker control).
|
|
|
|
else
|
|
Cal.SetDate(DTPicker.Date);
|
|
|
|
Cal.GetCalendarControl.OnResize := @CalendarResize;
|
|
Cal.GetCalendarControl.OnClick := @CalendarClick;
|
|
if Cal.GetCalendarControl is TWinControl then begin
|
|
TWinControl(Cal.GetCalendarControl).OnKeyDown := @CalendarKeyDown;
|
|
TWinControl(Cal.GetCalendarControl).TabStop := True;
|
|
TWinControl(Cal.GetCalendarControl).SetFocus;
|
|
end;
|
|
|
|
Shape.Parent := Self;
|
|
Cal.GetCalendarControl.Parent := Self;
|
|
Cal.GetCalendarControl.BringToFront;
|
|
end;
|
|
|
|
destructor TDTCalendarForm.Destroy;
|
|
begin
|
|
SetClosingCalendarForm;
|
|
if Assigned(DTPickersParentForm) then
|
|
DTPickersParentForm.RemoveAllHandlersOfObject(Self);
|
|
|
|
if Assigned(Cal) then begin
|
|
Cal.GetCalendarControl.OnResize := nil;
|
|
Cal.GetCalendarControl.OnClick := nil;
|
|
if Cal.GetCalendarControl is TWinControl then
|
|
TWinControl(Cal.GetCalendarControl).OnKeyDown := nil;
|
|
Cal.Free;
|
|
Cal := nil;
|
|
end;
|
|
FreeAndNil(Shape);
|
|
|
|
if Assigned(DTPicker) then begin
|
|
if (Screen.ActiveControl = DTPicker) then
|
|
DTPicker.Invalidate;
|
|
|
|
if DTPicker.FCalendarForm = nil then
|
|
DTPicker.FAllowDroppingCalendar := True;
|
|
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TCustomDateTimePicker }
|
|
|
|
procedure TCustomDateTimePicker.SetChecked(const AValue: Boolean);
|
|
begin
|
|
if Assigned(FCheckBox) then
|
|
FCheckBox.Checked := AValue;
|
|
|
|
CheckTextEnabled;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CheckTextEnabled;
|
|
begin
|
|
FTextEnabled := Self.Enabled and ((dtpoEnabledIfUnchecked in Options) or GetChecked);
|
|
|
|
if Assigned(FArrowButton) then
|
|
FArrowButton.Enabled := FTextEnabled;
|
|
|
|
if Assigned(FUpDown) then
|
|
FUpDown.Enabled := FTextEnabled;
|
|
|
|
if Assigned(FCheckBox) then
|
|
FCheckBox.Enabled := Self.Enabled;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDateDisplayOrder(
|
|
const AValue: TDateDisplayOrder);
|
|
var
|
|
PreviousEffectiveDDO: TDateDisplayOrder;
|
|
begin
|
|
if FDateDisplayOrder <> AValue then begin
|
|
PreviousEffectiveDDO := FEffectiveDateDisplayOrder;
|
|
FDateDisplayOrder := AValue;
|
|
AdjustEffectiveDateDisplayOrder;
|
|
if FEffectiveDateDisplayOrder <> PreviousEffectiveDDO then begin
|
|
AdjustSelection;
|
|
UpdateDate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDateMode(const AValue: TDTDateMode);
|
|
begin
|
|
FDateMode := AValue;
|
|
UpdateShowArrowButton;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetHideDateTimeParts(AValue: TDateTimeParts);
|
|
begin
|
|
if FHideDateTimeParts <> AValue then begin
|
|
FHideDateTimeParts := AValue;
|
|
AdjustEffectiveHideDateTimeParts;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetKind(const AValue: TDateTimeKind);
|
|
begin
|
|
if FKind <> AValue then begin
|
|
FKind := AValue;
|
|
AdjustEffectiveHideDateTimeParts;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetLeadingZeros(const AValue: Boolean);
|
|
begin
|
|
if FLeadingZeros = AValue then Exit;
|
|
|
|
FLeadingZeros := AValue;
|
|
UpdateDate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMonthNames(AValue: String);
|
|
var
|
|
I, N, LenMNSep: Integer;
|
|
MonthNamesSeparator: String;
|
|
|
|
begin
|
|
if FMonthNames <> AValue then begin
|
|
AValue := TrimRight(AValue);
|
|
FMonthNames := AValue;
|
|
|
|
if UpperCase(AValue) = 'SHORT' then
|
|
for I := Low(TMonthNameArray) to High(TMonthNameArray) do
|
|
FMonthNamesArray[I] := AnsiToUtf8(DefaultFormatSettings.ShortMonthNames[I])
|
|
else begin
|
|
N := 0;
|
|
if Length(AValue) >= 24 then begin
|
|
MonthNamesSeparator := UTF8Copy(AValue, 1, 1);
|
|
LenMNSep := Length(MonthNamesSeparator);
|
|
if LenMNSep > 0 then begin
|
|
Delete(AValue, 1, LenMNSep);
|
|
|
|
while N < 12 do begin
|
|
I := Pos(MonthNamesSeparator, AValue);
|
|
if I <= 1 then begin
|
|
if (I = 0) and (N = 11) and (Length(AValue) > 0) then begin
|
|
Inc(N);
|
|
FMonthNamesArray[N] := AValue;
|
|
end;
|
|
|
|
Break;
|
|
end;
|
|
|
|
Inc(N);
|
|
Dec(I);
|
|
FMonthNamesArray[N] := Copy(AValue, 1, I);
|
|
Delete(AValue, 1, I + LenMNSep);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
if N < 12 then
|
|
for I := Low(TMonthNameArray) to High(TMonthNameArray) do
|
|
FMonthNamesArray[I] := AnsiToUtf8(DefaultFormatSettings.LongMonthNames[I]);
|
|
end;
|
|
|
|
if FShowMonthNames and
|
|
not (dtpMonth in FEffectiveHideDateTimeParts) then begin
|
|
FRecalculatingTextSizesNeeded := True;
|
|
UpdateDate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetNullInputAllowed(const AValue: Boolean);
|
|
begin
|
|
FNullInputAllowed := AValue;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetOptions(
|
|
const aOptions: TDateTimePickerOptions);
|
|
begin
|
|
if FOptions = aOptions then Exit;
|
|
FOptions := aOptions;
|
|
|
|
if FArrowButton<>nil then
|
|
FArrowButton.Flat := dtpoFlatButton in Options;
|
|
|
|
if FUpDown <> nil then
|
|
TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options;
|
|
|
|
CheckTextEnabled;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDate(const AValue: TDate);
|
|
begin
|
|
if IsNullDate(AValue) then
|
|
DateTime := NullDate
|
|
else if DateIsNull then
|
|
DateTime := Int(AValue)
|
|
else
|
|
DateTime := ComposeDateTime(AValue, FDateTime);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDateTime(const AValue: TDateTime);
|
|
begin
|
|
if not EqualDateTime(AValue, FDateTime) then begin
|
|
if IsNullDate(AValue) then
|
|
FDateTime := NullDate
|
|
else
|
|
FDateTime := AValue;
|
|
|
|
UpdateDate(dtpoDoChangeOnSetDateTime in FOptions);
|
|
end else
|
|
UpdateDate;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDateSeparator(const AValue: String);
|
|
begin
|
|
SetSeparators(AValue, FTimeSeparator);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMaxDate(const AValue: TDate);
|
|
begin
|
|
if not IsNullDate(AValue) then begin
|
|
|
|
if AValue > TheBiggestDate then
|
|
FMaxDate := TheBiggestDate
|
|
else if AValue <= FMinDate then
|
|
FMaxDate := FMinDate
|
|
else
|
|
FMaxDate := Int(AValue);
|
|
|
|
if not DateIsNull then
|
|
if FMaxDate < GetDate then
|
|
SetDate(FMaxDate);
|
|
|
|
AdjustEffectiveCenturyFrom;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMinDate(const AValue: TDate);
|
|
begin
|
|
if not IsNullDate(AValue) then begin
|
|
|
|
if AValue < TheSmallestDate then
|
|
FMinDate := TheSmallestDate
|
|
else if AValue >= FMaxDate then
|
|
FMinDate := FMaxDate
|
|
else
|
|
FMinDate := Int(AValue);
|
|
|
|
if not DateIsNull then
|
|
if FMinDate > GetDate then
|
|
SetDate(FMinDate);
|
|
|
|
AdjustEffectiveCenturyFrom;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetReadOnly(const AValue: Boolean);
|
|
begin
|
|
if FReadOnly <> AValue then begin
|
|
if AValue then
|
|
ConfirmChanges;
|
|
|
|
FReadOnly := AValue;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TDTCheckBox = class(TCheckBox)
|
|
protected
|
|
procedure CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
end;
|
|
|
|
procedure TDTCheckBox.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
begin
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
|
|
WithThemeSpace);
|
|
|
|
PreferredHeight := 1;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetShowCheckBox(const AValue: Boolean);
|
|
begin
|
|
if GetShowCheckBox <> AValue then begin
|
|
DisableAlign;
|
|
try
|
|
if AValue then begin
|
|
FCheckBox := TDTCheckBox.Create(Self);
|
|
|
|
{$IFNDEF WINDOWS}
|
|
{ On Windows, the following line seems to not have any effect, but I
|
|
enclosed it in IFNDEF anyway. }
|
|
FCheckBox.Color := clBtnFace; { This line is here because of CheckBox's
|
|
strange behavior in Linux -- when parent's colour is white, which is
|
|
the default in our case (actually, our default is clWindow, but it's
|
|
usually white) and when the check box is on a form shown modally, if
|
|
we close the form and then show it again, the check box refuses to
|
|
paint it's "checker" shape.
|
|
|
|
I spent a lot of time trying to solve this and this is the best I
|
|
came up with -- setting the check box's colour to clBtnFace seems to
|
|
be a workaround.
|
|
|
|
Nice thing is that it seems not to really effect neither the checker's
|
|
colour on the screen, nor the colour of check box's "box", so we didn't
|
|
actually spoil the check box's default appearence on the screen. }
|
|
{$ENDIF}
|
|
|
|
FCheckBox.ControlStyle := FCheckBox.ControlStyle +
|
|
[csNoFocus, csNoDesignSelectable];
|
|
FCheckBox.AllowGrayed := False;
|
|
FCheckBox.TabStop := False;
|
|
|
|
FCheckBox.Checked := True;
|
|
FCheckBox.Enabled := Self.Enabled;
|
|
|
|
FCheckBox.Parent := Self;
|
|
|
|
FCheckBox.OnChange := @CheckBoxChange;
|
|
end else begin
|
|
FCheckBox.OnChange := nil;
|
|
FreeAndNil(FCheckBox);
|
|
|
|
end;
|
|
ArrangeCtrls;
|
|
|
|
finally
|
|
EnableAlign;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetShowMonthNames(AValue: Boolean);
|
|
begin
|
|
if FShowMonthNames <> AValue then begin
|
|
FShowMonthNames := AValue;
|
|
if not (dtpMonth in FEffectiveHideDateTimeParts) then begin
|
|
FRecalculatingTextSizesNeeded := True;
|
|
UpdateDate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTextForNullDate(const AValue: TCaption);
|
|
begin
|
|
if FTextForNullDate = AValue then
|
|
Exit;
|
|
|
|
FTextForNullDate := AValue;
|
|
if DateIsNull then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTime(const AValue: TTime);
|
|
begin
|
|
if IsNullDate(AValue) then
|
|
DateTime := NullDate
|
|
else if DateIsNull then
|
|
DateTime := ComposeDateTime(Max(Min(SysUtils.Date, MaxDate), MinDate), AValue)
|
|
else
|
|
DateTime := ComposeDateTime(FDateTime, AValue);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTimeSeparator(const AValue: String);
|
|
begin
|
|
SetSeparators(FDateSeparator, AValue);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTimeDisplay(const AValue: TTimeDisplay);
|
|
begin
|
|
if FTimeDisplay <> AValue then begin
|
|
FTimeDisplay:=AValue;
|
|
AdjustEffectiveHideDateTimeParts;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTimeFormat(const AValue: TTimeFormat);
|
|
begin
|
|
if FTimeFormat <> AValue then begin
|
|
FTimeFormat := AValue;
|
|
AdjustEffectiveHideDateTimeParts;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetTrailingSeparator(const AValue: Boolean);
|
|
begin
|
|
if FTrailingSeparator <> AValue then begin
|
|
FTrailingSeparator := AValue;
|
|
FRecalculatingTextSizesNeeded := True;
|
|
UpdateIfUserChangedText;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetUseDefaultSeparators(const AValue: Boolean);
|
|
begin
|
|
if FUseDefaultSeparators <> AValue then begin
|
|
if AValue then begin
|
|
SetSeparators(DefaultFormatSettings.DateSeparator,
|
|
DefaultFormatSettings.TimeSeparator);
|
|
// Note that here, in SetSeparators procedure,
|
|
// the field FUseDefaultSeparators is set to False.
|
|
end;
|
|
// Therefore, the following line must NOT be moved above.
|
|
FUseDefaultSeparators := AValue;
|
|
end;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetHour: Word;
|
|
begin
|
|
Result := GetHMSMs.Hour;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetMiliSec: Word;
|
|
begin
|
|
Result := GetHMSMs.MiliSec;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetMinute: Word;
|
|
begin
|
|
Result := GetHMSMs.Minute;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetSecond: Word;
|
|
begin
|
|
Result := GetHMSMs.Second;
|
|
end;
|
|
|
|
{ RecalculateTextSizesIfNeeded
|
|
--------------------------------
|
|
In this procedure we measure text and store the values in the following
|
|
fields: FDateWidth, FTimeWidth, FTextWidth, FTextHeigth, FDigitWidth,
|
|
FSeparatorWidth, FTimeSeparatorWidth, FSepNoSpaceWidth. These fields are used
|
|
in calculating our preffered size and when painting.
|
|
The procedure is called internally when needed (when properties which
|
|
influence the appearence change). }
|
|
procedure TCustomDateTimePicker.RecalculateTextSizesIfNeeded;
|
|
const
|
|
NullMonthChar = 'x';
|
|
var
|
|
C: Char;
|
|
N, J: Integer;
|
|
S: String;
|
|
I: TDateTimePart;
|
|
DateParts, TimeParts: Integer;
|
|
begin
|
|
if HandleAllocated and FRecalculatingTextSizesNeeded then begin
|
|
FRecalculatingTextSizesNeeded := False;
|
|
|
|
FDigitWidth := 0;
|
|
for C := '0' to '9' do begin
|
|
N := Canvas.GetTextWidth(C);
|
|
if N > FDigitWidth then
|
|
FDigitWidth := N;
|
|
end;
|
|
|
|
DateParts := 0;
|
|
FSepNoSpaceWidth := 0;
|
|
FSeparatorWidth := 0;
|
|
FMonthWidth := 0;
|
|
FDateWidth := 0;
|
|
FNullMonthText := '';
|
|
S := '';
|
|
if FKind in [dtkDate, dtkDateTime] then begin
|
|
|
|
for I := dtpDay to dtpYear do
|
|
if not (I in FEffectiveHideDateTimeParts) then begin
|
|
Inc(DateParts);
|
|
if I = dtpYear then begin
|
|
FDateWidth := FDateWidth + 4 * FDigitWidth;
|
|
end else if (I = dtpMonth) and FShowMonthNames then begin
|
|
FMonthWidth := FDigitWidth; // Minimal MonthWidth is DigitWidth.
|
|
for J := Low(TMonthNameArray) to High(TMonthNameArray) do begin
|
|
N := Canvas.GetTextWidth(FMonthNamesArray[J]);
|
|
if N > FMonthWidth then
|
|
FMonthWidth := N;
|
|
end;
|
|
|
|
N := Canvas.GetTextWidth(NullMonthChar);
|
|
if N > 0 then begin
|
|
N := FMonthWidth div N - 1;
|
|
if N > 1 then
|
|
FNullMonthText := StringOfChar(NullMonthChar, N);
|
|
end;
|
|
if N <= 1 then
|
|
FNullMonthText := NullMonthChar;
|
|
|
|
FDateWidth := FDateWidth + FMonthWidth;
|
|
end else
|
|
FDateWidth := FDateWidth + 2 * FDigitWidth;
|
|
|
|
end;
|
|
|
|
if DateParts > 0 then begin
|
|
if FTrailingSeparator then begin
|
|
FSepNoSpaceWidth := Canvas.GetTextWidth(TrimRight(FDateSeparator));
|
|
Inc(FDateWidth, FSepNoSpaceWidth);
|
|
end;
|
|
|
|
if DateParts > 1 then begin
|
|
FSeparatorWidth := Canvas.GetTextWidth(FDateSeparator);
|
|
S := FDateSeparator;
|
|
|
|
FDateWidth := FDateWidth + (DateParts - 1) * FSeparatorWidth;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
TimeParts := 0;
|
|
FTimeWidth := 0;
|
|
FAMPMWidth := 0;
|
|
FTimeSeparatorWidth := 0;
|
|
if FKind in [dtkTime, dtkDateTime] then begin
|
|
|
|
for I := dtpHour to dtpMiliSec do
|
|
if not (I in FEffectiveHideDateTimeParts) then begin
|
|
Inc(TimeParts);
|
|
|
|
if I = dtpMiliSec then
|
|
FTimeWidth := FTimeWidth + 3 * FDigitWidth
|
|
else
|
|
FTimeWidth := FTimeWidth + 2 * FDigitWidth;
|
|
|
|
end;
|
|
|
|
if TimeParts > 1 then begin
|
|
FTimeSeparatorWidth := Canvas.GetTextWidth(FTimeSeparator);
|
|
S := S + FTimeSeparator;
|
|
FTimeWidth := FTimeWidth + (TimeParts - 1) * FTimeSeparatorWidth;
|
|
end;
|
|
|
|
if not (dtpAMPM in FEffectiveHideDateTimeParts) then begin
|
|
S := S + 'APM';
|
|
FAMPMWidth := Max(Canvas.TextWidth('AM'), Canvas.TextWidth('PM'));
|
|
FTimeWidth := FTimeWidth + FDigitWidth + FAMPMWidth;
|
|
end;
|
|
|
|
end;
|
|
|
|
FTextWidth := FDateWidth + FTimeWidth;
|
|
if (DateParts > 0) and (TimeParts > 0) then
|
|
FTextWidth := FTextWidth + 2 * FDigitWidth;
|
|
|
|
FTextHeight := Canvas.GetTextHeight('0123456789' + S);
|
|
|
|
end;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetDay: Word;
|
|
begin
|
|
Result := GetYYYYMMDD.Day;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetMonth: Word;
|
|
begin
|
|
Result := GetYYYYMMDD.Month;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetYear: Word;
|
|
begin
|
|
Result := GetYYYYMMDD.Year;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetHMSMs(const NowIfNull: Boolean): THMSMs;
|
|
begin
|
|
if DateIsNull then begin
|
|
if NowIfNull then
|
|
DecodeTime(SysUtils.Time, Result.Hour, Result.Minute, Result.Second, Result.MiliSec)
|
|
else
|
|
with Result do begin
|
|
Hour := 0;
|
|
Minute := 0;
|
|
Second := 0;
|
|
MiliSec := 0;
|
|
end;
|
|
end else
|
|
DecodeTime(FDateTime, Result.Hour, Result.Minute, Result.Second, Result.MiliSec);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetYYYYMMDD(const TodayIfNull: Boolean;
|
|
const WithCorrection: Boolean): TYMD;
|
|
begin
|
|
if DateIsNull then begin
|
|
if TodayIfNull then
|
|
DecodeDate(SysUtils.Date, Result.Year, Result.Month, Result.Day)
|
|
else
|
|
with Result do begin
|
|
Day := 0;
|
|
Month := 0;
|
|
Year := 0;
|
|
end;
|
|
end else begin
|
|
DecodeDate(FDateTime, Result.Year, Result.Month, Result.Day);
|
|
if WithCorrection then begin
|
|
case FCorrectedDTP of
|
|
dtpDay:
|
|
Result.Day := FCorrectedValue;
|
|
dtpMonth:
|
|
Result.Month := FCorrectedValue;
|
|
dtpYear:
|
|
Result.Year := FCorrectedValue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetHour(const AValue: Word);
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectHour;
|
|
|
|
HMSMs := GetHMSMs(True);
|
|
HMSMs.Hour := AValue;
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMiliSec(const AValue: Word);
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMiliSec;
|
|
|
|
HMSMs := GetHMSMs(True);
|
|
HMSMs.MiliSec := AValue;
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMinute(const AValue: Word);
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMinute;
|
|
|
|
HMSMs := GetHMSMs(True);
|
|
HMSMs.Minute := AValue;
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetSecond(const AValue: Word);
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectSecond;
|
|
|
|
HMSMs := GetHMSMs(True);
|
|
HMSMs.Second := AValue;
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetSeparators(const DateSep, TimeSep: String);
|
|
var
|
|
SeparatorsChanged: Boolean;
|
|
begin
|
|
FUseDefaultSeparators := False;
|
|
SeparatorsChanged := False;
|
|
|
|
if FDateSeparator <> DateSep then begin
|
|
FDateSeparator := DateSep;
|
|
SeparatorsChanged := True;
|
|
end;
|
|
|
|
if FTimeSeparator <> TimeSep then begin
|
|
FTimeSeparator := TimeSep;
|
|
SeparatorsChanged := True;
|
|
end;
|
|
|
|
if SeparatorsChanged then begin
|
|
FRecalculatingTextSizesNeeded := True;
|
|
Invalidate;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDay(const AValue: Word);
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectDay;
|
|
YMD := GetYYYYMMDD(True, True);
|
|
|
|
YMD.Day := AValue;
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetMonth(const AValue: Word);
|
|
var
|
|
YMD: TYMD;
|
|
N: Word;
|
|
begin
|
|
SelectMonth;
|
|
YMD := GetYYYYMMDD(True, True);
|
|
|
|
YMD.Month := AValue;
|
|
|
|
N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
|
|
if YMD.Day > N then
|
|
YMD.Day := N;
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetYear(const AValue: Word);
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectYear;
|
|
|
|
YMD := GetYYYYMMDD(True, True);
|
|
YMD.Year := AValue;
|
|
if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
|
|
YMD.Day := 28;
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetYYYYMMDD(const AValue: TYMD);
|
|
var
|
|
D: TDateTime;
|
|
begin
|
|
if TryEncodeDate(AValue.Year, AValue.Month, AValue.Day, D) then
|
|
SetDate(D)
|
|
else
|
|
UpdateDate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetHMSMs(const AValue: THMSMs);
|
|
var
|
|
T: TDateTime;
|
|
begin
|
|
if TryEncodeTime(AValue.Hour, AValue.Minute,
|
|
AValue.Second, AValue.MiliSec, T) then
|
|
SetTime(T)
|
|
else
|
|
UpdateDate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UpdateIfUserChangedText;
|
|
var
|
|
W: Word;
|
|
S: String;
|
|
begin
|
|
if FUserChangedText then begin
|
|
Inc(FUserChanging);
|
|
try
|
|
FUserChangedText := False;
|
|
S := Trim(GetSelectedText);
|
|
|
|
if FSelectedTextPart = 8 then begin
|
|
W := GetHour;
|
|
if upCase(S[1]) = 'A' then begin
|
|
if W >= 12 then
|
|
Dec(W, 12);
|
|
end else begin
|
|
if W < 12 then
|
|
Inc(W, 12);
|
|
end;
|
|
SetHour(W);
|
|
FSelectedTextPart := 8;
|
|
end else begin
|
|
|
|
W := StrToInt(S);
|
|
case GetSelectedDateTimePart of
|
|
dtpYear:
|
|
begin
|
|
if Length(S) <= 2 then begin
|
|
// If user entered the year in two digit format (or even only
|
|
// one digit), we will set the year according to the CenturyFrom
|
|
// property (We actually use FEffectiveCenturyFrom field, which
|
|
// is adjusted to take care of MinDate and MaxDate properties,
|
|
// besides CenturyFrom).
|
|
if W >= (FEffectiveCenturyFrom mod 100) then
|
|
W := W + 100 * (FEffectiveCenturyFrom div 100)
|
|
else
|
|
W := W + 100 * (FEffectiveCenturyFrom div 100 + 1);
|
|
|
|
end;
|
|
SetYear(W);
|
|
end;
|
|
|
|
dtpDay:
|
|
SetDay(W);
|
|
|
|
dtpMonth:
|
|
SetMonth(W);
|
|
|
|
dtpHour:
|
|
begin
|
|
if (FTimeFormat = tf12) then begin
|
|
if GetHour < 12 then begin
|
|
if W = 12 then
|
|
SetHour(0)
|
|
else
|
|
SetHour(W);
|
|
end else begin
|
|
if W = 12 then
|
|
SetHour(W)
|
|
else
|
|
SetHour(W + 12);
|
|
end;
|
|
end else
|
|
SetHour(W);
|
|
end;
|
|
dtpMinute:
|
|
SetMinute(W);
|
|
dtpSecond:
|
|
SetSecond(W);
|
|
dtpMiliSec:
|
|
SetMiliSec(W);
|
|
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
FCorrectedDTP := dtpAMPM;
|
|
Dec(FUserChanging);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetSelectedText: String;
|
|
begin
|
|
if FSelectedTextPart <= 3 then
|
|
Result := FTextPart[FSelectedTextPart]
|
|
else
|
|
Result := FTimeText[TDateTimePart(FSelectedTextPart - 1)];
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AdjustSelection;
|
|
begin
|
|
if GetDateTimePartFromTextPart(FSelectedTextPart) in
|
|
FEffectiveHideDateTimeParts then
|
|
MoveSelectionLR(False);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AdjustEffectiveCenturyFrom;
|
|
var
|
|
Y1, Y2, M, D: Word;
|
|
begin
|
|
DecodeDate(FMinDate, Y1, M, D);
|
|
|
|
if Y1 > FCenturyFrom then
|
|
FEffectiveCenturyFrom := Y1 // If we use CenturyFrom which is set to value
|
|
// below MinDate's year, then when user enters two digit year, the
|
|
// DateTime would automatically be set to MinDate value, even though
|
|
// we perhaps allow same two-digit year in following centuries. It
|
|
// would be less user friendly.
|
|
// This is therefore better.
|
|
|
|
else begin
|
|
DecodeDate(FMaxDate, Y2, M, D);
|
|
|
|
if Y2 < 100 then
|
|
Y2 := 0
|
|
else
|
|
Dec(Y2, 99); // -- We should not use CenturyFrom if it is set to value
|
|
// greater then MaxDate's year minus 100 years.
|
|
// For example:
|
|
// if CenturyFrom = 1941 and MaxDate = 31.12.2025, then if user enters
|
|
// Year 33, we could not set the year to 2033 anyway, because of MaxDate
|
|
// limit. Note that if we just leave CenturyFrom to effectively remain as
|
|
// is, then in case of our example the DateTime would be automatically
|
|
// reduced to MaxDate value. Setting the year to 1933 is rather expected
|
|
// behaviour, so our internal field FEffectiveCenturyFrom should be 1926.
|
|
|
|
// Therefore:
|
|
if Y2 < FCenturyFrom then
|
|
FEffectiveCenturyFrom := Max(Y1, Y2)
|
|
else
|
|
FEffectiveCenturyFrom := FCenturyFrom; // -- FCenturyFrom has passed all
|
|
// our tests, so we'll really use it without any correction.
|
|
end;
|
|
end;
|
|
|
|
{ AdjustEffectiveDateDisplayOrder procedure
|
|
-------------------------------------------
|
|
If date display order ddoTryDefault is set, then we will decide which
|
|
display order to use according to ShortDateFormat global variable. This
|
|
procedure tries to achieve that by searching through short date format string,
|
|
to see which letter comes first -- d, m or y. When it finds any of these
|
|
characters, it assumes that date order should be d-m-y, m-d-y, or y-m-d
|
|
respectively. If the search through ShortDateFormat is unsuccessful by any
|
|
chance, we try the same with LongDateFormat global variable. If we don't
|
|
succeed again, we'll assume y-m-d order. }
|
|
procedure TCustomDateTimePicker.AdjustEffectiveDateDisplayOrder;
|
|
var
|
|
S: String;
|
|
I, J, Le: Integer;
|
|
InQuoteChar: Char;
|
|
begin
|
|
if FDateDisplayOrder = ddoTryDefault then begin
|
|
S := DefaultFormatSettings.ShortDateFormat;
|
|
FEffectiveDateDisplayOrder := ddoTryDefault;
|
|
|
|
repeat
|
|
InQuoteChar := Chr(0);
|
|
Le := Length(S);
|
|
|
|
I := 0;
|
|
while I < Le do begin
|
|
Inc(I);
|
|
if InQuoteChar = Chr(0) then begin
|
|
case S[I] of
|
|
'''', '"':
|
|
InQuoteChar := S[I];
|
|
'D', 'd':
|
|
begin
|
|
{ If 3 or more "d"-s are standing together, then it's day
|
|
of week, but here we are interested in day of month.
|
|
So, we have to see what is following: }
|
|
J := I + 1;
|
|
while (J <= Le) and (upCase(S[J]) = 'D') do
|
|
Inc(J);
|
|
|
|
if J <= I + 2 then begin
|
|
FEffectiveDateDisplayOrder := ddoDMY;
|
|
Break;
|
|
end;
|
|
|
|
I := J - 1;
|
|
end;
|
|
'M', 'm':
|
|
begin
|
|
FEffectiveDateDisplayOrder := ddoMDY;
|
|
Break;
|
|
end;
|
|
'Y', 'y':
|
|
begin
|
|
FEffectiveDateDisplayOrder := ddoYMD;
|
|
Break;
|
|
end;
|
|
end;
|
|
end else
|
|
if S[I] = InQuoteChar then
|
|
InQuoteChar := Chr(0);
|
|
|
|
end;
|
|
|
|
if FEffectiveDateDisplayOrder = ddoTryDefault then begin
|
|
{ We couldn't decide with ShortDateFormat, let's try with
|
|
LongDateFormat now. }
|
|
S := DefaultFormatSettings.LongDateFormat;
|
|
{ But now we must set something to be default. This ensures that the
|
|
repeat loop breaks next time. If we don't find anything in
|
|
LongDateFormat, we'll leave with y-m-d order. }
|
|
FEffectiveDateDisplayOrder := ddoYMD;
|
|
|
|
end else
|
|
Break;
|
|
|
|
until False;
|
|
|
|
end else
|
|
FEffectiveDateDisplayOrder := FDateDisplayOrder;
|
|
|
|
case FEffectiveDateDisplayOrder of
|
|
ddoDMY:
|
|
begin
|
|
FDayPos := 1;
|
|
FMonthPos := 2;
|
|
FYearPos := 3;
|
|
end;
|
|
ddoMDY:
|
|
begin
|
|
FDayPos := 2;
|
|
FMonthPos := 1;
|
|
FYearPos := 3;
|
|
end;
|
|
ddoYMD:
|
|
begin
|
|
FDayPos := 3;
|
|
FMonthPos := 2;
|
|
FYearPos := 1;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AdjustEffectiveHideDateTimeParts;
|
|
var
|
|
I: TDateTimePart;
|
|
PreviousEffectiveHideDateTimeParts: set of TDateTimePart;
|
|
begin
|
|
PreviousEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts;
|
|
FEffectiveHideDateTimeParts := [];
|
|
|
|
for I := Low(TDateTimeParts) to High(TDateTimeParts) do
|
|
if I in FHideDateTimeParts then
|
|
Include(FEffectiveHideDateTimeParts, I);
|
|
|
|
if FKind = dtkDate then
|
|
FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
|
|
[dtpHour, dtpMinute, dtpSecond, dtpMiliSec, dtpAMPM]
|
|
else begin
|
|
if FKind = dtkTime then
|
|
FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
|
|
[dtpDay, dtpMonth, dtpYear];
|
|
|
|
case FTimeDisplay of
|
|
tdHM:
|
|
FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
|
|
[dtpSecond, dtpMiliSec];
|
|
tdHMS:
|
|
FEffectiveHideDateTimeParts := FEffectiveHideDateTimeParts +
|
|
[dtpMiliSec];
|
|
end;
|
|
|
|
if (FTimeFormat = tf24) or (dtpHour in FEffectiveHideDateTimeParts) then
|
|
Include(FEffectiveHideDateTimeParts, dtpAMPM);
|
|
end;
|
|
|
|
if FEffectiveHideDateTimeParts
|
|
<> PreviousEffectiveHideDateTimeParts then begin
|
|
AdjustSelection;
|
|
FRecalculatingTextSizesNeeded := True;
|
|
UpdateShowArrowButton;
|
|
UpdateDate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectDateTimePart(
|
|
const DateTimePart: TDateTimePart);
|
|
begin
|
|
if not (DateTimePart in FEffectiveHideDateTimeParts) then begin
|
|
case DateTimePart of
|
|
dtpDay:
|
|
FSelectedTextPart := FDayPos;
|
|
dtpMonth:
|
|
FSelectedTextPart := FMonthPos;
|
|
dtpYear:
|
|
FSelectedTextPart := FYearPos;
|
|
else
|
|
FSelectedTextPart := 1 + Ord(DateTimePart);
|
|
end;
|
|
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DestroyCalendarForm;
|
|
begin
|
|
if Assigned(FCalendarForm) then begin
|
|
TDTCalendarForm(FCalendarForm).FClosing := True;
|
|
FCalendarForm.Release;
|
|
FCalendarForm := nil;
|
|
end;
|
|
end;
|
|
|
|
class function TCustomDateTimePicker.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.cx := 102;
|
|
Result.cy := 23;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.ConfirmChanges;
|
|
begin
|
|
UpdateIfUserChangedText;
|
|
FConfirmedDateTime := FDateTime;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UndoChanges;
|
|
begin
|
|
if FDateTime = FConfirmedDateTime then begin
|
|
Inc(FSkipChangeInUpdateDate); // prevents calling Change in UpdateDate,
|
|
try // but UpdateDate should be called anyway, because user might have
|
|
// changed text on screen and it should be updated to what it was.
|
|
UpdateDate;
|
|
finally
|
|
Dec(FSkipChangeInUpdateDate);
|
|
end;
|
|
end else begin
|
|
FDateTime := FConfirmedDateTime;
|
|
UpdateDate;
|
|
end;
|
|
|
|
end;
|
|
|
|
{ GetDateTimePartFromTextPart function
|
|
-----------------------------------------------
|
|
Returns part of date/time from the position (1-8). }
|
|
function TCustomDateTimePicker.GetDateTimePartFromTextPart(
|
|
TextPart: TTextPart): TDateTimePart;
|
|
begin
|
|
Result := TDateTimePart(TextPart - 1);
|
|
|
|
case FEffectiveDateDisplayOrder of
|
|
ddoMDY:
|
|
if Result = dtpDay then
|
|
Result := dtpMonth
|
|
else if Result = dtpMonth then
|
|
Result := dtpDay;
|
|
ddoYMD:
|
|
if Result = dtpDay then
|
|
Result := dtpYear
|
|
else if Result = dtpYear then
|
|
Result := dtpDay;
|
|
end;
|
|
end;
|
|
|
|
{ GetSelectedDateTimePart function
|
|
---------------------------------
|
|
Returns part of date/time which is currently selected. }
|
|
function TCustomDateTimePicker.GetSelectedDateTimePart: TDateTimePart;
|
|
begin
|
|
Result := GetDateTimePartFromTextPart(FSelectedTextPart);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.FontChanged(Sender: TObject);
|
|
begin
|
|
FRecalculatingTextSizesNeeded := True;
|
|
inherited FontChanged(Sender);
|
|
end;
|
|
|
|
{ GetTextOrigin
|
|
---------------
|
|
Returns upper left corner of the rectangle where the text is written.
|
|
Also used in calculating our preffered size. }
|
|
function TCustomDateTimePicker.GetTextOrigin(IgnoreRightToLeft: Boolean
|
|
): TPoint;
|
|
begin
|
|
Result.y := BorderSpacing.InnerBorder + BorderWidth;
|
|
if Assigned(FCheckBox) then
|
|
Result.x := Result.y + FCheckBox.BorderSpacing.Left
|
|
+ FCheckBox.BorderSpacing.Right + FCheckBox.Width
|
|
else
|
|
Result.x := Result.y;
|
|
|
|
if (not IgnoreRightToLeft) and IsRightToLeft then
|
|
Result.x := ClientWidth - Result.x - FTextWidth;
|
|
end;
|
|
|
|
{ MoveSelectionLR
|
|
-----------------
|
|
Moves selection to left or to right. If parameter ToLeft is true, then the
|
|
selection moves to left, otherwise to right. }
|
|
procedure TCustomDateTimePicker.MoveSelectionLR(const ToLeft: Boolean);
|
|
var
|
|
I, SafetyTextPart: TTextPart;
|
|
begin
|
|
UpdateIfUserChangedText;
|
|
|
|
SafetyTextPart := Low(TTextPart);
|
|
I := FSelectedTextPart;
|
|
repeat
|
|
if ToLeft then begin
|
|
if I <= Low(TTextPart) then
|
|
I := High(TTextPart)
|
|
else
|
|
Dec(I);
|
|
end else begin
|
|
if I >= High(TTextPart) then
|
|
I := Low(TTextPart)
|
|
else
|
|
Inc(I);
|
|
end;
|
|
|
|
if not (GetDateTimePartFromTextPart(I)
|
|
in FEffectiveHideDateTimeParts) then
|
|
FSelectedTextPart := I;
|
|
|
|
{ Is it possible that all parts are hidden? Yes it is!
|
|
So we need to ensure that this doesn't loop forever.
|
|
When this insurance text part gets to high value, break }
|
|
Inc(SafetyTextPart);
|
|
until (I = FSelectedTextPart) or (SafetyTextPart >= High(TTextPart));
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
Inc(FUserChanging);
|
|
try
|
|
if FTextEnabled then
|
|
inherited KeyDown(Key, Shift); // calls OnKeyDown event
|
|
|
|
CheckAndApplyKeyCode(Key);
|
|
finally
|
|
Dec(FUserChanging);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.KeyPress(var Key: char);
|
|
begin
|
|
if FTextEnabled then begin
|
|
Inc(FUserChanging);
|
|
try
|
|
inherited KeyPress(Key);
|
|
|
|
CheckAndApplyKey(Key);
|
|
finally
|
|
Dec(FUserChanging);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
{ SelectTextPartUnderMouse
|
|
--------------------------
|
|
This procedure determines which text part (date or time part -- day, month,
|
|
year, hour, minute...) should be selected in response to mouse message.
|
|
Used in MouseDown and DoMouseWheel methods. }
|
|
procedure TCustomDateTimePicker.SelectTextPartUnderMouse(XMouse: Integer);
|
|
var
|
|
I, M, NX: Integer;
|
|
InTime: Boolean;
|
|
DTP: TDateTimePart;
|
|
begin
|
|
UpdateIfUserChangedText;
|
|
SetFocusIfPossible;
|
|
|
|
if Focused then begin
|
|
// Calculating mouse position inside text
|
|
// in order to select date part under mouse cursor.
|
|
NX := XMouse - GetTextOrigin.x;
|
|
|
|
InTime := False;
|
|
if FTimeWidth > 0 then begin
|
|
if FDateWidth > 0 then begin
|
|
if NX >= FDateWidth + FDigitWidth then begin
|
|
InTime := True;
|
|
NX := NX - FDateWidth - 2 * FDigitWidth;
|
|
end;
|
|
end else
|
|
InTime := True;
|
|
end;
|
|
|
|
if InTime then begin
|
|
FSelectedTextPart := 8;
|
|
|
|
if (dtpAMPM in FEffectiveHideDateTimeParts) or
|
|
(NX < FTimeWidth - FAMPMWidth - FDigitWidth div 2) then begin
|
|
FSelectedTextPart := 7;
|
|
I := 4;
|
|
M := FTimeSeparatorWidth div 2;
|
|
while I <= 6 do begin
|
|
DTP := GetDateTimePartFromTextPart(I);
|
|
if not (DTP in FEffectiveHideDateTimeParts) then begin
|
|
Inc(M, 2 * FDigitWidth);
|
|
if M > NX then begin
|
|
FSelectedTextPart := I;
|
|
Break;
|
|
end;
|
|
|
|
Inc(M, FTimeSeparatorWidth);
|
|
end;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
end else if FDateWidth > 0 then begin
|
|
|
|
FSelectedTextPart := 3;
|
|
I := 1;
|
|
M := FSeparatorWidth div 2;
|
|
while I <= 2 do begin
|
|
if not(GetDateTimePartFromTextPart(I)
|
|
in FEffectiveHideDateTimeParts) then begin
|
|
if I = FYearPos then
|
|
Inc(M, 4 * FDigitWidth)
|
|
else if (I = FMonthPos) and FShowMonthNames then
|
|
Inc(M, FMonthWidth)
|
|
else
|
|
Inc(M, 2 * FDigitWidth);
|
|
|
|
if M > NX then begin
|
|
FSelectedTextPart := I;
|
|
Break;
|
|
end;
|
|
|
|
Inc(M, FSeparatorWidth);
|
|
end;
|
|
|
|
Inc(I);
|
|
end;
|
|
|
|
end;
|
|
|
|
if GetDateTimePartFromTextPart(FSelectedTextPart)
|
|
in FEffectiveHideDateTimeParts then
|
|
MoveSelectionLR(True);
|
|
|
|
Invalidate;
|
|
//-------------------------------------------------------
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if FTextEnabled then begin
|
|
SelectTextPartUnderMouse(X);
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end else
|
|
SetFocusIfPossible;
|
|
|
|
end;
|
|
|
|
function TCustomDateTimePicker.DoMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
|
begin
|
|
Result := False;
|
|
if FTextEnabled then begin
|
|
SelectTextPartUnderMouse(MousePos.x);
|
|
if not FReadOnly then begin
|
|
Inc(FUserChanging);
|
|
try
|
|
if WheelDelta < 0 then
|
|
DecreaseCurrentTextPart
|
|
else
|
|
IncreaseCurrentTextPart;
|
|
|
|
Result := True;
|
|
finally
|
|
Dec(FUserChanging);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
var
|
|
TextOrigin: TPoint;
|
|
M: Integer;
|
|
|
|
begin
|
|
RecalculateTextSizesIfNeeded;
|
|
TextOrigin := GetTextOrigin(True);
|
|
|
|
// We must use TextOrigin's x + y (x is, of course, left margin, but not right
|
|
// margin if check box is shown. However, y, which is top margin, always
|
|
// equals right margin).
|
|
PreferredWidth := TextOrigin.x + TextOrigin.y;
|
|
|
|
if Assigned(FUpDown) then
|
|
Inc(PreferredWidth, FUpDown.Width)
|
|
else if Assigned(FArrowButton) then
|
|
Inc(PreferredWidth, FArrowButton.Width);
|
|
|
|
PreferredWidth := PreferredWidth + FTextWidth;
|
|
|
|
M := Width - ClientWidth;
|
|
PreferredWidth := PreferredWidth + M;
|
|
|
|
PreferredHeight := 2 * TextOrigin.y + FTextHeight + M;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetBiDiMode(AValue: TBiDiMode);
|
|
begin
|
|
inherited SetBiDiMode(AValue);
|
|
ArrangeCtrls;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseCurrentTextPart;
|
|
begin
|
|
if DateIsNull then begin
|
|
if FSelectedTextPart <= 3 then
|
|
SetDateTime(SysUtils.Date)
|
|
else
|
|
SetDateTime(SysUtils.Now);
|
|
|
|
end else begin
|
|
case GetSelectedDateTimePart of
|
|
dtpDay: IncreaseDay;
|
|
dtpMonth: IncreaseMonth;
|
|
dtpYear: IncreaseYear;
|
|
dtpHour: IncreaseHour;
|
|
dtpMinute: IncreaseMinute;
|
|
dtpSecond: IncreaseSecond;
|
|
dtpMiliSec: IncreaseMiliSec;
|
|
dtpAMPM: ChangeAMPM;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseCurrentTextPart;
|
|
begin
|
|
if DateIsNull then begin
|
|
if FSelectedTextPart <= 3 then
|
|
SetDateTime(SysUtils.Date)
|
|
else
|
|
SetDateTime(SysUtils.Now);
|
|
|
|
end else begin
|
|
case GetSelectedDateTimePart of
|
|
dtpDay: DecreaseDay;
|
|
dtpMonth: DecreaseMonth;
|
|
dtpYear: DecreaseYear;
|
|
dtpHour: DecreaseHour;
|
|
dtpMinute: DecreaseMinute;
|
|
dtpSecond: DecreaseSecond;
|
|
dtpMiliSec: DecreaseMiliSec;
|
|
dtpAMPM: ChangeAMPM;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseMonth;
|
|
var
|
|
YMD: TYMD;
|
|
N: Word;
|
|
begin
|
|
SelectMonth;
|
|
if Cascade then
|
|
SetDateTime(IncMonth(DateTime))
|
|
else begin
|
|
YMD := GetYYYYMMDD(True);
|
|
|
|
if YMD.Month >= 12 then
|
|
YMD.Month := 1
|
|
else
|
|
Inc(YMD.Month);
|
|
|
|
N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
|
|
if YMD.Day > N then
|
|
YMD.Day := N;
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseYear;
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectYear;
|
|
YMD := GetYYYYMMDD(True);
|
|
|
|
Inc(YMD.Year);
|
|
if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
|
|
YMD.Day := 28;
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseDay;
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectDay;
|
|
if Cascade then
|
|
SetDateTime(IncDay(DateTime))
|
|
else begin
|
|
YMD := GetYYYYMMDD(True);
|
|
|
|
if YMD.Day >= NumberOfDaysInMonth(YMD.Month, YMD.Year) then
|
|
YMD.Day := 1
|
|
else
|
|
Inc(YMD.Day);
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseMonth;
|
|
var
|
|
YMD: TYMD;
|
|
N: Word;
|
|
begin
|
|
SelectMonth;
|
|
if Cascade then
|
|
SetDateTime(IncMonth(DateTime, -1))
|
|
else begin
|
|
YMD := GetYYYYMMDD(True);
|
|
|
|
if YMD.Month <= 1 then
|
|
YMD.Month := 12
|
|
else
|
|
Dec(YMD.Month);
|
|
|
|
N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
|
|
if YMD.Day > N then
|
|
YMD.Day := N;
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseYear;
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectYear;
|
|
YMD := GetYYYYMMDD(True);
|
|
Dec(YMD.Year);
|
|
if (YMD.Month = 2) and (YMD.Day > 28) and (not IsLeapYear(YMD.Year)) then
|
|
YMD.Day := 28;
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseDay;
|
|
var
|
|
YMD: TYMD;
|
|
begin
|
|
SelectDay;
|
|
if Cascade then
|
|
SetDateTime(IncDay(DateTime, -1))
|
|
else begin
|
|
YMD := GetYYYYMMDD(True);
|
|
|
|
if YMD.Day <= 1 then
|
|
YMD.Day := NumberOfDaysInMonth(YMD.Month, YMD.Year)
|
|
else
|
|
Dec(YMD.Day);
|
|
|
|
SetYYYYMMDD(YMD);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseHour;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectHour;
|
|
if Cascade then
|
|
SetDateTime(IncHour(DateTime))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Hour >= 23 then
|
|
HMSMs.Hour := 0
|
|
else
|
|
Inc(HMSMs.Hour);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseMinute;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMinute;
|
|
if Cascade then
|
|
SetDateTime(IncMinute(DateTime))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Minute >= 59 then
|
|
HMSMs.Minute := 0
|
|
else
|
|
Inc(HMSMs.Minute);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseSecond;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectSecond;
|
|
if Cascade then
|
|
SetDateTime(IncSecond(DateTime))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Second >= 59 then
|
|
HMSMs.Second := 0
|
|
else
|
|
Inc(HMSMs.Second);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.IncreaseMiliSec;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMiliSec;
|
|
if Cascade then
|
|
SetDateTime(IncMilliSecond(DateTime))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.MiliSec >= 999 then
|
|
HMSMs.MiliSec := 0
|
|
else
|
|
Inc(HMSMs.MiliSec);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseHour;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectHour;
|
|
if Cascade then
|
|
SetDateTime(IncHour(DateTime, -1))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Hour <= 0 then
|
|
HMSMS.Hour := 23
|
|
else
|
|
Dec(HMSMs.Hour);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseMinute;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMinute;
|
|
if Cascade then
|
|
SetDateTime(IncMinute(DateTime, -1))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Minute <= 0 then
|
|
HMSMs.Minute := 59
|
|
else
|
|
Dec(HMSMs.Minute);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseSecond;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectSecond;
|
|
if Cascade then
|
|
SetDateTime(IncSecond(DateTime, -1))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Second <= 0 then
|
|
HMSMs.Second := 59
|
|
else
|
|
Dec(HMSMs.Second);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DecreaseMiliSec;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectMiliSec;
|
|
if Cascade then
|
|
SetDateTime(IncMilliSecond(DateTime, -1))
|
|
else begin
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.MiliSec <= 0 then
|
|
HMSMs.MiliSec := 999
|
|
else
|
|
Dec(HMSMs.MiliSec);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.ChangeAMPM;
|
|
var
|
|
HMSMs: THMSMs;
|
|
begin
|
|
SelectAMPM;
|
|
HMSMs := GetHMSMs(True);
|
|
|
|
if HMSMs.Hour >= 12 then
|
|
Dec(HMSMS.Hour, 12)
|
|
else
|
|
Inc(HMSMS.Hour, 12);
|
|
|
|
SetHMSMs(HMSMs);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UpdateDate(const CallChangeFromSetDateTime: Boolean);
|
|
var
|
|
W: Array[1..3] of Word;
|
|
WT: Array[dtpHour..dtpAMPM] of Word;
|
|
DTP: TDateTimePart;
|
|
begin
|
|
FCorrectedDTP := dtpAMPM;
|
|
|
|
FUserChangedText := False;
|
|
|
|
if not (DateIsNull or FJumpMinMax) then begin
|
|
if Int(FDateTime) > FMaxDate then
|
|
FDateTime := ComposeDateTime(FMaxDate, FDateTime);
|
|
|
|
if FDateTime < FMinDate then
|
|
FDateTime := ComposeDateTime(FMinDate, FDateTime);
|
|
end;
|
|
|
|
if (FSkipChangeInUpdateDate = 0) then begin
|
|
// we'll skip the next part if called from UndoChanges
|
|
// and in recursive calls which could be made through calling Change
|
|
Inc(FSkipChangeInUpdateDate);
|
|
try
|
|
if (FUserChanging > 0) // the change is caused by user interaction
|
|
or CallChangeFromSetDateTime // call from SetDateTime with option dtpoDoChangeOnSetDateTime
|
|
then
|
|
try
|
|
Change;
|
|
except
|
|
UndoChanges;
|
|
raise;
|
|
end;
|
|
|
|
if FUserChanging = 0 then
|
|
FConfirmedDateTime := FDateTime;
|
|
|
|
finally
|
|
Dec(FSkipChangeInUpdateDate);
|
|
end;
|
|
end;
|
|
|
|
if DateIsNull then begin
|
|
if dtpYear in FEffectiveHideDateTimeParts then
|
|
FTextPart[FYearPos] := ''
|
|
else
|
|
FTextPart[FYearPos] := '0000';
|
|
|
|
if dtpMonth in FEffectiveHideDateTimeParts then
|
|
FTextPart[FMonthPos] := ''
|
|
else
|
|
FTextPart[FMonthPos] := '00';
|
|
|
|
if dtpDay in FEffectiveHideDateTimeParts then
|
|
FTextPart[FDayPos] := ''
|
|
else
|
|
FTextPart[FDayPos] := '00';
|
|
|
|
for DTP := dtpHour to dtpAMPM do begin
|
|
if DTP in FEffectiveHideDateTimeParts then
|
|
FTimeText[DTP] := ''
|
|
else if DTP = dtpAMPM then
|
|
FTimeText[DTP] := 'XX'
|
|
else if DTP = dtpMiliSec then
|
|
FTimeText[DTP] := '999'
|
|
else
|
|
FTimeText[DTP] := '99';
|
|
end;
|
|
|
|
end else begin
|
|
DecodeDate(FDateTime, W[3], W[2], W[1]);
|
|
|
|
if dtpYear in FEffectiveHideDateTimeParts then
|
|
FTextPart[FYearPos] := ''
|
|
else if FLeadingZeros then
|
|
FTextPart[FYearPos] := RightStr('000' + IntToStr(W[3]), 4)
|
|
else
|
|
FTextPart[FYearPos] := IntToStr(W[3]);
|
|
|
|
if dtpMonth in FEffectiveHideDateTimeParts then
|
|
FTextPart[FMonthPos] := ''
|
|
else if FShowMonthNames then
|
|
FTextPart[FMonthPos] := FMonthNamesArray[W[2]]
|
|
else if FLeadingZeros then
|
|
FTextPart[FMonthPos] := RightStr('0' + IntToStr(W[2]), 2)
|
|
else
|
|
FTextPart[FMonthPos] := IntToStr(W[2]);
|
|
|
|
if dtpDay in FEffectiveHideDateTimeParts then
|
|
FTextPart[FDayPos] := ''
|
|
else if FLeadingZeros then
|
|
FTextPart[FDayPos] := RightStr('0' + IntToStr(W[1]), 2)
|
|
else
|
|
FTextPart[FDayPos] := IntToStr(W[1]);
|
|
|
|
DecodeTime(FDateTime, WT[dtpHour], WT[dtpMinute], WT[dtpSecond], WT[dtpMiliSec]);
|
|
|
|
if dtpAMPM in FEffectiveHideDateTimeParts then
|
|
FTimeText[dtpAMPM] := ''
|
|
else begin
|
|
if WT[dtpHour] < 12 then begin
|
|
FTimeText[dtpAMPM] := 'AM';
|
|
if WT[dtpHour] = 0 then
|
|
WT[dtpHour] := 12;
|
|
end else begin
|
|
FTimeText[dtpAMPM] := 'PM';
|
|
if WT[dtpHour] > 12 then
|
|
Dec(WT[dtpHour], 12);
|
|
end;
|
|
end;
|
|
|
|
for DTP := dtpHour to dtpMiliSec do begin
|
|
if DTP in FEffectiveHideDateTimeParts then
|
|
FTimeText[DTP] := ''
|
|
else if (DTP = dtpHour) and (not FLeadingZeros) then
|
|
FTimeText[DTP] := IntToStr(WT[dtpHour])
|
|
else if DTP = dtpMiliSec then
|
|
FTimeText[DTP] := RightStr('00' + IntToStr(WT[DTP]), 3)
|
|
else
|
|
FTimeText[DTP] := RightStr('0' + IntToStr(WT[DTP]), 2);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if HandleAllocated then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DoEnter;
|
|
begin
|
|
inherited DoEnter;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DoExit;
|
|
begin
|
|
inherited DoExit;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.Click;
|
|
begin
|
|
if FTextEnabled then
|
|
inherited Click;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DblClick;
|
|
begin
|
|
if FTextEnabled then
|
|
inherited DblClick;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if FTextEnabled then
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if FTextEnabled then
|
|
inherited KeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
|
begin
|
|
if FTextEnabled then
|
|
inherited UTF8KeyPress(UTF8Key);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectDay;
|
|
begin
|
|
SelectDateTimePart(dtpDay);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectMonth;
|
|
begin
|
|
SelectDateTimePart(dtpMonth);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectYear;
|
|
begin
|
|
SelectDateTimePart(dtpYear);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SendExternalKey(const aKey: Char);
|
|
var
|
|
K: Word;
|
|
begin
|
|
if FTextEnabled then begin
|
|
if aKey in ['n', 'N'] then begin
|
|
K := VK_N;
|
|
CheckAndApplyKeyCode(K);
|
|
end else
|
|
CheckAndApplyKey(aKey);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SendExternalKeyCode(const Key: Word);
|
|
var
|
|
Ch: Char;
|
|
K: Word;
|
|
begin
|
|
if Key in [Ord('0')..Ord('9'), Ord('a'), Ord('A'), Ord('p'), Ord('P')] then begin
|
|
if FTextEnabled then begin
|
|
Ch := Char(Key);
|
|
CheckAndApplyKey(Ch);
|
|
end;
|
|
end else begin
|
|
K := Key;
|
|
CheckAndApplyKeyCode(K);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.RemoveAllHandlersOfObject(AnObject: TObject);
|
|
begin
|
|
inherited RemoveAllHandlersOfObject(AnObject);
|
|
|
|
if Assigned(FOnChangeHandlers) then
|
|
FOnChangeHandlers.RemoveAllMethodsOfObject(AnObject);
|
|
|
|
if Assigned(FOnCheckBoxChangeHandlers) then
|
|
FOnCheckBoxChangeHandlers.RemoveAllMethodsOfObject(AnObject);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectHour;
|
|
begin
|
|
SelectDateTimePart(dtpHour);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectMinute;
|
|
begin
|
|
SelectDateTimePart(dtpMinute);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectSecond;
|
|
begin
|
|
SelectDateTimePart(dtpSecond);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectMiliSec;
|
|
begin
|
|
SelectDateTimePart(dtpMiliSec);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectAMPM;
|
|
begin
|
|
SelectDateTimePart(dtpAMPM);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetEnabled(Value: Boolean);
|
|
begin
|
|
if GetEnabled <> Value then begin
|
|
inherited SetEnabled(Value);
|
|
CheckTextEnabled;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetAutoSize(Value: Boolean);
|
|
begin
|
|
if AutoSize <> Value then begin
|
|
if Value then
|
|
InvalidatePreferredSize;
|
|
|
|
inherited SetAutoSize(Value);
|
|
end;
|
|
end;
|
|
|
|
// I had to override CreateWnd, because in design time on Linux Lazarus crashes
|
|
// if we try to do anchoring of child controls in constructor.
|
|
// Therefore, I needed to ensure that controls anchoring does not take place
|
|
// before CreateWnd has done. So, I moved all anchoring code to a procedure
|
|
// ArrangeCtrls and introduced a boolean field FDoNotArrangeControls which
|
|
// prevents that code from executing before CreateWnd.
|
|
//!!! Later, I simplified the arranging procedure, so maybe it can be done now
|
|
// before window creation is done. It's better to leave this delay system,
|
|
// anyway -- we might change anchoring code again for some reason.
|
|
procedure TCustomDateTimePicker.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
|
|
if FDoNotArrangeControls then begin { This field is set to True in constructor.
|
|
Its purpose is to prevent control anchoring until this point. That's because
|
|
on Linux Lazarus crashes when control is dropped on form in designer if
|
|
particular anchoring code executes before CreateWnd has done its job. }
|
|
FDoNotArrangeControls := False;
|
|
ArrangeCtrls;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetDateTimeJumpMinMax(const AValue: TDateTime);
|
|
begin
|
|
FJumpMinMax := True;
|
|
try
|
|
SetDateTime(AValue);
|
|
finally
|
|
FJumpMinMax := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.ArrangeCtrls;
|
|
var
|
|
C: TControl;
|
|
begin
|
|
if not FDoNotArrangeControls then begin //Read the note above CreateWnd procedure.
|
|
DisableAlign;
|
|
try
|
|
if GetShowCheckBox then begin
|
|
if IsRightToLeft then begin
|
|
FCheckBox.Align := alRight;
|
|
FCheckBox.BorderSpacing.Left := 0;
|
|
FCheckBox.BorderSpacing.Right := 2;
|
|
end else begin
|
|
FCheckBox.Align := alLeft;
|
|
FCheckBox.BorderSpacing.Left := 2;
|
|
FCheckBox.BorderSpacing.Right := 0;
|
|
end;
|
|
FCheckBox.BringToFront;
|
|
end;
|
|
|
|
if Assigned(FUpDown) then
|
|
C := FUpDown
|
|
else if Assigned(FArrowButton) then
|
|
C := FArrowButton
|
|
else
|
|
C := nil;
|
|
|
|
if Assigned(C) then begin
|
|
if IsRightToLeft then
|
|
C.Align := alLeft
|
|
else
|
|
C.Align := alRight;
|
|
|
|
C.BringToFront;
|
|
end;
|
|
|
|
CheckTextEnabled;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
|
|
Invalidate;
|
|
finally
|
|
EnableAlign;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
if FOnChangeHandlers<>nil then
|
|
FOnChangeHandlers.CallNotifyEvents(Self);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectDate;
|
|
begin
|
|
if (FSelectedTextPart > 3)
|
|
or (GetDateTimePartFromTextPart(FSelectedTextPart)
|
|
in FEffectiveHideDateTimeParts) then
|
|
FSelectedTextPart := 1;
|
|
|
|
if GetDateTimePartFromTextPart(FSelectedTextPart)
|
|
in FEffectiveHideDateTimeParts then
|
|
MoveSelectionLR(False);
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SelectTime;
|
|
begin
|
|
if (FSelectedTextPart < 4)
|
|
or (GetDateTimePartFromTextPart(FSelectedTextPart)
|
|
in FEffectiveHideDateTimeParts) then
|
|
FSelectedTextPart := 4;
|
|
|
|
if GetDateTimePartFromTextPart(FSelectedTextPart)
|
|
in FEffectiveHideDateTimeParts then
|
|
MoveSelectionLR(False);
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.Paint;
|
|
var
|
|
I, M, N, K, L: Integer;
|
|
DD: Array[1..8] of Integer;
|
|
R: TRect;
|
|
SelectStep: 0..8;
|
|
TextStyle: TTextStyle;
|
|
DTP: TDateTimePart;
|
|
S: String;
|
|
|
|
begin
|
|
if ClientRectNeedsInterfaceUpdate then // In Qt widgetset, this solves the
|
|
DoAdjustClientRectChange; // problem of dispositioned client rect.
|
|
|
|
if FRecalculatingTextSizesNeeded then begin
|
|
if AutoSize then begin
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
end;
|
|
|
|
RecalculateTextSizesIfNeeded;
|
|
end;
|
|
|
|
TextStyle := Canvas.TextStyle;
|
|
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.FillRect(ClientRect);
|
|
|
|
R.TopLeft := GetTextOrigin;
|
|
|
|
M := 2 * R.Top + FTextHeight;
|
|
M := (ClientHeight - M) div 2;
|
|
|
|
Inc(R.Top, M);
|
|
|
|
R.Bottom := R.Top + FTextHeight;
|
|
|
|
TextStyle.Layout := tlCenter;
|
|
TextStyle.Wordbreak := False;
|
|
TextStyle.Opaque := False;
|
|
TextStyle.RightToLeft := IsRightToLeft;
|
|
|
|
if DateIsNull and (FTextForNullDate <> '')
|
|
and (not (FTextEnabled and Focused)) then begin
|
|
|
|
if IsRightToLeft then begin
|
|
TextStyle.Alignment := taRightJustify;
|
|
R.Right := R.Left + FTextWidth;
|
|
R.Left := 0;
|
|
end else begin
|
|
TextStyle.Alignment := taLeftJustify;
|
|
R.Right := Width;
|
|
end;
|
|
|
|
if FTextEnabled then
|
|
Canvas.Font.Color := Font.Color
|
|
else
|
|
Canvas.Font.Color := clGrayText;
|
|
|
|
Canvas.TextRect(R, R.Left, R.Top, FTextForNullDate, TextStyle);
|
|
|
|
end else begin
|
|
TextStyle.Alignment := taRightJustify;
|
|
|
|
SelectStep := 0;
|
|
if FTextEnabled then begin
|
|
Canvas.Font.Color := Font.Color;
|
|
if Focused then
|
|
SelectStep := FSelectedTextPart;
|
|
end else begin
|
|
Canvas.Font.Color := clGrayText;
|
|
end;
|
|
|
|
if dtpYear in FEffectiveHideDateTimeParts then begin
|
|
DD[FYearPos] := 0;
|
|
M := 4;
|
|
L := 0;
|
|
end else begin
|
|
DD[FYearPos] := 4 * FDigitWidth;
|
|
M := FYearPos;
|
|
L := FYearPos;
|
|
end;
|
|
|
|
if dtpMonth in FEffectiveHideDateTimeParts then
|
|
DD[FMonthPos] := 0
|
|
else begin
|
|
if FShowMonthNames then
|
|
DD[FMonthPos] := FMonthWidth
|
|
else
|
|
DD[FMonthPos] := 2 * FDigitWidth;
|
|
|
|
if FMonthPos < M then
|
|
M := FMonthPos;
|
|
|
|
if FMonthPos > L then
|
|
L := FMonthPos;
|
|
|
|
end;
|
|
|
|
if dtpDay in FEffectiveHideDateTimeParts then
|
|
DD[FDayPos] := 0
|
|
else begin
|
|
DD[FDayPos] := 2 * FDigitWidth;
|
|
if FDayPos < M then
|
|
M := FDayPos;
|
|
if FDayPos > L then
|
|
L := FDayPos;
|
|
end;
|
|
|
|
N := 3;
|
|
K := 3;
|
|
for DTP := dtpHour to dtpAMPM do begin
|
|
I := Ord(DTP) + 1;
|
|
if DTP in FEffectiveHideDateTimeParts then
|
|
DD[I] := 0
|
|
else if DTP = dtpAMPM then begin
|
|
DD[I] := FAMPMWidth;
|
|
N := I;
|
|
end else begin
|
|
if DTP = dtpMiliSec then
|
|
DD[I] := 3 * FDigitWidth
|
|
else
|
|
DD[I] := 2 * FDigitWidth;
|
|
|
|
if K < I then
|
|
K := I;
|
|
end;
|
|
|
|
if N < K then
|
|
N := K;
|
|
|
|
end;
|
|
|
|
for I := M to N do begin
|
|
if DD[I] <> 0 then begin
|
|
|
|
R.Right := R.Left + DD[I];
|
|
if I <= 3 then begin
|
|
if (I = FMonthPos) and FShowMonthNames then begin
|
|
TextStyle.Alignment := taCenter;
|
|
if DateIsNull then
|
|
S := FNullMonthText
|
|
else
|
|
S := FTextPart[I];
|
|
end else
|
|
S := FTextPart[I];
|
|
|
|
end else
|
|
S := FTimeText[TDateTimePart(I - 1)];
|
|
|
|
if I = SelectStep then begin
|
|
TextStyle.Opaque := True;
|
|
Canvas.Brush.Color := clHighlight;
|
|
Canvas.Font.Color := clHighlightText;
|
|
|
|
Canvas.TextRect(R, R.Left, R.Top, S, TextStyle);
|
|
|
|
TextStyle.Opaque := False;
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.Font.Color := Self.Font.Color;
|
|
end else
|
|
Canvas.TextRect(R, R.Left, R.Top, S, TextStyle);
|
|
|
|
TextStyle.Alignment := taRightJustify;
|
|
R.Left := R.Right;
|
|
|
|
if I < L then begin
|
|
R.Right := R.Left + FSeparatorWidth;
|
|
if not ((I = FMonthPos) and FShowMonthNames) then
|
|
Canvas.TextRect(R, R.Left, R.Top, FDateSeparator, TextStyle);
|
|
end else if I > L then begin
|
|
if I = K then begin
|
|
R.Right := R.Left + FDigitWidth;
|
|
end else if I < K then begin
|
|
R.Right := R.Left + FTimeSeparatorWidth;
|
|
Canvas.TextRect(R, R.Left, R.Top, FTimeSeparator, TextStyle);
|
|
end;
|
|
end else begin
|
|
if FTrailingSeparator then begin
|
|
R.Right := R.Left + FSepNoSpaceWidth;
|
|
Canvas.TextRect(R, R.Left, R.Top,
|
|
TrimRight(FDateSeparator), TextStyle);
|
|
end;
|
|
if FTimeWidth > 0 then
|
|
R.Right := R.Right + 2 * FDigitWidth;
|
|
|
|
end;
|
|
R.Left := R.Right;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
inherited Paint;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.EditingDone;
|
|
begin
|
|
if FNoEditingDone <= 0 then begin
|
|
ConfirmChanges;
|
|
|
|
inherited EditingDone;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.ArrowMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
DropDownCalendarForm;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UpDownClick(Sender: TObject;
|
|
Button: TUDBtnType);
|
|
begin
|
|
SetFocusIfPossible;
|
|
|
|
if not FReadOnly then begin
|
|
Inc(FUserChanging);
|
|
try
|
|
if Button = btNext then
|
|
IncreaseCurrentTextPart
|
|
else
|
|
DecreaseCurrentTextPart;
|
|
finally
|
|
Dec(FUserChanging);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DoDropDown;
|
|
begin
|
|
if Assigned(FOnDropDown) then
|
|
FOnDropDown(Self);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DoCloseUp;
|
|
begin
|
|
if Assigned(FOnCloseUp) then
|
|
FOnCloseUp(Self);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetChecked: Boolean;
|
|
begin
|
|
Result := (not Assigned(FCheckBox)) or (FCheckBox.State = cbChecked);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.AreSeparatorsStored: Boolean;
|
|
begin
|
|
Result := not FUseDefaultSeparators;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetDate: TDate;
|
|
begin
|
|
if DateIsNull then
|
|
Result := NullDate
|
|
else
|
|
Result := Int(FDateTime);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetDateTime: TDateTime;
|
|
begin
|
|
if DateIsNull then
|
|
Result := NullDate
|
|
else
|
|
Result := FDateTime;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetDroppedDown: Boolean;
|
|
begin
|
|
Result := Assigned(FCalendarForm);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetShowCheckBox: Boolean;
|
|
begin
|
|
Result := Assigned(FCheckBox);
|
|
end;
|
|
|
|
function TCustomDateTimePicker.GetTime: TTime;
|
|
begin
|
|
if DateIsNull then
|
|
Result := NullDate
|
|
else
|
|
Result := Abs(Frac(FDateTime));
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetArrowShape(const AValue: TArrowShape);
|
|
begin
|
|
if FArrowShape = AValue then Exit;
|
|
|
|
FArrowShape := AValue;
|
|
if FArrowButton<>nil then
|
|
FArrowButton.Invalidate;
|
|
end;
|
|
|
|
const
|
|
DefaultUpDownWidth = 15;
|
|
DefaultArrowButtonWidth = DefaultUpDownWidth + 2;
|
|
|
|
procedure TCustomDateTimePicker.SetAutoButtonSize(AValue: Boolean);
|
|
begin
|
|
if FAutoButtonSize <> AValue then begin
|
|
FAutoButtonSize := AValue;
|
|
|
|
if AValue then
|
|
AutoResizeButton
|
|
else begin
|
|
if Assigned(FUpDown) then
|
|
FUpDown.Width := DefaultUpDownWidth
|
|
else if Assigned(FArrowButton) then
|
|
FArrowButton.Width := DefaultArrowButtonWidth;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetCalAlignment(AValue: TDTCalAlignment);
|
|
begin
|
|
if FCalAlignment = AValue then Exit;
|
|
FCalAlignment := AValue;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetCalendarWrapperClass(
|
|
AValue: TCalendarControlWrapperClass);
|
|
begin
|
|
if FCalendarWrapperClass = AValue then Exit;
|
|
FCalendarWrapperClass := AValue;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetCenturyFrom(const AValue: Word);
|
|
begin
|
|
if FCenturyFrom = AValue then Exit;
|
|
|
|
FCenturyFrom := AValue;
|
|
AdjustEffectiveCenturyFrom;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CheckBoxChange(Sender: TObject);
|
|
begin
|
|
CheckTextEnabled;
|
|
SetFocusIfPossible;
|
|
|
|
CheckBoxChange;
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CheckBoxChange;
|
|
begin
|
|
if Assigned(FOnCheckBoxChange) then
|
|
FOnCheckBoxChange(Self);
|
|
|
|
if FOnCheckBoxChangeHandlers<>nil then
|
|
FOnCheckBoxChangeHandlers.CallNotifyEvents(Self);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.SetFocusIfPossible;
|
|
var
|
|
F: TCustomForm;
|
|
|
|
begin
|
|
Inc(FNoEditingDone);
|
|
try
|
|
F := GetParentForm(Self);
|
|
|
|
if Assigned(F) and F.CanFocus and CanTab then
|
|
SetFocus;
|
|
|
|
finally
|
|
Dec(FNoEditingDone);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AutoResizeButton;
|
|
begin
|
|
if Assigned(FArrowButton) then
|
|
FArrowButton.Width := MulDiv(ClientHeight, 9, 10)
|
|
else if Assigned(FUpDown) then
|
|
FUpDown.Width := MulDiv(ClientHeight, 79, 100);
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CheckAndApplyKey(const Key: Char);
|
|
var
|
|
S: String;
|
|
DTP: TDateTimePart;
|
|
N, L: Integer;
|
|
YMD: TYMD;
|
|
HMSMs: THMSMs;
|
|
D, T: TDateTime;
|
|
Finished, ForceChange: Boolean;
|
|
|
|
begin
|
|
if (not FReadOnly) then begin
|
|
Finished := False;
|
|
ForceChange := False;
|
|
|
|
if FSelectedTextPart = 8 then begin
|
|
case upCase(Key) of
|
|
'A': S := 'AM';
|
|
'P': S := 'PM';
|
|
else
|
|
Finished := True;
|
|
end;
|
|
ForceChange := True;
|
|
|
|
end else if Key in ['0'..'9'] then begin
|
|
|
|
DTP := GetSelectedDateTimePart;
|
|
|
|
if DTP = dtpYear then
|
|
N := 4
|
|
else if DTP = dtpMiliSec then
|
|
N := 3
|
|
else
|
|
N := 2;
|
|
|
|
S := Trim(GetSelectedText);
|
|
if FUserChangedText and (Length(S) < N) then
|
|
S := S + Key
|
|
else
|
|
S := Key;
|
|
|
|
if (Length(S) >= N) then begin
|
|
|
|
FCorrectedDTP := dtpAMPM;
|
|
|
|
L := StrToInt(S);
|
|
if DTP < dtpHour then begin
|
|
YMD := GetYYYYMMDD(True);
|
|
case DTP of
|
|
dtpDay: YMD.Day := L;
|
|
dtpMonth: YMD.Month := L;
|
|
dtpYear: YMD.Year := L;
|
|
end;
|
|
|
|
if AutoAdvance and (YMD.Day <= 31) and
|
|
(YMD.Day > NumberOfDaysInMonth(YMD.Month, YMD.Year)) then begin
|
|
case DTP of
|
|
dtpDay:
|
|
case FEffectiveDateDisplayOrder of
|
|
ddoDMY: begin
|
|
FCorrectedValue := YMD.Month + 1;
|
|
FCorrectedDTP := dtpMonth;
|
|
end;
|
|
ddoMDY:
|
|
FCorrectedDTP := dtpYear;
|
|
end;
|
|
dtpMonth:
|
|
case FEffectiveDateDisplayOrder of
|
|
ddoMDY, ddoYMD: begin
|
|
FCorrectedValue := NumberOfDaysInMonth(YMD.Month, YMD.Year);
|
|
FCorrectedDTP := dtpDay;
|
|
end;
|
|
ddoDMY:
|
|
FCorrectedDTP := dtpYear;
|
|
end;
|
|
dtpYear:
|
|
if (FEffectiveDateDisplayOrder = ddoYMD) and (YMD.Month = 2)
|
|
and (YMD.Day = 29) and not IsLeapYear(YMD.Year) then begin
|
|
FCorrectedValue := YMD.Month + 1;
|
|
FCorrectedDTP := dtpMonth;
|
|
end;
|
|
end;
|
|
|
|
case FCorrectedDTP of
|
|
dtpDay:
|
|
YMD.Day := FCorrectedValue;
|
|
dtpMonth:
|
|
YMD.Month := FCorrectedValue;
|
|
dtpYear:
|
|
if (YMD.Day = 29) and (YMD.Month = 2) then begin
|
|
while not IsLeapYear(YMD.Year) do
|
|
Inc(YMD.Year);
|
|
FCorrectedValue := YMD.Year;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
if TryEncodeDate(YMD.Year, YMD.Month, YMD.Day, D)
|
|
and (D >= MinDate) and (D <= MaxDate) then
|
|
ForceChange := True
|
|
else if N = 4 then begin
|
|
UpdateDate;
|
|
Finished := True;
|
|
end else
|
|
S := Key;
|
|
|
|
end else begin
|
|
if (DTP = dtpHour) and (FTimeFormat = tf12) then begin
|
|
if not (L in [1..12]) then
|
|
S := Key
|
|
else
|
|
ForceChange := True;
|
|
|
|
end else begin
|
|
|
|
HMSMs := GetHMSMs(True);
|
|
case DTP of
|
|
dtpHour: HMSMs.Hour := L;
|
|
dtpMinute: HMSMs.Minute := L;
|
|
dtpSecond: HMSMs.Second := L;
|
|
dtpMiliSec: HMSMs.MiliSec := L;
|
|
end;
|
|
if not TryEncodeTime(HMSMs.Hour, HMSMs.Minute, HMSMs.Second,
|
|
HMSMs.MiliSec, T) then
|
|
S := Key
|
|
else
|
|
ForceChange := True;
|
|
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end else
|
|
Finished := True;
|
|
|
|
if (not Finished) and (GetSelectedText <> S) then begin
|
|
if (not FUserChangedText) and DateIsNull then
|
|
if FSelectedTextPart <= 3 then
|
|
DateTime := SysUtils.Date
|
|
else
|
|
DateTime := SysUtils.Now;
|
|
|
|
if (not FLeadingZeros) and (FSelectedTextPart <= 4) then
|
|
while (Length(S) > 1) and (S[1] = '0') do
|
|
Delete(S, 1, 1);
|
|
|
|
if FSelectedTextPart <= 3 then
|
|
FTextPart[FSelectedTextPart] := S
|
|
else
|
|
FTimeText[TDateTimePart(FSelectedTextPart - 1)] := S;
|
|
|
|
FUserChangedText := True;
|
|
|
|
if ForceChange then begin
|
|
if FAutoAdvance then begin
|
|
MoveSelectionLR(False);
|
|
Invalidate;
|
|
end else
|
|
UpdateIfUserChangedText;
|
|
end else
|
|
Invalidate;
|
|
|
|
DoAutoCheck;
|
|
end;
|
|
|
|
FCorrectedDTP := dtpAMPM;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.CheckAndApplyKeyCode(var Key: Word);
|
|
var
|
|
K: Word;
|
|
begin
|
|
if (Key = VK_SPACE) then begin
|
|
if GetShowCheckBox then
|
|
FCheckBox.Checked := not FCheckBox.Checked;
|
|
|
|
end else if FTextEnabled then begin
|
|
|
|
case Key of
|
|
VK_LEFT, VK_RIGHT, VK_OEM_COMMA, VK_OEM_PERIOD, VK_DIVIDE,
|
|
VK_OEM_MINUS, VK_SEPARATOR, VK_DECIMAL, VK_SUBTRACT:
|
|
begin
|
|
K := Key;
|
|
Key := 0;
|
|
MoveSelectionLR(K = VK_LEFT);
|
|
Invalidate;
|
|
end;
|
|
VK_UP:
|
|
begin
|
|
Key := 0;
|
|
UpdateIfUserChangedText;
|
|
if not FReadOnly then
|
|
begin
|
|
IncreaseCurrentTextPart;
|
|
DoAutoCheck;
|
|
end;
|
|
end;
|
|
VK_DOWN:
|
|
begin
|
|
Key := 0;
|
|
UpdateIfUserChangedText;
|
|
if not FReadOnly then
|
|
begin
|
|
DecreaseCurrentTextPart;
|
|
DoAutoCheck;
|
|
end;
|
|
end;
|
|
VK_RETURN:
|
|
if not FReadOnly then
|
|
EditingDone;
|
|
|
|
VK_ESCAPE:
|
|
if not FReadOnly then begin
|
|
UndoChanges;
|
|
EditingDone;
|
|
end;
|
|
VK_N:
|
|
if (not FReadOnly) and FNullInputAllowed then
|
|
SetDateTime(NullDate);
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.WMKillFocus(var Message: TLMKillFocus);
|
|
begin
|
|
// On Qt it seems that WMKillFocus happens even when focus jumps to some other
|
|
// form. This behaviour differs from win and gtk 2 (where it happens only when
|
|
// focus jumps to other control on the same form) and we should prevent it at
|
|
// least for our calendar, because it triggers EditingDone.
|
|
if Screen.ActiveCustomForm <> FCalendarForm then
|
|
inherited WMKillFocus(Message);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.WMSize(var Message: TLMSize);
|
|
begin
|
|
inherited WMSize(Message);
|
|
|
|
if FAutoButtonSize then
|
|
AutoResizeButton;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DropDownCalendarForm;
|
|
begin
|
|
SetFocusIfPossible;
|
|
|
|
if FAllowDroppingCalendar then begin
|
|
if not (FReadOnly or Assigned(FCalendarForm)
|
|
or (csDesigning in ComponentState)) then begin
|
|
FCalendarForm := TDTCalendarForm.CreateNewDTCalendarForm(nil, Self);
|
|
FCalendarForm.Show;
|
|
end;
|
|
|
|
end else begin
|
|
DestroyCalendarForm;
|
|
FAllowDroppingCalendar := True;
|
|
end;
|
|
|
|
end;
|
|
|
|
{ TDTUpDown }
|
|
|
|
{ When our UpDown control gets enabled/disabled, the two its buttons' Enabled
|
|
property is set accordingly. }
|
|
procedure TDTUpDown.SetEnabled(Value: Boolean);
|
|
|
|
procedure SetEnabledForAllChildren(AWinControl: TWinControl);
|
|
var
|
|
I: Integer;
|
|
C: TControl;
|
|
begin
|
|
for I := 0 to AWinControl.ControlCount - 1 do begin
|
|
C := AWinControl.Controls[I];
|
|
C.Enabled := Value;
|
|
|
|
if C is TWinControl then
|
|
SetEnabledForAllChildren(TWinControl(C));
|
|
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited SetEnabled(Value);
|
|
|
|
SetEnabledForAllChildren(Self);
|
|
end;
|
|
|
|
{ Our UpDown control is always alligned, but setting its PreferredHeight
|
|
uncoditionally to 1 prevents the UpDown to mess with our PreferredHeight.
|
|
The problem is that if we didn't do this, when our Height is greater than
|
|
really preffered, UpDown prevents it to be set correctly when we set AutoSize
|
|
to True. }
|
|
procedure TDTUpDown.CalculatePreferredSize(var PreferredWidth, PreferredHeight:
|
|
integer; WithThemeSpace: Boolean);
|
|
begin
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
|
|
WithThemeSpace);
|
|
|
|
PreferredHeight := 1;
|
|
end;
|
|
|
|
{ We don't want to let EditingDone event to fire each time up-down buttons get
|
|
clicked. That is why WndProc is overriden. }
|
|
procedure TDTUpDown.WndProc(var Message: TLMessage);
|
|
begin
|
|
if ((Message.msg >= LM_MOUSEFIRST) and (Message.msg <= LM_MOUSELAST))
|
|
or ((Message.msg >= LM_MOUSEFIRST2) and (Message.msg <= LM_MOUSELAST2)) then begin
|
|
|
|
Inc(DTPicker.FNoEditingDone);
|
|
try
|
|
inherited WndProc(Message);
|
|
finally
|
|
Dec(DTPicker.FNoEditingDone);
|
|
end
|
|
|
|
end else
|
|
inherited WndProc(Message);
|
|
|
|
end;
|
|
|
|
{ TDTSpeedButton }
|
|
|
|
{ See the coment above TDTUpDown.CalculatePreferredSize }
|
|
procedure TDTSpeedButton.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
begin
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
|
|
WithThemeSpace);
|
|
|
|
PreferredHeight := 1;
|
|
end;
|
|
|
|
{ Prevent EditingDone to fire whenever the SpeedButton gets clicked }
|
|
procedure TDTSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
Inc(DTPicker.FNoEditingDone);
|
|
try
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
finally
|
|
Dec(DTPicker.FNoEditingDone);
|
|
end;
|
|
end;
|
|
|
|
procedure TDTSpeedButton.Paint;
|
|
procedure DrawDropDownArrow(const Canvas: TCanvas; const DropDownButtonRect: TRect);
|
|
var
|
|
Details: TThemedElementDetails;
|
|
ArrowState: TThemedToolBar;
|
|
ASize: TSize;
|
|
ARect: TRect;
|
|
begin
|
|
if Enabled then
|
|
ArrowState := ttbSplitButtonDropDownNormal
|
|
else
|
|
ArrowState := ttbSplitButtonDropDownDisabled;
|
|
Details := ThemeServices.GetElementDetails(ArrowState);
|
|
ASize := ThemeServices.GetDetailSize(Details);
|
|
ARect := DropDownButtonRect;
|
|
InflateRect(ARect, -(ARect.Right-ARect.Left-ASize.cx) div 2, 0);
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
|
|
end;
|
|
const
|
|
ArrowColor = TColor($8D665A);
|
|
var
|
|
X, Y: Integer;
|
|
begin
|
|
inherited Paint;
|
|
|
|
// First I ment to put arrow images in a lrs file. In my opinion, however, that
|
|
// wouldn't be an elegant option for so simple shapes.
|
|
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.Pen.Color := ArrowColor;
|
|
Canvas.Brush.Color := Canvas.Pen.Color;
|
|
|
|
X := (Width-9) div 2;
|
|
Y := (Height-6) div 2;
|
|
|
|
{ Let's draw shape of the arrow on the button: }
|
|
case DTPicker.FArrowShape of
|
|
asTheme:
|
|
DrawDropDownArrow(Canvas, Rect(0, 0, Width, Height));
|
|
|
|
asClassicLarger:
|
|
{ triangle: }
|
|
Canvas.Polygon([Point(X+0, Y+1), Point(X+8, Y+1),
|
|
Point(X+4, Y+5)]);
|
|
asClassicSmaller:
|
|
{ triangle -- smaller variant: }
|
|
Canvas.Polygon([Point(X+1, Y+2), Point(X+7, Y+2),
|
|
Point(X+4, Y+5)]);
|
|
asModernLarger:
|
|
{ modern: }
|
|
Canvas.Polygon([Point(X+0, Y+1), Point(X+1, Y+0),
|
|
Point(X+4, Y+3), Point(X+7, Y+0), Point(X+8, Y+1), Point(X+4, Y+5)]);
|
|
asModernSmaller:
|
|
{ modern -- smaller variant: }
|
|
Canvas.Polygon([Point(X+1, Y+2), Point(X+2, Y+1),
|
|
Point(X+4, Y+3), Point(X+6, Y+1), Point(X+7, Y+2), Point(X+4, Y+5)]);
|
|
asYetAnotherShape:
|
|
{ something in between, not very pretty: }
|
|
Canvas.Polygon([Point(X+0, Y+1), Point(X+1, Y+0),
|
|
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)]);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.UpdateShowArrowButton;
|
|
|
|
procedure CreateArrowBtn;
|
|
begin
|
|
if not Assigned(FArrowButton) then begin
|
|
DestroyCalendarForm;
|
|
DestroyUpDown;
|
|
|
|
FArrowButton := TDTSpeedButton.Create(Self);
|
|
FArrowButton.ControlStyle := FArrowButton.ControlStyle +
|
|
[csNoFocus, csNoDesignSelectable];
|
|
FArrowButton.Flat := dtpoFlatButton in Options;
|
|
TDTSpeedButton(FArrowButton).DTPicker := Self;
|
|
FArrowButton.SetBounds(0, 0, DefaultArrowButtonWidth, 1);
|
|
|
|
FArrowButton.Parent := Self;
|
|
FAllowDroppingCalendar := True;
|
|
|
|
TDTSpeedButton(FArrowButton).OnMouseDown := @ArrowMouseDown;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure CreateUpDown;
|
|
begin
|
|
if not Assigned(FUpDown) then begin
|
|
DestroyArrowBtn;
|
|
|
|
FUpDown := TDTUpDown.Create(Self);
|
|
FUpDown.ControlStyle := FUpDown.ControlStyle +
|
|
[csNoFocus, csNoDesignSelectable];
|
|
|
|
TDTUpDown(FUpDown).DTPicker := Self;
|
|
TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options;
|
|
|
|
FUpDown.SetBounds(0, 0, DefaultUpDownWidth, 1);
|
|
|
|
FUpDown.Parent := Self;
|
|
|
|
TDTUpDown(FUPDown).OnClick := @UpDownClick;
|
|
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ReallyShowArrowButton: Boolean;
|
|
|
|
begin
|
|
if FDateMode = dmNone then begin
|
|
DestroyArrowBtn;
|
|
DestroyUpDown;
|
|
|
|
end else begin
|
|
ReallyShowArrowButton := (FDateMode = dmComboBox) and
|
|
not (dtpDay in FEffectiveHideDateTimeParts);
|
|
|
|
if (ReallyShowArrowButton <> Assigned(FArrowButton)) or
|
|
(Assigned(FArrowButton) = Assigned(FUpDown)) then begin
|
|
DisableAlign;
|
|
try
|
|
if ReallyShowArrowButton then
|
|
CreateArrowBtn
|
|
else
|
|
CreateUpDown;
|
|
|
|
ArrangeCtrls;
|
|
|
|
finally
|
|
EnableAlign;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DestroyUpDown;
|
|
begin
|
|
if Assigned(FUpDown) then begin
|
|
TDTUpDown(FUPDown).OnClick := nil;
|
|
FreeAndNil(FUpDown);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DoAutoCheck;
|
|
begin
|
|
if ShowCheckBox and not Checked and (dtpoAutoCheck in Options) then
|
|
Checked := True;
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.DestroyArrowBtn;
|
|
begin
|
|
if Assigned(FArrowButton) then begin
|
|
TDTSpeedButton(FArrowButton).OnMouseDown := nil;
|
|
DestroyCalendarForm;
|
|
FreeAndNil(FArrowButton);
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomDateTimePicker.Create(AOwner: TComponent);
|
|
var
|
|
I: Integer;
|
|
DTP: TDateTimePart;
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, cx, cy);
|
|
|
|
FCalAlignment := dtaDefault;
|
|
FCorrectedDTP := dtpAMPM;
|
|
FCorrectedValue := 0;
|
|
FSkipChangeInUpdateDate := 0;
|
|
FNoEditingDone := 0;
|
|
FArrowShape := asTheme;
|
|
FAllowDroppingCalendar := True;
|
|
|
|
FOnDropDown := nil;
|
|
FOnCloseUp := nil;
|
|
|
|
ParentColor := False;
|
|
FCheckBox := nil;
|
|
FArrowButton := nil;
|
|
FUpDown := nil;
|
|
|
|
FKind := dtkDate;
|
|
FNullInputAllowed := True;
|
|
FOptions := cDefOptions;
|
|
|
|
{ Thanks to Luiz Américo for this:
|
|
Lazarus ignores empty string when saving to lrs. Therefore, the problem
|
|
is, when TextForNullDate is set to an empty string and after the project
|
|
is saved and opened again, then, this property gets default value NULL
|
|
instead of empty string. The following condition seems to be a workaround
|
|
for this. }
|
|
if (AOwner = nil) or not (csReading in Owner.ComponentState) then
|
|
FTextForNullDate := 'NULL';
|
|
|
|
FCenturyFrom := 1941;
|
|
FRecalculatingTextSizesNeeded := True;
|
|
FOnChange := nil;
|
|
FOnCheckBoxChange := nil;
|
|
FSeparatorWidth := 0;
|
|
FSepNoSpaceWidth := 0;
|
|
FDigitWidth := 0;
|
|
FTimeSeparatorWidth := 0;
|
|
FAMPMWidth := 0;
|
|
FDateWidth := 0;
|
|
FTimeWidth := 0;
|
|
FTextWidth := 0;
|
|
FTextHeight := 0;
|
|
FMonthWidth := 0;
|
|
FHideDateTimeParts := [];
|
|
FShowMonthNames := False;
|
|
FNullMonthText := '';
|
|
|
|
for I := Low(FTextPart) to High(FTextPart) do
|
|
FTextPart[I] := '';
|
|
|
|
for DTP := dtpHour to dtpAMPM do
|
|
FTimeText[DTP] := '';
|
|
|
|
FTimeDisplay := tdHMS;
|
|
FTimeFormat := tf24;
|
|
|
|
FLeadingZeros := True;
|
|
FUserChanging := 0;
|
|
FReadOnly := False;
|
|
FDateTime := SysUtils.Now;
|
|
FConfirmedDateTime := FDateTime;
|
|
FMinDate := TheSmallestDate;
|
|
FMaxDate := TheBiggestDate;
|
|
FTrailingSeparator := False;
|
|
FDateDisplayOrder := ddoTryDefault;
|
|
FSelectedTextPart := 1;
|
|
FUseDefaultSeparators := True;
|
|
FDateSeparator := DefaultFormatSettings.DateSeparator;
|
|
FTimeSeparator := DefaultFormatSettings.TimeSeparator;
|
|
FEffectiveCenturyFrom := FCenturyFrom;
|
|
FJumpMinMax := False;
|
|
|
|
ParentColor := False;
|
|
TabStop := True;
|
|
BorderWidth := 2;
|
|
BorderStyle := bsSingle;
|
|
ParentFont := True;
|
|
AutoSize := True;
|
|
|
|
FTextEnabled := True;
|
|
FCalendarForm := nil;
|
|
FDoNotArrangeControls := True;
|
|
FCascade := False;
|
|
FAutoButtonSize := False;
|
|
FAutoAdvance := True;
|
|
FCalendarWrapperClass := nil;
|
|
FEffectiveHideDateTimeParts := [];
|
|
|
|
AdjustEffectiveDateDisplayOrder;
|
|
AdjustEffectiveHideDateTimeParts;
|
|
|
|
SetMonthNames('Long');
|
|
SetDateMode(dmComboBox);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AddHandlerOnChange(
|
|
const AOnChange: TNotifyEvent; AsFirst: Boolean);
|
|
begin
|
|
if FOnChangeHandlers=nil then
|
|
FOnChangeHandlers := TMethodList.Create;
|
|
FOnChangeHandlers.Add(TMethod(AOnChange), not AsFirst);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.AddHandlerOnCheckBoxChange(
|
|
const AOnCheckBoxChange: TNotifyEvent; AsFirst: Boolean);
|
|
begin
|
|
if FOnCheckBoxChangeHandlers=nil then
|
|
FOnCheckBoxChangeHandlers := TMethodList.Create;
|
|
FOnCheckBoxChangeHandlers.Add(TMethod(AOnCheckBoxChange), not AsFirst);
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.RemoveHandlerOnChange(AOnChange: TNotifyEvent);
|
|
begin
|
|
if Assigned(FOnChangeHandlers) then
|
|
FOnChangeHandlers.Remove(TMethod(AOnChange));
|
|
end;
|
|
|
|
procedure TCustomDateTimePicker.RemoveHandlerOnCheckBoxChange(
|
|
AOnCheckBoxChange: TNotifyEvent);
|
|
begin
|
|
if Assigned(FOnCheckBoxChangeHandlers) then
|
|
FOnCheckBoxChangeHandlers.Remove(TMethod(AOnCheckBoxChange));
|
|
end;
|
|
|
|
destructor TCustomDateTimePicker.Destroy;
|
|
begin
|
|
FDoNotArrangeControls := True;
|
|
DestroyArrowBtn;
|
|
DestroyUpDown;
|
|
SetShowCheckBox(False);
|
|
FOnChangeHandlers.Free;
|
|
FOnCheckBoxChangeHandlers.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomDateTimePicker.DateIsNull: Boolean;
|
|
begin
|
|
Result := IsNullDate(FDateTime);
|
|
end;
|
|
|
|
end.
|