diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas
index a3a9f4dde..3fd953f19 100644
--- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas
+++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas
@@ -5,7 +5,7 @@ unit SpkToolbar;
{.$DEFINE EnhancedRecordSupport}
{.$DEFINE DELAYRUNTIMER}
- //Translation from Polish into English by Raf20076, Poland, 2016
+//Translation from Polish into English by Raf20076, Poland, 2016
//I do my best but if you find any mistakes in English comments
//please correct it.
@@ -17,6 +17,7 @@ unit SpkToolbar;
* License: Modified LGPL (with linking exception, like Lazarus LCL) *
' See "license.txt" in this installation *
* *
+* Lazarus port and contributions: Luiz Américo, Werner Pamler, Husker *
* *
*******************************************************************************)
@@ -24,18 +25,24 @@ interface
uses
LCLType, LMessages, LCLVersion, Graphics, SysUtils, Controls, Classes, Math,
- Dialogs, Forms, Types, ExtCtrls,
- SpkGraphTools, SpkGUITools, SpkMath, spkt_Appearance, spkt_BaseItem,
- spkt_Const, spkt_Dispatch, spkt_Tab, spkt_Pane, spkt_Types;
+ Dialogs, Forms, Types, ExtCtrls, Menus, ImgList,
+ SpkGraphTools, SpkGUITools, SpkMath, spkt_Appearance, spkt_BaseItem, spkt_Const,
+ spkt_Dispatch, spkt_Tab, spkt_Pane, spkt_Types, spkt_Buttons, spkt_Tools;
type
{ Type describes regions of the toolbar which are used during handling
of interaction with the mouse }
- TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents);
+ TSpkMouseToolbarElement = (teNone, teToolbarArea, teTabs, teTabContents, teMenuButton);
TSpkTabChangingEvent = procedure(Sender: TObject; OldIndex, NewIndex: integer;
var Allowed: boolean) of object;
+ { Type describes Menu Button style }
+ TSpkMenuButtonStyle = (mbsCaption, mbsCaptionDropdown);
+
+ { Type describes Menu Button states }
+ TSpkMenuButtonState = (mbtIdle, mbtHottrack, mbtPressed);
+
type
TSpkToolbar = class;
@@ -118,6 +125,9 @@ type
{ ClipRect of region content of tab }
FTabContentsClipRect: T2DIntRect;
+ { Rect of the Menu Button }
+ FMenuButtonRect: T2DIntRect;
+
{ The element over which the mouse pointer is }
FMouseHoverElement: TSpkMouseToolbarElement;
@@ -150,6 +160,24 @@ type
FOnTabChanging: TSpkTabChangingEvent;
FOnTabChanged: TNotifyEvent;
+ { Menu Button image index }
+ FMenuButtonCaption: String;
+
+ { Menu Button dropdown menu }
+ FMenuButtonDropdownMenu: TPopupMenu;
+
+ { Flag to manage visibility of dropdown arrow on Menu Button }
+ FMenuButtonStyle: TSpkMenuButtonStyle;
+
+ { Flag to manage visibility of Menu Button }
+ FShowMenuButton: Boolean;
+
+ { Menu Button state }
+ FMenuButtonState: TSpkMenuButtonState;
+
+ { Menu Button click event }
+ FOnMenuButtonClick: TNotifyEvent;
+
{$IFDEF DELAYRUNTIMER}
procedure DelayRunTimer(Sender: TObject);
{$ENDIF}
@@ -214,6 +242,9 @@ type
and swiches the flag FInternalUpdating off}
procedure InternalEndUpdate;
+ { Function calculates Menu Button dropdown point }
+ function GetMenuButtonDropdownPoint: T2DIntPoint;
+
// ************************************************
// *** Covering of methods from derived classes ***
// ************************************************
@@ -262,6 +293,26 @@ type
procedure TabMouseUp({%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
{%H-}X, {%H-}Y: integer);
+ // *************************************************
+ // *** Handling of mouse events for Menu Button ***
+ // *************************************************
+
+ { Method called when the mouse will move over the region of Menu Button }
+ procedure MenuButtonMouseMove({%H-}Shift: TShiftState; X, Y: integer);
+
+ { Method called when mouse pointer left the region of Menu Button }
+ procedure MenuButtonMouseLeave;
+
+ { Method called when the mouse button is pressed
+ and at the same time the mouse pointer is over the region of Menu Button }
+ procedure MenuButtonMouseDown(Button: TMouseButton; {%H-}Shift: TShiftState;
+ X, Y: integer);
+
+ { Method called when one of the mouse buttons is released
+ and at the same time the region of Menu Button was active element of toolbar }
+ procedure MenuButtonMouseUp({%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
+ {%H-}X, {%H-}Y: integer);
+
// *********************
// *** Extra support ***
// *********************
@@ -317,6 +368,18 @@ type
{ Setter for toolbar style, i.e. quick selection of new appearance theme }
procedure SetStyle(const Value: TSpkStyle);
+ { Setter for Menu Button caption }
+ procedure SetMenuButtonCaption(Value: String);
+
+ { Setter for Menu Button dropdown menu }
+ procedure SetMenuButtonDropdownMenu(const Value: TPopupMenu);
+
+ { Setter for style of Menu Button }
+ procedure SetMenuButtonStyle(Value: TSpkMenuButtonStyle);
+
+ { Setter for visibility of Menu Button }
+ procedure SetShowMenuButton(Value: Boolean);
+
{ Calculates the height of the entire toolbar }
function CalcToolbarHeight: Integer;
@@ -407,6 +470,9 @@ type
Savings and readings from LFM is done manually }
property Tabs: TSpkTabs read FTabs;
+ // *** Menu Button ***
+ procedure DoMenuButtonClick;
+
published
{ Component background color }
@@ -440,6 +506,22 @@ type
{ Unscaled size of the large images }
property LargeImagesWidth: Integer read FLargeImagesWidth write SetLargeImagesWidth default 32;
+ { Menu Button caption }
+ property MenuButtonCaption: String read FMenuButtonCaption write SetMenuButtonCaption;
+
+ { Menu Button dropdown menu }
+ property MenuButtonDropdownMenu: TPopupMenu read FMenuButtonDropdownMenu write SetMenuButtonDropdownMenu;
+
+ { Menu Button style }
+ property MenuButtonStyle: TSpkMenuButtonStyle read FMenuButtonStyle write SetMenuButtonStyle default mbsCaption;
+
+ { Show Menu Button flag }
+ property ShowMenuButton: Boolean read FShowMenuButton write SetShowMenuButton default False;
+
+ { Event called on Menu Button clik }
+ property OnMenuButtonClick: TNotifyEvent
+ read FOnMenuButtonClick write FOnMenuButtonClick;
+
{ Events called before and after another tab is selected }
property OnTabChanging: TSpkTabChangingEvent
read FOnTabChanging write FOnTabChanging;
@@ -586,9 +668,11 @@ begin
{$IFDEF EnhancedRecordSupport}
FTabClipRect := T2DIntRect.Create(0, 0, 0, 0);
FTabContentsClipRect := T2DIntRect.Create(0, 0, 0, 0);
+ FMenuButtonRect := T2DIntRect.Create(0, 0, 0, 0);
{$ELSE}
FTabClipRect.Create(0, 0, 0, 0);
FTabContentsClipRect.Create(0, 0, 0, 0);
+ FMenuButtonRect.Create(0, 0, 0, 0);
{$ENDIF}
FMouseHoverElement := teNone;
@@ -608,7 +692,13 @@ begin
FTabIndex := -1;
Color := clSkyBlue;
- {$IFDEF DELAYRUNTIMER}
+ FMenuButtonCaption := 'Menu';
+ FMenuButtonDropdownMenu := nil;
+ FMenuButtonStyle := mbsCaption;
+ FShowMenuButton := False;
+ FMenuButtonState := mbtIdle;
+
+ {$IFDEF DELAYRUNTIMER}
FDelayRunTimer := TTimer.Create(nil);
FDelayRunTimer.Interval := 36;
FDelayRunTimer.Enabled := False;
@@ -754,6 +844,11 @@ begin
TabMouseDown(Button, Shift, X, Y);
end
else
+ if FMouseActiveElement = teMenuButton then
+ begin
+ MenuButtonMouseDown(Button, Shift, X, Y);
+ end
+ else
if FMouseActiveElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -775,6 +870,12 @@ begin
TabMouseDown(Button, Shift, X, Y);
end
else
+ if FMouseHoverElement = teMenuButton then
+ begin
+ FMouseActiveElement := teMenuButton;
+ MenuButtonMouseDown(Button, Shift, X, Y);
+ end
+ else
if FMouseHoverElement = teTabContents then
begin
FMouseActiveElement := teTabContents;
@@ -809,6 +910,11 @@ begin
TabMouseLeave;
end
else
+ if FMouseHoverElement = teMenuButton then
+ begin
+ MenuButtonMouseLeave;
+ end
+ else
if FMouseHoverElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -843,7 +949,11 @@ begin
{$ENDIF}
if FTabClipRect.Contains(MousePoint) then
- NewMouseHoverElement := teTabs
+ begin
+ NewMouseHoverElement := teTabs;
+ if FMenuButtonRect.Contains(MousePoint) and FShowMenuButton then
+ NewMouseHoverElement := teMenuButton
+ end
else
if FTabContentsClipRect.Contains(MousePoint) then
NewMouseHoverElement := teTabContents
@@ -859,6 +969,11 @@ begin
TabMouseMove(Shift, X, Y);
end
else
+ if FMouseActiveElement = teMenuButton then
+ begin
+ MenuButtonMouseMove(Shift, X, Y);
+ end
+ else
if FMouseActiveElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -881,6 +996,11 @@ begin
TabMouseLeave;
end
else
+ if FMouseHoverElement = teMenuButton then
+ begin
+ MenuButtonMouseLeave;
+ end
+ else
if FMouseHoverElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -899,6 +1019,11 @@ begin
TabMouseMove(Shift, X, Y);
end
else
+ if NewMouseHoverElement = teMenuButton then
+ begin
+ MenuButtonMouseMove(Shift, X, Y);
+ end
+ else
if NewMouseHoverElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -932,6 +1057,11 @@ begin
TabMouseUp(Button, Shift, X, Y);
end
else
+ if FMouseActiveElement = teMenuButton then
+ begin
+ MenuButtonMouseUp(Button, Shift, X, Y);
+ end
+ else
if FMouseActiveElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -951,6 +1081,9 @@ begin
if FMouseActiveElement = teTabs then
TabMouseLeave
else
+ if FMouseActiveElement = teMenuButton then
+ MenuButtonMouseLeave
+ else
if FMouseActiveElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -965,6 +1098,9 @@ begin
if FMouseHoverElement = teTabs then
TabMouseMove(Shift, X, Y)
else
+ if FMouseHoverElement = teMenuButton then
+ MenuButtonMouseMove(Shift, X, Y)
+ else
if FMouseHoverElement = teTabContents then
begin
if FTabIndex <> -1 then
@@ -1337,7 +1473,7 @@ procedure TSpkToolbar.ValidateBuffer;
procedure DrawBody;
var
FocusedAppearance: TSpkToolbarAppearance;
- i: integer;
+ i, j: integer;
tabHeight: Integer;
begin
//Loading appearance of selected tab
@@ -1429,10 +1565,20 @@ procedure TSpkToolbar.ValidateBuffer;
while not (FTabs[i].Visible) do
Dec(i);
+ // First visible tab is looked for
+ j := 0;
+ while not (FTabs[j].Visible) do
+ Inc(j);
+
//Only right part, the rest will be drawn with tabs
if FTabRects[i].Right < self.Width - FocusedAppearance.Tab.CornerRadius - 1 then
+ begin
TGuiTools.DrawHLine(FBuffer, FTabRects[i].Right + 1, self.Width -
FocusedAppearance.Tab.CornerRadius, tabHeight, FocusedAppearance.Tab.BorderColor);
+ //...But left part should be drawn if FShowMenuButton = True
+ if FShowMenuButton then
+ TGuiTools.DrawHLine(FBuffer, 0, FTabRects[j].Left, tabHeight, FocusedAppearance.Tab.BorderColor);
+ end;
end;
end;
@@ -1614,7 +1760,8 @@ procedure TSpkToolbar.ValidateBuffer;
TGuiTools.DrawHLine(FBuffer,
TabRect.Left + 2 * ATabCornerRadius - 1,
- TabRect.Right - 2 * ATabCornerRadius + 2,
+// TabRect.Right - 2 * ATabCornerRadius + 2,
+ TabRect.Right - 2 * ATabCornerRadius + 1,
0,
Border,
FTabClipRect);
@@ -1724,6 +1871,277 @@ procedure TSpkToolbar.ValidateBuffer;
FTabs[FTabIndex].Draw(FBuffer, FTabContentsClipRect);
end;
+ // Drawing procedures for Menu Button
+ procedure DrawMenuButton;
+
+ procedure DrawMenuButtonBackground(BorderColor, GradientFrom, GradientTo: TColor; GradientKind: TBackgroundKind);
+ var
+ MenuButtonRegion: HRGN;
+ TmpRegion, TmpRegion2: HRGN;
+ aCornerRadius: Integer;
+ DrawRounded: Boolean;
+ begin
+
+ case FAppearance.MenuButton.ShapeStyle of
+ mbssRounded:
+ begin
+ aCornerRadius := MenuButtonCornerRadius;
+ DrawRounded := True;
+ end;
+ mbssRectangle:
+ begin
+ aCornerRadius := 0;
+ DrawRounded := False;
+ end;
+ end;
+
+ //Middle rectangle
+ MenuButtonRegion := CreateRectRgn(
+ FMenuButtonRect.Left + aCornerRadius - 1,
+ FMenuButtonRect.Top + aCornerRadius,
+ FMenuButtonRect.Right - aCornerRadius + 1 + 1,
+// FMenuButtonRect.Bottom + 1
+ FMenuButtonRect.Bottom
+ );
+
+ //Top part with top convex curves
+ TmpRegion := CreateRectRgn(
+ FMenuButtonRect.Left + 2 * aCornerRadius - 1,
+ FMenuButtonRect.Top,
+ FMenuButtonRect.Right - 2 * aCornerRadius + 1 + 1,
+ FMenuButtonRect.Top + aCornerRadius
+ );
+ CombineRgn(MenuButtonRegion, MenuButtonRegion, TmpRegion, RGN_OR);
+ DeleteObject(TmpRegion);
+
+ TmpRegion := CreateEllipticRgn(
+ FMenuButtonRect.Left + aCornerRadius - 1,
+ FMenuButtonRect.Top,
+ FMenuButtonRect.Left + 3 * aCornerRadius,
+ FMenuButtonRect.Top + 2 * aCornerRadius + 1
+ );
+ CombineRgn(MenuButtonRegion, MenuButtonRegion, TmpRegion, RGN_OR);
+ DeleteObject(TmpRegion);
+
+ TmpRegion := CreateEllipticRgn(
+ FMenuButtonRect.Right - 3 * aCornerRadius + 2,
+ FMenuButtonRect.Top,
+ FMenuButtonRect.Right - aCornerRadius + 3,
+ FMenuButtonRect.Top + 2 * aCornerRadius + 1
+ );
+ CombineRgn(MenuButtonRegion, MenuButtonRegion, TmpRegion, RGN_OR);
+ DeleteObject(TmpRegion);
+
+ TGUITools.DrawRegion(FBuffer.Canvas,
+ MenuButtonRegion,
+ FMenuButtonRect,
+ GradientFrom,
+ GradientTo,
+ GradientKind);
+
+ DeleteObject(MenuButtonRegion);
+
+ // Draw left vertical line of Menu Button
+ if DrawRounded then
+ TGuiTools.DrawVLine(FBuffer,
+ FMenuButtonRect.left + aCornerRadius - 1,
+ FMenuButtonRect.top + aCornerRadius,
+ FMenuButtonRect.Bottom - 1,
+ BorderColor,
+ FTabClipRect)
+ else
+ TGuiTools.DrawVLine(FBuffer,
+ FMenuButtonRect.left,
+ FMenuButtonRect.top,
+ FMenuButtonRect.Bottom - 1,
+ BorderColor,
+ FTabClipRect);
+
+ // Draw right vertical line of Menu Button
+ if DrawRounded then
+ TGuiTools.DrawVLine(FBuffer,
+ FMenuButtonRect.Right - aCornerRadius + 1,
+ FMenuButtonRect.top + aCornerRadius,
+ FMenuButtonRect.Bottom - 1,
+ BorderColor,
+ FTabClipRect)
+ else
+ TGuiTools.DrawVLine(FBuffer,
+ FMenuButtonRect.Right,
+ FMenuButtonRect.top,
+ FMenuButtonRect.Bottom - 1,
+ BorderColor,
+ FTabClipRect);
+
+ // Draw left top corner of Menu Button
+ if DrawRounded then
+ TGuiTools.DrawAARoundCorner(FBuffer,
+ {$IFDEF EnhancedRecordSupport}
+ T2DIntPoint.Create(FMenuButtonRect.Left + aCornerRadius - 1, 0),
+ {$ELSE}
+ Create2DIntPoint(FMenuButtonRect.Left + aCornerRadius - 1, 0),
+ {$ENDIF}
+ aCornerRadius,
+ cpLeftTop,
+ BorderColor,
+ FTabClipRect);
+
+ // Draw right top corner of Menu Button
+ if DrawRounded then
+ TGuiTools.DrawAARoundCorner(FBuffer,
+ {$IFDEF EnhancedRecordSupport}
+ T2DIntPoint.Create(FMenuButtonRect.Right - 2 * aCornerRadius + 2, 0),
+ {$ELSE}
+ Create2DIntPoint(FMenuButtonRect.Right - 2 * aCornerRadius + 2, 0),
+ {$ENDIF}
+ aCornerRadius,
+ cpRightTop,
+ BorderColor,
+ FTabClipRect);
+
+ // Draw horizontal top line of Menu Button
+ if DrawRounded then
+ TGuiTools.DrawHLine(FBuffer,
+ FMenuButtonRect.Left + 2 * aCornerRadius - 1,
+ FMenuButtonRect.Right - 2 * aCornerRadius + 1,
+ 0,
+ BorderColor,
+ FTabClipRect)
+ else
+ TGuiTools.DrawHLine(FBuffer,
+ FMenuButtonRect.Left,
+ FMenuButtonRect.Right,
+ 0,
+ BorderColor,
+ FTabClipRect);
+
+ end;
+
+ procedure DrawMenuButtonText(AFont: TFont; AOverrideTextColor: TColor = clNone);
+ var
+ x, y: integer;
+ clr: TColor;
+ begin
+ FBuffer.canvas.font.Assign(AFont);
+
+ if AOverrideTextColor <> clNone then
+ clr := AOverrideTextColor
+ else
+ clr := AFont.Color;
+
+ Case FMenuButtonStyle of
+ mbsCaption:
+ begin
+ x := FMenuButtonRect.left + (FMenuButtonRect.Width - FBuffer.Canvas.textwidth(
+ FMenuButtonCaption)) div 2;
+ y := FMenuButtonRect.top + (FMenuButtonRect.Height - FBuffer.Canvas.Textheight('Wy')) div 2;
+ end;
+ mbsCaptionDropdown:
+ begin
+ x := FMenuButtonRect.left + (FMenuButtonRect.Width - FBuffer.Canvas.textwidth(
+ FMenuButtonCaption) - SmallButtonDropdownWidth) div 2;
+ y := FMenuButtonRect.top + (FMenuButtonRect.Height - FBuffer.Canvas.Textheight('Wy')) div 2;
+ end;
+ end;
+
+ TGuiTools.DrawText(FBuffer.Canvas,
+ x,
+ y,
+ FMenuButtonCaption,
+ clr,
+ FTabClipRect);
+ end;
+
+ procedure DrawMenuButtonDropdownArrow(AFont: TFont; AOverrideTextColor: TColor = clNone);
+ var
+ dx: Integer;
+ ARect: TRect;
+ clr: TColor;
+ P: array[0..3] of TPoint;
+ begin
+ dx := SmallButtonDropdownWidth;
+ inc(dx, SmallButtonBorderWidth);
+
+ ARect := Classes.Rect(FMenuButtonRect.Right - dx - ToolbarTabCaptionsTextHPadding - SmallButtonPadding,
+ FMenuButtonRect.Top, FMenuButtonRect.Right, FMenuButtonRect.Bottom);
+
+ if AOverrideTextColor <> clNone then
+ clr := AOverrideTextColor
+ else
+ clr := AFont.Color;
+
+ P[2].x := ARect.Left + (ARect.Right - ARect.Left) div 2;
+ P[2].y := ARect.Top + (ARect.Bottom - ARect.Top + DropDownArrowHeight) div 2 - 1;
+ P[0] := Point(P[2].x - DropDownArrowWidth div 2, P[2].y - DropDownArrowHeight div 2);
+ P[1] := Point(P[2].x + DropDownArrowWidth div 2, P[0].y);
+ P[3] := P[0];
+ FBuffer.Canvas.Brush.Color := clr;
+ FBuffer.Canvas.Pen.Style := psClear;
+ FBuffer.Canvas.Polygon(P);
+ end;
+
+ var
+ aMenuButtonBorderColor: TColor;
+ aMenuButtonGradientFrom: TColor;
+ aMenuButtonGradientTo: TColor;
+ aMenuButtonGradientKind: TBackgroundKind;
+ aMenuButtonCaptionFont: TFont;
+ aMenuButtonCaptionFontAltColor: TColor;
+ begin
+ // Choose colors according to Menu Button state
+ case FMenuButtonState of
+ mbtIdle:
+ begin
+ //aMenuButtonBorderColor := clGreen;
+ //aMenuButtonGradientFrom := clRed;
+ //aMenuButtonGradientTo := clYellow;
+ //aMenuButtonGradientKind := bkVerticalGradient;
+ //aMenuButtonCaptionFont := FAppearance.Tab.TabHeaderFont;
+ //aMenuButtonCaptionFontAltColor := clWhite;
+ aMenuButtonCaptionFont := FAppearance.MenuButton.CaptionFont;
+ FAppearance.MenuButton.GetIdleColors(False, aMenuButtonCaptionFontAltColor,
+ aMenuButtonBorderColor, aMenuButtonGradientFrom, aMenuButtonGradientTo,
+ aMenuButtonGradientKind, 0);
+ end;
+ mbtHottrack:
+ begin
+ //aMenuButtonBorderColor := clRed;
+ //aMenuButtonGradientFrom := clNavy;
+ //aMenuButtonGradientTo := clBlue;
+ //aMenuButtonGradientKind := bkVerticalGradient;
+ //aMenuButtonCaptionFont := FAppearance.Tab.TabHeaderFont;
+ //aMenuButtonCaptionFontAltColor := clWhite;
+ aMenuButtonCaptionFont := FAppearance.MenuButton.CaptionFont;
+ FAppearance.MenuButton.GetHotTrackColors(False, aMenuButtonCaptionFontAltColor,
+ aMenuButtonBorderColor, aMenuButtonGradientFrom, aMenuButtonGradientTo,
+ aMenuButtonGradientKind, 0);
+ end;
+ mbtPressed:
+ begin
+ //aMenuButtonBorderColor := clYellow;
+ //aMenuButtonGradientFrom := clGreen;
+ //aMenuButtonGradientTo := clRed;
+ //aMenuButtonGradientKind := bkVerticalGradient;
+ //aMenuButtonCaptionFont := FAppearance.Tab.TabHeaderFont;
+ //aMenuButtonCaptionFontAltColor := clWhite;
+ aMenuButtonCaptionFont := FAppearance.MenuButton.CaptionFont;
+ FAppearance.MenuButton.GetActiveColors (False, aMenuButtonCaptionFontAltColor,
+ aMenuButtonBorderColor, aMenuButtonGradientFrom, aMenuButtonGradientTo,
+ aMenuButtonGradientKind, 0);
+ end;
+ end;
+
+ // *** Menu button background ***
+ DrawMenuButtonBackground(aMenuButtonBorderColor, aMenuButtonGradientFrom, aMenuButtonGradientTo, aMenuButtonGradientKind);
+
+ // *** Menu button caption ***
+ DrawMenuButtonText(aMenuButtonCaptionFont, aMenuButtonCaptionFontAltColor);
+
+ // *** Menu button dropdown arrow ***
+ if FMenuButtonStyle = mbsCaptionDropdown then
+ DrawMenuButtonDropdownArrow(aMenuButtonCaptionFont, aMenuButtonCaptionFontAltColor);
+ end;
+
begin
if FInternalUpdating or FUpdating then
exit;
@@ -1746,6 +2164,10 @@ begin
// *** Tabs content ***
DrawTabContents;
+ // *** Menu button ***
+ if FShowMenuButton then
+ DrawMenuButton;
+
// Buffer is correct
FBufferValid := True;
end;
@@ -1756,6 +2178,9 @@ var
x: integer;
TabWidth: integer;
TabAppearance: TSpkToolbarAppearance;
+ MenuButtonWidth: Integer;
+ AdditionalPadding: Boolean;
+ MenuButtonTextWidth: Integer;
begin
if FInternalUpdating or FUpdating then
exit;
@@ -1786,11 +2211,62 @@ begin
TabAppearance.Tab.CalcCaptionHeight);
{$ENDIF}
+ // *** Menu button ***
+ // Had to be calculated first, to adjust Tabs rects
+ MenuButtonWidth := 0;
+ AdditionalPadding := false;
+
+ // Text
+ FBuffer.Canvas.Font.Assign(TabAppearance.Element.CaptionFont);
+ MenuButtonTextWidth := FBuffer.Canvas.TextWidth(FMenuButtonCaption);
+
+ MenuButtonWidth := MenuButtonWidth + SmallButtonPadding + MenuButtonTextWidth;
+ AdditionalPadding := true;
+
+ // Padding behind the text or icon
+ if AdditionalPadding then
+ MenuButtonWidth := MenuButtonWidth + SmallButtonPadding;
+
+ // The width of the Menu button content must be at least MENUBUTTON_MIN_WIDTH
+ MenuButtonWidth := Max(MenuButtonMinWidth, MenuButtonWidth);
+
+ // *** Dropdown ***
+ case FMenuButtonStyle of
+ mbsCaption:
+ begin
+ MenuButtonWidth := 2 + // Frame
+ 2 * TabAppearance.Tab.CornerRadius +
+ // Curves
+ 2 * ToolbarTabCaptionsTextHPadding +
+ // Internal margins
+ Max(MenuButtonWidth, MenuButtonMinWidth);
+ end;
+ mbsCaptionDropdown:
+ begin
+ MenuButtonWidth := 2 + // Frame
+ 2 * TabAppearance.Tab.CornerRadius +
+ // Curves
+ 2 * ToolbarTabCaptionsTextHPadding +
+ // Internal margins
+ Max(MenuButtonWidth + SmallButtonDropdownWidth, MenuButtonMinWidth);
+ end;
+ end;
+
+ // Set Menu Button rect
+ FMenuButtonRect.Left := 0;
+ FMenuButtonRect.Top := 0;
+ FMenuButtonRect.Right := MenuButtonWidth;
+ FMenuButtonRect.Bottom := FAppearance.Tab.CalcCaptionHeight;
+
// Rects of tabs headings (containg top frame of component)
Setlength(FTabRects, FTabs.Count);
if FTabs.Count > 0 then
begin
- x := ToolbarCornerRadius;
+ // Add left space for Menu Button before Tabs if FShowMenuButton = True
+ if FShowMenuButton then
+ x := ToolbarCornerRadius + (FMenuButtonRect.Right - FMenuButtonRect.Left) + 2
+ else
+ x := ToolbarCornerRadius + 1;
for i := 0 to FTabs.Count - 1 do
if FTabs[i].Visible then
begin
@@ -1918,6 +2394,9 @@ begin
TabBorderSize := round(TAB_BORDER_SIZE * AXProportion);
TabHeight := PaneHeight + TabPaneTopPadding + TabPaneBottomPadding + TabBorderSize;
+ MenuButtonCornerRadius := MENUBUTTON_CORNER_RADIUS;
+ MenuButtonMinWidth := round(MENUBUTTON_MIN_WIDTH * AXProportion);
+
ToolbarBorderWidth := round(TOOLBAR_BORDER_WIDTH * AXProportion);
ToolbarCornerRadius := TOOLBAR_CORNER_RADIUS;
// ToolbarTabCaptionsHeight := round(TOOLBAR_TAB_CAPTIONS_HEIGHT * AYProportion);
@@ -1938,6 +2417,9 @@ begin
if TabCornerRadius > 1 then
TabCornerRadius := round(TabCornerRadius * AXProportion);
+ if MenubuttonCornerRadius > 1 then
+ MenuButtonCornerRadius := round(MenuButtonCornerRadius * AXProportion);
+
if ToolbarCornerRadius > 1 then
ToolbarCornerRadius := round(ToolbarCornerRadius * AXProportion);
@@ -1988,5 +2470,129 @@ begin
NotifyMetricsChanged
end;
+//************************************************************
+//*** All added procs and funcs for Menu Button management ***
+//************************************************************
+
+// Setter for MenuButtonCaption
+procedure TSpkToolbar.SetMenuButtonCaption(Value: String);
+begin
+ FMenuButtonCaption := Value;
+ SetMetricsInvalid;
+ if not (FInternalUpdating or FUpdating) then
+ Repaint;
+end;
+
+// Setter for MenuButtonDropdownMenu
+procedure TSpkToolbar.SetMenuButtonDropdownMenu(const Value: TPopupMenu);
+begin
+ FMenuButtonDropdownMenu := Value;
+ //if Assigned(FToolbarDispatch) then
+ // FToolbarDispatch.NotifyMetricsChanged;
+end;
+
+// Setter for MenuButtonStyle
+procedure TSpkToolbar.SetMenuButtonStyle(Value: TSpkMenuButtonStyle);
+begin
+ FMenuButtonStyle := Value;
+ SetMetricsInvalid;
+ if not (FInternalUpdating or FUpdating) then
+ Repaint;
+end;
+
+// Setter for ShowMenuButton
+procedure TSpkToolbar.SetShowMenuButton(Value: Boolean);
+begin
+ FShowMenuButton := Value;
+ SetMetricsInvalid;
+ if not (FInternalUpdating or FUpdating) then
+ Repaint;
+end;
+
+// Get the point to dropdown menu of Menu Button. Match the left bottom
+// corner of FMenuButtonRect.
+function TSpkToolbar.GetMenuButtonDropdownPoint: T2DIntPoint;
+begin
+ {$IFDEF EnhancedRecordSupport}
+ Result := T2DIntPoint.Create(FMenuButtonRect.left, FMenuButtonRect.Bottom+1);
+ {$ELSE}
+ Result.Create(FMenuButtonRect.left, FMenuButtonRect.Bottom+1);
+ {$ENDIF}
+end;
+
+// MouseMove to support Menu Button
+procedure TSpkToolbar.MenuButtonMouseMove(Shift: TShiftState; X, Y: integer);
+var
+ NewTabHover: integer;
+ TabRect: T2DIntRect;
+ i: integer;
+begin
+ //During rebuilding procees the mouse is ignored
+ if FInternalUpdating or FUpdating then
+ exit;
+
+ // Change Menu Button state and repaint
+ FMenuButtonState := mbtHottrack;
+ SetMetricsInvalid;
+ Repaint;
+end;
+
+// MouseLeave to support Menu Button
+procedure TSpkToolbar.MenuButtonMouseLeave;
+begin
+ //During rebuilding procees the mouse is ignored
+ if FInternalUpdating or FUpdating then
+ exit;
+
+ // Change Menu Button state and repaint
+ FMenuButtonState := mbtIdle;
+ SetMetricsInvalid;
+ Repaint;
+end;
+
+// MouseDown to support Menu Button
+procedure TSpkToolbar.MenuButtonMouseDown(Button: TMouseButton; {%H-}Shift: TShiftState;
+ X, Y: integer);
+begin
+ //During rebuilding procees the mouse is ignored
+ if FInternalUpdating or FUpdating then
+ exit;
+
+ // Change Menu Button state and repaint
+ FMenuButtonState := mbtPressed;
+ SetMetricsInvalid;
+ Repaint;
+end;
+
+// MouseUp to support Menu Button
+procedure TSpkToolbar.MenuButtonMouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: integer);
+var
+ aPopupPoint: TPoint;
+begin
+ //During rebuilding procees the mouse is ignored
+ if FInternalUpdating or FUpdating then
+ exit;
+
+ // Change Menu Button state and repaint
+ FMenuButtonState := mbtHottrack;
+ SetMetricsInvalid;
+ Repaint;
+
+ // Dropdown the Menu button dropdown menu and fire the event for click
+ if Assigned(FMenuButtonDropdownMenu) and (FShowMenuButton) then
+ begin
+ aPopupPoint := ClientToScreen(GetMenuButtonDropdownPoint);
+ TPopupMenu(FMenuButtonDropdownMenu).PopUp(aPopupPoint.X, aPopupPoint.Y);
+ DoMenuButtonClick;
+ end;
+end;
+
+// Support for Menu Button click
+procedure TSpkToolbar.DoMenuButtonClick;
+begin
+ if Assigned(FOnMenuButtonClick) then
+ FOnMenuButtonClick(self);
+end;
end.
diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
index cb6642048..9d90d4070 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
@@ -27,6 +27,8 @@ type
TSpkElementStyle = (esRounded, esRectangle);
+ TSpkMenuButtonShapeStyle = (mbssRounded, mbssRectangle);
+
TSpkStyle = (
spkOffice2007Blue,
spkOffice2007Silver, spkOffice2007SilverTurquoise,
@@ -91,6 +93,95 @@ type
end;
+ { TSpkMenuButtonAppearance }
+
+ // Note :
+ // For consistancy in appearance drawing with Tabs, CornerRadius and
+ // CaptionHeight used to draw Menu Button come from TSpkTabAppearance.
+
+ TSpkMenuButtonAppearance = class(TPersistent)
+ private
+ FDispatch: TSpkBaseAppearanceDispatch;
+ FCaptionFont: TFont;
+ FIdleFrameColor: TColor;
+ FIdleGradientFromColor: TColor;
+ FIdleGradientToColor: TColor;
+ FIdleGradientType: TBackgroundKind;
+ FIdleCaptionColor: TColor;
+ FHotTrackFrameColor: TColor;
+ FHotTrackGradientFromColor: TColor;
+ FHotTrackGradientToColor: TColor;
+ FHotTrackGradientType: TBackgroundKind;
+ FHotTrackCaptionColor: TColor;
+ FHotTrackBrightnessChange: Integer;
+ FActiveFrameColor: TColor;
+ FActiveGradientFromColor: TColor;
+ FActiveGradientToColor: TColor;
+ FActiveGradientType: TBackgroundKind;
+ FActiveCaptionColor: TColor;
+ FShapeStyle: TSpkMenubuttonShapeStyle;
+ procedure SetActiveCaptionColor(const Value: TColor);
+ procedure SetActiveFrameColor(const Value: TColor);
+ procedure SetActiveGradientFromColor(const Value: TColor);
+ procedure SetActiveGradientToColor(const Value: TColor);
+ procedure SetActiveGradientType(const Value: TBackgroundKind);
+ procedure SetCaptionFont(const Value: TFont);
+ procedure SetHotTrackCaptionColor(const Value: TColor);
+ procedure SetHotTrackFrameColor(const Value: TColor);
+ procedure SetHotTrackGradientFromColor(const Value: TColor);
+ procedure SetHotTrackGradientToColor(const Value: TColor);
+ procedure SetHotTrackGradientType(const Value: TBackgroundKind);
+ procedure SetHotTrackBrightnessChange(const Value: Integer);
+ procedure SetIdleCaptionColor(const Value: TColor);
+ procedure SetIdleFrameColor(const Value: TColor);
+ procedure SetIdleGradientFromColor(const Value: TColor);
+ procedure SetIdleGradientToColor(const Value: TColor);
+ procedure SetIdleGradientType(const Value: TBackgroundKind);
+ procedure SetShapeStyle(const Value: TSpkMenuButtonShapeStyle);
+
+ procedure CaptionFontChange(Sender: TObject);
+ public
+ constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+
+ procedure LoadFromXML(Node: TSpkXMLNode);
+ procedure SaveToPascal(AList: TStrings);
+ procedure SaveToXML(Node: TSpkXMLNode);
+ procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
+
+ procedure GetActiveColors(IsChecked: Boolean; out ACaptionColor, AFrameColor,
+ AGradientFromColor, AGradientToColor: TColor; out AGradientKind: TBackgroundKind;
+ ABrightenBy: Integer = 0);
+ procedure GetHotTrackColors(IsChecked: Boolean; out ACaptionColor, AFrameColor,
+ AGradientFromColor, AGradientToColor: TColor; out AGradientKind: TBackgroundKind;
+ ABrightenBy: Integer = 0);
+ procedure GetIdleColors(IsChecked: Boolean; out ACaptionColor, AFrameColor,
+ AGradientFromColor, AGradientToColor: TColor; out AGradientKind: TBackgroundKind;
+ ABrightenBy: Integer = 0);
+
+ published
+ property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
+ property IdleFrameColor: TColor read FIdleFrameColor write SetIdleFrameColor;
+ property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor;
+ property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor;
+ property IdleGradientType: TBackgroundKind read FIdleGradientType write SetIdleGradientType;
+ property IdleCaptionColor: TColor read FIdleCaptionColor write SetIdleCaptionColor;
+ property HotTrackFrameColor: TColor read FHotTrackFrameColor write SetHotTrackFrameColor;
+ property HotTrackGradientFromColor: TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor;
+ property HotTrackGradientToColor: TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor;
+ property HotTrackGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType;
+ property HotTrackCaptionColor: TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor;
+ property HotTrackBrightnessChange: Integer read FHotTrackBrightnessChange write SetHotTrackBrightnessChange default 20;
+ property ActiveFrameColor: TColor read FActiveFrameColor write SetActiveFrameColor;
+ property ActiveGradientFromColor: TColor read FActiveGradientFromColor write SetActiveGradientFromColor;
+ property ActiveGradientToColor: TColor read FActiveGradientToColor write SetActiveGradientToColor;
+ property ActiveGradientType: TBackgroundKind read FActiveGradientType write SetActiveGradientType;
+ property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor;
+ property ShapeStyle: TSpkMenuButtonShapeStyle read FShapeStyle write SetShapeStyle;
+ end;
+
+
{ TSpkPaneAppearance }
TSpkPaneAppearance = class(TPersistent)
@@ -261,12 +352,14 @@ type
private
FAppearanceDispatch: TSpkToolbarAppearanceDispatch;
FTab: TSpkTabAppearance;
+ FMenuButton: TSpkMenuButtonAppearance;
FPane: TSpkPaneAppearance;
FElement: TSpkElementAppearance;
FDispatch: TSpkBaseAppearanceDispatch;
procedure SetElementAppearance(const Value: TSpkElementAppearance);
procedure SetPaneAppearance(const Value: TSpkPaneAppearance);
procedure SetTabAppearance(const Value: TSpkTabAppearance);
+ procedure SetMenuButtonAppearance(const Value: TSpkMenuButtonAppearance);
public
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce;
destructor Destroy; override;
@@ -278,6 +371,7 @@ type
procedure LoadFromXML(Node: TSpkXMLNode);
published
property Tab: TSpkTabAppearance read FTab write SetTabAppearance;
+ property MenuButton: TSpkMenuButtonAppearance read FMenuButton write SetMenuButtonAppearance;
property Pane: TSpkPaneAppearance read FPane write SetPaneAppearance;
property Element: TSpkElementAppearance read FElement write SetElementAppearance;
end;
@@ -1587,6 +1681,7 @@ begin
FDispatch := ADispatch;
FAppearanceDispatch := TSpkToolbarAppearanceDispatch.Create(self);
FTab := TSpkTabAppearance.Create(FAppearanceDispatch);
+ FMenuButton := TSpkMenuButtonAppearance.Create(FAppearanceDispatch);
FPane := TSpkPaneAppearance.create(FAppearanceDispatch);
FElement := TSpkElementAppearance.create(FAppearanceDispatch);
end;
@@ -1595,6 +1690,7 @@ destructor TSpkToolbarAppearance.Destroy;
begin
FElement.Free;
FPane.Free;
+ FMenuButton.Free;
FTab.Free;
FAppearanceDispatch.Free;
inherited;
@@ -1609,6 +1705,7 @@ begin
Src := TSpkToolbarAppearance(Source);
self.FTab.Assign(Src.Tab);
+ self.FMenuButton.Assign(Src.MenuButton);
self.FPane.Assign(Src.Pane);
self.FElement.Assign(Src.Element);
@@ -1623,6 +1720,7 @@ var
Subnode: TSpkXMLNode;
begin
Tab.Reset;
+ MenuButton.Reset;
Pane.Reset;
Element.Reset;
@@ -1633,6 +1731,10 @@ begin
if Assigned(Subnode) then
Tab.LoadFromXML(Subnode);
+ Subnode := Node['Menu Button', false];
+ if Assigned(Subnode) then
+ MenuButton.LoadFromXML(Subnode);
+
Subnode := Node['Pane', false];
if Assigned(Subnode) then
Pane.LoadFromXML(Subnode);
@@ -1651,6 +1753,7 @@ end;
procedure TSpkToolbarAppearance.Reset(AStyle: TSpkStyle = spkOffice2007Blue);
begin
FTab.Reset(AStyle);
+ FMenuButton.Reset(AStyle);
FPane.Reset(AStyle);
FElement.Reset(AStyle);
if Assigned(FAppearanceDispatch) then
@@ -1661,6 +1764,7 @@ procedure TSpkToolbarAppearance.SaveToPascal(AList: TStrings);
begin
AList.Add('with Appearance do begin');
FTab.SaveToPascal(AList);
+ FMenuButton.SaveToPascal(AList);
FPane.SaveToPascal(AList);
FElement.SaveToPascal(AList);
AList.Add('end;');
@@ -1673,6 +1777,9 @@ begin
Subnode := Node['Tab',true];
FTab.SaveToXML(Subnode);
+ Subnode := Node['Menu Button',true];
+ FMenuButton.SaveToXML(Subnode);
+
Subnode := Node['Pane',true];
FPane.SaveToXML(Subnode);
@@ -1701,4 +1808,570 @@ begin
//AFont.Assign(Screen.MenuFont); // wp: If this really is harmful this proc should be removed.
end;
+procedure TSpkToolbarAppearance.SetMenubuttonAppearance(const Value: TSpkMenuButtonAppearance);
+begin
+ FMenuButton.Assign(Value);
+end;
+
+//****
+
+constructor TSpkMenuButtonAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
+begin
+ inherited Create;
+ FDispatch := ADispatch;
+ FCaptionFont := TFont.Create;
+ FCaptionFont.OnChange := CaptionFontChange;
+ FHotTrackBrightnessChange := 40;
+ Reset;
+end;
+
+destructor TSpkMenuButtonAppearance.Destroy;
+begin
+ FCaptionFont.Free;
+ inherited Destroy;
+end;
+
+procedure TSpkMenuButtonAppearance.Assign(Source: TPersistent);
+var
+ SrcAppearance: TSpkMenuButtonAppearance;
+begin
+ if Source is TSpkMenuButtonAppearance then
+ begin
+ SrcAppearance := TSpkMenuButtonAppearance(Source);
+
+ FCaptionFont.Assign(SrcAppearance.CaptionFont);
+ FIdleFrameColor := SrcAppearance.IdleFrameColor;
+ FIdleGradientFromColor := SrcAppearance.IdleGradientFromColor;
+ FIdleGradientToColor := SrcAppearance.IdleGradientToColor;
+ FIdleGradientType := SrcAppearance.IdleGradientType;
+ FIdleCaptionColor := SrcAppearance.IdleCaptionColor;
+ FHotTrackFrameColor := SrcAppearance.HotTrackFrameColor;
+ FHotTrackGradientFromColor := SrcAppearance.HotTrackGradientFromColor;
+ FHotTrackGradientToColor := SrcAppearance.HotTrackGradientToColor;
+ FHotTrackGradientType := SrcAppearance.HotTrackGradientType;
+ FHotTrackCaptionColor := SrcAppearance.HotTrackCaptionColor;
+ FHotTrackBrightnessChange := SrcAppearance.HotTrackBrightnessChange;
+ FActiveFrameColor := SrcAppearance.ActiveFrameColor;
+ FActiveGradientFromColor := SrcAppearance.ActiveGradientFromColor;
+ FActiveGradientToColor := SrcAppearance.ActiveGradientToColor;
+ FActiveGradientType := SrcAppearance.ActiveGradientType;
+ FActiveCaptionColor := SrcAppearance.ActiveCaptionColor;
+ FShapeStyle := SrcAppearance.ShapeStyle;
+
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+ end else
+ raise AssignException.Create('TSpkMenuButtonAppearance.Assign: Cannot assign the objecct '+Source.ClassName+' to TSpkMenuButtonAppearance!');
+end;
+
+procedure TSpkMenuButtonAppearance.CaptionFontChange(Sender: TObject);
+begin
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.GetActiveColors(IsChecked: Boolean;
+ out ACaptionColor, AFrameColor, AGradientFromColor, AGradientToColor: TColor;
+ out AGradientKind: TBackgroundKind; ABrightenBy: Integer = 0);
+const
+ DELTA = -20;
+begin
+ ACaptionColor := FActiveCaptionColor;
+ AFrameColor := FActiveFrameColor;
+ AGradientFromColor := FActiveGradientFromColor;
+ AGradientToColor := FActiveGradientToColor;
+ AGradientKind := FActiveGradientType;
+
+ if IsChecked then
+ ABrightenBy := DELTA + ABrightenBy;
+
+ if ABrightenBy <> 0 then
+ begin
+ ACaptionColor := TColorTools.Brighten(ACaptionColor, ABrightenBy);
+ AFrameColor := TColorTools.Brighten(AFrameColor, ABrightenBy);
+ AGradientFromColor := TColorTools.Brighten(AGradientFromColor, ABrightenBy);
+ AGradientToColor := TColorTools.Brighten(AGradientToColor, ABrightenBy);
+ end;
+end;
+
+procedure TSpkMenuButtonAppearance.GetIdleColors(IsChecked: Boolean;
+ out ACaptionColor, AFrameColor, AGradientFromColor, AGradientToColor: TColor;
+ out AGradientKind: TBackgroundKind; ABrightenBy: Integer = 0);
+const
+ DELTA = 10;
+begin
+ if IsChecked then
+ begin
+ ABrightenBy := DELTA + ABrightenBy;
+ ACaptionColor := FActiveCaptionColor;
+ AFrameColor := FActiveFrameColor;
+ AGradientFromColor := FActiveGradientFromColor;
+ AGradientToColor := FActiveGradientToColor;
+ AGradientKind := FActiveGradientType;
+ end else
+ begin
+ ACaptionColor := FIdleCaptionColor;
+ AFrameColor := FIdleFrameColor;
+ AGradientFromColor := FIdleGradientFromColor;
+ AGradientToColor := FIdleGradientToColor;
+ AGradientKind := FIdleGradientType;
+ end;
+
+ if ABrightenBy <> 0 then
+ begin
+ ACaptionColor := TColorTools.Brighten(ACaptionColor, ABrightenBy);
+ AFrameColor := TColorTools.Brighten(AFrameColor, ABrightenBy);
+ AGradientFromColor := TColorTools.Brighten(AGradientFromColor, ABrightenBy);
+ AGradientToColor := TColorTools.Brighten(AGradientToColor, ABrightenBy);
+ end;
+end;
+
+procedure TSpkMenuButtonAppearance.GetHotTrackColors(IsChecked: Boolean;
+ out ACaptionColor, AFrameColor, AGradientFromColor, AGradientToColor: TColor;
+ out AGradientKind: TBackgroundKind; ABrightenBy: Integer = 0);
+const
+ DELTA = 20;
+begin
+ if IsChecked then begin
+ ABrightenBy := ABrightenBy + DELTA;
+ ACaptionColor := FActiveCaptionColor;
+ AFrameColor := FActiveFrameColor;
+ AGradientFromColor := FActiveGradientFromColor;
+ AGradientToColor := FActiveGradientToColor;
+ AGradientKind := FActiveGradientType;
+ end else begin
+ ACaptionColor := FHotTrackCaptionColor;
+ AFrameColor := FHotTrackFrameColor;
+ AGradientFromColor := FHotTrackGradientFromColor;
+ AGradientToColor := FHotTrackGradientToColor;
+ AGradientKind := FHotTrackGradientType;
+ end;
+ if ABrightenBy <> 0 then begin
+ ACaptionColor := TColorTools.Brighten(ACaptionColor, ABrightenBy);
+ AFrameColor := TColorTools.Brighten(AFrameColor, ABrightenBy);
+ AGradientFromColor := TColorTools.Brighten(AGradientFromColor, ABrightenBy);
+ AGradientToColor := TColorTools.Brighten(AGradientToColor, ABrightenBy);
+ end;
+end;
+
+procedure TSpkMenuButtonAppearance.LoadFromXML(Node: TSpkXMLNode);
+var
+ Subnode: TSpkXMLNode;
+begin
+ if not Assigned(Node) then
+ exit;
+
+ Subnode := Node['CaptionFont', false];
+ if Assigned(Subnode) then
+ TSpkXMLTools.Load(Subnode, FCaptionFont);
+
+ // Idle
+ Subnode := Node['IdleFrameColor', false];
+ if Assigned(Subnode) then
+ FIdleFrameColor := Subnode.TextAsColor;
+
+ Subnode := Node['IdleGradientFromColor', false];
+ if Assigned(Subnode) then
+ FIdleGradientFromColor := Subnode.TextAsColor;
+
+ Subnode := Node['IdleGradientToColor', false];
+ if Assigned(Subnode) then
+ FIdleGradientToColor := Subnode.TextAsColor;
+
+ Subnode := Node['IdleGradientType', false];
+ if Assigned(Subnode) then
+ FIdleGradientType := TBackgroundKind(Subnode.TextAsInteger);
+
+ Subnode := Node['IdleCaptionColor', false];
+ if Assigned(Subnode) then
+ FIdleCaptionColor := Subnode.TextAsColor;
+
+ // HotTrack
+ Subnode := Node['HottrackFrameColor', false];
+ if Assigned(Subnode) then
+ FHottrackFrameColor := Subnode.TextAsColor;
+
+ Subnode := Node['HottrackGradientFromColor', false];
+ if Assigned(Subnode) then
+ FHottrackGradientFromColor := Subnode.TextAsColor;
+
+ Subnode := Node['HottrackGradientToColor', false];
+ if Assigned(Subnode) then
+ FHottrackGradientToColor := Subnode.TextAsColor;
+
+ Subnode := Node['HottrackGradientType', false];
+ if Assigned(Subnode) then
+ FHottrackGradientType := TBackgroundKind(Subnode.TextAsInteger);
+
+ Subnode := Node['HottrackCaptionColor', false];
+ if Assigned(Subnode) then
+ FHottrackCaptionColor := Subnode.TextAsColor;
+
+ Subnode := Node['HottrackBrightnessChange', false];
+ if Assigned(Subnode) then
+ FHottrackBrightnessChange := Subnode.TextAsInteger;
+
+ // Active
+ Subnode := Node['ActiveFrameColor', false];
+ if Assigned(Subnode) then
+ FActiveFrameColor := Subnode.TextAsColor;
+
+ Subnode := Node['ActiveGradientFromColor', false];
+ if Assigned(Subnode) then
+ FActiveGradientFromColor := Subnode.TextAsColor;
+
+ Subnode := Node['ActiveGradientToColor', false];
+ if Assigned(Subnode) then
+ FActiveGradientToColor := Subnode.TextAsColor;
+
+ Subnode := Node['ActiveGradientType', false];
+ if Assigned(Subnode) then
+ FActiveGradientType := TBackgroundKind(Subnode.TextAsInteger);
+
+ Subnode := Node['ActiveCaptionColor', false];
+ if Assigned(Subnode) then
+ FActiveCaptionColor := Subnode.TextAsColor;
+
+ // Other
+ Subnode := Node['ShapeStyle', false];
+ if Assigned(SubNode) then
+ FShapeStyle := TSpkMenuButtonShapeStyle(Subnode.TextAsInteger);
+end;
+
+procedure TSpkMenuButtonAppearance.Reset(AStyle: TSpkStyle = spkOffice2007Blue);
+begin
+ SetDefaultFont(FCaptionFont);
+
+ case AStyle of
+ spkOffice2007Blue,
+ spkOffice2007Silver,
+ spkOffice2007SilverTurquoise:
+ begin
+ FCaptionFont.Style := [];
+ FCaptionFont.Color := $00FFFFFF;
+ FIdleFrameColor := $00A1481F;
+ FIdleGradientFromColor := $00DF8A47;
+ FIdleGradientToColor := $00B76129;
+ FIdleGradientType := bkConcave;
+ FIdleCaptionColor := $00FFFFFF;
+ FHotTrackFrameColor := $00A1481F;
+ FHotTrackGradientFromColor := $00E79D5B;
+ FHotTrackGradientToColor := $00BE6731;
+ FHotTrackGradientType := bkConcave;
+ FHotTrackCaptionColor := $00FFFFFF;
+ FHotTrackBrightnessChange := 40;
+ FActiveFrameColor := $00A94D1C;
+ FActiveGradientFromColor := $00DD8A3E;
+ FActiveGradientToColor := $00BD6126;
+ FActiveGradientType := bkConcave;
+ FActiveCaptionColor := $00FFFFFF;
+ FShapeStyle := mbssRounded;
+ end;
+
+ //spkOffice2007Silver,
+ //spkOffice2007SilverTurquoise:
+ // begin
+ // FCaptionFont.Style := [];
+ // FCaptionFont.Color := $008B4215;
+ // FIdleFrameColor := $00B8B1A9;
+ // FIdleGradientFromColor := $00F4F4F2;
+ // FIdleGradientToColor := $00E6E5E3;
+ // FIdleGradientType := bkConcave;
+ // FIdleCaptionColor := $0060655F;
+ // FHotTrackBrightnessChange := 40;
+ // FHotTrackFrameColor := $009BCFDD;
+ // FHotTrackGradientFromColor := $00DAFCFF;
+ // FHotTrackGradientToColor := $004DD7FF;
+ // FHotTrackGradientType := bkConcave;
+ // FHotTrackCaptionColor := $0087426F;
+ // if AStyle = spkOffice2007SilverTurquoise then
+ // begin
+ // FHotTrackFrameColor := $009E7D0E;
+ // FHotTrackGradientFromColor := $00FBF1D0;
+ // FHotTrackGradientToColor := $00F4DD8A;
+ // end;
+ // FActiveFrameColor := $0054768B;
+ // FActiveGradientFromColor := $006CBBFE;
+ // FActiveGradientToColor := $003D92FC;
+ // FActiveGradientType := bkConcave;
+ // FActiveCaptionColor := $0080426E;
+ // if AStyle = spkOffice2007SilverTurquoise then
+ // begin
+ // FActiveFrameColor := $0077620B;
+ // FActiveGradientFromColor := $00F4DB82;
+ // FActiveGradientToColor := $00ECC53E;
+ // end;
+ // FShapeStyle := mbssRounded;
+ // end;
+
+ spkMetroLight:
+ begin
+ FCaptionFont.Style := [];
+ FCaptionFont.Color := $00FFFFFF;
+ FIdleFrameColor := $00B46600;
+ FIdleGradientFromColor := $00B46600;
+ FIdleGradientToColor := $00B46600;
+ FIdleGradientType := bkSolid;
+ FIdleCaptionColor := $00FFFFFF;
+ FHotTrackFrameColor := $00DD7D00;
+ FHotTrackGradientFromColor := $00DD7D00;
+ FHotTrackGradientToColor := $00DD7D00;
+ FHotTrackGradientType := bkSolid;
+ FHotTrackCaptionColor := $00FFFFFF;
+ FHotTrackBrightnessChange := 20;
+ FActiveFrameColor := $00965500;
+ FActiveGradientFromColor := $00965500;
+ FActiveGradientToColor := $00965500;
+ FActiveGradientType := bkSolid;
+ FActiveCaptionColor := $00FFFFFF;
+ FShapeStyle := mbssRectangle;
+ end;
+
+ spkMetroDark:
+ begin
+ FCaptionFont.Style := [];
+ FCaptionFont.Color := $00FFFFFF;
+ FIdleFrameColor := $00B46600;
+ FIdleGradientFromColor := $00B46600;
+ FIdleGradientToColor := $00B46600;
+ FIdleGradientType := bkSolid;
+ FIdleCaptionColor := $00FFFFFF;
+ FHotTrackFrameColor := $00DD7D00;
+ FHotTrackGradientFromColor := $00DD7D00;
+ FHotTrackGradientToColor := $00DD7D00;
+ FHotTrackGradientType := bkSolid;
+ FHotTrackCaptionColor := $00FFFFFF;
+ FHotTrackBrightnessChange := 10;
+ FActiveFrameColor := $00965500;
+ FActiveGradientFromColor := $00965500;
+ FActiveGradientToColor := $00965500;
+ FActiveGradientType := bkSolid;
+ FActiveCaptionColor := $00FFFFFF;
+ FShapeStyle := mbssRectangle;
+ end;
+ end;
+end;
+
+procedure TSpkMenuButtonAppearance.SaveToPascal(AList: TStrings);
+begin
+ with AList do begin
+ Add(' with MenuButton do begin');
+ SaveFontToPascal(AList, FCaptionFont, ' CaptionFont');
+
+ Add(' IdleFrameColor := $' + IntToHex(FIdleFrameColor, 8) + ';');
+ Add(' IdleGradientFromColor := $' + IntToHex(FIdleGradientFromColor, 8) + ';');
+ Add(' IdleGradientToColor := $' + IntToHex(FIdleGradientToColor, 8) + ';');
+ Add(' IdleGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FIdleGradientType)) + ';');
+ Add(' IdleCaptionColor := $' + IntToHex(FIdleCaptionColor, 8) + ';');
+
+ Add(' HotTrackFrameColor := $' + IntToHex(FHotTrackFrameColor, 8) + ';');
+ Add(' HotTrackGradientFromColor := $' + IntToHex(FHotTrackGradientFromColor, 8) + ';');
+ Add(' HotTrackGradientToColor := $' + IntToHex(FHotTrackGradientToColor, 8) + ';');
+ Add(' HotTrackGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FHotTrackGradientType)) + ';');
+ Add(' HotTrackCaptionColor := $' + IntToHex(FHotTrackCaptionColor, 8) + ';');
+ Add(' HotTrackBrightnessChange := ' + IntToStr(FHotTrackBrightnessChange) + ';');
+
+ Add(' ActiveFrameColor := $' + IntToHex(FActiveFrameColor, 8) + ';');
+ Add(' ActiveGradientFromColor := $' + IntToHex(FActiveGradientFromColor, 8) + ';');
+ Add(' ActiveGradientToColor := $' + IntToHex(FActiveGradientToColor, 8) + ';');
+ Add(' ActiveGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FActiveGradientType)) + ';');
+ Add(' ActiveCaptionColor := $' + IntToHex(FActiveCaptionColor, 8) + ';');
+
+ Add(' ShapeStyle := ' + GetEnumName(TypeInfo(TSpkMenuButtonShapeStyle), ord(FShapeStyle)) + ';');
+ Add(' end;');
+ end;
+end;
+
+procedure TSpkMenuButtonAppearance.SaveToXML(Node: TSpkXMLNode);
+var
+ Subnode: TSpkXMLNode;
+begin
+ if not Assigned(Node) then
+ exit;
+
+ Subnode := Node['CaptionFont', true];
+ TSpkXMLTools.Save(Subnode, FCaptionFont);
+
+ // Idle
+ Subnode := Node['IdleFrameColor', true];
+ Subnode.TextAsColor := FIdleFrameColor;
+
+ Subnode := Node['IdleGradientFromColor', true];
+ Subnode.TextAsColor := FIdleGradientFromColor;
+
+ Subnode := Node['IdleGradientToColor', true];
+ Subnode.TextAsColor := FIdleGradientToColor;
+
+ Subnode := Node['IdleGradientType', true];
+ Subnode.TextAsInteger := integer(FIdleGradientType);
+
+ Subnode := Node['IdleCaptionColor', true];
+ Subnode.TextAsColor := FIdleCaptionColor;
+
+ // HotTrack
+ Subnode := Node['HottrackFrameColor', true];
+ Subnode.TextAsColor := FHottrackFrameColor;
+
+ Subnode := Node['HottrackGradientFromColor', true];
+ Subnode.TextAsColor := FHottrackGradientFromColor;
+
+ Subnode := Node['HottrackGradientToColor', true];
+ Subnode.TextAsColor := FHottrackGradientToColor;
+
+ Subnode := Node['HottrackGradientType', true];
+ Subnode.TextAsInteger := integer(FHottrackGradientType);
+
+ Subnode := Node['HottrackCaptionColor', true];
+ Subnode.TextAsColor := FHottrackCaptionColor;
+
+ Subnode := Node['HottrackBrightnessChange', true];
+ Subnode.TextAsInteger := FHotTrackBrightnessChange;
+
+ // Active
+ Subnode := Node['ActiveFrameColor', true];
+ Subnode.TextAsColor := FActiveFrameColor;
+
+ Subnode := Node['ActiveGradientFromColor', true];
+ Subnode.TextAsColor := FActiveGradientFromColor;
+
+ Subnode := Node['ActiveGradientToColor', true];
+ Subnode.TextAsColor := FActiveGradientToColor;
+
+ Subnode := Node['ActiveGradientType', true];
+ Subnode.TextAsInteger := integer(FActiveGradientType);
+
+ Subnode := Node['ActiveCaptionColor', true];
+ Subnode.TextAsColor := FActiveCaptionColor;
+
+ // Other
+ Subnode := Node['ShapeStyle', true];
+ Subnode.TextAsInteger := integer(FShapeStyle);
+end;
+
+procedure TSpkMenuButtonAppearance.SetActiveCaptionColor(const Value: TColor);
+begin
+ FActiveCaptionColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetActiveFrameColor(const Value: TColor);
+begin
+ FActiveFrameColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetActiveGradientFromColor(const Value: TColor);
+begin
+ FActiveGradientFromColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetActiveGradientToColor(const Value: TColor);
+begin
+ FActiveGradientToColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetActiveGradientType(const Value: TBackgroundKind);
+begin
+ FActiveGradientType := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetCaptionFont(const Value: TFont);
+begin
+ FCaptionFont.Assign(Value);
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackBrightnessChange(const Value: Integer);
+begin
+ FHotTrackBrightnessChange := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackCaptionColor(const Value: TColor);
+begin
+ FHotTrackCaptionColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackFrameColor(const Value: TColor);
+begin
+ FHotTrackFrameColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackGradientFromColor(const Value: TColor);
+begin
+ FHotTrackGradientFromColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackGradientToColor(const Value: TColor);
+begin
+ FHotTrackGradientToColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetHotTrackGradientType(const Value: TBackgroundKind);
+begin
+ FHotTrackGradientType := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetIdleCaptionColor(const Value: TColor);
+begin
+ FIdleCaptionColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetIdleFrameColor(const Value: TColor);
+begin
+ FIdleFrameColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetIdleGradientFromColor(const Value: TColor);
+begin
+ FIdleGradientFromColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetIdleGradientToColor(const Value: TColor);
+begin
+ FIdleGradientToColor := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetIdleGradientType(const Value: TBackgroundKind);
+begin
+ FIdleGradientType := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkMenuButtonAppearance.SetShapeStyle(const Value: TSpkMenuButtonShapeStyle);
+begin
+ FShapeStyle := Value;
+ if FDispatch <> nil then
+ FDispatch.NotifyAppearanceChanged;
+end;
+
end.
diff --git a/components/spktoolbar/SpkToolbar/spkt_Const.pas b/components/spktoolbar/SpkToolbar/spkt_Const.pas
index 10c39fc86..0ec37bab7 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Const.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Const.pas
@@ -132,6 +132,16 @@ const
TAB_BORDER_SIZE = 1;
+ // *******************
+ // *** Menu button ***
+ // *******************
+
+ /// Menu button corner radius
+ MENUBUTTON_CORNER_RADIUS = 4;
+ /// Menu button minimum width
+ MENUBUTTON_MIN_WIDTH = 32;
+
+
// ***************
// *** Toolbar ***
// ***************
@@ -264,7 +274,17 @@ var
TabHeight: Integer;
- // ***************
+ // *******************
+ // *** Menu button ***
+ // *******************
+
+ /// Menu button corner radius
+ MenuButtonCornerRadius: Integer;
+ /// Menu button minimum width
+ MenuButtonMinWidth: Integer;
+
+
+// ***************
// *** Toolbar ***
// ***************
@@ -356,6 +376,9 @@ begin
TabBorderSize := SpkScaleX(TAB_BORDER_SIZE, FromDPI, ToDPI);
TabHeight := PaneHeight + TabPaneTopPadding + TabPaneBottomPadding + TabBorderSize;
+ MenuButtonCornerRadius := MENUBUTTON_CORNER_RADIUS;
+ MenuButtonMinWidth := SpkScaleX(MENUBUTTON_MIN_WIDTH, FromDPI, ToDPI);
+
ToolbarBorderWidth := SpkScaleX(TOOLBAR_BORDER_WIDTH, FromDPI, ToDPI);
ToolbarCornerRadius := TOOLBAR_CORNER_RADIUS;
// ToolbarTabCaptionsHeight := SpkScaleY(TOOLBAR_TAB_CAPTIONS_HEIGHT, FromDPI, ToDPI);
@@ -376,6 +399,9 @@ begin
if TabCornerRadius > 1 then
TabCornerRadius := SpkScaleX(TabCornerRadius, FromDPI, ToDPI);
+ if MenuButtonCornerRadius > 1 then
+ MenuButtonCornerRadius := SpkScaleX(MenuButtonCornerRadius, FromDPI, ToDPI);
+
if ToolbarCornerRadius > 1 then
ToolbarCornerRadius := SpkScaleX(ToolbarCornerRadius, FromDPI, ToDPI);
end;