paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 12:19:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

DateTimePicker: Make widths of ArrowButton and UpDown highDPI-aware. Issue #35814.

Browse Source 
git-svn-id: trunk@61558 -
This commit is contained in:
wp 2019-07-10 20:50:57 +00:00
parent ac17315ae2
commit d32b16b312
1 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/datetimectrls/datetimepicker.pas
View File

@ -350,6 +350,8 @@ type
procedure DoDropDown; virtual; procedure DoDropDown; virtual;
procedure DoCloseUp; virtual; procedure DoCloseUp; virtual;
procedure DoAutoCheck; virtual; procedure DoAutoCheck; virtual;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
procedure AddHandlerOnChange(const AOnChange: TNotifyEvent; procedure AddHandlerOnChange(const AOnChange: TNotifyEvent;
AsFirst: Boolean = False); virtual; AsFirst: Boolean = False); virtual;
@ -533,6 +535,10 @@ implementation
uses uses
DateUtils, LCLCalWrapper; DateUtils, LCLCalWrapper;
const
DefaultUpDownWidth = 15;
DefaultArrowButtonWidth = DefaultUpDownWidth + 2;
function NumberOfDaysInMonth(const Month, Year: Word): Word; function NumberOfDaysInMonth(const Month, Year: Word): Word;
begin begin
Result := 0; Result := 0;
@ -3273,10 +3279,6 @@ begin
FArrowButton.Invalidate; FArrowButton.Invalidate;
end; end;
const
DefaultUpDownWidth = 15;
DefaultArrowButtonWidth = DefaultUpDownWidth + 2;
procedure TCustomDateTimePicker.SetAutoButtonSize(AValue: Boolean); procedure TCustomDateTimePicker.SetAutoButtonSize(AValue: Boolean);
begin begin
if FAutoButtonSize <> AValue then begin if FAutoButtonSize <> AValue then begin
@ -3286,9 +3288,9 @@ begin
AutoResizeButton AutoResizeButton
else begin else begin
if Assigned(FUpDown) then if Assigned(FUpDown) then
FUpDown.Width := DefaultUpDownWidth FUpDown.Width := Scale96ToFont(DefaultUpDownWidth)
else if Assigned(FArrowButton) then else if Assigned(FArrowButton) then
FArrowButton.Width := DefaultArrowButtonWidth; FArrowButton.Width := Scale96ToFont(DefaultArrowButtonWidth);
end; end;
end; end;
@ -3347,7 +3349,6 @@ begin
FArrowButton.Width := MulDiv(ClientHeight, 9, 10) FArrowButton.Width := MulDiv(ClientHeight, 9, 10)
else if Assigned(FUpDown) then else if Assigned(FUpDown) then
FUpDown.Width := MulDiv(ClientHeight, 79, 100); FUpDown.Width := MulDiv(ClientHeight, 79, 100);
end; end;
procedure TCustomDateTimePicker.CheckAndApplyKey(const Key: Char); procedure TCustomDateTimePicker.CheckAndApplyKey(const Key: Char);
@ -3772,7 +3773,7 @@ procedure TCustomDateTimePicker.UpdateShowArrowButton;
[csNoFocus, csNoDesignSelectable]; [csNoFocus, csNoDesignSelectable];
FArrowButton.Flat := dtpoFlatButton in Options; FArrowButton.Flat := dtpoFlatButton in Options;
TDTSpeedButton(FArrowButton).DTPicker := Self; TDTSpeedButton(FArrowButton).DTPicker := Self;
FArrowButton.SetBounds(0, 0, DefaultArrowButtonWidth, 1); FArrowButton.SetBounds(0, 0, Scale96ToFont(DefaultArrowButtonWidth), 1);
FArrowButton.Parent := Self; FArrowButton.Parent := Self;
FAllowDroppingCalendar := True; FAllowDroppingCalendar := True;
@ -3794,7 +3795,7 @@ procedure TCustomDateTimePicker.UpdateShowArrowButton;
TDTUpDown(FUpDown).DTPicker := Self; TDTUpDown(FUpDown).DTPicker := Self;
TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options; TDTUpDown(FUpDown).Flat := dtpoFlatButton in Options;
FUpDown.SetBounds(0, 0, DefaultUpDownWidth, 1); FUpDown.SetBounds(0, 0, Scale96ToFont(DefaultUpDownWidth), 1);
FUpDown.Parent := Self; FUpDown.Parent := Self;
@ -3848,6 +3849,22 @@ begin
Checked := True; Checked := True;
end; end;
procedure TCustomDateTimePicker.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if (not FAutoButtonSize) then begin
if Assigned(FArrowButton) then
FArrowButton.Width := Scale96ToFont(DefaultArrowButtonWidth);
if Assigned(FUpDown) then
FUpDown.Width := Scale96ToFont(DefaultUpdownWidth);
end;
end;
end;
procedure TCustomDateTimePicker.DestroyArrowBtn; procedure TCustomDateTimePicker.DestroyArrowBtn;
begin begin
if Assigned(FArrowButton) then begin if Assigned(FArrowButton) then begin