unit Vcl.StyledCategoryButtons;

Vcl.ImgList

, System.UITypes

, System.SysUtils

, System.Classes

, System.Math

, Vcl.ToolWin

, Vcl.ComCtrls

, Vcl.StdCtrls

, Vcl.ExtCtrls

, Vcl.Themes

, Vcl.Controls

, Vcl.ActnList

, Vcl.Menus

, Vcl.CategoryButtons

, Winapi.Messages

, Winapi.Windows

, Vcl.StyledButton

, Vcl.ButtonStylesAttributes

, Vcl.StandardButtonStyles

, Vcl.Graphics

;

resourcestring

ERROR_SETTING_CATEGORYBUTTONS_STYLE = 'Error setting CategoryButtons Style: %s/%s/%s not available';

/// <summary>Exception class for styled category buttons errors</summary>

EStyledCategoryButtonsError = Exception;

TStyledCategoryButtons = class;

/// <summary>Class reference type for TStyledCategoryButtons descendants</summary>

TStyledCategoryButtonsClass = class of TStyledCategoryButtons;

TStyledButtonItem = class;

/// <summary>Class reference type for TStyledButtonItem descendants</summary>

TStyledButtonItemClass = class of TButtonItem;

TStyledButtonCategory = class;

/// <summary>Class reference type for TStyledButtonCategory descendants</summary>

TStyledButtonCategoryClass = class of TStyledButtonCategory;

TStyledButtonCategories = class;

/// <summary>Class reference type for TStyledButtonCategories descendants</summary>

TStyledButtonCategoriesClass = class of TStyledButtonCategories;

/// <summary>Callback procedure for iterating category button items</summary>

/// <param name="Button">The current button item being processed</param>

TButtonProc = reference to procedure (Button: TStyledButtonItem);

/// <summary>Event handler for retrieving notification badge information</summary>

/// <param name="ACategoryIndex">Index of the category</param>

/// <param name="AButtonItemIndex">Index of the button item within the category</param>

/// <param name="ABadgeContent">Badge text content</param>

/// <param name="ASize">Badge size</param>

/// <param name="APosition">Badge position on the button</param>

/// <param name="AColor">Badge background color</param>

/// <param name="AFontColor">Badge text color</param>

/// <param name="AFontStyle">Badge font style</param>

TGetCategoryButtonsBadgeInfo = procedure (

const ACategoryIndex: Integer;

const AButtonItemIndex: Integer;

var ABadgeContent: string;

var ASize: TNotificationBadgeSize;

var APosition: TNotificationBadgePosition;

var AColor: TColor;

var AFontColor: TColor;

var AFontStyle: TFontStyles) of Object;

/// <summary>Styled button category for organizing button items</summary>

/// <remarks>

/// TStyledButtonCategory represents a group of related buttons within

/// a TStyledCategoryButtons component. Categories can be collapsed/expanded

/// and provide visual grouping with header text.

/// </remarks>

TStyledButtonCategory = class(TButtonCategory)

protected

public

constructor Create(Collection: TCollection); override;

end;

/// <summary>Collection class for styled button categories</summary>

/// <remarks>

/// TStyledButtonCategories is a collection that holds TStyledButtonCategory

/// objects, each containing one or more TStyledButtonItem objects. This

/// provides a two-level hierarchy for organizing buttons.

/// </remarks>

TStyledButtonCategories = class(TButtonCategories)

private

function GetStyledCategoryButtons: TStyledCategoryButtons;

function GetItem(Index: Integer): TStyledButtonCategory;

procedure SetItem(Index: Integer; const AValue: TStyledButtonCategory);

public

constructor Create(const CategoryButtons: TCategoryButtons); override;

function Add: TStyledButtonCategory;

property CategoryButtons: TStyledCategoryButtons read GetStyledCategoryButtons;

property Items[Index: Integer]: TStyledButtonCategory read GetItem write SetItem; default;

end;

/// <summary>Styled button item with individual style support</summary>

/// <remarks>

/// TStyledButtonItem represents a single button within a category.

/// Each item can have its own StyleFamily, StyleClass, StyleAppearance,

/// StyleDrawType, StyleRadius, and StyleRoundedCorners properties,

/// allowing individual buttons to have different appearances.

/// </remarks>

TStyledButtonItem = class(TButtonItem)

private

FCollection: TButtonCollection;

//Styled Attributes

FStyleRadius: Integer;

FStyleRoundedCorners: TRoundedCorners;

FStyleDrawType: TStyledButtonDrawType;

FStyleFamily: TStyledButtonFamily;

FStyleClass: TStyledButtonClass;

FStyleAppearance: TStyledButtonAppearance;

FStyleApplied: Boolean;

procedure InvalidateOwner;

function IsCustomDrawType: Boolean;

function IsCustomRoundedCorners: Boolean;

