mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-28 10:02:14 +00:00
Code Issues Projects Releases Packages Wiki Activity
doublecmd/components/ZVDateTimeCtrls/zvdatetimepicker.pas
Alexander Koblov 307a4e3a83 ADD: ZVDateTimeCtrls component
2011-03-04 18:16:36 +00:00

3658 lines
102 KiB
ObjectPascal
Raw Blame History

{
TZVDateTimePicker control for Lazarus
- - - - - - - - - - - - - - - - - - -
Author: Zoran Vučenović, January and February 2010
Зоран Вученовић, јануар и фебруар 2010.
Last change: May 2010
This unit is part of ZVDateTimeCtrls 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 TZVDateTimePicker control does not use native Win control. It has been
written and initially tested on Windows XP with win widgetset, but then tested
and adjusted on Ubuntu Linux 9.10 with gtk2 widgetset.
Additionaly, tests were made on Qt widget set too, on both Windows and Linux.
-----------------------------------------------------------
LICENCE
- - - -
Modified LGPL -- see COPYING.TXT.
-----------------------------------------------------------
NO WARRANTY
- - - - - -
There is no warranty whatsoever.
-----------------------------------------------------------
BEST REGARDS TO LAZARUS COMMUNITY!
- - - - - - - - - - - - - - - - - -
I do hope this control will be useful.
}
unit ZVDateTimePicker;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, Controls, LCLType, Graphics, Math, StdCtrls,
Buttons, ExtCtrls, Forms, Calendar, ComCtrls, Types, LCLVersion;
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);
TheBiggestDate = TDateTime(2958465.0); // 31. dec. 9999.
//{$IFDEF WINDOWS}
// TCalendar does not accept smaller dates then 14. sep. 1752 on Windows
// platform (see 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). So, this will be the
// down limit:
TheSmallestDate = TDateTime(-53780.0); // 1. okt. 1752.
//{$ELSE} -- I just commented this out. Let's behave uniformely as much as
// possible -- I won't allow dates before 1. okt. 1752. on any platform (who
// cares about those).
// TheSmallestDate = TDateTime(-693593.0); // 1. jan. 0001.
//{$ENDIF}
{$IF (lcl_major > 0) OR (lcl_minor > 9) OR ((lcl_minor = 9) AND (lcl_release >= 29))}
{$DEFINE LCL_0_9_29_OR_AFTER}
{$ELSE}
{$IFDEF LCLQt}
{$DEFINE QT_BEFORE_0_9_29}
{$ENDIF}
{$IFEND}
type
TYMD = record
Year, Month, Day: Word;
end;
THMSMs = record
Hour, Minute, Second, MiliSec: Word;
end;
TDateDisplayOrder = (ddoDMY, ddoMDY, ddoYMD, ddoTryDefault);
TDateTextPart = (dtpDay, dtpMonth, dtpYear, dtpTime);
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 = (dtkDate, dtkTime, dtkDateTime); // Determines if we should
// display date, time or both.
TTimeTextPart = (ttpHour, ttpMinute, ttpSecond, ttpMiliSec, ttpAMPM);
{ TCustomDateTimeEditor }
TCustomDateTimeEditor = class(TCustomControl)
private
FCenturyFrom, FEffectiveCenturyFrom: Word;
FDateDisplayOrder: TDateDisplayOrder;
FKind: TDateTimeKind;
FLeadingZeros: Boolean;
FNullInputAllowed: Boolean;
FDateTime: TDateTime;
FConfirmedDate: TDateTime;
FDateSeparator: UTF8String;
FReadOnly: Boolean;
FMaxDate, FMinDate: TDate;
FTextForNullDate: UTF8String;
FTimeSeparator: UTF8String;
FTimeDisplay: TTimeDisplay;
FTimeFormat: TTimeFormat;
FTrailingSeparator: Boolean;
FUseDefaultSeparators: Boolean;
FUserChangedText: Boolean;
FTextPart: array[1..3] of UTF8String;
FTimeText: array[TTimeTextPart] of UTF8String;
FOnChange: TNotifyEvent;
FStoredLockCount: Integer;
FDigitWidth: Integer;
FTextHeight: Integer;
FSeparatorWidth: Integer;
FSepNoSpaceWidth: Integer;
FTimeSeparatorWidth: Integer;
FSelectedTextPart: 1..8;
FRecalculatingTextSizesNeeded: Boolean;
FJumpMinMax: Boolean;
FAMPMWidth: Integer;
FDateWidth, FTimeWidth: Integer;
function AreSeparatorsStored: Boolean;
function GetHour: Word;
function GetMiliSec: Word;
function GetMinute: Word;
function GetSecond: Word;
function GetDate: TDate;
function GetTime: TTime;
procedure RecalculateTextSizesIfNeeded;
function GetDay: Word;
function GetMonth: Word;
function GetYear: Word;
function GetHMSMs(const NowIfNull: Boolean = False): THMSMs;
function GetYYYYMMDD(const TodayIfNull: Boolean = False): TYMD;
procedure SetCenturyFrom(const AValue: Word);
procedure SetKind(const AValue: TDateTimeKind);
procedure SetHour(const AValue: Word);
procedure SetLeadingZeros(const AValue: Boolean);
procedure SetMiliSec(const AValue: Word);
procedure SetMinute(const AValue: Word);
procedure SetSecond(const AValue: Word);
procedure SetDate(const AValue: TDate);
procedure SetDateTime(const AValue: TDateTime);
procedure SetDateDisplayOrder(const AValue: TDateDisplayOrder);
procedure SetDateSeparator(const AValue: UTF8String);
procedure SetSeparators(const DateSep, TimeSep: UTF8String);
procedure SetDay(const AValue: Word);
procedure SetMaxDate(const AValue: TDate);
procedure SetMinDate(const AValue: TDate);
procedure SetMonth(const AValue: Word);
procedure SetTextForNullDate(const AValue: UTF8String);
procedure SetTime(const AValue: TTime);
procedure SetTimeSeparator(const AValue: UTF8String);
procedure SetTimeDisplay(const AValue: TTimeDisplay);
procedure SetTimeFormat(const AValue: TTimeFormat);
procedure SetTrailingSeparator(const AValue: Boolean);
procedure SetUseDefaultSeparators(const AValue: Boolean);
procedure SetYear(const AValue: Word);
procedure SetReadOnly(Value: Boolean);
procedure SetYYYYMMDD(const AValue: TYMD);
procedure SetHMSMs(const AValue: THMSMs);
procedure UpdateIfUserChangedText;
function GetSelectedText: UTF8String;
procedure AdjustEffectiveCenturyFrom;
procedure SelectDateTextPart(const DateTextPart: TDateTextPart);
procedure SelectTimeTextPart(const TimeTextPart: TTimeTextPart);
protected
procedure ConfirmChanges;
procedure UndoChanges;
procedure SetDateTimeJumpMinMax(const AValue: TDateTime);
procedure ChangeDateTimeInternally(const AValue: TDateTime);
function GetEffectiveDateDisplayOrder: TDateDisplayOrder; virtual;
function GetCurrentDateTextPart: TDateTextPart;
function GetCurrentTimeTextPart: TTimeTextPart;
procedure FontChanged(Sender: TObject); override;
function GetTextOrigin: 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; virtual;
procedure DoEnter; override;
procedure DoExit; override;
procedure SetEnabled(Value: Boolean); override;
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean); 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 Change; virtual;
property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
property AutoSize default True;
property TabStop default True;
property BorderStyle default bsSingle;
property ParentColor default False;
property DateDisplayOrder: TDateDisplayOrder
read FDateDisplayOrder write SetDateDisplayOrder default ddoTryDefault;
property MaxDate: TDate read FMaxDate write SetMaxDate;
property MinDate: TDate read FMinDate write SetMinDate;
property DateSeparator: UTF8String
read FDateSeparator write SetDateSeparator stored AreSeparatorsStored;
property UseDefaultSeparators: Boolean
read FUseDefaultSeparators write SetUseDefaultSeparators;
property TrailingSeparator: Boolean
read FTrailingSeparator write SetTrailingSeparator default False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property TextForNullDate: UTF8String
read FTextForNullDate write SetTextForNullDate;
property LeadingZeros: Boolean
read FLeadingZeros write SetLeadingZeros default True;
property NullInputAllowed: Boolean
read FNullInputAllowed write FNullInputAllowed default True;
property Kind: TDateTimeKind read FKind write SetKind;
property TimeSeparator: UTF8String
read FTimeSeparator write SetTimeSeparator stored AreSeparatorsStored;
property TimeFormat: TTimeFormat
read FTimeFormat write SetTimeFormat default tf24;
property TimeDisplay: TTimeDisplay
read FTimeDisplay write SetTimeDisplay default tdHMS;
property Date: TDate read GetDate write SetDate;
property DateTime: TDateTime read FDateTime write SetDateTime;
property Time: TTime read GetTime write SetTime;
property CenturyFrom: Word
read FCenturyFrom write SetCenturyFrom default 1941;
property Day: Word read GetDay write SetDay stored False;
property Month: Word read GetMonth write SetMonth stored False;
property Year: Word read GetYear write SetYear stored False;
property Hour: Word read GetHour write SetHour stored False;
property Minute: Word read GetMinute write SetMinute stored False;
property Second: Word read GetSecond write SetSecond stored False;
property MiliSec: Word read GetMiliSec write SetMiliSec stored False;
public
constructor Create(AOwner: TComponent); override;
function DateIsNull: Boolean;
procedure SelectDay;
procedure SelectMonth;
procedure SelectYear;
procedure SelectHour;
procedure SelectMinute;
procedure SelectSecond;
procedure SelectMiliSec;
procedure SelectAMPM;
procedure SelectDate;
procedure SelectTime;
procedure Paint; override;
procedure EditingDone; override;
published
//
end;
{TDateTimeEditor}
TDateTimeEditor = class(TCustomDateTimeEditor)
public
property DateTime;
published
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 ShowHint;
property ParentShowHint;
property Date;
property Align;
property Anchors;
property Constraints;
property Cursor;
property PopupMenu;
property Visible;
property LeadingZeros;
property NullInputAllowed;
property Kind;
property TimeSeparator;
property TimeFormat;
property TimeDisplay;
property Time;
property UseDefaultSeparators;
// events:
property OnChange;
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 OnMouseMove;
property OnMouseUp;
property OnMouseLeave;
property OnResize;
property OnUTF8KeyPress;
end;
TArrowShape = (asClassicSmaller, asClassicLarger, asModernSmaller,
asModernLarger, asYetAnotherShape);
TDTDateMode = (dmComboBox, dmUpDown, dmNone);
{ TCustomZVDateTimePicker }
TCustomZVDateTimePicker = class(TCustomControl)
private
FArrowShape: TArrowShape;
FDateMode: TDTDateMode;
FDateTimeEditor: TCustomDateTimeEditor;
FCheckBox: TCheckBox;
FUpDown: TCustomUpDown;
FOnChange: TNotifyEvent;
FOnDropDown: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
FPanelForArrowButton: TPanel;
FArrowButton: TSpeedButton;
FCalendarForm: TCustomForm;
FCal: TCalendar;
FShape: TShape;
FRememberedCalendarFormOrigin: TPoint;
FDoNotArrangeControls: Boolean;
FClosingCalendarForm: Boolean;
FCallFromDateTimeEditorEnter: Boolean;
FCallFromDateTimeEditorExit: Boolean;
FCloseCalendarOnChange: Boolean;
FForceShowCalendar: Boolean;
function AreSeparatorsStored: Boolean;
function GetCenturyFrom: Word;
function GetChecked: Boolean;
function GetDateDisplayOrder: TDateDisplayOrder;
function GetKind: TDateTimeKind;
function GetLeadingZeros: Boolean;
function GetNullInputAllowed: Boolean;
function GetDate: TDate;
function GetDateTime: TDateTime;
function GetDateSeparator: UTF8String;
function GetMaxDate: TDate;
function GetMinDate: TDate;
function GetReadOnly: Boolean;
function GetShowCheckBox: Boolean;
function GetTextForNullDate: UTF8String;
function GetTime: TTime;
function GetTimeSeparator: UTF8String;
function GetTimeDisplay: TTimeDisplay;
function GetTimeFormat: TTimeFormat;
function GetTrailingSeparator: Boolean;
function GetUseDefaultSeparators: Boolean;
procedure SetArrowShape(const AValue: TArrowShape);
procedure SetCenturyFrom(const AValue: Word);
procedure SetChecked(const AValue: Boolean);
procedure CheckIfDateEditorIsEnabled;
procedure SetDateDisplayOrder(const AValue: TDateDisplayOrder);
procedure SetDateMode(const AValue: TDTDateMode);
procedure SetKind(const AValue: TDateTimeKind);
procedure SetLeadingZeros(const AValue: Boolean);
procedure SetNullInputAllowed(const AValue: Boolean);
procedure SetDate(const AValue: TDate);
procedure SetDateTime(const AValue: TDateTime);
procedure SetDateSeparator(const AValue: UTF8String);
procedure SetMaxDate(const AValue: TDate);
procedure SetMinDate(const AValue: TDate);
procedure SetReadOnly(const AValue: Boolean);
procedure SetShowCheckBox(const AValue: Boolean);
procedure SetTextForNullDate(const AValue: UTF8String);
procedure SetTime(const AValue: TTime);
procedure SetTimeSeparator(const AValue: UTF8String);
procedure SetTimeDisplay(const AValue: TTimeDisplay);
procedure SetTimeFormat(const AValue: TTimeFormat);
procedure SetTrailingSeparator(const AValue: Boolean);
procedure SetUseDefaultSeparators(const AValue: Boolean);
procedure DestroyTheCalendar;
procedure AdjustCalendarFormSize;
procedure AdjustCalendarFormScreenPosition;
procedure CreateCalendarForm;
procedure DestroyCalendarForm;
procedure CloseCalendarForm(AndSetTheDate: Boolean = False);
procedure DropDownCalendarForm;
procedure UpdateShowArrowButton(NewDateMode: TDTDateMode;
NewKind: TDateTimeKind);
procedure DestroyUpDown;
procedure DestroyArrowBtn;
procedure DateTimeEditorChange(Sender: TObject);
procedure DateTimeEditorEnter(Sender: TObject);
procedure DateTimeEditorExit(Sender: TObject);
procedure DateTimeEditorEditingDone(Sender: TObject);
procedure DateTimeEditorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DateTimeEditorKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DateTimeEditorKeyPress(Sender: TObject; var Key: char);
procedure DateTimeEditorUTF8KeyPress(Sender: TObject;
var UTF8Key: TUTF8Char);
procedure DateTimeEditorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DateTimeEditorMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure DateTimeEditorMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DateTimeEditorClick(Sender: TObject);
procedure DateTimeEditorDblClick(Sender: TObject);
procedure DateTimeEditorTripleClick(Sender: TObject);
procedure DateTimeEditorQuadClick(Sender: TObject);
procedure ArrowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
procedure CheckBoxChange(Sender: TObject);
procedure CalendarKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure CalendarResize(Sender: TObject);
procedure CalendarMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CalendarChange(Sender: TObject);
procedure CalendarFormDeactivate(Sender: TObject);
procedure CalendarFormShow(Sender: TObject);
procedure CalendarFormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure CalendarFormDestroy(Sender: TObject);
protected
// In older Lazarus versions, GetControlClassDefaultSize is of type TPoint,
// since 0.9.29, svn rev. 25204, it's TSize.
{$IFDEF LCL_0_9_29_OR_AFTER}
class function GetControlClassDefaultSize: TSize; override;
{$ELSE}
class function GetControlClassDefaultSize: TPoint; override;
{$ENDIF}
procedure SetHint(const Value: TTranslateString); override;
procedure SetEnabled(Value: Boolean); override;
procedure CreateWnd; override;
procedure SetDateTimeJumpMinMax(const AValue: TDateTime);
procedure ArrangeCtrls; virtual;
procedure Change; virtual;
procedure DoDropDown; virtual;
procedure DoCloseUp; virtual;
procedure DrawArrowButtonGlyph; virtual;
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean); override;
procedure DoEnter; override;
procedure DoExit; override;
property BorderStyle default bsSingle;
property AutoSize default True;
property TabStop default True;
property ParentColor default False;
property CenturyFrom: Word
read GetCenturyFrom write SetCenturyFrom;
property DateDisplayOrder: TDateDisplayOrder
read GetDateDisplayOrder write SetDateDisplayOrder default ddoTryDefault;
property MaxDate: TDate
read GetMaxDate write SetMaxDate;
property MinDate: TDate
read GetMinDate write SetMinDate;
property DateTime: TDateTime read GetDateTime write SetDateTime;
property TrailingSeparator: Boolean
read GetTrailingSeparator write SetTrailingSeparator;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property LeadingZeros: Boolean read GetLeadingZeros write SetLeadingZeros;
property TextForNullDate: UTF8String
read GetTextForNullDate write SetTextForNullDate;
property NullInputAllowed: Boolean
read GetNullInputAllowed write SetNullInputAllowed default True;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
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 asModernSmaller;
property Kind: TDateTimeKind
read GetKind write SetKind;
property DateSeparator: UTF8String
read GetDateSeparator write SetDateSeparator stored AreSeparatorsStored;
property TimeSeparator: UTF8String
read GetTimeSeparator write SetTimeSeparator stored AreSeparatorsStored;
property UseDefaultSeparators: Boolean
read GetUseDefaultSeparators write SetUseDefaultSeparators;
property TimeFormat: TTimeFormat read GetTimeFormat write SetTimeFormat;
property TimeDisplay: TTimeDisplay read GetTimeDisplay write SetTimeDisplay;
property Time: TTime read GetTime write SetTime;
property Date: TDate read GetDate write SetDate;
property DateMode: TDTDateMode read FDateMode write SetDateMode;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function DateIsNull: Boolean;
procedure SelectDate;
procedure SelectTime;
published
//
end;
{TZVDateTimePicker}
TZVDateTimePicker = class(TCustomZVDateTimePicker)
public
property DateTime;
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;
// events:
property OnChange;
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 OnMouseMove;
property OnMouseUp;
property OnMouseLeave;
property OnResize;
property OnUTF8KeyPress;
end;
function EqualDateTime(const A, B: TDateTime): Boolean;
function IsNullDate(DT: TDateTime): Boolean;
implementation
function NumberOfDaysInMonth(const Month, Year: Word): Word;
begin
Result := 0;
if Month in [1..12] then
Result := MonthDays[IsLeapYear(Year), Month];
end;
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;
procedure Exchange(var W1, W2: Word);
var
W: Word;
begin
W := W1;
W1 := W2;
W2 := W;
end;
{ TCustomDateTimeEditor }
procedure TCustomDateTimeEditor.SetDateTime(const AValue: TDateTime);
begin
if not EqualDateTime(AValue, FDateTime) then begin
if IsNullDate(AValue) then
FDateTime := NullDate
else
FDateTime := AValue;
Change;
end;
UpdateDate;
end;
procedure TCustomDateTimeEditor.SetDateDisplayOrder(const AValue: TDateDisplayOrder);
var
PreviousEffectiveDDO: TDateDisplayOrder;
begin
if FDateDisplayOrder <> AValue then begin
PreviousEffectiveDDO := GetEffectiveDateDisplayOrder;
FDateDisplayOrder := AValue;
if PreviousEffectiveDDO <> GetEffectiveDateDisplayOrder then
UpdateDate;
end;
end;
procedure TCustomDateTimeEditor.SetDateSeparator(const AValue: UTF8String);
begin
SetSeparators(AValue, FTimeSeparator);
end;
procedure TCustomDateTimeEditor.SetSeparators(const DateSep,
TimeSep: UTF8String);
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 TCustomDateTimeEditor.RecalculateTextSizesIfNeeded;
var
C: Char;
N: Integer;
S: UTF8String;
begin
if 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;
if FKind in [dtkDate, dtkDateTime] then begin
FSeparatorWidth := Canvas.GetTextWidth(FDateSeparator);
FDateWidth := 8 * FDigitWidth + 2 * FSeparatorWidth;
if FTrailingSeparator then begin
FSepNoSpaceWidth := Canvas.GetTextWidth(TrimRight(FDateSeparator));
Inc(FDateWidth, FSepNoSpaceWidth);
end else
FSepNoSpaceWidth := 0;
S := FDateSeparator;
end else begin
if FSelectedTextPart < 4 then
FSelectedTextPart := 4;
S := '';
FSeparatorWidth := 0;
FSepNoSpaceWidth := 0;
FDateWidth := 0;
end;
FAMPMWidth := 0;
if FKind in [dtkTime, dtkDateTime] then begin
S := S + FTimeSeparator;
FTimeSeparatorWidth := Canvas.GetTextWidth(FTimeSeparator);
case FTimeDisplay of
tdHM:
FTimeWidth := 4 * FDigitWidth + FTimeSeparatorWidth;
tdHMS:
FTimeWidth := 6 * FDigitWidth + 2 * FTimeSeparatorWidth;
tdHMSMs:
FTimeWidth := 9 * FDigitWidth + 3 * FTimeSeparatorWidth;
end;
if FTimeFormat = tf12 then begin
S := S + 'APM';
FAMPMWidth := Max(Canvas.TextWidth('AM'), Canvas.TextWidth('PM'));
FTimeWidth := FTimeWidth + FDigitWidth + FAMPMWidth;
end;
if Ord(FTimeDisplay) + 5 < FSelectedTextPart then
if (FSelectedTextPart < 8) or (FTimeFormat = tf24) then
FSelectedTextPart := 4;
end else begin
if FSelectedTextPart > 3 then
FSelectedTextPart := 1;
FTimeSeparatorWidth := 0;
FTimeWidth := 0;
end;
FTextHeight := Canvas.GetTextHeight('0123456789' + S);
end;
end;
function TCustomDateTimeEditor.GetTime: TTime;
begin
if DateIsNull then
Result := NullDate
else
Result := Abs(Frac(FDateTime));
end;
function TCustomDateTimeEditor.AreSeparatorsStored: Boolean;
begin
Result := not FUseDefaultSeparators;
end;
function TCustomDateTimeEditor.GetHour: Word;
begin
Result := GetHMSMs.Hour;
end;
function TCustomDateTimeEditor.GetMiliSec: Word;
begin
Result := GetHMSMs.MiliSec;
end;
function TCustomDateTimeEditor.GetMinute: Word;
begin
Result := GetHMSMs.Minute;
end;
function TCustomDateTimeEditor.GetSecond: Word;
begin
Result := GetHMSMs.Second;
end;
function TCustomDateTimeEditor.GetDate: TDate;
begin
if DateIsNull then
Result := NullDate
else
Result := Int(FDateTime);
end;
function TCustomDateTimeEditor.GetDay: Word;
begin
Result := GetYYYYMMDD.Day;
end;
function TCustomDateTimeEditor.GetMonth: Word;
begin
Result := GetYYYYMMDD.Month;
end;
function TCustomDateTimeEditor.GetYear: Word;
begin
Result := GetYYYYMMDD.Year;
end;
function TCustomDateTimeEditor.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 TCustomDateTimeEditor.GetYYYYMMDD(const TodayIfNull: 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
DecodeDate(FDateTime, Result.Year, Result.Month, Result.Day);
end;
procedure TCustomDateTimeEditor.SetCenturyFrom(const AValue: Word);
begin
if FCenturyFrom = AValue then Exit;
FCenturyFrom := AValue;
AdjustEffectiveCenturyFrom;
end;
procedure TCustomDateTimeEditor.SetKind(const AValue: TDateTimeKind);
begin
if FKind = AValue then Exit;
FKind := AValue;
FRecalculatingTextSizesNeeded := True;
UpdateDate;
end;
procedure TCustomDateTimeEditor.SetHour(const AValue: Word);
var
HMSMs: THMSMs;
begin
SelectHour;
HMSMs := GetHMSMs(True);
HMSMs.Hour := AValue;
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.SetLeadingZeros(const AValue: Boolean);
begin
if FLeadingZeros = AValue then Exit;
FLeadingZeros := AValue;
UpdateDate;
end;
procedure TCustomDateTimeEditor.SetMiliSec(const AValue: Word);
var
HMSMs: THMSMs;
begin
SelectMiliSec;
HMSMs := GetHMSMs(True);
HMSMs.MiliSec := AValue;
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.SetMinute(const AValue: Word);
var
HMSMs: THMSMs;
begin
SelectMinute;
HMSMs := GetHMSMs(True);
HMSMs.Minute := AValue;
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.SetSecond(const AValue: Word);
var
HMSMs: THMSMs;
begin
SelectSecond;
HMSMs := GetHMSMs(True);
HMSMs.Second := AValue;
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.SetDay(const AValue: Word);
var
YMD: TYMD;
begin
SelectDay;
YMD := GetYYYYMMDD(True);
YMD.Day := AValue;
SetYYYYMMDD(YMD);
end;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.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 TCustomDateTimeEditor.SetMonth(const AValue: Word);
var
YMD: TYMD;
N: Word;
begin
SelectMonth;
YMD := GetYYYYMMDD(True);
YMD.Month := AValue;
N := NumberOfDaysInMonth(YMD.Month, YMD.Year);
if YMD.Day > N then
YMD.Day := N;
SetYYYYMMDD(YMD);
end;
procedure TCustomDateTimeEditor.SetTextForNullDate(const AValue: UTF8String);
begin
if FTextForNullDate = AValue then Exit;
FTextForNullDate := AValue;
if DateIsNull then
Invalidate;
end;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.SetTimeSeparator(const AValue: UTF8String);
begin
SetSeparators(FDateSeparator, AValue);
end;
procedure TCustomDateTimeEditor.SetTimeDisplay(const AValue: TTimeDisplay);
begin
if FTimeDisplay = AValue then Exit;
FTimeDisplay:=AValue;
FRecalculatingTextSizesNeeded := True;
UpdateDate;
end;
procedure TCustomDateTimeEditor.SetTimeFormat(const AValue: TTimeFormat);
begin
if FTimeFormat <> AValue then begin
FTimeFormat := AValue;
FRecalculatingTextSizesNeeded := True;
UpdateDate;
end;
end;
procedure TCustomDateTimeEditor.SetTrailingSeparator(const AValue: Boolean);
begin
if FTrailingSeparator = AValue then Exit;
FTrailingSeparator := AValue;
FRecalculatingTextSizesNeeded := True;
UpdateIfUserChangedText;
Invalidate;
end;
procedure TCustomDateTimeEditor.SetUseDefaultSeparators(const AValue: Boolean);
begin
if FUseDefaultSeparators <> AValue then begin
if AValue then begin
SetSeparators(SysUtils.DateSeparator, SysUtils.TimeSeparator);
// Note that here, in SetSeparators procedure,
// the field FUseDefaultSeparators is set to False.
end;
// Therefore, the next line must NOT be moved above.
FUseDefaultSeparators := AValue;
end;
end;
procedure TCustomDateTimeEditor.SetYear(const AValue: Word);
var
YMD: TYMD;
begin
SelectYear;
YMD := GetYYYYMMDD(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 TCustomDateTimeEditor.SetYYYYMMDD(const AValue: TYMD);
var
D: TDateTime;
begin
if TryEncodeDate(AValue.Year, AValue.Month, AValue.Day, D) then
SetDate(D)
else
UpdateDate;
end;
procedure TCustomDateTimeEditor.SetHMSMs(const AValue: THMSMs);
var
T: TDateTime;
begin
if TryEncodeTime(AValue.Hour, AValue.Minute,
AValue.Second, AValue.MiliSec, T) then begin
SetTime(T);
end else
UpdateDate;
end;
{ GetEffectiveDateDisplayOrder function
----------------------------------
If date display order ddoTryDefault is set, then we will decide which
display order to use according to ShortDateFormat global variable. The
function 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. }
function TCustomDateTimeEditor.GetEffectiveDateDisplayOrder: TDateDisplayOrder;
var
S: String;
I: Integer;
begin
if FDateDisplayOrder = ddoTryDefault then begin
S := ShortDateFormat;
Result := ddoTryDefault;
repeat
for I := 1 to Length(S) do begin
case upCase(S[I]) of
'D': begin
Result := ddoDMY;
Break;
end;
'M': begin
Result := ddoMDY;
Break;
end;
'Y': begin
Result := ddoYMD;
Break;
end;
end;
end;
if Result = ddoTryDefault then begin
S := LongDateFormat; { We couldn't decide with ShortDateFormat, let's
try with LongDateFormat now. }
Result := ddoYMD; { -- 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. }
end else
Break;
until False;
end else
Result := FDateDisplayOrder;
end;
procedure TCustomDateTimeEditor.UpdateIfUserChangedText;
var
W: Word;
S: UTF8String;
begin
if FUserChangedText then begin
Inc(FStoredLockCount);
try
FUserChangedText := False;
S := Trim(GetSelectedText);
if FSelectedTextPart = 8 then begin
S := UTF8UpperCase(UTF8Copy(S, 1, 1));
W := GetHour;
if S = '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 GetCurrentDateTextPart 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 besides CenturyFrom properties).
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);
else
case GetCurrentTimeTextPart of
ttpHour:
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;
ttpMinute:
SetMinute(W);
ttpSecond:
SetSecond(W);
ttpMiliSec:
SetMiliSec(W);
end;
end;
end;
finally
Dec(FStoredLockCount);
end;
end;
end;
function TCustomDateTimeEditor.GetSelectedText: UTF8String;
begin
if FSelectedTextPart <= 3 then
Result := FTextPart[FSelectedTextPart]
else
Result := FTimeText[TTimeTextPart(FSelectedTextPart - 4)];
end;
procedure TCustomDateTimeEditor.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;
procedure TCustomDateTimeEditor.FontChanged(Sender: TObject);
begin
FRecalculatingTextSizesNeeded := True;
inherited FontChanged(Sender);
end;
function TCustomDateTimeEditor.GetTextOrigin: TPoint;
begin
Result.x := BorderSpacing.InnerBorder + BorderWidth;
Result.y := Result.x;
end;
procedure TCustomDateTimeEditor.SetReadOnly(Value: Boolean);
begin
if FReadOnly <> Value then begin
if Value then begin
ConfirmChanges;
UpdateDate;
end;
FReadOnly := Value;
end;
end;
procedure TCustomDateTimeEditor.KeyDown(var Key: Word; Shift: TShiftState);
var
M, K, N: Integer;
begin
Inc(FStoredLockCount);
try
inherited KeyDown(Key, Shift); // calls OnKeyDown event
case Key of
VK_LEFT, VK_RIGHT:
begin
UpdateIfUserChangedText;
if FKind in [dtkDate, dtkDateTime] then
M := 1
else
M := 4;
if FKind in [dtkTime, dtkDateTime] then begin
K := Ord(FTimeDisplay) + 5;
if FTimeFormat = tf12 then
N := 8
else
N := K;
end else begin
N := 3;
K := 3;
end;
if Key = VK_LEFT then begin
if FSelectedTextPart = M then
FSelectedTextPart := N
else if (FSelectedTextPart = N) and (K < N) then
FSelectedTextPart := K
else
Dec(FSelectedTextPart);
end else begin
if FSelectedTextPart = N then
FSelectedTextPart := M
else if (FSelectedTextPart = K) and (K < N) then
FSelectedTextPart := N
else
Inc(FSelectedTextPart);
end;
Invalidate;
end;
VK_UP:
begin
UpdateIfUserChangedText;
if not FReadOnly then
IncreaseCurrentTextPart;
end;
VK_DOWN:
begin
UpdateIfUserChangedText;
if not FReadOnly then
DecreaseCurrentTextPart;
end;
VK_RETURN:
if not FReadOnly then begin
ConfirmChanges;
EditingDone;
end;
VK_ESCAPE:
if not FReadOnly then begin
UndoChanges;
EditingDone;
end;
VK_N:
if (not FReadOnly) and FNullInputAllowed then begin
if FUserChangedText or (not DateIsNull) then begin
SetDateTime(NullDate);
//Change;
end else
SetDateTime(NullDate);
end;
end;
finally
Dec(FStoredLockCount);
end;
end;
procedure TCustomDateTimeEditor.KeyPress(var Key: char);
var
S: String;
DTP: TDateTextPart;
TTP: TTimeTextPart;
N, L: Integer;
YMD: TYMD;
HMSMs: THMSMs;
D, T: TDateTime;
Finished: Boolean;
begin
Inc(FStoredLockCount);
try
inherited KeyPress(Key);
if (not ReadOnly) then begin
Finished := False;
if FSelectedTextPart = 8 then begin
case upCase(Key) of
'A': S := 'AM';
'P': S := 'PM';
else
Finished := True;
end;
end else if Key in ['0'..'9'] then begin
TTP := ttpAMPM;
DTP := GetCurrentDateTextPart;
if DTP = dtpYear then
N := 4
else if DTP = dtpTime then begin
TTP := GetCurrentTimeTextPart;
if TTP = ttpMiliSec then
N := 3
else
N := 2;
end else
N := 2;
S := Trim(GetSelectedText);
if FUserChangedText and (UTF8Length(S) < N) then begin
S := S + Key;
if (not FLeadingZeros) and (FSelectedTextPart <= 4) then
while (UTF8Length(S) > 1) and (UTF8Copy(S, 1, 1) = '0') do
UTF8Delete(S, 1, 1);
end else begin
S := Key;
end;
if (UTF8Length(S) >= N) then begin
L := StrToInt(S);
if DTP <> dtpTime then begin
YMD := GetYYYYMMDD(True);
case DTP of
dtpDay: YMD.Day := L;
dtpMonth: YMD.Month := L;
dtpYear: YMD.Year := L;
end;
if not TryEncodeDate(YMD.Year, YMD.Month, YMD.Day, D) then begin
D := MinDate - 1;
end;
if (D < MinDate) or (D > MaxDate) then begin
if N = 4 then begin
UpdateDate;
//Change;
Finished := True;
end else
S := Key;
end;
end else begin
if (TTP = ttpHour) and (FTimeFormat = tf12) then begin
if not (L in [1..12]) then
S := Key;
end else begin
HMSMs := GetHMSMs(True);
case TTP of
ttpHour: HMSMs.Hour := L;
ttpMinute: HMSMs.Minute := L;
ttpSecond: HMSMs.Second := L;
ttpMiliSec: HMSMs.MiliSec := L;
end;
if not TryEncodeTime(HMSMs.Hour, HMSMs.Minute, HMSMs.Second,
HMSMs.MiliSec, T) then
S := Key;
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 FSelectedTextPart <= 3 then
FTextPart[FSelectedTextPart] := S
else
FTimeText[TTimeTextPart(FSelectedTextPart - 4)] := S;
FUserChangedText := True;
//Change;
Invalidate;
end;
end;
finally
Dec(FStoredLockCount);
end;
end;
procedure TCustomDateTimeEditor.SelectTextPartUnderMouse(XMouse: Integer);
var
M, NX: Integer;
InTime: Boolean;
begin
UpdateIfUserChangedText;
if CanFocus then
SetFocus;
if Focused then begin
// Calculating mouse position inside text
// in order to select date part under mouse cursor.
FSelectedTextPart := 8;
NX := XMouse - GetTextOrigin.x;
if FKind = dtkDateTime then begin
if NX >= FDateWidth + FDigitWidth then begin
InTime := True;
NX := NX - FDateWidth - 2 * FDigitWidth;
end else
InTime := False;
end else
InTime := FKind = dtkTime;
if InTime then begin
if (FTimeFormat = tf24) or
(NX < FTimeWidth - FAMPMWidth - FDigitWidth div 2) then begin
M := 2 * FDigitWidth + FTimeSeparatorWidth div 2;
if M > NX then
FSelectedTextPart := 4
else begin
if FTimeDisplay = tdHM then
FSelectedTextPart := 5
else begin
M := M + FTimeSeparatorWidth + 2 * FDigitWidth;
if M > NX then
FSelectedTextPart := 5
else begin
if FTimeDisplay = tdHMS then
FSelectedTextPart := 6
else begin
M := M + FTimeSeparatorWidth + 2 * FDigitWidth;
if M > NX then
FSelectedTextPart := 6
else
FSelectedTextPart := 7;
end;
end;
end;
end;
end;
end else begin
M := 2 * FDigitWidth;
if GetEffectiveDateDisplayOrder = ddoYMD then
M := 2 * M;
Inc(M, FSeparatorWidth div 2);
if M > NX then begin
FSelectedTextPart := 1;
end else begin
M := M + FSeparatorWidth + 2 * FDigitWidth;
if M > NX then begin
FSelectedTextPart := 2;
end else begin
FSelectedTextPart := 3
end;
end;
end;
Invalidate;
//-------------------------------------------------------
end;
end;
procedure TCustomDateTimeEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
SelectTextPartUnderMouse(X);
inherited;
end;
function TCustomDateTimeEditor.DoMouseWheel(Shift: TShiftState; WheelDelta:
Integer; MousePos: TPoint): Boolean;
begin
{$IFDEF QT_BEFORE_0_9_29}
if not Enabled then Exit; // On Qt the control receives
// MouseWheel event even when disabled!!!
// Željko fixed this in 0.9.29, rev. 24348
{$ENDIF}
SelectTextPartUnderMouse(MousePos.x);
if not FReadOnly then begin
if WheelDelta < 0 then
DecreaseCurrentTextPart
else
IncreaseCurrentTextPart;
Result := True;
end;
end;
procedure TCustomDateTimeEditor.UpdateDate;
var
W: Array[1..3] of Word;
WT: Array[TTimeTextPart] of Word;
YearPos, I: Integer;
TTP, TTPEnd: TTimeTextPart;
begin
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 FKind in [dtkTime, dtkDateTime] then begin
if DateIsNull then begin
FTimeText[ttpHour] := '99';
FTimeText[ttpMinute] := '99';
FTimeText[ttpMiliSec] := '';
if FTimeDisplay >= tdHMS then begin
FTimeText[ttpSecond] := '99';
if FTimeDisplay >= tdHMSMs then
FTimeText[ttpMiliSec] := '999';
end else
FTimeText[ttpSecond] := '';
if FTimeFormat = tf12 then
FTimeText[ttpAMPM] := 'XX'
else
FTimeText[ttpAMPM] := '';
end else begin
case FTimeDisplay of
tdHMSMs: TTPEnd := ttpMiliSec;
tdHMS: TTPEnd := ttpSecond;
else
TTPEnd := ttpMinute;
end;
DecodeTime(FDateTime, WT[ttpHour], WT[ttpMinute], WT[ttpSecond], WT[ttpMiliSec]);
if FTimeFormat = tf12 then begin
if WT[ttpHour] < 12 then begin
FTimeText[ttpAMPM] := 'AM';
if WT[ttpHour] = 0 then
WT[ttpHour] := 12;
end else begin
FTimeText[ttpAMPM] := 'PM';
if WT[ttpHour] > 12 then
Dec(WT[ttpHour], 12);
end;
end else
FTimeText[ttpAMPM] := '';
if FLeadingZeros then
FTimeText[ttpHour] := RightStr('0' + IntToStr(WT[ttpHour]), 2)
else
FTimeText[ttpHour] := IntToStr(WT[ttpHour]);
for TTP := ttpMinute to ttpMiliSec do begin
if TTP <= TTPEnd then begin
if TTP = ttpMiliSec then
FTimeText[TTP] := RightStr('00' + IntToStr(WT[TTP]), 3)
else
FTimeText[TTP] := RightStr('0' + IntToStr(WT[TTP]), 2);
end else
FTimeText[TTP] := '';
end;
end;
end else
for TTP := Low(TTimeTextPart) to High(TTimeTextPart) do
FTimeText[TTP] := '';
if FKind in [dtkDate, dtkDateTime] then begin
if DateIsNull then begin
if GetEffectiveDateDisplayOrder = ddoYMD then begin
FTextPart[1] := '0000';
FTextPart[3] := '00';
end else begin
FTextPart[1] := '00';
FTextPart[3] := '0000';
end;
FTextPart[2] := '00';
end else begin
DecodeDate(FDateTime, W[3], W[2], W[1]);
YearPos := 3;
case GetEffectiveDateDisplayOrder of
ddoMDY:
Exchange(W[1], W[2]);
ddoYMD:
begin
Exchange(W[1], W[3]);
YearPos := 1;
end;
end;
for I := Low(FTextPart) to High(FTextPart) do begin
if I = YearPos then
FTextPart[I] := RightStr('000' + IntToStr(W[I]), 4)
else if FLeadingZeros then
FTextPart[I] := RightStr('0' + IntToStr(W[I]), 2)
else
FTextPart[I] := IntToStr(W[I]);
end;
end;
end else
for I := Low(FTextPart) to High(FTextPart) do
FTextPart[I] := '';
if FStoredLockCount = 0 then
ConfirmChanges;
Invalidate;
end;
procedure TCustomDateTimeEditor.SelectDay;
begin
SelectDateTextPart(dtpDay);
end;
procedure TCustomDateTimeEditor.SelectMonth;
begin
SelectDateTextPart(dtpMonth);
end;
procedure TCustomDateTimeEditor.SelectYear;
begin
SelectDateTextPart(dtpYear);
end;
procedure TCustomDateTimeEditor.SelectHour;
begin
SelectTimeTextPart(ttpHour);
end;
procedure TCustomDateTimeEditor.SelectMinute;
begin
SelectTimeTextPart(ttpMinute);
end;
procedure TCustomDateTimeEditor.SelectSecond;
begin
SelectTimeTextPart(ttpSecond);
end;
procedure TCustomDateTimeEditor.SelectMiliSec;
begin
SelectTimeTextPart(ttpMiliSec);
end;
procedure TCustomDateTimeEditor.SelectAMPM;
begin
SelectTimeTextPart(ttpAMPM);
end;
procedure TCustomDateTimeEditor.SelectDate;
begin
if FSelectedTextPart > 3 then
SelectDay;
end;
procedure TCustomDateTimeEditor.SelectTime;
begin
if FSelectedTextPart < 4 then
SelectHour;
end;
procedure TCustomDateTimeEditor.Paint;
var
I, M, N, K: Integer;
DD: Array[1..8] of Integer;
R: TRect;
SelectStep: 0..8;
TextStyle: TTextStyle;
begin
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;
if ClientHeight > M then begin
M := (ClientHeight - M) div 2;
Inc(R.Top, M);
end;
R.Bottom := R.Top + FTextHeight;
TextStyle.Layout := tlCenter;
TextStyle.Wordbreak := False;
TextStyle.Opaque := False;
if DateIsNull and (FTextForNullDate > '')
and (not Focused) then begin
R.Right := R.Left + FDateWidth + FTimeWidth;
if Kind = dtkDateTime then
R.Right := R.Right + 2 * FDigitWidth;
if R.Right - R.Left > Canvas.GetTextWidth(FTextForNullDate) then
TextStyle.Alignment := taCenter
else
TextStyle.Alignment := taLeftJustify;
if Enabled 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 Enabled then begin
Canvas.Font.Color := Font.Color;
if Focused then
SelectStep := FSelectedTextPart;
end else begin
Canvas.Font.Color := clGrayText;
end;
if FKind in [dtkDate, dtkDateTime] then begin
DD[2] := 2 * FDigitWidth;
if GetEffectiveDateDisplayOrder = ddoYMD then begin
DD[1] := 4 * FDigitWidth;
DD[3] := 2 * FDigitWidth;
end else begin
DD[1] := 2 * FDigitWidth;
DD[3] := 4 * FDigitWidth;
end;
M := 1;
end else begin
M := 4;
//for I := 1 to 3 do DD[I] := 0;
end;
if FKind in [dtkTime, dtkDateTime] then begin
DD[4] := 2 * FDigitWidth;
DD[5] := 2 * FDigitWidth;
if FTimeDisplay = tdHMSMs then begin
DD[7] := 3 * FDigitWidth;
DD[6] := 2 * FDigitWidth;
K := 7;
end else begin
DD[7] := 0;
if FTimeDisplay = tdHM then begin
DD[6] := 0;
K := 5;
end else begin
DD[6] := 2 * FDigitWidth;
K := 6;
end;
end;
if FTimeFormat = tf12 then begin
N := 8;
DD[8] := FAMPMWidth;
end else begin
DD[8] := 0;
N := K;
end;
end else begin
N := 3;
K := 3;
end;
for I := M to N do begin
if DD[I] <> 0 then begin
if SelectStep = I then begin
TextStyle.Opaque := True;
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end;
R.Right := R.Left + DD[I];
if I <= 3 then
Canvas.TextRect(R, R.Left, R.Top, FTextPart[I], TextStyle)
else
Canvas.TextRect(R, R.Left, R.Top, FTimeText[TTimeTextPart(I - 4)], TextStyle);
R.Left := R.Right;
if SelectStep = I then begin
TextStyle.Opaque := False;
Canvas.Brush.Color := Color;
Canvas.Font.Color := Self.Font.Color;
end;
if I < 3 then begin
R.Right := R.Left + FSeparatorWidth;
Canvas.TextRect(R, R.Left, R.Top, FDateSeparator, TextStyle);
end else if I > 3 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 FKind = dtkDateTime then
R.Right := R.Right + 2 * FDigitWidth;
end;
R.Left := R.Right;
end;
end;
end;
inherited Paint;
end;
function TCustomDateTimeEditor.DateIsNull: Boolean;
begin
Result := IsNullDate(FDateTime);
end;
function TCustomDateTimeEditor.GetCurrentDateTextPart: TDateTextPart;
begin
if FSelectedTextPart > 3 then
Result := dtpTime
else begin
case FSelectedTextPart of
1: Result := dtpDay;
2: Result := dtpMonth;
3: Result := dtpYear;
end;
case GetEffectiveDateDisplayOrder 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;
end;
function TCustomDateTimeEditor.GetCurrentTimeTextPart: TTimeTextPart;
begin
if FSelectedTextPart > 4 then
Result := TTimeTextPart(FSelectedTextPart - 4)
else
Result := ttpHour;
end;
procedure TCustomDateTimeEditor.SelectDateTextPart(const DateTextPart: TDateTextPart);
begin
if FKind in [dtkDate, dtkDateTime] then begin
case DateTextPart of
dtpDay: //SelectDay;
begin
case GetEffectiveDateDisplayOrder of
ddoDMY: FSelectedTextPart := 1;
ddoMDY: FSelectedTextPart := 2;
ddoYMD: FSelectedTextPart := 3;
end;
end;
dtpMonth: //SelectMonth;
begin
if GetEffectiveDateDisplayOrder = ddoMDY then
FSelectedTextPart := 1
else
FSelectedTextPart := 2;
end;
dtpYear: //SelectYear;
begin
if GetEffectiveDateDisplayOrder = ddoYMD then
FSelectedTextPart := 1
else
FSelectedTextPart := 3;
end;
end;
Invalidate;
end;
end;
procedure TCustomDateTimeEditor.SelectTimeTextPart(const TimeTextPart:
TTimeTextPart);
var
B: Boolean;
begin
if FKind in [dtkTime, dtkDateTime] then begin
if TimeTextPart = ttpAMPM then
B := FTimeFormat = tf12
else
B := Ord(FTimeDisplay) + 1 >= Ord(TimeTextPart);
if B then
FSelectedTextPart := 4 + Ord(TimeTextPart);
end;
Invalidate;
end;
procedure TCustomDateTimeEditor.ConfirmChanges;
begin
UpdateIfUserChangedText;
FConfirmedDate := FDateTime;
end;
procedure TCustomDateTimeEditor.UndoChanges;
begin
SetDateTime(FConfirmedDate);
end;
procedure TCustomDateTimeEditor.SetDateTimeJumpMinMax(const AValue: TDateTime);
begin
FJumpMinMax := True;
try
SetDateTime(AValue);
finally
FJumpMinMax := False;
end;
end;
procedure TCustomDateTimeEditor.ChangeDateTimeInternally(const AValue: TDateTime);
begin
Inc(FStoredLockCount);
try
SetDateTime(AValue);
finally
Dec(FStoredLockCount);
end;
end;
procedure TCustomDateTimeEditor.DoEnter;
begin
inherited DoEnter;
Invalidate;
end;
procedure TCustomDateTimeEditor.DoExit;
begin
ConfirmChanges;
inherited DoExit;
Invalidate;
end;
procedure TCustomDateTimeEditor.EditingDone;
begin
UpdateIfUserChangedText;
inherited EditingDone;
end;
procedure TCustomDateTimeEditor.SetEnabled(Value: Boolean);
begin
if GetEnabled <> Value then begin
inherited SetEnabled(Value);
Invalidate;
end;
end;
procedure TCustomDateTimeEditor.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
var
TextOrigin: TPoint;
Was0: Boolean;
begin
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
WithThemeSpace);
Was0 := PreferredHeight = 0;
RecalculateTextSizesIfNeeded;
TextOrigin := GetTextOrigin;
PreferredWidth := PreferredWidth + 2 * TextOrigin.x + FDateWidth + FTimeWidth;
if Kind = dtkDateTime then
PreferredWidth := PreferredWidth + 2 * FDigitWidth;
PreferredHeight := Max(2 * TextOrigin.y + FTextHeight, PreferredHeight);
if Was0 then begin
if BorderStyle = bsSingle then begin
{
Only by experimenting, I came to conclusion that BorderStyle bsSingle needs two
pixels on each side around. It has nothing to do with BorderWidth property,
that's apparently separate thing. Is there some property which gives this value?
For now, I just assume two pixels on each side. Therefore, I add 4 to width and
height:
This seems to work well on both Windows (win WS) and Linux (gtk2 WS).
-- and on Qt - Windows and Linux --
}
PreferredWidth := PreferredWidth + 4;
PreferredHeight := PreferredHeight + 4;
end;
end;
end;
procedure TCustomDateTimeEditor.IncreaseCurrentTextPart;
begin
if DateIsNull then begin
if FSelectedTextPart <= 3 then
SetDateTime(SysUtils.Date)
else
SetDateTime(SysUtils.Now);
//Change;
end else begin
case GetCurrentDateTextPart of
dtpDay: IncreaseDay;
dtpMonth: IncreaseMonth;
dtpYear: IncreaseYear;
else
case GetCurrentTimeTextPart of
ttpHour: IncreaseHour;
ttpMinute: IncreaseMinute;
ttpSecond: IncreaseSecond;
ttpMiliSec: IncreaseMiliSec;
ttpAMPM: ChangeAMPM;
end;
end;
end;
end;
procedure TCustomDateTimeEditor.DecreaseCurrentTextPart;
begin
if DateIsNull then begin
if FSelectedTextPart <= 3 then
SetDateTime(SysUtils.Date)
else
SetDateTime(SysUtils.Now);
//Change;
end else begin
case GetCurrentDateTextPart of
dtpDay: DecreaseDay;
dtpMonth: DecreaseMonth;
dtpYear: DecreaseYear;
else
case GetCurrentTimeTextPart of
ttpHour: DecreaseHour;
ttpMinute: DecreaseMinute;
ttpSecond: DecreaseSecond;
ttpMiliSec: DecreaseMiliSec;
ttpAMPM: ChangeAMPM;
end;
end;
end;
end;
constructor TCustomDateTimeEditor.Create(AOwner: TComponent);
var
I: Integer;
TTP: TTimeTextPart;
begin
inherited Create(AOwner);
FKind := dtkDate;
FNullInputAllowed := True;
FTextForNullDate := 'NULL';
FCenturyFrom := 1941;
FRecalculatingTextSizesNeeded := True;
FOnChange := nil;
FSeparatorWidth := 0;
FSepNoSpaceWidth := 0;
FDigitWidth := 0;
FTimeSeparatorWidth := 0;
FAMPMWidth := 0;
FDateWidth := 0;
FTimeWidth := 0;
FTextHeight := 0;
for I := Low(FTextPart) to High(FTextPart) do
FTextPart[I] := '';
for TTP := Low(TTimeTextPart) to High(TTimeTextPart) do
FTimeText[TTP] := '';
FTimeDisplay := tdHMS;
FTimeFormat := tf24;
FLeadingZeros := True;
FStoredLockCount := 0;
FReadOnly := False;
FDateTime := SysUtils.Now;
FConfirmedDate := FDateTime;
FMinDate := TheSmallestDate;
FMaxDate := TheBiggestDate;
FTrailingSeparator := False;
FDateDisplayOrder := ddoTryDefault;
FSelectedTextPart := 1;
FUseDefaultSeparators := True;
FDateSeparator := SysUtils.DateSeparator;
FTimeSeparator := SysUtils.TimeSeparator;
FEffectiveCenturyFrom := FCenturyFrom;
FJumpMinMax := False;
ParentColor := False;
TabStop := True;
BorderWidth := 2;
BorderStyle := bsSingle;
ParentFont := True;
AutoSize := True;
UpdateDate;
end;
procedure TCustomDateTimeEditor.IncreaseMonth;
var
YMD: TYMD;
N: Word;
begin
SelectMonth;
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;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.IncreaseDay;
var
YMD: TYMD;
begin
SelectDay;
YMD := GetYYYYMMDD(True);
if YMD.Day >= NumberOfDaysInMonth(YMD.Month, YMD.Year) then
YMD.Day := 1
else
Inc(YMD.Day);
SetYYYYMMDD(YMD);
end;
procedure TCustomDateTimeEditor.DecreaseMonth;
var
YMD: TYMD;
N: Word;
begin
SelectMonth;
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;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.DecreaseDay;
var
YMD: TYMD;
begin
SelectDay;
YMD := GetYYYYMMDD(True);
if YMD.Day <= 1 then
YMD.Day := NumberOfDaysInMonth(YMD.Month, YMD.Year)
else
Dec(YMD.Day);
SetYYYYMMDD(YMD);
end;
procedure TCustomDateTimeEditor.IncreaseHour;
var
HMSMs: THMSMs;
begin
SelectHour;
HMSMs := GetHMSMs(True);
if HMSMs.Hour >= 23 then
HMSMs.Hour := 0
else
Inc(HMSMs.Hour);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.IncreaseMinute;
var
HMSMs: THMSMs;
begin
SelectMinute;
HMSMs := GetHMSMs(True);
if HMSMs.Minute >= 59 then
HMSMs.Minute := 0
else
Inc(HMSMs.Minute);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.IncreaseSecond;
var
HMSMs: THMSMs;
begin
SelectSecond;
HMSMs := GetHMSMs(True);
if HMSMs.Second >= 59 then
HMSMs.Second := 0
else
Inc(HMSMs.Second);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.IncreaseMiliSec;
var
HMSMs: THMSMs;
begin
SelectMiliSec;
HMSMs := GetHMSMs(True);
if HMSMs.MiliSec >= 999 then
HMSMs.MiliSec := 0
else
Inc(HMSMs.MiliSec);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.DecreaseHour;
var
HMSMs: THMSMs;
begin
SelectHour;
HMSMs := GetHMSMs(True);
if HMSMs.Hour <= 0 then
HMSMS.Hour := 23
else
Dec(HMSMs.Hour);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.DecreaseMinute;
var
HMSMs: THMSMs;
begin
SelectMinute;
HMSMs := GetHMSMs(True);
if HMSMs.Minute <= 0 then
HMSMs.Minute := 59
else
Dec(HMSMs.Minute);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.DecreaseSecond;
var
HMSMs: THMSMs;
begin
SelectSecond;
HMSMs := GetHMSMs(True);
if HMSMs.Second <= 0 then
HMSMs.Second := 59
else
Dec(HMSMs.Second);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.DecreaseMiliSec;
var
HMSMs: THMSMs;
begin
SelectMiliSec;
HMSMs := GetHMSMs(True);
if HMSMs.MiliSec <= 0 then
HMSMs.MiliSec := 999
else
Dec(HMSMs.MiliSec);
SetHMSMs(HMSMs);
end;
procedure TCustomDateTimeEditor.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 TCustomDateTimeEditor.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
{ TCustomZVDateTimePicker }
procedure TCustomZVDateTimePicker.SetChecked(const AValue: Boolean);
begin
if Assigned(FCheckBox) then
FCheckBox.Checked := AValue;
Invalidate;
end;
procedure TCustomZVDateTimePicker.CheckIfDateEditorIsEnabled;
begin
FDateTimeEditor.SetEnabled(Self.Enabled and GetChecked);
if Assigned(FArrowButton) then begin
FPanelForArrowButton.Enabled := FDateTimeEditor.Enabled;
FArrowButton.Enabled := FDateTimeEditor.Enabled;
end;
if Assigned(FUpDown) then
FUpDown.Enabled := FDateTimeEditor.Enabled;
end;
procedure TCustomZVDateTimePicker.SetDateDisplayOrder(const AValue: TDateDisplayOrder);
begin
FDateTimeEditor.DateDisplayOrder := AValue;
end;
procedure TCustomZVDateTimePicker.SetDateMode(const AValue: TDTDateMode);
begin
UpdateShowArrowButton(AValue, Kind);
FDateMode := AValue;
end;
procedure TCustomZVDateTimePicker.SetKind(const AValue: TDateTimeKind);
begin
if FDateTimeEditor.Kind <> AValue then begin
UpdateShowArrowButton(FDateMode, AValue);
FDateTimeEditor.Kind := AValue;
end;
end;
procedure TCustomZVDateTimePicker.SetLeadingZeros(const AValue: Boolean);
begin
FDateTimeEditor.LeadingZeros := AValue;
end;
procedure TCustomZVDateTimePicker.SetNullInputAllowed(const AValue: Boolean);
begin
FDateTimeEditor.NullInputAllowed := AValue;
end;
procedure TCustomZVDateTimePicker.SetDate(const AValue: TDate);
begin
FDateTimeEditor.Date := AValue;
end;
procedure TCustomZVDateTimePicker.SetDateTime(const AValue: TDateTime);
begin
if not EqualDateTime(FDateTimeEditor.DateTime, AValue) then
FDateTimeEditor.DateTime := AValue;
end;
procedure TCustomZVDateTimePicker.SetDateSeparator(const AValue: UTF8String);
begin
FDateTimeEditor.DateSeparator := AValue;
end;
procedure TCustomZVDateTimePicker.SetMaxDate(const AValue: TDate);
begin
FDateTimeEditor.MaxDate := AValue;
end;
procedure TCustomZVDateTimePicker.SetMinDate(const AValue: TDate);
begin
FDateTimeEditor.MinDate := AValue;
end;
procedure TCustomZVDateTimePicker.SetReadOnly(const AValue: Boolean);
begin
FDateTimeEditor.ReadOnly := AValue;
end;
procedure TCustomZVDateTimePicker.SetShowCheckBox(const AValue: Boolean);
var
CB: TCheckBox;
begin
if GetShowCheckBox <> AValue then begin
DisableAlign;
try
if AValue then begin
FCheckBox := TCheckBox.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 + [csNoDesignSelectable];
FCheckBox.AllowGrayed := False;
FCheckBox.TabStop := False;
FCheckBox.Parent := Self;
FCheckBox.Checked := True;
FCheckBox.OnChange := @CheckBoxChange;
ArrangeCtrls;
end else begin
FCheckBox.OnChange := nil;
CB := FCheckBox;
FCheckBox := nil;
ArrangeCtrls;
if not CB.Checked then
CheckIfDateEditorIsEnabled;
if Self.Enabled and CB.Focused and FDateTimeEditor.Enabled then
FDateTimeEditor.SetFocus;
FreeAndNil(CB);
end;
finally
EnableAlign;
end;
end;
end;
procedure TCustomZVDateTimePicker.SetTextForNullDate(const AValue: UTF8String);
begin
FDateTimeEditor.TextForNullDate := AValue;
end;
procedure TCustomZVDateTimePicker.SetTime(const AValue: TTime);
begin
FDateTimeEditor.Time := AValue;
end;
procedure TCustomZVDateTimePicker.SetTimeSeparator(const AValue: UTF8String);
begin
FDateTimeEditor.TimeSeparator := AValue;
end;
procedure TCustomZVDateTimePicker.SetTimeDisplay(const AValue: TTimeDisplay);
begin
FDateTimeEditor.TimeDisplay := AValue;
end;
procedure TCustomZVDateTimePicker.SetTimeFormat(const AValue: TTimeFormat);
begin
FDateTimeEditor.TimeFormat := AValue;
end;
procedure TCustomZVDateTimePicker.SetTrailingSeparator(const AValue: Boolean);
begin
FDateTimeEditor.TrailingSeparator := AValue;
end;
procedure TCustomZVDateTimePicker.SetUseDefaultSeparators(const AValue: Boolean);
begin
FDateTimeEditor.UseDefaultSeparators := AValue;
end;
procedure TCustomZVDateTimePicker.DestroyTheCalendar;
begin
if Assigned(FCal) then begin
FCal.OnChange := nil;
FCal.OnResize := nil;
FCal.OnMouseUp := nil;
FCal.OnKeyDown := nil;
FreeAndNil(FCal);
end;
FreeAndNil(FShape);
end;
procedure TCustomZVDateTimePicker.AdjustCalendarFormSize;
begin
FCalendarForm.ClientWidth := FCal.Width + 2;
FCalendarForm.ClientHeight := FCal.Height + 2;
FShape.SetBounds(0, 0, FCalendarForm.ClientWidth, FCalendarForm.ClientHeight);
AdjustCalendarFormScreenPosition;
end;
procedure TCustomZVDateTimePicker.CreateCalendarForm;
var
P: TPoint;
begin
if not (csDesigning in ComponentState) then begin
DestroyCalendarForm;
FCloseCalendarOnChange := False;
P := Point(0, 0);
FCal := TCalendar.Create(nil);
FCal.AutoSize := True;
FCal.GetPreferredSize(P.x, P.y);
FCal.Align := alNone;
FCal.SetBounds(1, 1, P.x, P.y);
FCal.TabStop := True;
FCalendarForm := TCustomForm.Create(nil);
{$IFDEF LCL_0_9_29_OR_AFTER}
// Nice new property!
FCalendarForm.PopupMode := pmAuto;
{$ENDIF}
FCalendarForm.SetBounds(-8000, -8000, P.x + 2, P.y + 2);
FRememberedCalendarFormOrigin := Point(-8000, -8000);
FCalendarForm.ShowInTaskBar := stNever;
FCalendarForm.BorderStyle := bsNone;
FShape := TShape.Create(nil);
FShape.Brush.Style := bsClear;
FCal.Parent := FCalendarForm;
FShape.Parent := FCalendarForm;
FCal.OnResize := @CalendarResize;
FCal.OnMouseUp := @CalendarMouseUp;
FCal.OnKeyDown := @CalendarKeyDown;
FCal.OnChange := @CalendarChange;
FCalendarForm.OnDeactivate := @CalendarFormDeactivate;
FCalendarForm.OnClose := @CalendarFormClose;
FCalendarForm.OnShow := @CalendarFormShow;
FCalendarForm.OnDestroy := @CalendarFormDestroy;
//AdjustCalendarFormSize;
end;
end;
procedure TCustomZVDateTimePicker.DestroyCalendarForm;
begin
if Assigned(FCalendarForm) then begin
DestroyTheCalendar;
FCalendarForm.Release;
FCalendarForm := nil;
end;
end;
procedure TCustomZVDateTimePicker.AdjustCalendarFormScreenPosition;
var
R: TRect;
P: TPoint;
H, W: Integer;
begin
H := FCalendarForm.Height;
W := FCalendarForm.Width;
P := ControlToScreen(Point(0, Height));
R := Screen.MonitorFromWindow(Self.Handle).WorkareaRect;
if P.y > R.Bottom - H then
P.y := P.y - H - 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 <> FRememberedCalendarFormOrigin.x)
or (P.y <> FRememberedCalendarFormOrigin.y) then begin
FCalendarForm.SetBounds(P.x, P.y, W, H);
FRememberedCalendarFormOrigin := P;
end;
end;
// In older Lazarus versions, GetControlClassDefaultSize is of type TPoint,
// since 0.9.29, svn rev. 25204, it's TSize.
{$IFDEF LCL_0_9_29_OR_AFTER}
class function TCustomZVDateTimePicker.GetControlClassDefaultSize: TSize;
begin
Result.cx := 102;
Result.cy := 23;
end;
{$ELSE}
class function TCustomZVDateTimePicker.GetControlClassDefaultSize: TPoint;
begin
Result.x := 102;
Result.y := 23;
end;
{$ENDIF}
procedure TCustomZVDateTimePicker.SetHint(const Value: TTranslateString);
begin
inherited SetHint(Value);
FDateTimeEditor.Hint := Hint;
end;
procedure TCustomZVDateTimePicker.SetEnabled(Value: Boolean);
begin
inherited SetEnabled(Value);
CheckIfDateEditorIsEnabled;
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 TCustomZVDateTimePicker.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 TCustomZVDateTimePicker.SetDateTimeJumpMinMax(const AValue: TDateTime);
begin
FDateTimeEditor.SetDateTimeJumpMinMax(AValue);
end;
procedure TCustomZVDateTimePicker.ArrangeCtrls;
begin
if not FDoNotArrangeControls then begin //Read the note above CreateWnd procedure.
DisableAutoSizing;
DisableAlign;
try
FDateTimeEditor.Align := alNone;
if GetShowCheckBox then begin
FCheckBox.Align := alLeft;
FCheckBox.BorderSpacing.Left := 2;
FDateTimeEditor.AnchorToCompanion(akLeft, 0, FCheckBox);
FCheckBox.BringToFront;
end else begin
FDateTimeEditor.Align := alLeft;
end;
CheckIfDateEditorIsEnabled;
InvalidatePreferredSize;
AdjustSize;
Invalidate;
finally
EnableAlign;
EnableAutoSizing;
end;
end;
end;
procedure TCustomZVDateTimePicker.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TCustomZVDateTimePicker.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
begin
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
WithThemeSpace);
if Assigned(FArrowButton) then
PreferredWidth := PreferredWidth +
Min(FPanelForArrowButton.Width, FDateTimeEditor.Width) + 2;
if Assigned(FUpDown) then
PreferredWidth := PreferredWidth +
Min(FUpDown.Width, FDateTimeEditor.Width) + 2;
end;
procedure TCustomZVDateTimePicker.SelectDate;
begin
FDateTimeEditor.SelectDate;
end;
procedure TCustomZVDateTimePicker.SelectTime;
begin
FDateTimeEditor.SelectTime;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorChange(Sender: TObject);
begin
Change;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
KeyDown(Key, Shift); // We call our event handler first, so that handler can
// prevent the default code from executing (by assigning 0 to Key; which
// would also prevent FDateTimeEditor's default key handling, as this code
// is called from there first).
if Key = VK_SPACE then begin
// Pressing the space bar checks / unchecks the check box.
if GetShowCheckBox then begin
{ On Linux, it seems to be enough to call FCheckBox.SetFocus. Check box
gets checked or unchecked automatically. Maybe the check box receives
this key event too, I don't know, but when I did testing on Linux,
leaving both next lines acted as if the check box is clicked twice, so
we need to isolate the first line from Linux.
On Windows, however, both next lines should execute. }
// {$IFDEF LCLWin32}
// It seems that this behaviour is special to Gtk2 ws. So, we will use this:
{$IFNDEF LCLGtk2}
FCheckBox.Checked := not FCheckBox.Checked;
{$ENDIF}
FCheckBox.SetFocus;
end;
end;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
KeyUp(Key, Shift);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorKeyPress(Sender: TObject; var Key: char);
begin
KeyPress(Key);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorUTF8KeyPress(Sender: TObject;
var UTF8Key: TUTF8Char);
begin
UTF8KeyPress(UTF8Key);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P, P1: TPoint;
begin
P := FDateTimeEditor.ClientOrigin;
P1 := ClientOrigin;
X := X + P.x - P1.x;
Y := Y + P.y - P1.y;
MouseDown(Button, Shift, X, Y);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
P, P1: TPoint;
begin
P := FDateTimeEditor.ClientOrigin;
P1 := ClientOrigin;
X := X + P.x - P1.x;
Y := Y + P.y - P1.y;
MouseMove(Shift, X, Y);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P, P1: TPoint;
begin
P := FDateTimeEditor.ClientOrigin;
P1 := ClientOrigin;
X := X + P.x - P1.x;
Y := Y + P.y - P1.y;
MouseUp(Button, Shift, X, Y);
end;
procedure TCustomZVDateTimePicker.DateTimeEditorEnter(Sender: TObject);
begin
FCallFromDateTimeEditorEnter := True;
try
DoEnter;
finally
FCallFromDateTimeEditorEnter := False;
end;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorExit(Sender: TObject);
begin
FCallFromDateTimeEditorExit := True;
try
DoExit;
finally
FCallFromDateTimeEditorExit := False;
end;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorEditingDone(Sender: TObject);
begin
EditingDone;
end;
procedure TCustomZVDateTimePicker.ArrowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
DropDownCalendarForm;
end;
procedure TCustomZVDateTimePicker.UpDownClick(Sender: TObject;
Button: TUDBtnType);
begin
FDateTimeEditor.SetFocus;
if not ReadOnly then begin
if Button = btNext then
FDateTimeEditor.IncreaseCurrentTextPart
else
FDateTimeEditor.DecreaseCurrentTextPart;
end;
end;
procedure TCustomZVDateTimePicker.DoDropDown;
begin
if Assigned(FOnDropDown) then
FOnDropDown(Self);
end;
procedure TCustomZVDateTimePicker.DoCloseUp;
begin
if Assigned(FOnCloseUp) then
FOnCloseUp(Self);
end;
function TCustomZVDateTimePicker.GetChecked: Boolean;
begin
Result := (not Assigned(FCheckBox)) or (FCheckBox.State = cbChecked);
end;
procedure TCustomZVDateTimePicker.DrawArrowButtonGlyph;
const
ArrowColor = TColor($8D665A);
begin
// 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.
if Assigned(FArrowButton) then begin
FArrowButton.Glyph.TransparentColor := clRed;
FArrowButton.Glyph.SetSize(9, 6);
FArrowButton.Glyph.Canvas.Brush.Style := bsSolid;
FArrowButton.Glyph.Canvas.Brush.Color := clSkyBlue;
FArrowButton.Glyph.Canvas.FillRect(0, 0, 9, 6);
FArrowButton.Glyph.Canvas.Pen.Color := ArrowColor;
FArrowButton.Glyph.Canvas.Brush.Color := FArrowButton.Glyph.Canvas.Pen.Color;
{ Let's draw shape of the arrow on the button: }
case FArrowShape of
asClassicLarger:
{ triangle: }
FArrowButton.Glyph.Canvas.Polygon([Point(0, 1), Point(8, 1), Point(4, 5)]);
asClassicSmaller:
{ triangle -- smaller variant: }
FArrowButton.Glyph.Canvas.Polygon([Point(1, 2), Point(7, 2), Point(4, 5)]);
asModernLarger:
{ modern: }
FArrowButton.Glyph.Canvas.Polygon([Point(0, 1), Point(1, 0), Point(4, 3),
Point(7, 0), Point(8, 1), Point(4, 5)]);
asModernSmaller:
{ modern -- smaller variant: }
FArrowButton.Glyph.Canvas.Polygon([Point(1, 2), Point(2, 1), Point(4, 3),
Point(6, 1), Point(7, 2), Point(4, 5)]);
asYetAnotherShape:
{ something in between, not very pretty: }
FArrowButton.Glyph.Canvas.Polygon([Point(0, 1), Point(1, 0), Point(2, 1),
Point(6, 1),Point(7, 0), Point(8, 1), Point(4, 5)]);
end;
FArrowButton.Glyph.TransparentColor := clSkyBlue;
end;
end;
function TCustomZVDateTimePicker.GetCenturyFrom: Word;
begin
Result := FDateTimeEditor.CenturyFrom;
end;
function TCustomZVDateTimePicker.AreSeparatorsStored: Boolean;
begin
Result := not GetUseDefaultSeparators;
end;
function TCustomZVDateTimePicker.GetDateDisplayOrder: TDateDisplayOrder;
begin
Result := FDateTimeEditor.DateDisplayOrder;
end;
function TCustomZVDateTimePicker.GetKind: TDateTimeKind;
begin
Result := FDateTimeEditor.Kind;
end;
function TCustomZVDateTimePicker.GetLeadingZeros: Boolean;
begin
Result := FDateTimeEditor.LeadingZeros;
end;
function TCustomZVDateTimePicker.GetNullInputAllowed: Boolean;
begin
Result := FDateTimeEditor.NullInputAllowed;
end;
function TCustomZVDateTimePicker.GetDate: TDate;
begin
Result := FDateTimeEditor.Date;
end;
function TCustomZVDateTimePicker.GetDateTime: TDateTime;
begin
Result := FDateTimeEditor.DateTime;
end;
function TCustomZVDateTimePicker.GetDateSeparator: UTF8String;
begin
Result := FDateTimeEditor.DateSeparator;
end;
function TCustomZVDateTimePicker.GetMaxDate: TDate;
begin
Result := FDateTimeEditor.MaxDate;
end;
function TCustomZVDateTimePicker.GetMinDate: TDate;
begin
Result := FDateTimeEditor.MinDate;
end;
function TCustomZVDateTimePicker.GetReadOnly: Boolean;
begin
Result := FDateTimeEditor.ReadOnly;
end;
function TCustomZVDateTimePicker.GetShowCheckBox: Boolean;
begin
Result := Assigned(FCheckBox);
end;
function TCustomZVDateTimePicker.GetTextForNullDate: UTF8String;
begin
Result := FDateTimeEditor.TextForNullDate;
end;
function TCustomZVDateTimePicker.GetTime: TTime;
begin
Result := FDateTimeEditor.GetTime;
end;
function TCustomZVDateTimePicker.GetTimeSeparator: UTF8String;
begin
Result := FDateTimeEditor.TimeSeparator;
end;
function TCustomZVDateTimePicker.GetTimeDisplay: TTimeDisplay;
begin
Result := FDateTimeEditor.TimeDisplay;
end;
function TCustomZVDateTimePicker.GetTimeFormat: TTimeFormat;
begin
Result := FDateTimeEditor.TimeFormat;
end;
function TCustomZVDateTimePicker.GetTrailingSeparator: Boolean;
begin
Result := FDateTimeEditor.TrailingSeparator;
end;
function TCustomZVDateTimePicker.GetUseDefaultSeparators: Boolean;
begin
Result := FDateTimeEditor.UseDefaultSeparators;
end;
procedure TCustomZVDateTimePicker.SetArrowShape(const AValue: TArrowShape);
begin
if FArrowShape = AValue then Exit;
FArrowShape := AValue;
DrawArrowButtonGlyph;
end;
procedure TCustomZVDateTimePicker.SetCenturyFrom(const AValue: Word);
begin
FDateTimeEditor.CenturyFrom := AValue;
end;
procedure TCustomZVDateTimePicker.CheckBoxChange(Sender: TObject);
begin
CheckIfDateEditorIsEnabled;
if Assigned(FCheckBox) then begin
if FCheckBox.Focused and FDateTimeEditor.Enabled then
FDateTimeEditor.SetFocus;
FCheckBox.TabStop := not FDateTimeEditor.Enabled;
end;
end;
procedure TCustomZVDateTimePicker.CalendarMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FCal.HitTest(Point(X, Y)) in [cpDate, cpNoWhere] then begin
// According to tests made by Željko Rikalo,
// on Qt widgetset the calendar's DateTime field does not get updated if
// we close the calendar form here, because on Qt change is not made until
// after the OnMouseUp event.
// Let's then try something else, as proposed by Željko:
// Closing the calendar form is moved to Calendar.OnChange.
{$IFDEF QT_BEFORE_0_9_29}
// Željko changed the Qt behaviour since Lazarus 0.9.29, revision 23641.
FCloseCalendarOnChange := True; // This is asked in
// CalendarChange procedure.
{$ELSE}
// On the other hand, on other widgetsets, the previous wouldn't work
// because OnChange gets called before OnMoueseUp event, so the OnChange
// event is already executed when we are here, so it's too late to notify
// it now.
// But the calendar's date is already changed then and we can simply
// call CloseCalendarForm immidiately.
CloseCalendarForm(True);
{$ENDIF}
end;
end;
procedure TCustomZVDateTimePicker.CalendarChange(Sender: TObject);
begin
{$IFDEF QT_BEFORE_0_9_29}
// See the coments in CalendarMouseUp procedure.
if FCloseCalendarOnChange then
CloseCalendarForm(True);
{$ENDIF}
end;
procedure TCustomZVDateTimePicker.CalendarKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_ESCAPE:
begin
CloseCalendarForm;
//Key := 0;
end;
VK_RETURN, VK_SPACE:
begin
CloseCalendarForm(True);
//Key := 0;
end;
end;
end;
procedure TCustomZVDateTimePicker.CalendarFormDeactivate(Sender: TObject);
begin
if not FClosingCalendarForm then
CloseCalendarForm;
end;
procedure TCustomZVDateTimePicker.CalendarFormShow(Sender: TObject);
begin
FClosingCalendarForm := False;
//AdjustCalendarFormScreenPosition;
AdjustCalendarFormSize;
DoDropDown; // calls OnDropDown event handler
end;
procedure TCustomZVDateTimePicker.CalendarFormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
FClosingCalendarForm := True;
CloseAction := caFree;
end;
procedure TCustomZVDateTimePicker.CalendarFormDestroy(Sender: TObject);
begin
DestroyTheCalendar;
FCalendarForm := nil;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorClick(Sender: TObject);
begin
Click;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorDblClick(Sender: TObject);
begin
DblClick;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorTripleClick(Sender: TObject);
begin
TripleClick;
end;
procedure TCustomZVDateTimePicker.DateTimeEditorQuadClick(Sender: TObject);
begin
QuadClick;
end;
procedure TCustomZVDateTimePicker.DoEnter;
begin
if FCallFromDateTimeEditorEnter then
inherited DoEnter
else if FDateTimeEditor.Enabled then
FDateTimeEditor.SetFocus
else if Assigned(FCheckBox) then
FCheckBox.SetFocus;
end;
procedure TCustomZVDateTimePicker.DoExit;
begin
if FCallFromDateTimeEditorExit then
inherited DoExit;
end;
procedure TCustomZVDateTimePicker.CloseCalendarForm(AndSetTheDate: Boolean);
begin
if Assigned(FCalendarForm) and (not FClosingCalendarForm) then begin
FClosingCalendarForm := True;
if AndSetTheDate then begin
if DateIsNull then begin
// we'll set the time to 0.0 (midnight)
FDateTimeEditor.ChangeDateTimeInternally(Int(FCal.DateTime));
// Change;
end else if not EqualDateTime(Int(DateTime), Int(FCal.DateTime)) then begin
// we'll change the date, but keep the time:
FDateTimeEditor.ChangeDateTimeInternally(
ComposeDateTime(FCal.DateTime, DateTime));
// Change;
end;
end;
try
FDateTimeEditor.SetFocus;
except
end;
FCalendarForm.Close;
DoCloseUp;
end;
end;
procedure TCustomZVDateTimePicker.DropDownCalendarForm;
{$IFNDEF LCLWin32}
var
F: TCustomForm;
{$ENDIF}
begin
if not (ReadOnly or Assigned(FCalendarForm)) then begin
try
CreateCalendarForm;
if DateIsNull then
FCal.DateTime := Max(MinDate, Min(SysUtils.Date, MaxDate))
else if DateTime < MinDate then // These "out of bounds" values can
FCal.DateTime := MinDate // happen when DateTime was set with
else if DateTime > MaxDate then // "SetDateTimeJumpMinMax" protected
FCal.DateTime := MaxDate // procedure (used in TDBZVDateTimePicker control).
else
FCal.DateTime := DateTime;
{$IFNDEF LCLWin32}
// On Gtk2, it seems that if a non-modal form is shown on top
// of a modal one, it can't get user interaction. So it is useless then.
// Therefore, if our parent is shown modally, we must show the calendar
// on a modal form too.
// Seems that it applies to Qt also!
F := GetParentForm(Self);
if Assigned(F) and (fsModal in F.FormState) then
FCalendarForm.ShowModal
else
{$ENDIF}
FCalendarForm.Show;
finally
if Assigned(FCalendarForm) and (not FCalendarForm.Visible) then
DestroyCalendarForm;
end;
end;
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)
protected
procedure SetEnabled(Value: Boolean); override;
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean); override;
end;
{ TDTUpDown }
{ When our UpDown control gets enabled/disabled, the two its buttons' Enabled
property is set accordingly. }
procedure TDTUpDown.SetEnabled(Value: Boolean);
var
I: Integer;
begin
inherited SetEnabled(Value);
for I := 0 to ControlCount - 1 do begin
Controls[I].Enabled := Value;
end;
end;
{ Our UpDown control is always alligned, but setting its PreferredHeight
uncoditionally to 0 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 := 0;
end;
procedure TCustomZVDateTimePicker.UpdateShowArrowButton(
NewDateMode: TDTDateMode; NewKind: TDateTimeKind);
procedure CreateArrowBtn;
begin
if not Assigned(FArrowButton) then begin
DestroyUpDown;
// We'll add a Panel which will be SpeedButton's parent.
// It's only needed because it's more appropriate to have speed button
// above the date text when we are not auto sized.
// The speed button itself cannot be brought in front of DateEditor,
// because TSpeedButton does not descend from TWinControl, so we need a
// panel to carry it.
FPanelForArrowButton := TPanel.Create(Self);
FPanelForArrowButton.ControlStyle := FPanelForArrowButton.ControlStyle +
[csNoFocus, csNoDesignSelectable];
FPanelForArrowButton.BorderStyle := bsNone;
FPanelForArrowButton.Caption := '';
FPanelForArrowButton.BevelInner := bvNone;
FPanelForArrowButton.BevelOuter := bvNone;
FPanelForArrowButton.SetBounds(0, 0, 17, 1);
FPanelForArrowButton.Parent := Self;
FPanelForArrowButton.Align := alRight;
FPanelForArrowButton.BringToFront;
FArrowButton := TSpeedButton.Create(Self);
FArrowButton.ControlStyle := FArrowButton.ControlStyle +
[csNoFocus, csNoDesignSelectable];
FArrowButton.SetBounds(0, 0, 17, 1);
FArrowButton.Parent := FPanelForArrowButton;
FArrowButton.Align := alClient;
FArrowButton.BringToFront;
DrawArrowButtonGlyph;
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];
FUpDown.SetBounds(0, 0, 15, 1);
FUpDown.Parent := Self;
FUpDown.Align := alRight;
FUpDown.BringToFront;
TDTUpDown(FUPDown).OnClick := @UpDownClick;
end;
end;
var
ReallyShowCalendar: Boolean;
begin
if NewDateMode = dmNone then begin
DestroyArrowBtn;
DestroyUpDown;
end else begin
ReallyShowCalendar := (NewDateMode = dmComboBox) and (NewKind <> dtkTime);
if (ReallyShowCalendar <> Assigned(FArrowButton)) or
(Assigned(FArrowButton) = Assigned(FUpDown)) then begin
if ReallyShowCalendar then
CreateArrowBtn
else
CreateUpDown;
ArrangeCtrls;
end;
end;
end;
procedure TCustomZVDateTimePicker.DestroyUpDown;
begin
if Assigned(FUpDown) then begin
TDTUpDown(FUPDown).OnClick := nil;
FreeAndNil(FUpDown);
end;
end;
procedure TCustomZVDateTimePicker.DestroyArrowBtn;
begin
if Assigned(FArrowButton) then begin
FArrowButton.OnMouseDown := nil;
DestroyCalendarForm;
FreeAndNil(FArrowButton);
FreeAndNil(FPanelForArrowButton);
end;
end;
procedure TCustomZVDateTimePicker.CalendarResize(Sender: TObject);
begin
AdjustCalendarFormSize;
end;
constructor TCustomZVDateTimePicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with GetControlClassDefaultSize do begin
{$IFDEF LCL_0_9_29_OR_AFTER}
SetInitialBounds(0, 0, cx, cy); // TSize since 0.9.29, svn rev. 25204
{$ELSE}
SetInitialBounds(0, 0, x, y); // TPoint in older Lazarus versions
{$ENDIF}
end;
FArrowShape := asModernSmaller;
FCallFromDateTimeEditorEnter := False;
FCallFromDateTimeEditorExit := False;
FOnDropDown := nil;
FOnCloseUp := nil;
FOnChange := nil;
FForceShowCalendar := False;
ParentColor := False;
FCheckBox := nil;
FArrowButton := nil;
FPanelForArrowButton := nil;
FUpDown := nil;
FDateTimeEditor := TCustomDateTimeEditor.Create(Self);
FDateTimeEditor.ControlStyle := FDateTimeEditor.ControlStyle + [csNoDesignSelectable];
FDateTimeEditor.BorderStyle := bsNone;
FDateTimeEditor.ParentColor := True;
FDateTimeEditor.Parent := Self;
FDateTimeEditor.Align := alLeft;
BorderStyle := bsSingle;
AutoSize := True;
TabStop := True;
FDateTimeEditor.OnChange := @DateTimeEditorChange;
FDateTimeEditor.OnKeyDown := @DateTimeEditorKeyDown;
FDateTimeEditor.OnEnter := @DateTimeEditorEnter;
FDateTimeEditor.OnExit := @DateTimeEditorExit;
FDateTimeEditor.OnEditingDone := @DateTimeEditorEditingDone;
FDateTimeEditor.OnClick := @DateTimeEditorClick;
FDateTimeEditor.OnDblClick := @DateTimeEditorDblClick;
FDateTimeEditor.OnTripleClick := @DateTimeEditorTripleClick;
FDateTimeEditor.OnQuadClick := @DateTimeEditorQuadClick;
FDateTimeEditor.OnKeyUp := @DateTimeEditorKeyUp;
FDateTimeEditor.OnKeyPress := @DateTimeEditorKeyPress;
FDateTimeEditor.OnUTF8KeyPress := @DateTimeEditorUTF8KeyPress;
FDateTimeEditor.OnMouseDown := @DateTimeEditorMouseDown;
FDateTimeEditor.OnMouseMove := @DateTimeEditorMouseMove;
FDateTimeEditor.OnMouseUp := @DateTimeEditorMouseUp;
FShape := nil;
FCal := nil;
FCalendarForm := nil;
FDoNotArrangeControls := True;
DateMode := dmComboBox;
end;
destructor TCustomZVDateTimePicker.Destroy;
begin
FDoNotArrangeControls := True;
DestroyUpDown;
DestroyArrowBtn;
SetShowCheckBox(False);
FDateTimeEditor.OnMouseUp := nil;
FDateTimeEditor.OnMouseMove := nil;
FDateTimeEditor.OnMouseDown := nil;
FDateTimeEditor.OnUTF8KeyPress := nil;
FDateTimeEditor.OnKeyPress := nil;
FDateTimeEditor.OnKeyUp := nil;
FDateTimeEditor.OnQuadClick := nil;
FDateTimeEditor.OnTripleClick := nil;
FDateTimeEditor.OnDblClick := nil;
FDateTimeEditor.OnClick := nil;
FDateTimeEditor.OnEditingDone := nil;
FDateTimeEditor.OnExit := nil;
FDateTimeEditor.OnEnter := nil;
FDateTimeEditor.OnKeyDown := nil;
FDateTimeEditor.OnChange := nil;
FreeThenNil(FDateTimeEditor);
inherited Destroy;
end;
function TCustomZVDateTimePicker.DateIsNull: Boolean;
begin
Result := FDateTimeEditor.DateIsNull;
end;
end.
Reference in a new issue View git blame Copy permalink