paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

spktoolbar: Fix dropdown arrows in Linux

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6162 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-01-31 21:44:46 +00:00
parent f1bb94b862
commit dcc90b77e4
4 changed files with 84 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@ -526,8 +526,6 @@ begin
end;
constructor TSpkToolbar.Create(AOwner: TComponent);
var
DesignDPI: Integer;
begin
inherited Create(AOwner);
@ -1812,7 +1810,7 @@ begin
LargeButtonMinWidth := round(LARGEBUTTON_MIN_WIDTH * AXProportion);
LargeButtonRadius := LARGEBUTTON_RADIUS;
LargeButtonBorderSize := round(LARGEBUTTON_BORDER_SIZE * AXProportion);
LargeButtonChevronHMargin := round(LARGEBUTTON_CHEVRON_HMARGIN * AXProportion);
LargeButtonChevronVMargin := round(LARGEBUTTON_CHEVRON_VMARGIN * AYProportion);
LargeButtonCaptionTopRail := round(LARGEBUTTON_CAPTION_TOP_RAIL * AYProportion);
LargeButtonCaptionButtomRail := round(LARGEBUTTON_CAPTION_BOTTOM_RAIL * AYProportion);

101
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

@ -16,7 +16,7 @@ unit spkt_Buttons;
interface
uses
Graphics, Classes, Controls, Menus, ActnList, Math,
Graphics, Classes, Types, Controls, Menus, ActnList, Math,
Dialogs, ImgList, Forms,
SpkGUITools, SpkGraphTools, SpkMath,
spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools;
@ -84,13 +84,13 @@ type
FAllowAllUp: Boolean;
FDropdownMenu: TPopupMenu;
// *** Obs³uga rysowania ***
/// <summary>Zadaniem metody w odziedziczonych klasach jest obliczenie
/// rectów przycisku i menu dropdown w zale¿noœci od FButtonState</summary>
// *** Drawing support ***
// The task of the method in inherited classes is to calculate the
// button's rectangle and the dropdown menu depending on FButtonState
procedure CalcRects; virtual; abstract;
function GetDropdownPoint: T2DIntPoint; virtual; abstract;
// *** Obs³uga akcji ***
// *** Action support ***
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
procedure Click; virtual;
procedure DoActionChange(Sender: TObject);
@ -99,6 +99,8 @@ type
function SiblingsChecked: Boolean; virtual;
procedure UncheckSiblings; virtual;
procedure DrawDropdownArrow(ABuffer: TBitmap; ARect: TRect; AColor: TColor);
// Getters and Setters
function GetChecked: Boolean; virtual;
procedure SetAction(const Value: TBasicAction); virtual;
@ -201,7 +203,9 @@ type
implementation
uses
LCLType, LCLIntf, LCLProc, SysUtils, spkt_Pane, spkt_Appearance;
LCLType, LCLIntf, LCLProc, SysUtils, Themes,
spkt_Pane, spkt_Appearance;
{ TSpkButtonActionLink }
@ -374,6 +378,38 @@ begin
ActionChange(Sender, False);
end;
procedure TSpkBaseButton.DrawDropdownArrow(ABuffer: TBitmap; ARect: TRect;
AColor: TColor);
const
w = 8;
h = 8;
var
details: TThemedElementDetails;
arrowState: TThemedToolBar;
P: array[0..3] of TPoint;
wsc, hsc: Integer;
begin
if ThemeServices.ThemesEnabled then begin
if Enabled then
arrowState := ttbSplitButtonDropdownNormal
else
arrowState := ttbSplitButtonDropDownDisabled;
details := ThemeServices.GetElementDetails(arrowState);
ThemeServices.DrawElement(ABuffer.Canvas.Handle, details, ARect);
end else begin
wsc := ScaleX(w, DesignDPI); // 0 1
hsc := ScaleY(h, DesignDPI); // 2
P[2].x := ARect.Left + (ARect.Right - ARect.Left) div 2;
P[2].y := ARect.Top + (ARect.Bottom - ARect.Top + hsc) div 2 - 1;
P[0] := Point(P[2].x - wsc div 2, P[2].y - hsc div 2);
P[1] := Point(P[2].x + wsc div 2, P[0].y);
P[3] := P[0];
ABuffer.Canvas.Brush.Color := AColor;
ABuffer.Canvas.Pen.Style := psClear;
ABuffer.Canvas.Polygon(P);
end;
end;
function TSpkBaseButton.GetAction: TBasicAction;
begin
if Assigned(FActionLink) then
@ -908,6 +944,7 @@ var
s: String;
P: T2DIntPoint;
drawBtn: Boolean;
R: TRect;
begin
if FToolbarDispatch = nil then
exit;
@ -1102,29 +1139,24 @@ begin
TGUITools.DrawText(ABuffer.Canvas, x, y, s, fontColor, ClipRect);
end else
begin
// Tekst nie z³amany
// The text is not broken
x := FButtonRect.Left + (FButtonRect.Width - ABuffer.Canvas.Textwidth(FCaption)) div 2;
y := FRect.Top + LargeButtonCaptionTopRail - txtHeight div 2;
TGUITools.DrawText(ABuffer.Canvas, x, y, FCaption, FontColor, ClipRect);
end;
// Chevron
ABuffer.Canvas.Font.Charset := DEFAULT_CHARSET;
ABuffer.Canvas.Font.Name := 'Marlett';
ABuffer.Canvas.Font.Style := [];
ABuffer.Canvas.Font.Orientation := 0;
// Dropdown arrow
if FButtonKind = bkDropdown then
begin
x := FButtonRect.Left + (FButtonRect.width - ABuffer.Canvas.Textwidth('u')) div 2;
y := FButtonRect.bottom - ABuffer.Canvas.Textheight('u') - LargeButtonChevronHMargin;
TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect);
y := FButtonRect.Bottom - ABuffer.Canvas.TextHeight('Tg') - 1;
R := Classes.Rect(FButtonRect.Left, y, FButtonRect.Right, FButtonRect.Bottom);
DrawDropdownArrow(ABuffer, R, fontcolor);
end else
if FButtonKind = bkButtonDropdown then
begin
x := FDropdownRect.Left + (FDropdownRect.width - ABuffer.Canvas.Textwidth('u')) div 2;
y := FDropdownRect.bottom - ABuffer.Canvas.Textheight('u') - LargeButtonChevronHMargin;
TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect);
y := FDropdownRect.Bottom - ABuffer.Canvas.TextHeight('Tg') - 1;
R := Classes.Rect(FDropdownRect.Left, y, FDropDownRect.Right, FDropdownRect.Bottom);
DrawDropdownArrow(ABuffer, R, fontcolor);
end;
end;
@ -1427,6 +1459,8 @@ var
cornerRadius: Integer;
imgList: TImageList;
drawBtn: Boolean;
R: TRect;
dx: Integer;
begin
if (FToolbarDispatch = nil) or (FAppearance = nil) then
exit;
@ -1608,29 +1642,18 @@ begin
end;
end;
// Chevron
ABuffer.Canvas.Font.Charset := DEFAULT_CHARSET;
ABuffer.Canvas.Font.Name := 'Marlett';
ABuffer.Canvas.Font.Style := [];
ABuffer.Canvas.Font.Orientation := 0;
if FButtonKind = bkDropdown then
begin
// Dropdown arrow
if FButtonKind in [bkDropdown, bkButtonDropdown] then begin
dx := SmallButtonDropdownWidth;
if FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup] then
x := FButtonRect.Right - SmallButtonHalfBorderWidth - (SmallButtonDropdownWidth + ABuffer.Canvas.Textwidth('u')) div 2 + 1
inc(dx, SmallButtonHalfBorderWidth)
else
x := FButtonRect.Right - SmallButtonBorderWidth - (SmallButtonDropdownWidth + ABuffer.Canvas.Textwidth('u')) div 2 + 1;
y := FButtonRect.top + (FButtonRect.height - ABuffer.Canvas.Textheight('u')) div 2;
TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', fontColor, ClipRect);
end else
if FButtonKind = bkButtonDropdown then
begin
if FGroupBehaviour in [gbBeginsGroup, gbContinuesGroup] then
x := FDropdownRect.Right - SmallButtonHalfBorderWidth - (SmallButtonDropdownWidth + ABuffer.Canvas.Textwidth('u')) div 2 + 1
inc(dx, SmallButtonBorderWidth);
if FButtonKind = bkDropdown then
R := Classes.Rect(FButtonRect.Right-dx, FButtonRect.Top, FButtonRect.Right, FButtonRect.Bottom)
else
x := FDropdownRect.Right - SmallButtonBorderWidth - (SmallButtonDropdownWidth + ABuffer.Canvas.Textwidth('u')) div 2 + 1;
y := FDropdownRect.top + (FDropdownRect.Height - ABuffer.Canvas.Textheight('u')) div 2;
TGUITools.DrawText(ABuffer.Canvas, x, y, 'u', FontColor, ClipRect);
R := Classes.Rect(FDropdownRect.Right-dx, FDropdownRect.Top, FDropdownRect.Right, FDropdownRect.Bottom);
DrawdropdownArrow(ABuffer, R, fontcolor);
end;
end;