function IsCustomRadius: Boolean;

function IsStoredStyle: Boolean;

procedure SetStyleFamily(const AValue: TStyledButtonFamily);

procedure SetStyleClass(const AValue: TStyledButtonClass);

procedure SetStyleAppearance(const AValue: TStyledButtonAppearance);

procedure SetStyleDrawType(const AValue: TStyledButtonDrawType);

procedure SetStyleRadius(const AValue: Integer);

procedure SetStyleRoundedCorners(const AValue: TRoundedCorners);

function GetStyledCategoryButtons: TStyledCategoryButtons;

function ApplyButtonStyle: Boolean;

procedure LoadDefaultStyles;

public

procedure Assign(Source: TPersistent); override;

constructor Create(Collection: TCollection); override;

procedure SetButtonStyle(const AStyleFamily: TStyledButtonFamily;

const AStyleClass: TStyledButtonClass;

const AStyleAppearance: TStyledButtonAppearance);

published

property CategoryButtons: TStyledCategoryButtons read GetStyledCategoryButtons;

//StyledComponents Attributes

property StyleRadius: Integer read FStyleRadius write SetStyleRadius stored IsCustomRadius;

property StyleDrawType: TStyledButtonDrawType read FStyleDrawType write SetStyleDrawType stored IsCustomDrawType;

property StyleRoundedCorners: TRoundedCorners read FStyleRoundedCorners write SetStyleRoundedCorners stored IsCustomRoundedCorners;

property StyleFamily: TStyledButtonFamily read FStyleFamily write SetStyleFamily stored IsStoredStyle;

property StyleClass: TStyledButtonClass read FStyleClass write SetStyleClass stored IsStoredStyle;

property StyleAppearance: TStyledButtonAppearance read FStyleAppearance write SetStyleAppearance stored IsStoredStyle;

end;

/// <summary>Styled category buttons component with modern appearance</summary>

/// <remarks>

/// TStyledCategoryButtons is a styled alternative to TCategoryButtons that

/// provides modern visual appearance through the StyledComponents styling

/// system. Organizes buttons into collapsible categories with headers.

/// Supports custom button styles (StyleFamily, StyleClass, StyleAppearance),

/// notification badges via OnGetNotificationBadgeInfo, and all standard

/// category buttons features. Individual items can override the component's

/// default style. Use RegisterDefaultRenderingStyle to set global defaults.

/// </remarks>

[ComponentPlatforms(pidWin32 or pidWin64)]

TStyledCategoryButtons = class(TCategoryButtons)

private

//StyledButton Attributes

FButtonStyleNormal: TStyledButtonAttributes;

FButtonStylePressed: TStyledButtonAttributes;

FButtonStyleSelected: TStyledButtonAttributes;

FButtonStyleHot: TStyledButtonAttributes;

FButtonStyleDisabled: TStyledButtonAttributes;

//Styled Attributes

FStyleRadius: Integer;

FStyleDrawType: TStyledButtonDrawType;

FStyleRoundedCorners: TRoundedCorners;

FStyleFamily: TStyledButtonFamily;

FStyleClass: TStyledButtonClass;

FStyleAppearance: TStyledButtonAppearance;

FCustomDrawType: Boolean;

FStyleApplied: Boolean;

//Notification Badge event handler

FOnGetNotificationBadgeInfo: TGetCategoryButtonsBadgeInfo;

FCaptionAlignment: TAlignment;

FImageAlignment: TImageAlignment;

FImageMargins: TImageMargins;

FSpacing: Integer;

FFlat: Boolean;

FButtonsCursor: TCursor;

FCursor: TCursor;

class var

_DefaultStyleDrawType: TStyledButtonDrawType;

_UseCustomDrawType: Boolean;

_DefaultFamily: TStyledButtonFamily;

_DefaultClass: TStyledButtonClass;

_DefaultAppearance: TStyledButtonAppearance;

_DefaultStyleRadius: Integer;

_DefaultButtonsCursor: TCursor;

procedure ImageMarginsChange(Sender: TObject);

function IsCustomDrawType: Boolean;

function IsCustomRoundedCorners: Boolean;

function IsCustomRadius: Boolean;

function ImageMarginsStored: Boolean;

function IsStoredStyleAppearance: Boolean;

function IsStoredStyleClass: Boolean;

function IsStoredStyleFamily: Boolean;

procedure SetStyleAppearance(const AValue: TStyledButtonAppearance);

procedure SetStyleClass(const AValue: TStyledButtonClass);

procedure SetStyleDrawType(const AValue: TStyledButtonDrawType);

procedure SetStyleFamily(const AValue: TStyledButtonFamily);

procedure SetStyleRadius(const AValue: Integer);

procedure SetStyleRoundedCorners(const AValue: TRoundedCorners);

