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;