paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 04:00:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: toolbar: High-DPI: fixes - use 0 as default button size

Browse Source 
git-svn-id: trunk@54238 -
This commit is contained in:
ondrej 2017-02-21 20:42:24 +00:00
parent 9d2597a2b5
commit eb5e2e2060
3 changed files with 83 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lcl/comctrls.pp
View File

@ -2206,7 +2206,7 @@ type
procedure SetButtonHeight(const AValue: Integer);
procedure SetButtonWidth(const AValue: Integer);
procedure SetDisabledImages(const AValue: TCustomImageList);
procedure SetDropDownWidth(const aDropDownWidth: Integer);
procedure SetDropDownWidth(const ADropDownWidth: Integer);
procedure SetFlat(const AValue: Boolean);
procedure SetHotImages(const AValue: TCustomImageList);
procedure SetImages(const AValue: TCustomImageList);
@ -2226,7 +2226,6 @@ type
protected const
cDefButtonWidth = 23;
cDefButtonHeight = 22;
cDropDownWidth = -1;
protected
FPrevVertical: Boolean;
function IsVertical: Boolean; virtual;
@ -2263,6 +2262,8 @@ type
function CanFocus: Boolean; override;
function GetRealDropDownWidth: Integer;
function GetRealButtonDropWidth: Integer;
function GetRealButtonWidth: Integer;
function GetRealButtonHeight: Integer;
public
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TToolButton read GetButton;
@ -2274,8 +2275,8 @@ type
property AutoSize;
property BorderSpacing;
property BorderWidth;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default cDefButtonHeight;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default cDefButtonWidth;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 0;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 0;
property Caption;
property ChildSizing;
property Constraints;
@ -2285,7 +2286,7 @@ type
property DragCursor;
property DragKind;
property DragMode;
property DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth default cDropDownWidth;
property DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth default 0;
property EdgeBorders default [ebTop];
property EdgeInner;
property EdgeOuter;

83
lcl/include/toolbar.inc
View File