function ApplyCategoryButtonsStyle: Boolean;

procedure SetStyleApplied(const AValue: Boolean);

function ApplyButtonStyle: Boolean;

function GetActiveStyleName: string;

function AsVCLStyle: Boolean;

function GetAsVCLComponent: Boolean;

procedure SetAsVCLComponent(const AValue: Boolean);

procedure ProcessButtons(AButtonProc: TButtonProc);

procedure SetButtonStyleDisabled(const AValue: TStyledButtonAttributes);

procedure SetButtonStyleHot(const AValue: TStyledButtonAttributes);

procedure SetButtonStyleNormal(const AValue: TStyledButtonAttributes);

procedure SetButtonStylePressed(const AValue: TStyledButtonAttributes);

procedure SetButtonStyleSelected(const AValue: TStyledButtonAttributes);

procedure GetDrawingStyle(const ACanvas: TCanvas;

const AButtonState: TStyledButtonState;

const AItem: TStyledButtonItem);

function GetAttributes(const AMode: TStyledButtonState): TStyledButtonAttributes;

procedure DrawBackgroundAndBorder(const ACanvas: TCanvas;

const ADrawRect, ADropDownRect: TRect;

const AStyleDrawType: TStyledButtonDrawType;

const ARadius: Single; const ARoundedCorners: TRoundedCorners);

procedure DrawCaptionAndImage(const ACanvas: TCanvas; const ASurfaceRect: TRect;

const ACaption: TCaption; const AImageIndex: Integer);

procedure SetCaptionAlignment(const AValue: TAlignment);

function GetImageSize(out AWidth, AHeight: Integer;

out AImageList: TCustomImageList): boolean;

procedure SetSpacing(const AValue: Integer);

procedure SetFlat(const AValue: Boolean);

function IsStyleEnabled: Boolean;

procedure SetCursor(const AValue: TCursor);

procedure SetImageAlignment(const AValue: TImageAlignment);

function GetScaleFactor: Single;

function CalcMaxBorderWidth: Integer;

function GetButtonCategories: TStyledButtonCategories;

procedure SetButtonCategories(const AValue: TStyledButtonCategories);

procedure SetImageMargins(const AValue: TImageMargins);

function IsDefaultImageMargins: Boolean;

procedure CalcDefaultImageMargins(const AValue: TImageAlignment);

{$IFNDEF D10_4+}

function IsCustomStyleActive: Boolean;

{$ENDIF}

//Windows messages

procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED;

protected

{$IFDEF D10_1+}

procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override;

{$ENDIF}

procedure Loaded; override;

function GetButtonCategoriesClass: TButtonCategoriesClass; override;

function GetButtonCategoryClass: TButtonCategoryClass; override;

function GetButtonItemClass: TButtonItemClass; override;

procedure UpdateStyleElements; override;

procedure DrawButton(const AButton: TButtonItem; ACanvas: TCanvas;

ARect: TRect; AState: TButtonDrawState); override;

procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;

public

procedure Assign(Source: TPersistent); override;

function StyledButtonState(const AState: TButtonDrawState): TStyledButtonState;

class procedure RegisterDefaultRenderingStyle(

const ADrawType: TStyledButtonDrawType;

const AFamily: TStyledButtonFamily = DEFAULT_CLASSIC_FAMILY;

const AClass: TStyledButtonClass = DEFAULT_WINDOWS_CLASS;

const AAppearance: TStyledButtonAppearance = DEFAULT_APPEARANCE;

const AStyleRadius: Integer = DEFAULT_RADIUS;

const AButtonsCursor: TCursor = DEFAULT_CURSOR); virtual;

procedure SetCategoryButtonsStyle(const AStyleFamily: TStyledButtonFamily;

const AStyleClass: TStyledButtonClass;

const AStyleAppearance: TStyledButtonAppearance);

procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

//Styled constructor

constructor CreateStyled(AOwner: TComponent;

const AFamily: TStyledButtonFamily;

const AClass: TStyledButtonClass;

const AAppearance: TStyledButtonAppearance); virtual;

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

property AsVCLComponent: Boolean read GetAsVCLComponent write SetAsVCLComponent stored False;

property StyleApplied: Boolean read FStyleApplied write SetStyleApplied;

published

property ButtonsCursor: TCursor read FButtonsCursor write FButtonsCursor default DEFAULT_CURSOR;

property Cursor: TCursor read FCursor write SetCursor default crDefault;

property CaptionAlignment: TAlignment read FCaptionAlignment write SetCaptionAlignment default taLeftJustify;

property Categories: TStyledButtonCategories read GetButtonCategories write SetButtonCategories;

property ImageAlignment: TImageAlignment read FImageAlignment write SetImageAlignment default iaLeft;