20
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@ -24,6 +24,9 @@ const
DPI_AWARE = false; // use lcl scaling instead
{$ENDIF}
var
DesignDPI: Integer;
procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
function SpkScaleX(Size: Integer; FromDPI: Integer; ToDPI: Integer = 0): integer;
function SpkScaleY(Size: Integer; FromDPI: Integer; ToDPI: Integer = 0): integer;
@ -39,7 +42,7 @@ const
LARGEBUTTON_MIN_WIDTH = 24;
LARGEBUTTON_RADIUS = 4;
LARGEBUTTON_BORDER_SIZE = 2;
LARGEBUTTON_CHEVRON_HMARGIN = 4;
LARGEBUTTON_CHEVRON_VMARGIN = 2;
LARGEBUTTON_CAPTION_TOP_RAIL = 45;
LARGEBUTTON_CAPTION_BOTTOM_RAIL = 58;
@ -151,7 +154,7 @@ var
LargeButtonMinWidth: Integer;
LargeButtonRadius: Integer;
LargeButtonBorderSize: Integer;
LargeButtonChevronHMargin: Integer;
LargeButtonChevronVMargin: Integer;
LargeButtonCaptionTopRail: Integer;
LargeButtonCaptionButtomRail: Integer;
@ -268,9 +271,12 @@ var
implementation
uses
LCLType;
LCLType, Types, Themes;
procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
var
detail: TThemedElementDetails;
detailSize: TSize;
begin
if not DPI_AWARE then
ToDPI := FromDPI;
@ -285,7 +291,7 @@ begin
LargeButtonMinWidth := SpkScaleX(LARGEBUTTON_MIN_WIDTH, FromDPI, ToDPI);
LargeButtonRadius := LARGEBUTTON_RADIUS;
LargeButtonBorderSize := SpkScaleX(LARGEBUTTON_BORDER_SIZE, FromDPI, ToDPI);
LargeButtonChevronHMargin := SpkScaleX(LARGEBUTTON_CHEVRON_HMARGIN, FromDPI, ToDPI);
LargeButtonChevronVMargin := SpkScaleY(LARGEBUTTON_CHEVRON_VMARGIN, FromDPI, ToDPI);
LargeButtonCaptionTopRail := SpkScaleY(LARGEBUTTON_CAPTION_TOP_RAIL, FromDPI, ToDPI);
LargeButtonCaptionButtomRail := SpkScaleY(LARGEBUTTON_CAPTION_BOTTOM_RAIL, FromDPI, ToDPI);
@ -297,6 +303,12 @@ begin
SmallButtonRadius := SMALLBUTTON_RADIUS;
SmallButtonMinWidth := 2 * SmallButtonPadding + SmallButtonGlyphWidth;
// Make sure that dropdown button is not too narrow
detail := ThemeServices.GetElementDetails(ttbSplitButtonDropDownNormal);
detailsize := ThemeServices.GetDetailSize(detail);
if SmallButtonDropdownWidth < detailSize.CX then
SmallButtondropdownWidth := detailSize.CX;
MaxElementHeight := SpkScaleY(MAX_ELEMENT_HEIGHT, FromDPI, ToDPI);
PaneRowHeight := SpkScaleY(PANE_ROW_HEIGHT, FromDPI, ToDPI);
PaneFullRowHeight := 3 * PaneRowHeight;

10
components/spktoolbar/SpkToolbar/spkt_Tools.pas
View File

@ -5,11 +5,11 @@ unit spkt_Tools;
(*******************************************************************************
* *
* Plik: spkt_Tools.pas *
* Opis: Klasy narzêdziowe u³atwiaj¹ce renderowanie toolbara. *
* Copyright: (c) 2009 by Spook. *
* License: Modified LGPL (with linking exception, like Lazarus LCL) *
' See "license.txt" in this installation *
* Unit: spkt_Tools.pas *
* Description: Tool classes for easier rendering of the toolbar. *
* Copyright: (c) 2009 by Spook. *
* License: Modified LGPL (with linking exception, like Lazarus LCL) *
' See "license.txt" in this installation *
* *
*******************************************************************************)