@ -89,9 +89,6 @@ begin
csDoubleClicks, csMenuEvents, csSetCaption, csParentBackground, csOpaque];
FFlat := True;
Height := 32;
FButtonWidth := cDefButtonWidth;
FButtonHeight := cDefButtonHeight;
FDropDownWidth := cDropDownWidth;
Details := ThemeServices.GetElementDetails(ttbSplitButtonDropDownNormal);
FThemeDropDownWidth := ThemeServices.GetDetailSize(Details).cx;
Details := ThemeServices.GetElementDetails(ttbDropDownButtonNormal);
@ -351,8 +348,7 @@ begin
BeginUpdate;
try
SetButtonSize(Round(ButtonWidth * AXProportion), Round(ButtonHeight * AYProportion));
if DropDownWidth<>cDropDownWidth then
DropDownWidth := Round(DropDownWidth * AXProportion);
DropDownWidth := Round(DropDownWidth * AXProportion);
FToolBarFlags := FToolBarFlags + [tbfUpdateVisibleBarNeeded];
finally
EndUpdate;
@ -374,10 +370,10 @@ begin
UpdateVisibleBar;
end;
procedure TToolBar.SetDropDownWidth(const aDropDownWidth: Integer);
procedure TToolBar.SetDropDownWidth(const ADropDownWidth: Integer);
begin
if FDropDownWidth = aDropDownWidth then Exit;
FDropDownWidth := aDropDownWidth;
if FDropDownWidth = ADropDownWidth then Exit;
FDropDownWidth := ADropDownWidth;
UpdateVisibleBar;
end;
@ -448,7 +444,7 @@ end;
function TToolBar.GetRealDropDownWidth: Integer;
begin
if FDropDownWidth < 0 then
if FDropDownWidth = 0 then
Result := MulDiv(FThemeDropDownWidth, Font.PixelsPerInch, Screen.PixelsPerInch)
else
Result := FDropDownWidth;
@ -456,12 +452,28 @@ end;
function TToolBar.GetRealButtonDropWidth: Integer;
begin
if FDropDownWidth < 0 then
if FDropDownWidth = 0 then
Result := MulDiv(FThemeButtonDropWidth, Font.PixelsPerInch, Screen.PixelsPerInch)
else
Result := FDropDownWidth+FThemeButtonDropWidth-FThemeDropDownWidth;
end;
function TToolBar.GetRealButtonHeight: Integer;
begin
if FButtonHeight = 0 then
Result := MulDiv(cDefButtonHeight, Font.PixelsPerInch, 96)
else
Result := FButtonHeight;
end;
function TToolBar.GetRealButtonWidth: Integer;
begin
if FButtonWidth = 0 then
Result := MulDiv(cDefButtonWidth, Font.PixelsPerInch, 96)
else
Result := FButtonWidth;
end;
procedure TToolBar.Paint;
begin
if csDesigning in ComponentState then
@ -479,7 +491,7 @@ var
CurControl: TControl;
NewWidth: Integer;
NewHeight: Integer;
i: Integer;
i, RealButtonWidth, RealButtonHeight: Integer;
ChangeW, ChangeH: Boolean;
begin
ChangeW := FButtonWidth <> NewButtonWidth;
@ -488,6 +500,8 @@ begin
FButtonWidth:=NewButtonWidth;
FButtonHeight:=NewButtonHeight;
RealButtonWidth := GetRealButtonWidth;
RealButtonHeight := GetRealButtonHeight;
if FUpdateCount > 0 then Exit;
if [csLoading, csDestroying] * ComponentState <> [] then Exit;
@ -503,7 +517,7 @@ begin
// width
if ChangeW
and (ButtonWidth > 0)
and (RealButtonWidth > 0)
and not CurControl.AutoSize
and (CurControl is TToolButton)
and (CurControl.Align in [alNone, alLeft, alRight])
@ -511,17 +525,17 @@ begin
if TToolButton(CurControl).Style in [tbsButton,tbsCheck,tbsDropDown]
then begin
CurControl.GetPreferredSize(NewWidth,NewHeight);
if NewWidth < ButtonWidth then
NewWidth := ButtonWidth;
if NewWidth < RealButtonWidth then
NewWidth := RealButtonWidth;
end;
end;
// height
// in horizontal toolbars the height is set by the toolbar independent of autosize
if ChangeH
and (ButtonHeight > 0)
and (RealButtonHeight > 0)
and ((Align in [alTop, alBottom]) or not CurControl.AutoSize)
then NewHeight := ButtonHeight;
then NewHeight := RealButtonHeight;
CurControl.SetBounds(CurControl.Left, CurControl.Top, NewWidth, NewHeight);
end;
@ -593,6 +607,7 @@ var
StartX, StartY: Integer;
Vertical: Boolean; // true = ToolBar is vertical, controls are put in rows
RowsLeftToRight: Boolean; // rows are left to right
RealButtonWidth, RealButtonHeight: Integer;
procedure CalculatePosition;
var
@ -615,12 +630,12 @@ var
begin
// column layout
NewControlHeight := PreferredBtnHeight;
NewControlWidth := ButtonWidth;
NewControlWidth := RealButtonWidth;
end
else
begin
// row layout
NewControlHeight := ButtonHeight;
NewControlHeight := RealButtonHeight;
NewControlWidth := PreferredBtnWidth;
end;
if (TToolButton(CurControl).Style in [tbsButton, tbsDropDown, tbsCheck]) then
@ -628,13 +643,13 @@ var
if Vertical then
begin
// column layout
if (NewControlHeight < ButtonHeight) then
NewControlHeight := ButtonHeight;
if (NewControlHeight < RealButtonHeight) then
NewControlHeight := RealButtonHeight;
end
else begin
// row layout
if (NewControlWidth < ButtonWidth) then
NewControlWidth := ButtonWidth;
if (NewControlWidth < RealButtonWidth) then
NewControlWidth := RealButtonWidth;
end;
end;
//debugln(['CalculatePosition preferred toolbutton size ',DbgSName(CurControl),' ',NewControlWidth,' ',NewControlHeight]);
@ -643,14 +658,14 @@ var
if Vertical then
begin
// column layout
NewControlWidth := ButtonWidth;
NewControlWidth := RealButtonWidth;
NewControlHeight := CurControl.Height;
end
else
begin
// row layout
NewControlWidth := CurControl.Width;
NewControlHeight := ButtonHeight;
NewControlHeight := RealButtonHeight;
end;
if Vertical or RowsLeftToRight then
@ -721,8 +736,8 @@ var
// try next row
NewBounds.Top := StartY;
NewBounds.Bottom := NewBounds.Top + NewControlHeight;
inc(NewBounds.Left, ButtonWidth);
inc(NewBounds.Right, ButtonWidth);
inc(NewBounds.Left, RealButtonWidth);
inc(NewBounds.Right, RealButtonWidth);
end
else
begin
@ -742,8 +757,8 @@ var
//debugln(['CalculatePosition overlaps: ',DbgSName(CurControl),' ',dbgs(NewBounds),' ARect=',DbgS(ARect),' StartX=',StartX]);
// try next row
inc(NewBounds.Top, ButtonHeight);
inc(NewBounds.Bottom, ButtonHeight);
inc(NewBounds.Top, RealButtonHeight);
inc(NewBounds.Bottom, RealButtonHeight);
if RowsLeftToRight then
begin
NewBounds.Left := StartX;
@ -782,6 +797,8 @@ var
begin
//DebugLn(['WrapButtons ',DbgSName(Self),' Wrapable=',Wrapable,' ',dbgs(BoundsRect),' Vertical=',IsVertical,' RTL=',UseRightToLeftAlignment,' Simulate=',Simulate]);
Result := True;
RealButtonWidth := GetRealButtonWidth;
RealButtonHeight := GetRealButtonHeight;
Vertical := IsVertical;
NewWidth := 0;
NewHeight := 0;
@ -826,9 +843,9 @@ begin
end;
// sort OrderedControls
if FRealizedButtonHeight = 0 then
FRealizedButtonHeight := FButtonHeight;
FRealizedButtonHeight := RealButtonHeight;
if FRealizedButtonWidth = 0 then
FRealizedButtonWidth := FButtonWidth;
FRealizedButtonWidth := RealButtonWidth;
if Vertical then
OrderedControls.Sort(TListSortCompare(@CompareToolBarControlVert))
else
@ -931,7 +948,7 @@ begin
begin
// user forced wrap -> start new line
y := StartY;
inc(x, ButtonWidth);
inc(x, RealButtonWidth);
if not Simulate then
inc(FRowCount);
end;
@ -946,13 +963,13 @@ begin
begin
// user forced wrap -> start new line
x := StartX;
inc(y, ButtonHeight);
inc(y, RealButtonHeight);
if not Simulate then
inc(FRowCount);
end;
end;
end;
FRealizedButtonHeight := FButtonHeight;
FRealizedButtonHeight := RealButtonHeight;
finally
ObstacleControls.Free;
OrderedControls.Free;