property ImageMargins: TImageMargins read FImageMargins write SetImageMargins stored ImageMarginsStored;

property Flat: Boolean read FFlat write SetFlat default False;

property Spacing: Integer read FSpacing write SetSpacing default 4;

//StyledButton Attributes

property ButtonStyleNormal: TStyledButtonAttributes read FButtonStyleNormal write SetButtonStyleNormal;

property ButtonStylePressed: TStyledButtonAttributes read FButtonStylePressed write SetButtonStylePressed;

property ButtonStyleSelected: TStyledButtonAttributes read FButtonStyleSelected write SetButtonStyleSelected;

property ButtonStyleHot: TStyledButtonAttributes read FButtonStyleHot write SetButtonStyleHot;

property ButtonStyleDisabled: TStyledButtonAttributes read FButtonStyleDisabled write SetButtonStyleDisabled;

//StyledComponents Attributes

property StyleRadius: Integer read FStyleRadius write SetStyleRadius stored IsCustomRadius;

property StyleDrawType: TStyledButtonDrawType read FStyleDrawType write SetStyleDrawType stored IsCustomDrawType;

property StyleRoundedCorners: TRoundedCorners read FStyleRoundedCorners write SetStyleRoundedCorners stored IsCustomRoundedCorners;

property StyleFamily: TStyledButtonFamily read FStyleFamily write SetStyleFamily stored IsStoredStyleFamily;

property StyleClass: TStyledButtonClass read FStyleClass write SetStyleClass stored IsStoredStyleClass;

property StyleAppearance: TStyledButtonAppearance read FStyleAppearance write SetStyleAppearance stored IsStoredStyleAppearance;

//Notification Badge Info Event Handler

property OnGetNotificationBadgeInfo: TGetCategoryButtonsBadgeInfo read FOnGetNotificationBadgeInfo write FOnGetNotificationBadgeInfo;

end;

Vcl.Consts

, Vcl.Forms

, System.Types

, System.RTLConsts

;

DEFAULT_IMAGE_HMARGIN = 2;

DEFAULT_IMAGE_VMARGIN = 2;

constructor TStyledCategoryButtons.CreateStyled(AOwner: TComponent;

const AFamily: TStyledButtonFamily; const AClass: TStyledButtonClass;

const AAppearance: TStyledButtonAppearance);

inherited Create(AOwner);

//new properties for StyledCategoryButtons

FCaptionAlignment := taLeftJustify;

FSpacing := 4;

FFlat := False;

FImageAlignment := iaLeft;

FButtonsCursor := _DefaultButtonsCursor;

FImageMargins := TImageMargins.Create;

FImageMargins.Left := 2;

FImageMargins.OnChange := ImageMarginsChange;

FButtonStyleNormal := TStyledButtonAttributes.Create(Self);

FButtonStyleNormal.Name := 'Normal';

FButtonStylePressed := TStyledButtonAttributes.Create(Self);

FButtonStylePressed.Name := 'Pressed';

FButtonStyleSelected := TStyledButtonAttributes.Create(Self);

FButtonStyleSelected.Name := 'Selected';

FButtonStyleHot := TStyledButtonAttributes.Create(Self);

FButtonStyleHot.Name := 'Hot';

FButtonStyleDisabled := TStyledButtonAttributes.Create(Self);

FButtonStyleDisabled.Name := 'Disabled';

FStyleDrawType := _DefaultStyleDrawType;

FStyleRadius := _DefaultStyleRadius;

FStyleRoundedCorners := ALL_ROUNDED_CORNERS;

FStyleFamily := AFamily;

FStyleClass := AClass;

FStyleAppearance := AAppearance;

end;

procedure TStyledCategoryButtons.CMStyleChanged(var Message: TMessage);

inherited;

ApplyButtonStyle;

end;

procedure TStyledCategoryButtons.ChangeScale(M, D: Integer;

isDpiChange: Boolean);

inherited;

{$IFNDEF D10_4+}

//Fixed in Delphi 10.4

ButtonWidth := MulDiv(ButtonWidth, M, D);

ButtonHeight := MulDiv(ButtonHeight, M, D);

Resize;

UpdateAllButtons;

{$ENDIF}

end;

constructor TStyledCategoryButtons.Create(AOwner: TComponent);

CreateStyled(AOwner,

_DefaultFamily,

_DefaultClass,

_DefaultAppearance);

end;

destructor TStyledCategoryButtons.Destroy;

FreeAndNil(FImageMargins);

FreeAndNil(FButtonStyleNormal);

FreeAndNil(FButtonStylePressed);

FreeAndNil(FButtonStyleSelected);

FreeAndNil(FButtonStyleHot);

FreeAndNil(FButtonStyleDisabled);

inherited Destroy;

end;

function TStyledCategoryButtons.GetScaleFactor: Single;

Result := {$IFDEF D10_3+}ScaleFactor{$ELSE}1{$ENDIF};

end;

procedure TStyledCategoryButtons.DrawBackgroundAndBorder(

const ACanvas: TCanvas; const ADrawRect, ADropDownRect: TRect;

const AStyleDrawType: TStyledButtonDrawType;

const ARadius: Single; const ARoundedCorners: TRoundedCorners);

LButtonOffset: Integer;

LDropDownRect: TRect;

LScaleFactor: Single;

LScaleFactor := GetScaleFactor;

LDropDownRect := ADropDownRect;

//Draw Button Shape

CanvasDrawshape(ACanvas, ADrawRect, AStyleDrawType,

ARadius*LScaleFactor, ARoundedCorners);

//Draw Bar and Triangle

if LDropDownRect.Width > 0 then

begin

if not (AStyleDrawType in [btRounded, btEllipse]) then

begin

CanvasDrawBar(ACanvas, LDropDownRect,

LScaleFactor,

ACanvas.Pen.Color);

CanvasDrawTriangle(ACanvas, LDropDownRect,

LScaleFactor,

ACanvas.Font.Color);

end

else

begin

LButtonOffset := LDropDownRect.Height div 8;

LDropDownRect.Left := LDropDownRect.Left - LButtonOffset;

LDropDownRect.Right := LDropDownRect.Right - LButtonOffset;

CanvasDrawTriangle(ACanvas, LDropDownRect,

LScaleFactor,

ACanvas.Font.Color);

end;

end;

end;

function TStyledCategoryButtons.GetImageSize(out AWidth, AHeight: Integer;

out AImageList: TCustomImageList): boolean;

AWidth := 0;

AHeight := 0;

//Return True if using ImageList

if Assigned(Images) then

begin

AWidth := Images.Width;

AHeight := Images.Height;

Result := True;

end

else

Result := False;

end;

procedure TStyledCategoryButtons.DrawCaptionAndImage(

const ACanvas: TCanvas; const ASurfaceRect: TRect;

const ACaption: TCaption; const AImageIndex: Integer);

LTextFlags: Cardinal;

LImageRect, LTextRect: TRect;

LImageList: TCustomImageList;

LImageWidth, LImageHeight: Integer;

LUseImageList: Boolean;

if boShowCaptions in ButtonOptions then

begin

case FCaptionAlignment of

taLeftJustify: LTextFlags := DT_NOCLIP or DT_LEFT or DT_VCENTER;

taRightJustify: LTextFlags := DT_NOCLIP or DT_RIGHT or DT_VCENTER;

else

LTextFlags := DT_NOCLIP or DT_CENTER or DT_VCENTER;

end;

LTextFlags := DrawTextBiDiModeFlags(LTextFlags);