46
lcl/include/toolbutton.inc
View File

@ -742,16 +742,14 @@ procedure TToolButton.SetStyle(Value: TToolButtonStyle);
begin
if FStyle = Value then exit;
FStyle := Value;
if Width = TToolBar.cDefButtonWidth then begin
case Value of
tbsSeparator: begin
Width := cDefSeparatorWidth;
Height := cDefSeparatorWidth;
end;
tbsDivider: begin
Width := cDefDividerWidth;
Height := cDefDividerWidth;
end;
case Value of
tbsSeparator: begin
Width := cDefSeparatorWidth;
Height := cDefSeparatorWidth;
end;
tbsDivider: begin
Width := cDefDividerWidth;
Height := cDefDividerWidth;
end;
end;
InvalidatePreferredSize;
@ -858,19 +856,27 @@ end;
procedure TToolButton.GetPreferredSize(
var PreferredWidth, PreferredHeight: integer; Raw: boolean;
WithThemeSpace: boolean);
var
RealButtonWidth, RealButtonHeight: Integer;
begin
inherited GetPreferredSize(PreferredWidth, PreferredHeight, Raw, WithThemeSpace);
if FToolbar = nil then Exit;
if FToolbar.ButtonHeight <= 0 then Exit;
RealButtonWidth := FToolbar.GetRealButtonWidth;
RealButtonHeight := FToolbar.GetRealButtonHeight;
if RealButtonHeight <= 0 then Exit;
// buttonheight overrules in hor toolbar
if FToolbar.Align in [alTop, alBottom] then
PreferredHeight := FToolbar.ButtonHeight;
if FToolBar.IsVertical then
PreferredWidth := RealButtonWidth
else
PreferredHeight := RealButtonHeight;
end;
function TToolButton.IsWidthStored: Boolean;
begin
Result := Style in [tbsSeparator, tbsDivider];
if FToolBar<>nil then
Result := Result and FToolBar.IsVertical;
end;
procedure TToolButton.RefreshControl;
@ -946,6 +952,8 @@ end;
function TToolButton.IsHeightStored: Boolean;
begin
Result := Style in [tbsSeparator, tbsDivider];
if FToolBar<>nil then
Result := Result and not FToolBar.IsVertical;
end;
function TToolButton.IsImageIndexStored: Boolean;
@ -1019,16 +1027,16 @@ begin
begin
if not TToolBar(AParent).IsVertical then begin
if Style in [tbsButton,tbsDropDown,tbsButtonDrop,tbsCheck] then
NewWidth := TToolBar(AParent).ButtonWidth
NewWidth := TToolBar(AParent).GetRealButtonWidth
else
NewWidth := Width;
NewHeight := TToolBar(AParent).ButtonHeight;
NewHeight := TToolBar(AParent).GetRealButtonHeight;
end else begin
if Style in [tbsButton,tbsDropDown,tbsButtonDrop,tbsCheck] then
NewHeight := TToolBar(AParent).ButtonHeight
NewHeight := TToolBar(AParent).GetRealButtonHeight
else
NewHeight := Height;
NewWidth := TToolBar(AParent).ButtonWidth;
NewWidth := TToolBar(AParent).GetRealButtonWidth;
end;
SetBoundsKeepBase(Left, Top, NewWidth, NewHeight);
end;
@ -1175,8 +1183,8 @@ begin
begin
inc(PreferredWidth, 4);
inc(PreferredHeight, 4);
PreferredWidth := Max(PreferredWidth, FToolBar.ButtonWidth);
PreferredHeight := Max(PreferredHeight, FToolBar.ButtonHeight);
PreferredWidth := Max(PreferredWidth, FToolBar.GetRealButtonWidth);
PreferredHeight := Max(PreferredHeight, FToolBar.GetRealButtonHeight);
case Style of
tbsDropDown: inc(PreferredWidth, FToolBar.GetRealDropDownWidth);
tbsButtonDrop: inc(PreferredWidth, FToolBar.GetRealButtonDropWidth-cDefButtonDropDecArrowWidth);