(*

end

else

begin

LTextFlags := DT_NOCLIP or DT_CENTER or DT_VCENTER;

end;

LUseImageList := GetImageSize(LImageWidth, LImageHeight, LImageList);

//Calculate LTextRect and LImageRect using ImageMargins and ImageAlignment

CalcImageAndTextRect(ASurfaceRect, ACaption, LTextRect, LImageRect,

LImageWidth, LImageHeight, FImageAlignment, FImageMargins,

CalcMaxBorderWidth, GetScaleFactor);

if LUseImageList and not Assigned(OnDrawIcon) then

begin

//Uses an ImageList to draw the Icon

Images.Draw(ACanvas, LImageRect.Left, LImageRect.Top,

AImageIndex, Enabled);

end;

if boShowCaptions in ButtonOptions then

DrawButtonText(ACanvas, ACaption, FCaptionAlignment, FSpacing,

CalcMaxBorderWidth, LTextRect, LTextFlags, True);

end;

function TStyledCategoryButtons.IsCustomStyleActive: Boolean;

Result := False;

end;

function TStyledCategoryButtons.StyledButtonState(

const AState: TButtonDrawState): TStyledButtonState;

//Calculate Styled State based on State

if (bdsHot in AState) and not (bdsDown in AState) then

Result := bsmHot

else if bdsDown in AState then

Result := bsmPressed

else if (bdsFocused in AState) or (bdsSelected in AState) then

Result := bsmSelected

else if not Enabled then

Result := bsmDisabled

else

Result := bsmNormal;

end;

procedure TStyledCategoryButtons.DrawButton(const AButton: TButtonItem;

ACanvas: TCanvas; ARect: TRect; AState: TButtonDrawState);

LSurfaceRect: TRect;

LOldFontName: TFontName;

LOldFontColor: TColor;

LOldFontStyle: TFontStyles;

LOldParentFont: boolean;

LOldBrushStyle: TBrushStyle;

LOldPenWidth: Integer;

LStyle: TCustomStyleServices;

LState: TStyledButtonState;

LDetails: TThemedElementDetails;

LButtonItem: TStyledButtonItem;

LDropDownRect: TRect;

LColor: TColor;

LBadgeSize: TNotificationBadgeSize;

LBadgePosition: TNotificationBadgePosition;

LBadgeColor: TColor;

LBadgeFontColor: TColor;

LBadgeFontStyle: TFontStyles;

LBadgeContent: string;

//Do not call inherited

LButtonItem := AButton as TStyledButtonItem;

Assert(Assigned(LButtonItem));

if Assigned(OnDrawButton) and (not (csDesigning in ComponentState)) then

OnDrawButton(Self, LButtonItem, ACanvas, ARect, AState)

else

begin

LState := StyledButtonState(AState);

LOldParentFont := ParentFont;

LOldFontName := ACanvas.Font.Name;

LOldFontColor := ACanvas.Font.Color;

LOldFontStyle := ACanvas.Font.Style;

LOldBrushStyle := ACanvas.Brush.Style;

LOldPenWidth := ACanvas.Pen.Width;

try

GetDrawingStyle(ACanvas, LState, LButtonItem);

//At the moment, no DropDown for Buttons

LDropDownRect := TRect.Create(0,0,0,0);

if FFlat then

begin

LStyle := StyleServices{$IFDEF D10_4+}(Self){$ENDIF};

if (LState in [bsmDisabled, bsmNormal]) and IsStyleEnabled then

begin

if (bdsSelected in AState) or (bdsDown in AState) then

LDetails := LStyle.GetElementDetails(tcbButtonSelected)

else if bdsHot in AState then

LDetails := LStyle.GetElementDetails(tcbButtonHot)

else

LDetails := LStyle.GetElementDetails(tcbButtonNormal);

if not (IsCustomStyleActive and not (seFont in StyleElements)) and

LStyle.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then

ACanvas.Font.Color := LColor;

end;

//Don't draw button Face for Flat Normal/disabled Button

if LState in [bsmDisabled, bsmNormal] then

ACanvas.Brush.Style := bsClear;

end;

if Assigned(OnBeforeDrawButton) then

OnBeforeDrawButton(Self, LButtonItem, ACanvas, ARect, AState);

DrawBackgroundAndBorder(ACanvas, ARect, LDropDownRect,

LButtonItem.StyleDrawType, LButtonItem.StyleRadius, LButtonItem.StyleRoundedCorners);

LSurfaceRect := ARect;

if LDropDownRect.Width <> 0 then

Dec(LSurfaceRect.Right, LDropDownRect.Width);

DrawCaptionAndImage(ACanvas, LSurfaceRect, LButtonItem.Caption,

LButtonItem.ImageIndex);

{ Draw the icon - prefer the event }

if Assigned(OnDrawIcon) then

OnDrawIcon(Self, LButtonItem, ACanvas, LSurfaceRect, AState, FSpacing);

LSurfaceRect := ClientRect;

//Get Notification Badge Infos by Event Handler

if Assigned(FOnGetNotificationBadgeInfo) then

begin

LBadgeSize := nbsNormal;

LBadgePosition := nbpTopRight;

LBadgeColor := DEFAULT_BADGE_COLOR;

LBadgeFontColor := DEFAULT_BADGE_FONT_COLOR;

LBadgeContent := '';

LBadgeFontStyle := [fsBold];

FOnGetNotificationBadgeInfo(

AButton.Category.Index, AButton.Index,

LBadgeContent, LBadgeSize, LBadgePosition,

LBadgeColor, LBadgeFontColor, LBadgeFontStyle);

if LBadgeContent <> '' then

begin

DrawButtonNotificationBadge(ACanvas, ARect, GetScaleFactor,

LBadgeContent, LBadgeSize, LBadgePosition,

LBadgeColor, LBadgeFontColor, LBadgeFontStyle);

end;

end;

(*

if Assigned(OnAfterDrawButton) then

OnAfterDrawButton(Self, LButtonItem, ACanvas, ARect, AState);

finally

//Restore original values

ACanvas.Font.Name := LOldFontName;

ACanvas.Font.Color := LOldFontColor;

ACanvas.Font.Style := LOldFontStyle;

ACanvas.Brush.Style := LOldBrushStyle;

ACanvas.Pen.Width := LOldPenWidth;

//ACanvas.Brush.Color := Color;

if LOldParentFont then

ParentFont := LOldParentFont;

end;

end;

end;

procedure TStyledCategoryButtons.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);

inherited;

end;

procedure TStyledCategoryButtons.ImageMarginsChange(Sender: TObject);

Invalidate;

end;

function TStyledCategoryButtons.IsDefaultImageMargins: Boolean;

//Default image margins: when all margins are zero except for

case FImageAlignment of

iaLeft: Result := (FImageMargins.Left = DEFAULT_IMAGE_HMARGIN) and

(FImageMargins.Top = 0) and (FImageMargins.Right = 0) and (FImageMargins.Bottom = 0);

iaRight: Result := (FImageMargins.Right = DEFAULT_IMAGE_HMARGIN) and

(FImageMargins.Top = 0) and (FImageMargins.Left = 0) and (FImageMargins.Bottom = 0);

iaTop: Result := (FImageMargins.Top = DEFAULT_IMAGE_VMARGIN) and

(FImageMargins.Left = 0) and (FImageMargins.Right = 0) and (FImageMargins.Bottom = 0);

iaBottom: Result := (FImageMargins.Bottom = DEFAULT_IMAGE_VMARGIN) and

(FImageMargins.Left = 0) and (FImageMargins.Right = 0) and (FImageMargins.Top = 0);

iaCenter: Result := (FImageMargins.Bottom = 0) and

(FImageMargins.Left = 0) and (FImageMargins.Right = 0) and (FImageMargins.Top = 0);

else

Result := False;

end;

end;

procedure TStyledCategoryButtons.CalcDefaultImageMargins(const AValue: TImageAlignment);

function AdJustMargin(const AMargin, AOffset: Integer): Integer;

begin

Result := AMargin + Round(AOffset*GetScaleFactor);

end;

if IsDefaultImageMargins then

begin

FImageMargins.Left := 0;

FImageMargins.Right := 0;

FImageMargins.Top := 0;

FImageMargins.Bottom := 0;

case AValue of

iaLeft: FImageMargins.Left := AdJustMargin(FImageMargins.Left, DEFAULT_IMAGE_HMARGIN);

iaRight: FImageMargins.Right := AdJustMargin(FImageMargins.Right, DEFAULT_IMAGE_HMARGIN);

iaTop: FImageMargins.Top := AdJustMargin(FImageMargins.Top, DEFAULT_IMAGE_VMARGIN);

iaBottom: FImageMargins.Bottom := AdJustMargin(FImageMargins.Bottom, DEFAULT_IMAGE_VMARGIN);

end;

end;

end;

function TStyledCategoryButtons.CalcMaxBorderWidth: Integer;

Result := Max(Max(Max(Max(FButtonStyleNormal.BorderWidth,

FButtonStylePressed.BorderWidth),

FButtonStyleSelected.BorderWidth),

FButtonStyleHot.BorderWidth),

FButtonStyleDisabled.BorderWidth);

end;

function TStyledCategoryButtons.ImageMarginsStored: Boolean;

Result := not IsDefaultImageMargins;

end;

function TStyledCategoryButtons.IsCustomDrawType: Boolean;

Result := FCustomDrawType;

end;

function TStyledCategoryButtons.IsCustomRoundedCorners: Boolean;

Result := StyleRoundedCorners <> ALL_ROUNDED_CORNERS;

end;

function TStyledCategoryButtons.IsCustomRadius: Boolean;

Result := StyleRadius <> DEFAULT_RADIUS;

end;

function TStyledCategoryButtons.IsStoredStyleAppearance: Boolean;

LClass: TStyledButtonClass;

LAppearance: TStyledButtonAppearance;

LButtonFamily: TButtonFamily;

StyleFamilyCheckAttributes(FStyleFamily, LClass, LAppearance, LButtonFamily);

Result := FStyleAppearance <> LAppearance;

end;

function TStyledCategoryButtons.IsStoredStyleClass: Boolean;

LClass: TStyledButtonClass;

LAppearance: TStyledButtonAppearance;

LButtonFamily: TButtonFamily;

StyleFamilyCheckAttributes(FStyleFamily, LClass, LAppearance, LButtonFamily);

if AsVCLStyle then

begin

Result := (FStyleClass <> GetActiveStyleName)

and not SameText(FStyleClass, 'Windows');

end

else

Result := FStyleClass <> LClass;

end;

function TStyledCategoryButtons.IsStoredStyleFamily: Boolean;

Result := FStyleFamily <> DEFAULT_CLASSIC_FAMILY;

end;

procedure TStyledCategoryButtons.Loaded;

inherited;

if not FStyleApplied (*and not HasCustomAttributes*) then

begin

StyleFamilyUpdateAttributes(

FStyleFamily, FStyleClass, FStyleAppearance,

FButtonStyleNormal, FButtonStylePressed, FButtonStyleSelected,

FButtonStyleHot, FButtonStyleDisabled);

StyleApplied := ApplyButtonStyle;

end;

end;

procedure TStyledCategoryButtons.MouseMove(Shift: TShiftState; X, Y: Integer);

LButtonItem: TButtonItem;

inherited;

LButtonItem := GetButtonAt(X, Y);

if Assigned(LButtonItem) then

inherited Cursor := FButtonsCursor

else

inherited Cursor := FCursor;

end;

class procedure TStyledCategoryButtons.RegisterDefaultRenderingStyle(

const ADrawType: TStyledButtonDrawType; const AFamily: TStyledButtonFamily;

const AClass: TStyledButtonClass; const AAppearance: TStyledButtonAppearance;

const AStyleRadius: Integer; const AButtonsCursor: TCursor);

_DefaultStyleDrawType := ADrawType;

_UseCustomDrawType := True;

_DefaultFamily := AFamily;

_DefaultClass := AClass;

_DefaultAppearance := AAppearance;

_DefaultStyleRadius := AStyleRadius;

_DefaultButtonsCursor := AButtonsCursor;

end;

function TStyledCategoryButtons.ApplyButtonStyle: Boolean;

LButtonFamily: TButtonFamily;

LStyleClass: TStyledButtonClass;

LStyleAppearance: TStyledButtonAppearance;

if AsVCLStyle then

begin

//if StyleElements contains seClient then use

//VCL Style assigned to Button or Global VCL Style

if seBorder in StyleElements then

LStyleAppearance := DEFAULT_APPEARANCE;

LStyleClass := GetActiveStyleName;

end

else

begin

LStyleClass := FStyleClass;

LStyleAppearance := FStyleAppearance;

end;

Result := StyleFamilyCheckAttributes(FStyleFamily,

LStyleClass, LStyleAppearance, LButtonFamily);

if Result (*or (csDesigning in ComponentState)*) then

begin

StyleFamilyUpdateAttributes(

FStyleFamily,

LStyleClass,

LStyleAppearance,

FButtonStyleNormal,

FButtonStylePressed,

FButtonStyleSelected,

FButtonStyleHot,

FButtonStyleDisabled);

end;

StyleClass := LStyleClass;

StyleAppearance := LStyleAppearance;

if Result then

Invalidate;

end;

procedure TStyledCategoryButtons.Assign(Source: TPersistent);

inherited Assign(Source);

if Source is TStyledCategoryButtons then

begin

FStyleFamily := TStyledCategoryButtons(Source).FStyleFamily;

FStyleClass := TStyledCategoryButtons(Source).FStyleClass;

FStyleAppearance := TStyledCategoryButtons(Source).FStyleAppearance;

FStyleRadius := TStyledCategoryButtons(Source).FStyleRadius;

FStyleRoundedCorners := TStyledCategoryButtons(Source).FStyleRoundedCorners;

FStyleDrawType := TStyledCategoryButtons(Source).FStyleDrawType;

FButtonsCursor := TStyledCategoryButtons(Source).FButtonsCursor;

Invalidate;

end;

end;

function TStyledCategoryButtons.AsVCLStyle: Boolean;

Result := (StyleFamily = DEFAULT_CLASSIC_FAMILY) and

(seClient in StyleElements);

end;

function TStyledCategoryButtons.GetAsVCLComponent: Boolean;

Result := (StyleFamily = DEFAULT_CLASSIC_FAMILY) and

(seClient in StyleElements) and

(FStyleClass = GetActiveStyleName);

end;

function TStyledCategoryButtons.GetButtonCategoriesClass: TButtonCategoriesClass;

Result := TStyledButtonCategories;

end;

function TStyledCategoryButtons.GetButtonCategoryClass: TButtonCategoryClass;

Result := TStyledButtonCategory;

end;

function TStyledCategoryButtons.GetButtonItemClass: TButtonItemClass;

Result := TStyledButtonItem;

end;

procedure TStyledCategoryButtons.SetAsVCLComponent(const AValue: Boolean);

if AValue <> GetAsVCLComponent then

begin

if AValue then

begin

FStyleFamily := DEFAULT_CLASSIC_FAMILY;

FStyleClass := DEFAULT_WINDOWS_CLASS;

FStyleAppearance := DEFAULT_APPEARANCE;

StyleElements := StyleElements + [seClient];

FCustomDrawType := False;

end

else if FStyleFamily = DEFAULT_CLASSIC_FAMILY then

begin

StyleElements := StyleElements - [seClient];

end;

UpdateStyleElements;

end;

end;

procedure TStyledCategoryButtons.UpdateStyleElements;

LStyleClass: TStyledButtonClass;

if AsVCLStyle then

begin

//if StyleElements contains seClient then Update style

//as VCL Style assigned to CategoryButtons or Global VCL Style

if seBorder in StyleElements then

StyleAppearance := DEFAULT_APPEARANCE;

LStyleClass := GetActiveStyleName;

FStyleClass := LStyleClass;

StyleApplied := ApplyCategoryButtonsStyle;

ProcessButtons(

procedure (ABtn: TStyledButtonItem)

begin

//ABtn.UpdateStyleElements;

ABtn.StyleDrawType := Self.StyleDrawType;