bgracontrols/bcbutton.pas

// SPDX-License-Identifier: LGPL-3.0-linking-exception
{ Customizable component which using BGRABitmap for drawing. Control mostly rendered
  using framework.

  Functionality:
  - Gradients
  - Double gradients
  - Rounding
  - Drop down list
  - Glyph
  - States (normal, hover, clicked)
  - Caption with shadow
  - Full alpha and antialias support

  originally written in 2012 by Krzysztof Dibowski dibowski at interia.pl
}

{******************************* CONTRIBUTOR(S) ******************************
- Edivando S. Santos Brasil | [email protected]
  (Compatibility with delphi VCL 11/2018)

***************************** END CONTRIBUTOR(S) *****************************}

unit BCButton;

{$I bgracontrols.inc}

interface

uses
  Classes, types, {$IFDEF FPC}LCLType, LResources, {$ENDIF} Controls, Dialogs,
  ActnList, ImgList, Menus, // MORA
  Buttons, Graphics,
  {$IFNDEF FPC}BGRAGraphics, GraphType, FPImage, {$ENDIF}
  BGRABitmap, BGRABitmapTypes, BCThemeManager, BCTypes, Forms, BCBasectrls,
  fpjsonrtti, Typinfo, fpjson;

{off $DEFINE DEBUG}

type
  TBCButtonMemoryUsage = (bmuLow, bmuMedium, bmuHigh);
  TBCButtonState = class;
  TBCButtonStyle = (bbtButton, bbtDropDown);
  TOnAfterRenderBCButton = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
    AState: TBCButtonState; ARect: TRect) of object;
  TBCButtonPropertyData = (pdNone, pdUpdateSize);

  // MORA: DropDown styles
  TBCButtonDropDownStyle = (
    bdsSeparate,     // DropDown is a separate button (default)
    bdsCommon        // DropDown is same as main button
    );
  TBCButtonDropDownPosition = (
    bdpLeft,         // default
    bdpBottom);

  { TBCButtonState }

  TBCButtonState = class(TBCProperty)
  private
    FBackground: TBCBackground;
    FBorder: TBCBorder;
    FFontEx: TBCFont;
    procedure OnChangeFont({%H-}Sender: TObject; {%H-}AData: PtrInt);
    procedure OnChangeChildProperty({%H-}Sender: TObject; AData: PtrInt);
    procedure SetBackground(AValue: TBCBackground);
    procedure SetBorder(AValue: TBCBorder);
    procedure SetFontEx(const AValue: TBCFont);
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure Scale(AScale: single; APreserveDefaultFontHeight: boolean = true);
  published
    property Background: TBCBackground read FBackground write SetBackground;
    property Border: TBCBorder read FBorder write SetBorder;
    property FontEx: TBCFont read FFontEx write SetFontEx;
  end;

  { TCustomBCButton }

  TCustomBCButton = class(TBCStyleGraphicControl)
  private
    { Private declarations }
    {$IFDEF INDEBUG}
    FRenderCount: integer;
    {$ENDIF}
    FDropDownArrowSize: integer;
    FDropDownWidth: integer;
    FFlipArrow: boolean;
    FActiveButt: TBCButtonStyle;
    FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
    FCanvasScale, FRenderScale: Single;
    FCanvasScaleMode: TBCCanvasScaleMode;
    FScaled: boolean;
    FGlyphAlignment: TBCAlignment;
    FGlyphOldPlacement: boolean;
    FGlyphScale: single;
    FInnerMargin: single;
    FMemoryUsage: TBCButtonMemoryUsage;
    FPreserveGlyphOnAssign: boolean;
    FRounding: TBCRounding;
    FRoundingDropDown: TBCRounding;
    FStateClicked: TBCButtonState;
    FStateHover: TBCButtonState;
    FStateNormal: TBCButtonState;
    FDown: boolean;
    FGlyph: TBitmap;
    FGlyphMargin: integer;
    FButtonState: TBCMouseState;
    FDownButtonState: TBCMouseState;
    FOnAfterRenderBCButton: TOnAfterRenderBCButton;
    FOnButtonClick: TNotifyEvent;
    FStaticButton: boolean;
    FStyle: TBCButtonStyle;
    FGlobalOpacity: byte;
    FTextApplyGlobalOpacity: boolean;
    AutoSizeExtraY: integer;
    AutoSizeExtraX: integer;
    FLastBorderWidth: integer;
    // MORA
    FClickOffset: boolean;
    FDropDownArrow: boolean;
    FDropDownMenu: TPopupMenu;
    FDropDownMenuVisible: boolean;
    FDropDownClosingTime: TDateTime;
    FDropDownPosition: TBCButtonDropDownPosition;
    FDropDownStyle: TBCButtonDropDownStyle;
    FImageChangeLink: TChangeLink;
    FImageIndex: integer;
    FImages: TCustomImageList;
    FSaveDropDownClosed: TNotifyEvent;
    FShowCaption: boolean;
    procedure AssignDefaultStyle;
    procedure CalculateGlyphSize(out NeededWidth, NeededHeight: integer);
    procedure DropDownClosed(Sender: TObject);
    function GetBGRAClick: TBGRABitmapEx;
    function GetBGRAHover: TBGRABitmapEx;
    function GetBGRANormal: TBGRABitmapEx;
    procedure OnRestoreProperty(Sender: TObject; AObject: TObject;
      Info: PPropInfo; AValue: TJSONData; var Handled: Boolean);
    procedure OnStreamProperty(Sender: TObject; AObject: TObject;
      Info: PPropInfo; var Res: TJSONData);
    procedure RenderAll(ANow: boolean = False);
    function GetButtonRect: TRect;
    function GetDropDownWidth(AFull: boolean = True): integer;
    function GetDropDownRect(AFull: boolean = True): TRect;
    procedure SetBCButtonStateClicked(const AValue: TBCButtonState);
    procedure SetBCButtonStateHover(const AValue: TBCButtonState);
    procedure SetBCButtonStateNormal(const AValue: TBCButtonState);
    procedure SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
    procedure SetClickOffset(AValue: boolean);
    procedure SetDown(AValue: boolean);
    procedure SetDropDownArrow(AValue: boolean);
    procedure SetDropDownArrowSize(AValue: integer);
    procedure SetDropDownPosition(AValue: TBCButtonDropDownPosition);
    procedure SetDropDownWidth(AValue: integer);
    procedure SetFlipArrow(AValue: boolean);
    procedure SetGlyph(const AValue: TBitmap);
    procedure SetGlyphAlignment(AValue: TBCAlignment);
    procedure SetGlyphMargin(const AValue: integer);
    procedure SetGlyphOldPlacement(AValue: boolean);
    procedure SetGlyphScale(AValue: single);
    procedure SetImageIndex(AValue: integer);
    procedure SetImages(AValue: TCustomImageList);
    procedure SetInnerMargin(AValue: single);
    procedure SetMemoryUsage(AValue: TBCButtonMemoryUsage);
    procedure SetRounding(AValue: TBCRounding);
    procedure SetRoundingDropDown(AValue: TBCRounding);
    procedure SetShowCaption(AValue: boolean);
    procedure SetStaticButton(const AValue: boolean);
    procedure SetStyle(const AValue: TBCButtonStyle);
    procedure SetGlobalOpacity(const AValue: byte);
    procedure SetTextApplyGlobalOpacity(const AValue: boolean);
    procedure UpdateSize;
    procedure OnChangeGlyph({%H-}Sender: TObject);
    procedure OnChangeState({%H-}Sender: TObject; AData: PtrInt);
    procedure ImageListChange(ASender: TObject);
    function  GetGlyph: TBitmap;
  protected
    { Protected declarations }
    procedure LimitMemoryUsage;
    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
      {%H-}WithThemeSpace: boolean); override;
    class function GetControlClassDefaultSize: TSize; override;
    procedure Click; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseEnter;  override;
    procedure MouseLeave;  override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure SetEnabled(Value: boolean); override;
    procedure TextChanged;  override;
  protected
    // MORA
    procedure ActionChange(Sender: TObject; CheckDefaults: boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState); virtual;
    procedure RenderState(ABGRA: TBGRABitmapEx; AState: TBCButtonState;
      const ARect: TRect; ARounding: TBCRounding); virtual;
    property ClickOffset: boolean read FClickOffset write SetClickOffset default False;
    property DropDownArrow: boolean
      read FDropDownArrow write SetDropDownArrow default False;
    property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
    property DropDownStyle: TBCButtonDropDownStyle
      read FDropDownStyle write FDropDownStyle default bdsSeparate;
    property DropDownPosition: TBCButtonDropDownPosition
      read FDropDownPosition write SetDropDownPosition default bdpLeft;
    property Images: TCustomImageList read FImages write SetImages;
    property ImageIndex: integer read FImageIndex write SetImageIndex default -1;
    property ShowCaption: boolean read FShowCaption write SetShowCaption default True;
  protected
    {$IFDEF INDEBUG}
    function GetDebugText: string; override;
    {$ENDIF}
    function GetStyleExtension: string; override;
    procedure ComputeScaling;
    procedure DrawControl; override;
    procedure RenderControl; override;
    property BGRANormal: TBGRABitmapEx read GetBGRANormal;
    property BGRAHover: TBGRABitmapEx read GetBGRAHover;
    property BGRAClick: TBGRABitmapEx read GetBGRAClick;
  protected
    property AutoSizeExtraVertical: integer read AutoSizeExtraY;
    property AutoSizeExtraHorizontal: integer read AutoSizeExtraX;
    property CanvasScaleMode: TBCCanvasScaleMode read FCanvasScaleMode write SetCanvasScaleMode default csmAuto;
    property Scaled: boolean read FScaled write FScaled default false;
    property StateNormal: TBCButtonState read FStateNormal write SetBCButtonStateNormal;
    property StateHover: TBCButtonState read FStateHover write SetBCButtonStateHover;
    property StateClicked: TBCButtonState read FStateClicked
      write SetBCButtonStateClicked;
    property Down: boolean read FDown write SetDown default False;
    property DropDownWidth: integer read FDropDownWidth write SetDropDownWidth;
    property DropDownArrowSize: integer read FDropDownArrowSize
      write SetDropDownArrowSize;
    property FlipArrow: boolean read FFlipArrow write SetFlipArrow default False;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphScale: single read FGlyphScale write SetGlyphScale default 1;
    property GlyphMargin: integer read FGlyphMargin write SetGlyphMargin default 5;
    property GlyphAlignment: TBCAlignment read FGlyphAlignment write SetGlyphAlignment default bcaCenter;
    property GlyphOldPlacement: boolean read FGlyphOldPlacement write SetGlyphOldPlacement default true;
    property Style: TBCButtonStyle read FStyle write SetStyle default bbtButton;
    property StaticButton: boolean
      read FStaticButton write SetStaticButton default False;
    property GlobalOpacity: byte read FGlobalOpacity write SetGlobalOpacity;
    property Rounding: TBCRounding read FRounding write SetRounding;
    property RoundingDropDown: TBCRounding read FRoundingDropDown
      write SetRoundingDropDown;
    property TextApplyGlobalOpacity: boolean
      read FTextApplyGlobalOpacity write SetTextApplyGlobalOpacity;
    property OnAfterRenderBCButton: TOnAfterRenderBCButton
      read FOnAfterRenderBCButton write FOnAfterRenderBCButton;
    property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
    property MemoryUsage: TBCButtonMemoryUsage read FMemoryUsage write SetMemoryUsage;
    property InnerMargin: single read FInnerMargin write SetInnerMargin;
    property PreserveGlyphOnAssign: boolean read FPreserveGlyphOnAssign write FPreserveGlyphOnAssign default True;
  public
    { Constructor }
    constructor Create(AOwner: TComponent); override;
    { Destructor }
    destructor Destroy; override;
    { Assign the properties from Source to this instance }
    procedure Assign(Source: TPersistent); override;
    { Set dropdown size and autosize extra padding }
    procedure SetSizeVariables(newDropDownWidth, newDropDownArrowSize,
      newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
    { Called by EndUpdate }
    procedure UpdateControl; override;
    property CanvasScale: single read FCanvasScale;
  public
    procedure ScaleStyle(AScale: single; APreserveDefaultFontHeight: boolean = true);
    {$IFDEF FPC}
    { Save all published settings to file }
    procedure SaveToFile(AFileName: string); override;
    procedure SaveToJSONFile(AFileName: string);
    function SaveToJSON: string;
    { Load and assign all published settings from file }
    procedure LoadFromFile(AFileName: string); override;
    procedure LoadFromJSONFile(AFileName: string);
    procedure LoadFromJSON(AJSON: string);
    { Assign the properties from AFileName to this instance }
    procedure AssignFromFile(AFileName: string); override;
    procedure AssignFromResource(AResourceName: string);
    {$ENDIF}
    { Used by SaveToFile/LoadFromFile }
    procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
      var ComponentClass: TComponentClass);
  end;

  TBCButton = class(TCustomBCButton)
  private
    FBCThemeManager: TBCThemeManager;
    procedure SetFBCThemeManager(AValue: TBCThemeManager);
  published
    property Action;
    property Align;
    property Anchors;
    { Click to edit the style. Available when editing only. If you want to stream the style from a file at runtime please use LoadFromFile and SaveToFile methods. }
    property AssignStyle;
    property AutoSize;
    { The style of the button when pressed. }
    property StateClicked;
    { The style of the button when hovered. }
    property StateHover;
    { The default style of the button. }
    property StateNormal;
    property BorderSpacing;
    property CanvasScaleMode;
    { Whether the component is DPI aware }
    property Scaled;
    property Caption;
    property Color;
    property Constraints;
    { Set to True to change the button to always show a StateClicked style that will not change when button is clicked or hovered. }
    property Down;
    { The width of the dropdown arrow area. }
    property DropDownWidth;
    { The size of the dropdown arrow. }
    property DropDownArrowSize;
    property Enabled;
    { Changes the direction of the arrow. Default: False. }
    property FlipArrow;
    { Set the opacity that will be applied to the whole button. Default: 255. }
    property GlobalOpacity;
    { The glyph icon. }
    property Glyph;
    property GlyphScale;
    property GlyphAlignment;
    property GlyphOldPlacement;
    property PreserveGlyphOnAssign;
    { The margin of the glyph icon. }
    property GlyphMargin;
    property Hint;
    property InnerMargin;
    { Called when the button finish the render. Use it to add your own drawings to the button. }
    property OnAfterRenderBCButton;
    { Called when the button part is clicked, not the dropdown. }
    property OnButtonClick;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property ParentColor;
    property PopupMenu;
    { Change the style of the rounded corners of the button. }
    property Rounding;
    { Change the style of the rounded corners of the dropdown part of the button. }
    property RoundingDropDown;
    { Set to True to change the button to always show a StateNormal style that will not change when button is clicked or hovered. }
    property StaticButton;
    property ShowHint;
    { The style of button that will be used. bbtButton or bbtDropDown. }
    property Style;
    { Apply the global opacity to rendered text. Default: False. }
    property TextApplyGlobalOpacity;
    property Visible;
    { -ToDo: Unused property? }
    property ClickOffset;
    { Show the dropdown arrow. }
    property DropDownArrow;
    { The dropdown menu that will be displayed when the button is pressed. }
    property DropDownMenu;
    { The kind of dropdown that will be used. bdsSeparate will show the dropdown down the dropdown arrow side. bdsCommon will show the dropdown down the whole button. }
    property DropDownStyle;
    { The position of the dropdown arrow. }
    property DropDownPosition;
    { The image list that holds an image to be used with the button ImageIndex property. }
    property Images;
    { The index of the image that will be used for the button as glyph icon if glyph property is not set. }
    property ImageIndex;
    { Show caption or hides it. Default: True. }
    property ShowCaption;
    { Limit memory usage by selecting one of the options. Default: bmuHigh. }
    property MemoryUsage;
    { The unique name of the control in the form. }
    property Name;
    property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
  end;

  { TBCButtonActionLink }

  TBCButtonActionLink = class(TControlActionLink)
  protected
    procedure AssignClient(AClient: TObject); override;
    procedure SetChecked(Value: boolean); override;
    procedure SetImageIndex(Value: integer); override;
  public
    function IsCheckedLinked: boolean; override;
    function IsImageIndexLinked: boolean; override;
  end;

{$IFDEF FPC}procedure Register;{$ENDIF}

implementation

uses {$IFDEF FPC}LCLIntf, PropEdits, GraphPropEdits, LCLProc, {$ENDIF}Math, BCTools, SysUtils;

const
  DropDownReopenDelay = 0.2/(24*60*60);

{$IFDEF FPC}//#
type
  TBCButtonImageIndexPropertyEditor = class(TImageIndexPropertyEditor)
  protected
    function GetImageList: TCustomImageList; override;
  end;
{$ENDIF}

{ TBCButton }

procedure TBCButton.SetFBCThemeManager(AValue: TBCThemeManager);
begin
  if FBCThemeManager=AValue then Exit;
  FBCThemeManager:=AValue;
end;

{$IFDEF FPC}//#
function TBCButtonImageIndexPropertyEditor.GetImageList: TCustomImageList;
var
  Component: TPersistent;
begin
  Component := GetComponent(0);
  if Component is TCustomBCButton then
    Result := TCustomBCButton(Component).Images
  else
    Result := nil;
end;
{$ENDIF}

{$IFDEF FPC}
procedure Register;
begin
  {$R images\bgracontrols_images.res}
  RegisterComponents('BGRA Button Controls', [TBCButton]);
  RegisterPropertyEditor(TypeInfo(integer), TBCButton,
    'ImageIndex', TBCButtonImageIndexPropertyEditor);
end;
{$ENDIF}

{ TBCButtonActionLink }

procedure TBCButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TCustomBCButton;
end;

procedure TBCButtonActionLink.SetChecked(Value: boolean);
begin
  if IsCheckedLinked then
    TCustomBCButton(FClient).Down := Value;
end;

procedure TBCButtonActionLink.SetImageIndex(Value: integer);
begin
  if IsImageIndexLinked then
    TCustomBCButton(FClient).ImageIndex := Value;
end;

function TBCButtonActionLink.IsCheckedLinked: boolean;
begin
  Result := inherited IsCheckedLinked and (TCustomBCButton(FClient).Down =
    (Action as TCustomAction).Checked);
end;

function TBCButtonActionLink.IsImageIndexLinked: boolean;
begin
  Result := inherited IsImageIndexLinked and
    (TCustomBCButton(FClient).ImageIndex = (Action as TCustomAction).ImageIndex);
end;

{ TBCButtonState }

procedure TBCButtonState.SetFontEx(const AValue: TBCFont);
begin
  if FFontEx = AValue then
    exit;
  FFontEx.Assign(AValue);

  Change;
end;

procedure TBCButtonState.OnChangeFont(Sender: TObject; AData: PtrInt);
begin
  Change(PtrInt(pdUpdateSize));
end;

procedure TBCButtonState.OnChangeChildProperty(Sender: TObject; AData: PtrInt);
begin
  Change(AData);
end;

procedure TBCButtonState.SetBackground(AValue: TBCBackground);
begin
  if FBackground = AValue then
    Exit;
  FBackground.Assign(AValue);

  Change;
end;

procedure TBCButtonState.SetBorder(AValue: TBCBorder);
begin
  if FBorder = AValue then
    Exit;
  FBorder.Assign(AValue);

  Change;
end;

constructor TBCButtonState.Create(AControl: TControl);
begin
  FBackground := TBCBackground.Create(AControl);
  FBorder := TBCBorder.Create(AControl);
  FFontEx := TBCFont.Create(AControl);

  FBackground.OnChange := OnChangeChildProperty;
  FBorder.OnChange := OnChangeChildProperty;
  FFontEx.OnChange := OnChangeFont;

  inherited Create(AControl);
end;

destructor TBCButtonState.Destroy;
begin
  FBackground.Free;
  FBorder.Free;
  FFontEx.Free;
  inherited Destroy;
end;

procedure TBCButtonState.Assign(Source: TPersistent);
begin
  if Source is TBCButtonState then
  begin
    FBackground.Assign(TBCButtonState(Source).FBackground);
    FBorder.Assign(TBCButtonState(Source).FBorder);
    FFontEx.Assign(TBCButtonState(Source).FFontEx);

    Change(PtrInt(pdUpdateSize));
  end
  else
    inherited Assign(Source);
end;

procedure TBCButtonState.Scale(AScale: single; APreserveDefaultFontHeight: boolean);
begin
  FBackground.Scale(AScale);
  FBorder.Scale(AScale);
  FFontEx.Scale(AScale, APreserveDefaultFontHeight);
end;

{ TCustomBCButton }

procedure TCustomBCButton.AssignDefaultStyle;
begin
  FRounding.RoundX := 12;
  FRounding.RoundY := 12;
  // Normal
  with StateNormal do
  begin
    Border.Style := bboNone;
    FontEx.Color := RGBToColor(230, 230, 255);
    FontEx.Style := [fsBold];
    FontEx.Shadow := True;
    FontEx.ShadowOffsetX := 1;
    FontEx.ShadowOffsetY := 1;
    FontEx.ShadowRadius := 2;
    Background.Gradient1EndPercent := 60;
    Background.Style := bbsGradient;
    // Gradient1
    with Background.Gradient1 do
    begin
      EndColor := RGBToColor(64, 64, 128);
      StartColor := RGBToColor(0, 0, 64);
    end;
    // Gradient2
    with Background.Gradient2 do
    begin
      EndColor := RGBToColor(0, 0, 64);
      GradientType := gtRadial;
      Point1XPercent := 50;
      Point1YPercent := 100;
      Point2YPercent := 0;
      StartColor := RGBToColor(64, 64, 128);
    end;
  end;
  // Hover
  with StateHover do
  begin
    Border.Style := bboNone;
    FontEx.Color := RGBToColor(255, 255, 255);
    FontEx.Style := [fsBold];
    FontEx.Shadow := True;
    FontEx.ShadowOffsetX := 1;
    FontEx.ShadowOffsetY := 1;
    FontEx.ShadowRadius := 2;
    Background.Gradient1EndPercent := 100;
    Background.Style := bbsGradient;
    // Gradient1
    with Background.Gradient1 do
    begin
      EndColor := RGBToColor(0, 64, 128);
      GradientType := gtRadial;
      Point1XPercent := 50;
      Point1YPercent := 100;
      Point2YPercent := 0;
      StartColor := RGBToColor(0, 128, 255);
    end;
  end;
  // Clicked
  with StateClicked do
  begin
    Border.Style := bboNone;
    FontEx.Color := RGBToColor(230, 230, 255);
    FontEx.Style := [fsBold];
    FontEx.Shadow := True;
    FontEx.ShadowOffsetX := 1;
    FontEx.ShadowOffsetY := 1;
    FontEx.ShadowRadius := 2;
    Background.Gradient1EndPercent := 100;
    Background.Style := bbsGradient;
    // Gradient1
    with Background.Gradient1 do
    begin
      EndColor := RGBToColor(0, 0, 64);
      GradientType := gtRadial;
      Point1XPercent := 50;
      Point1YPercent := 100;
      Point2YPercent := 0;
      StartColor := RGBToColor(0, 64, 128);
    end;
  end;
end;

procedure TCustomBCButton.CalculateGlyphSize(out NeededWidth, NeededHeight: integer);
begin
  if Assigned(FGlyph) and not FGlyph.Empty then
  begin
    NeededWidth := ceil(FGlyph.Width * FGlyphScale * FRenderScale);
    NeededHeight := ceil(FGlyph.Height * FGlyphScale * FRenderScale);
  end
  else
  if Assigned(FImages) then
  begin
    NeededWidth := FImages.ResolutionForPPI[FImages.Width, Screen.PixelsPerInch, 1].Width;
    NeededHeight := FImages.ResolutionForPPI[FImages.Width, Screen.PixelsPerInch, 1].Height;
  end
  else
  begin
    NeededHeight := 0;
    NeededWidth := 0;
  end;
end;

procedure TCustomBCButton.RenderAll(ANow: boolean);
begin
  if (csCreating in ControlState) or IsUpdating then
    Exit;

  if ANow then
  begin
    Render(FBGRANormal, FStateNormal);
    Render(FBGRAHover, FStateHover);
    Render(FBGRAClick, FStateClicked);
  end
  else
  begin
    if Assigned(FBGRANormal) then FBGRANormal.NeedRender := True;
    if Assigned(FBGRAHover) then FBGRAHover.NeedRender := True;
    if Assigned(FBGRAClick) then FBGRAClick.NeedRender := True;
  end;
end;

function TCustomBCButton.GetButtonRect: TRect;
begin
  Result := GetClientRect;
  if FStyle = bbtDropDown then
    case FDropDownPosition of
      bdpBottom:
        Dec(Result.Bottom, GetDropDownWidth(False));
      else
        // bdpLeft:
        Dec(Result.Right, GetDropDownWidth(False));
    end;
end;

function TCustomBCButton.GetDropDownWidth(AFull: boolean): integer;
begin
  Result := round(
    (FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width))
    * FRenderScale / FCanvasScale);
end;

function TCustomBCButton.GetGlyph: TBitmap;
begin
  Result := FGlyph as TBitmap;
end;

function TCustomBCButton.GetDropDownRect(AFull: boolean): TRect;
begin
  Result := GetClientRect;
  case FDropDownPosition of
    bdpBottom:
      Result.Top := Result.Bottom - GetDropDownWidth(AFull);
    else
      // bdpLeft:
      Result.Left := Result.Right - GetDropDownWidth(AFull);
  end;
end;

procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);

  procedure GetActualGlyph(out ABitmap: TBitmap; out AScale: single);
  begin
    if Assigned(FGlyph) and not FGlyph.Empty then
    begin
      ABitmap := FGlyph;
      AScale := FRenderScale * FGlyphScale;
    end else
    if Assigned(FImages) and (FImageIndex > -1) and (FImageIndex < FImages.Count) then
    begin
      ABitmap := TBitmap.Create;
      {$IFDEF FPC}
      FImages.ResolutionForPPI[FImages.Width, Screen.PixelsPerInch, FCanvasScale].GetBitmap(FImageIndex, ABitmap);
      AScale := 1;
      {$ELSE}
      FImages.GetBitmapRaw(FImageIndex, result);
      AScale := Screen.PixelsPerInch / 96 * FCanvasScale;
      {$ENDIF}
    end else
    begin
      ABitmap := nil;
      AScale := 1;
    end;
  end;

  procedure RenderGlyph(ARect: TRect; AGlyph: TBitmap);
  begin
    if ARect.IsEmpty or (AGlyph = nil) then exit;
    ABGRA.StretchPutImage(ARect, AGlyph, dmLinearBlend);
  end;

var
  r, r_a, r_g: TRect;
  g: TBitmap;
  actualCaption: TCaption;
  freeScaled: boolean;
  scaledState: TBCButtonState;
  scaledArrowSize, scaledGlyphMargin, scaledInnerMargin: integer;
  scaledRounding, scaledRoundingDropDown: TBCRounding;
  gScale: single;

begin
  if (csCreating in ControlState) or IsUpdating or (ABGRA = nil) then
    Exit;


  if FRenderScale <> 1 then
  begin
    scaledState := TBCButtonState.Create(nil);
    scaledState.Assign(AState);
    scaledState.Scale(FRenderScale, false);
    scaledRounding := TBCRounding.Create(nil);
    scaledRounding.Assign(Rounding);
    scaledRounding.Scale(FRenderScale);
    scaledRoundingDropDown := TBCRounding.Create(nil);
    scaledRoundingDropDown.Assign(RoundingDropDown);
    scaledRoundingDropDown.Scale(FRenderScale);
    freeScaled := true;
  end
  else
  begin
    scaledState := AState;
    scaledRounding := Rounding;
    scaledRoundingDropDown := RoundingDropDown;
    freeScaled := false;
  end;
  scaledArrowSize := round(DropDownArrowSize * FRenderScale);
  scaledGlyphMargin := round(GlyphMargin * FRenderScale);
  scaledInnerMargin := round(InnerMargin * FRenderScale);

  ABGRA.NeedRender := False;

  { Refreshing size }
  ABGRA.SetSize(round(Width * FCanvasScale), round(Height * FCanvasScale));

  { Clearing previous paint }
  ABGRA.Fill(BGRAPixelTransparent);

  { Basic body }
  r := ScaleRect(GetButtonRect, FCanvasScale);
  RenderState(ABGRA, scaledState, r, scaledRounding);

  if not GlyphOldPlacement then
    r.Inflate(-scaledInnerMargin,-scaledInnerMargin);

  { Calculating rect }
  CalculateBorderRect(scaledState.Border, r);

  if FStyle = bbtDropDown then
  begin
    r_a := ScaleRect(GetDropDownRect, FCanvasScale);
    RenderState(ABGRA, scaledState, r_a, scaledRoundingDropDown);
    CalculateBorderRect(scaledState.Border, r_a);

    // Click offset for arrow
    if FClickOffset and (AState = FStateClicked) then
      r_a.Offset(1,1);

    if FFlipArrow then
      RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badUp,
        scaledState.FontEx.Color)
    else
      RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badDown,
        scaledState.FontEx.Color);
  end;

  // Click offset for text and glyph
  if FClickOffset and (AState = FStateClicked) then
    r.Offset(round(1 * FRenderScale), round(1 * FRenderScale));

  // DropDown arrow
  if FDropDownArrow and (FStyle <> bbtDropDown) then
  begin
    r_a := r;
    r_a.Left := r_a.Right - round(FDropDownWidth * FRenderScale);
    if FFlipArrow then
      RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badUp,
        scaledState.FontEx.Color)
    else
      RenderArrow(TBGRABitmap(ABGRA), r_a, scaledArrowSize, badDown,
        scaledState.FontEx.Color);
    Dec(R.Right, round(FDropDownWidth * FRenderScale));
  end;

  GetActualGlyph(g, gScale);
  if FShowCaption then actualCaption := self.Caption else actualCaption := '';
  r_g := ComputeGlyphPosition(r, g, GlyphAlignment, scaledGlyphMargin, actualCaption,
    scaledState.FontEx, GlyphOldPlacement, gScale);

  if FTextApplyGlobalOpacity then
  begin
    { Drawing text }
    RenderText(r, scaledState.FontEx, actualCaption, ABGRA, Enabled);
    RenderGlyph(r_g, g);
    { Set global opacity }
    ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
  end
  else
  begin
    { Set global opacity }
    ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
    { Drawing text }
    RenderText(r, scaledState.FontEx, actualCaption, ABGRA, Enabled);
    RenderGlyph(r_g, g);
  end;
  if g <> FGlyph then g.Free;

  { Convert to gray if not enabled }
  if not Enabled then ABGRA.InplaceGrayscale;

  if Assigned(FOnAfterRenderBCButton) then
    FOnAfterRenderBCButton(Self, ABGRA, scaledState, r);

  if freeScaled then
  begin
    FreeAndNil(scaledState);
    FreeAndNil(scaledRounding);
    FreeAndNil(scaledRoundingDropDown);
  end;

  {$IFDEF INDEBUG}
  FRenderCount := FRenderCount +1;
  {$ENDIF}
end;

procedure TCustomBCButton.RenderState(ABGRA: TBGRABitmapEx;
  AState: TBCButtonState; const ARect: TRect; ARounding: TBCRounding);
begin
  RenderBackgroundAndBorder(ARect, AState.FBackground, TBGRABitmap(ABGRA),
    ARounding, AState.FBorder, round(FInnerMargin * FRenderScale));
end;

procedure TCustomBCButton.OnChangeGlyph(Sender: TObject);
begin
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.OnChangeState(Sender: TObject; AData: PtrInt);
begin
  RenderControl;
  if (TBCButtonPropertyData(AData) = pdUpdateSize) or
    (FStateNormal.Border.Width <> FLastBorderWidth) then
    UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.ImageListChange(ASender: TObject);
begin
  if ASender = Images then
  begin
    RenderControl;
    Invalidate;
  end;
end;

procedure TCustomBCButton.LimitMemoryUsage;
begin
  {$IFNDEF FPC}//# //@  IN DELPHI NEEDRENDER NEED TO BE TRUE. IF FALSE COMPONENT IN BGRANORMAL BE BLACK AFTER INVALIDATE.
  if Assigned(FBGRANormal) then FBGRANormal.NeedRender := True;
  if Assigned(FBGRAHover) then FBGRAHover.NeedRender := True;
  if Assigned(FBGRAClick) then FBGRAClick.NeedRender := True;
  {$ENDIF}
  if (FMemoryUsage = bmuLow) and Assigned(FBGRANormal) then FBGRANormal.Discard;
  if (FMemoryUsage <> bmuHigh) then
  begin
    if Assigned(FBGRAHover) then FBGRAHover.Discard;
    if Assigned(FBGRAClick) then FBGRAClick.Discard;
  end;
end;

procedure TCustomBCButton.SetBCButtonStateClicked(const AValue: TBCButtonState);
begin
  if FStateClicked = AValue then
    exit;
  FStateClicked.Assign(AValue);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetBCButtonStateHover(const AValue: TBCButtonState);
begin
  if FStateHover = AValue then
    exit;
  FStateHover.Assign(AValue);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetBCButtonStateNormal(const AValue: TBCButtonState);
begin
  if FStateNormal = AValue then
    exit;
  FStateNormal.Assign(AValue);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
begin
  if FCanvasScaleMode=AValue then Exit;
  FCanvasScaleMode:=AValue;
  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetClickOffset(AValue: boolean);
begin
  if FClickOffset = AValue then
    Exit;
  FClickOffset := AValue;
  RenderControl;
end;

procedure TCustomBCButton.SetDown(AValue: boolean);
begin
  if FDown = AValue then
    exit;
  FDown := AValue;
  if FDown then
    FButtonState := msClicked
  else
    FButtonState := msNone;
  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetDropDownArrow(AValue: boolean);
begin
  if FDropDownArrow = AValue then
    Exit;
  FDropDownArrow := AValue;
  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetDropDownArrowSize(AValue: integer);
begin
  if FDropDownArrowSize = AValue then
    Exit;
  FDropDownArrowSize := AValue;

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetDropDownPosition(AValue: TBCButtonDropDownPosition);
begin
  if FDropDownPosition = AValue then
    Exit;
  FDropDownPosition := AValue;

  if FStyle <> bbtDropDown then
    Exit;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetDropDownWidth(AValue: integer);
begin
  if FDropDownWidth = AValue then
    Exit;
  FDropDownWidth := AValue;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetFlipArrow(AValue: boolean);
begin
  if FFlipArrow = AValue then
    Exit;
  FFlipArrow := AValue;

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetGlyph(const AValue: TBitmap);
begin
  if (FGlyph <> nil) and (FGlyph = AValue) then
    exit;

  FGlyph.Assign(AValue);

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetGlyphAlignment(AValue: TBCAlignment);
begin
  if FGlyphAlignment=AValue then Exit;
  FGlyphAlignment:=AValue;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetGlyphMargin(const AValue: integer);
begin
  if FGlyphMargin = AValue then
    exit;
  FGlyphMargin := AValue;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetGlyphOldPlacement(AValue: boolean);
begin
  if FGlyphOldPlacement=AValue then Exit;
  FGlyphOldPlacement:=AValue;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetGlyphScale(AValue: single);
begin
  if FGlyphScale=AValue then Exit;
  FGlyphScale:=AValue;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetImageIndex(AValue: integer);
begin
  if FImageIndex = AValue then
    Exit;
  FImageIndex := AValue;
  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetImages(AValue: TCustomImageList);
begin
  if FImages = AValue then
    Exit;
  FImages := AValue;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetInnerMargin(AValue: single);
begin
  if FInnerMargin=AValue then Exit;
  FInnerMargin:=AValue;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetMemoryUsage(AValue: TBCButtonMemoryUsage);
begin
  if FMemoryUsage=AValue then Exit;
  FMemoryUsage:=AValue;
  LimitMemoryUsage;
end;

procedure TCustomBCButton.SetRounding(AValue: TBCRounding);
begin
  if FRounding = AValue then
    Exit;
  FRounding.Assign(AValue);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetRoundingDropDown(AValue: TBCRounding);
begin
  if FRoundingDropDown = AValue then
    Exit;
  FRoundingDropDown.Assign(AValue);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetShowCaption(AValue: boolean);
begin
  if FShowCaption = AValue then
    Exit;
  FShowCaption := AValue;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.SetStaticButton(const AValue: boolean);
begin
  if FStaticButton = AValue then
    exit;
  FStaticButton := AValue;

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetStyle(const AValue: TBCButtonStyle);
begin
  if FStyle = AValue then
    exit;
  FStyle := AValue;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.UpdateSize;
begin
  InvalidatePreferredSize;
  AdjustSize;
end;

procedure TCustomBCButton.CalculatePreferredSize(
  var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
var
//  AWidth: integer;
  gh, gw, gm: integer;
  actualCaption: TCaption;
  horizAlign, relHorizAlign: TAlignment;
  vertAlign, relVertAlign: TTextLayout;
  glyphHorzMargin, glyphVertMargin: integer;
  tw, th, availW: integer;
  scaledFont: TBCFont;
  ownScaledFont: Boolean;
begin
  if (Parent = nil) or (not Parent.HandleAllocated) then
    Exit;

  ComputeScaling;

  FLastBorderWidth := FStateNormal.Border.Width;
  CalculateGlyphSize(gw, gh);
  gm := round(GlyphMargin * FRenderScale);

  // more precise computation of font with Retina scaling
  // and DPI aware computation
  if (FRenderScale <> 1) and FShowCaption then
  begin
    scaledFont := TBCFont.Create(nil);
    scaledFont.Assign(FStateNormal.FontEx);
    scaledFont.Scale(FRenderScale, false);
    ownScaledFont := true;
  end else
  begin
    scaledFont := FStateNormal.FontEx;
    ownScaledFont := false;
  end;

  if GlyphOldPlacement then
  begin
    {  if WidthIsAnchored then
        AWidth := Width
      else
        AWidth := 10000;}

    PreferredWidth := 0;
    PreferredHeight := 0;
    if FShowCaption then
    begin
      CalculateTextSize(Caption, scaledFont, PreferredWidth, PreferredHeight);
    end;

    // Extra pixels for DropDown
    if Style = bbtDropDown then
      if FDropDownPosition in [bdpBottom] then
        Inc(PreferredHeight, round(GetDropDownWidth * FCanvasScale))
      else
        Inc(PreferredWidth, round(GetDropDownWidth * FCanvasScale));

    if (Style = bbtButton) and FDropDownArrow then
      Inc(PreferredWidth, round(FDropDownArrowSize * FRenderScale));


    //if (FGlyph <> nil) and (not FGlyph.Empty) then
    if (gw > 0) and (gh > 0) then
    begin
      //if Caption = '' then
      if PreferredWidth = 0 then
      begin
        Inc(PreferredWidth, gw{ - AutoSizeExtraY * 2});
        Inc(PreferredHeight, gh);
      end
      else
      begin
        Inc(PreferredWidth, gw + gm);
        if gh > PreferredHeight then
          PreferredHeight := gh;
      end;
    end;

    // Extra pixels for AutoSize
    Inc(PreferredWidth, round(AutoSizeExtraX * FRenderScale));
    Inc(PreferredHeight, round(AutoSizeExtraY * FRenderScale));
  end else
  begin
    if ShowCaption then actualCaption := Caption else actualCaption := '';
    PreferredWidth := round(InnerMargin * FRenderScale);
    PreferredHeight := round(InnerMargin * FRenderScale);
    case FStyle of
    bbtDropDown:
      case FDropDownPosition of
        bdpBottom: inc(PreferredHeight, round(GetDropDownWidth(False) * FCanvasScale));
        else{bdpLeft} inc(PreferredWidth, round(GetDropDownWidth(False) * FCanvasScale));
      end;
    else{bbtButton} if FDropDownArrow then
      inc(PreferredWidth, round(FDropDownWidth * FRenderScale));
    end;
    inc(PreferredWidth, round(FStateNormal.Border.Width * FRenderScale));
    inc(PreferredHeight, round(FStateNormal.Border.Width * FRenderScale));

    if actualCaption='' then
    begin
      inc(PreferredWidth,gw);
      inc(PreferredHeight,gh);
      if gw>0 then inc(PreferredWidth, gm*2);
      if gh>0 then inc(PreferredHeight, gm*2);
    end else
    begin
      GetGlyphActualLayout(actualCaption, scaledFont, GlyphAlignment, gm,
        horizAlign, vertAlign, relHorizAlign, relVertAlign, glyphHorzMargin, glyphVertMargin);
      availW := 65535;
      if (Align in [alTop,alBottom]) and (Parent <> nil) then
        availW := round((Parent.ClientWidth - BorderSpacing.Left - BorderSpacing.Right) * FCanvasScale - PreferredWidth);
      CalculateTextSizeEx(actualCaption, scaledFont, tw, th, availW);

      if (tw<>0) and scaledFont.WordBreak then inc(tw);
      if vertAlign<>relVertAlign then
      begin
        inc(PreferredWidth,  max(gw+2*gm,tw));
        inc(PreferredHeight, gm+gh+th);
      end
      else
      begin
        inc(PreferredWidth,  gm+gw+tw);
        inc(PreferredHeight, max(gh+2*gm,th));
      end;
    end;
  end;
  if ownScaledFont then scaledFont.Free;
  PreferredWidth:= ceil(PreferredWidth / FCanvasScale);
  PreferredHeight := ceil(PreferredHeight / FCanvasScale);
end;

class function TCustomBCButton.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 123;
  Result.CY := 33;
end;

procedure TCustomBCButton.Click;
begin
  if (FActiveButt = bbtDropDown) and Assigned(FOnButtonClick) then
  begin
    FOnButtonClick(Self);
    Exit;
  end;
  inherited Click;
end;

procedure TCustomBCButton.DropDownClosed(Sender: TObject);
begin
  if Assigned(FSaveDropDownClosed) then
    FSaveDropDownClosed(Sender);
  {$IFDEF FPC}//#
  if Assigned(FDropDownMenu) then
    FDropDownMenu.OnClose := FSaveDropDownClosed;
  {$ENDIF}

  FDropDownMenuVisible := False;
  FDropDownClosingTime := Now;
end;

function TCustomBCButton.GetBGRAClick: TBGRABitmapEx;
begin
  if FBGRAClick = nil then
  begin
    FBGRAClick := TBGRABitmapEx.Create(round(Width * FCanvasScale),
      round(Height * FCanvasScale), BGRAPixelTransparent);
    FBGRAClick.CustomData := PtrInt(FStateClicked);
  end;
  result := FBGRAClick;
end;

function TCustomBCButton.GetBGRAHover: TBGRABitmapEx;
begin
  if FBGRAHover = nil then
  begin
    FBGRAHover := TBGRABitmapEx.Create(round(Width * FCanvasScale),
      round(Height * FCanvasScale), BGRAPixelTransparent);
    FBGRAHover.CustomData := PtrInt(FStateHover);
  end;
  result := FBGRAHover;
end;

function TCustomBCButton.GetBGRANormal: TBGRABitmapEx;
begin
  if FBGRANormal = nil then
  begin
    FBGRANormal := TBGRABitmapEx.Create(round(Width * FCanvasScale),
      round(Height * FCanvasScale), BGRAPixelTransparent);
    FBGRANormal.CustomData := PtrInt(FStateNormal);
  end;
  result := FBGRANormal;
end;

procedure TCustomBCButton.OnRestoreProperty(Sender: TObject; AObject: TObject;
  Info: PPropInfo; AValue: TJSONData; var Handled: Boolean);
var
  bgracolor: TBGRAPixel;
begin
  Handled := False;
  if (Info^.PropType^.Name = 'TGraphicsColor') then
  begin
    Handled := True;
    bgracolor := StrToBGRA(AValue.AsString);
    SetPropValue(AObject, Info, BGRAToColor(bgracolor));
  end;

  // fix to don't assign null values
  if AValue.JSONType = jtNULL then
    Handled := True;
end;

procedure TCustomBCButton.OnStreamProperty(Sender: TObject; AObject: TObject;
  Info: PPropInfo; var Res: TJSONData);
var
  bgracolor: TBGRAPixel;
begin
  if (Info^.PropType^.Name = 'TGraphicsColor') then
  begin
    bgracolor := ColorToBGRA(TColor(GetPropValue(AObject, Info, False)));
    Res.Free;
    Res := TJSONString.Create('rgb('+IntToStr(bgracolor.red)+','+IntToStr(bgracolor.green)+','+IntToStr(bgracolor.blue)+')');
  end;
end;

procedure TCustomBCButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
var
 ClientToScreenPoint : TPoint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if csDesigning in ComponentState then
    exit;

  if (Button = mbLeft) and Enabled {and (not (FButtonState = msClicked)) } then
  begin
    case FActiveButt of
      bbtButton:
        if not (FButtonState = msClicked) then
        begin
          FButtonState := msClicked;
          if FDropDownStyle = bdsCommon then
            FDownButtonState := msClicked
          else
            FDownButtonState := msNone;
          Invalidate;
        end;
      bbtDropDown:
        if not (FDownButtonState = msClicked) then
        begin
          if FDropDownStyle = bdsCommon then
            FButtonState := msClicked
          else
            FButtonState := msNone;
          FDownButtonState := msClicked;
          Invalidate;
        end;
    end;
    // Old
    {FButtonState := msClicked;
    Invalidate;}

    // MORA: Show DropDown menu
    if FDropDownMenuVisible or (Now < FDropDownClosingTime+DropDownReopenDelay) then
      FDropDownMenuVisible := False // Prevent redropping
    else
    if ((FActiveButt = bbtDropDown) or (FStyle = bbtButton)) and
      (FDropDownMenu <> nil) and Enabled then
    begin
      ClientToScreenPoint := ClientToScreen(Point(0, Height));
      with ClientToScreenPoint do
      begin
        // normal button
        if FStyle = bbtButton then
        begin
          x := x + Width * integer(FDropDownMenu.Alignment = paRight);
          if FFlipArrow then
            y := y -Height;
        end
        else
          // dropdown button
        begin
          if FDropDownPosition = bdpBottom then
          begin
            x := x + Width * integer(FDropDownMenu.Alignment = paRight);
            if FFlipArrow then
              y := y -(FDropDownWidth + (FStateNormal.FBorder.Width * 2));
          end
          else
          begin
            if FFlipArrow then
              y := y -Height;
            if FDropDownStyle = bdsSeparate then
              x := x + Width - (FDropDownWidth + (FStateNormal.FBorder.Width * 2)) *
                integer(FDropDownMenu.Alignment <> paRight)
            else
              x := x + Width * integer(FDropDownMenu.Alignment = paRight);
          end;
        end;

        FDropDownMenuVisible := True;
        {$IFDEF FPC}//#
        FSaveDropDownClosed := FDropDownMenu.OnClose;
        FDropDownMenu.OnClose := DropDownClosed;
        {$ENDIF}
        FDropDownMenu.PopUp(x, y);
      end;
    end;
  end;
end;

procedure TCustomBCButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
{var
  p: TPoint;}
begin
  inherited MouseUp(Button, Shift, X, Y);
  if csDesigning in ComponentState then
    exit;

  if (Button = mbLeft) and Enabled {and (FButtonState = msClicked)} then
  begin
    case FActiveButt of
      bbtButton:
        if FButtonState = msClicked then
        begin
          FButtonState := msHover;
          if FDropDownStyle = bdsCommon then
            FDownButtonState := msHover
          else
            FDownButtonState := msNone;
          Invalidate;
        end;
      bbtDropDown:
        if FDownButtonState = msClicked then
        begin
          FDownButtonState := msHover;
          if FDropDownStyle = bdsCommon then
            FButtonState := msHover
          else
            FButtonState := msNone;
          Invalidate;
        end;
    end;
    // Old
    {FButtonState := msHover;
    Invalidate;}
  end;

  //if (FActiveButt = bbtDropDown) and (PopupMenu <> nil) and Enabled then
  //begin
  //  if FFlipArrow then
  //    p := ClientToScreen(Point(Width - FDropDownWidth - (FStateNormal.FBorder.Width * 2),
  //      {PopupMenu.Height} -1))
  //  else
  //    p := ClientToScreen(Point(Width - FDropDownWidth - (FStateNormal.FBorder.Width * 2), Height + 1));

  //  PopupMenu.PopUp(p.x, p.y);
  //end;
end;

procedure TCustomBCButton.MouseEnter;
begin
  if csDesigning in ComponentState then
    exit;
  case FActiveButt of
    bbtButton:
    begin
      if FDown then
        FButtonState := msClicked
      else
        FButtonState := msHover;

      if FDropDownStyle = bdsSeparate then
        FDownButtonState := msNone
      else
        FDownButtonState := msHover;
    end;
    bbtDropDown:
    begin
      if FDown then
        FButtonState := msClicked
      else
      if FDropDownStyle = bdsSeparate then
        FButtonState := msNone
      else
        FButtonState := msHover;
      FDownButtonState := msHover;
    end;
  end;
  Invalidate;
  // Old
  {FButtonState := msHover;
  Invalidate;}
  inherited MouseEnter;
end;

procedure TCustomBCButton.MouseLeave;
begin
  if csDesigning in ComponentState then
    exit;
  if FDown then
  begin
    FButtonState := msClicked;
    FActiveButt := bbtButton;
  end
  else
    FButtonState := msNone;
  FDownButtonState := msNone;
  Invalidate;
  inherited MouseLeave;
end;

procedure TCustomBCButton.MouseMove(Shift: TShiftState; X, Y: integer);

  function IsOverDropDown: boolean;
  begin
    with GetButtonRect do
      case FDropDownPosition of
        bdpBottom:
          Result := Y > Bottom;
        else
          Result := X > GetButtonRect.Right;
      end;
  end;

begin
  inherited MouseMove(Shift, X, Y);

  if FStyle = bbtButton then
    FActiveButt := bbtButton
  else
  begin
    // Calling invalidate only when active button changed. Otherwise, we leave
    // this for LCL. This reduce paint call
    if (FActiveButt = bbtButton) and IsOverDropDown then
    begin
      FActiveButt := bbtDropDown;
      if FDropDownStyle <> bdsCommon then // Don't need invalidating
      begin
        FDownButtonState := msHover;
        if FDown then
          FButtonState := msClicked
        else
          FButtonState := msNone;
        Invalidate;
      end;
    end
    else
    if (FActiveButt = bbtDropDown) and not IsOverDropDown then
    begin
      FActiveButt := bbtButton;
      if FDropDownStyle <> bdsCommon then // Don't need invalidating
      begin
        if FDown then
          FButtonState := msClicked
        else
          FButtonState := msHover;
        FDownButtonState := msNone;
        Invalidate;
      end;
    end;
  end;
end;

procedure TCustomBCButton.SetEnabled(Value: boolean);
begin
  inherited SetEnabled(Value);

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.TextChanged;
begin
  inherited TextChanged;
  RenderControl;
  UpdateSize;
  Invalidate;
end;

procedure TCustomBCButton.ActionChange(Sender: TObject; CheckDefaults: boolean);
var
  NewAction: TCustomAction;
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
  begin
    NewAction := TCustomAction(Sender);
    if (not CheckDefaults) or (not Down) then
      Down := NewAction.Checked;
    if (not CheckDefaults) or (ImageIndex < 0) then
      ImageIndex := NewAction.ImageIndex;
  end;
end;

function TCustomBCButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TBCButtonActionLink;
end;

procedure TCustomBCButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FImages) and (Operation = opRemove) then
    Images := nil;
end;

procedure TCustomBCButton.UpdateControl;
begin
  RenderControl;
  inherited UpdateControl; // indalidate
end;

procedure TCustomBCButton.ScaleStyle(AScale: single; APreserveDefaultFontHeight: boolean);
begin
  StateNormal.Scale(AScale, APreserveDefaultFontHeight);
  StateHover.Scale(AScale, APreserveDefaultFontHeight);
  StateClicked.Scale(AScale, APreserveDefaultFontHeight);
  Rounding.Scale(AScale);
  RoundingDropDown.Scale(AScale);
  DropDownWidth:= round(DropDownWidth*AScale);
  DropDownArrowSize:= round(DropDownArrowSize*AScale);
  GlyphMargin:= round(GlyphMargin*AScale);
  GlyphScale := GlyphScale*AScale;
  InnerMargin:= round(InnerMargin*AScale);
end;

{$IFDEF FPC}//#
procedure TCustomBCButton.SaveToFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    WriteComponentAsTextToStream(AStream, Self);
    AStream.SaveToFile(AFileName);
  finally
    AStream.Free;
  end;
end;

procedure TCustomBCButton.SaveToJSONFile(AFileName: string);
begin
  with TStringList.Create do
  begin
    try
      Text := SaveToJSON;
      SaveToFile(AFileName);
    finally
      Free;
    end;
  end;
end;

function TCustomBCButton.SaveToJSON: string;
var
  Streamer: TJSONStreamer;
begin
  Streamer := TJSONStreamer.Create(nil);
  try
    Streamer.OnStreamProperty := OnStreamProperty;
    Result := Streamer.ObjectToJSONString(Self);
  finally
    Streamer.Destroy;
  end;
end;

procedure TCustomBCButton.LoadFromFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    AStream.LoadFromFile(AFileName);
    ReadComponentFromTextStream(AStream, TComponent(Self), OnFindClass);
  finally
    AStream.Free;
  end;
end;

procedure TCustomBCButton.LoadFromJSONFile(AFileName: string);
var
  sFile: TStringList;
begin
  try
    sFile := TStringList.Create;
    sFile.LoadFromFile(AFileName);
    LoadFromJSON(sFile.Text);
  finally
    sFile.Free;
  end;
end;

procedure TCustomBCButton.LoadFromJSON(AJSON: string);
var
  DeStreamer: TJSONDeStreamer;
  temp: TBCButton;
begin
  temp := TBCButton.Create(nil);
  DeStreamer := TJSONDeStreamer.Create(nil);
  try
    DeStreamer.OnRestoreProperty := OnRestoreProperty;
    DeStreamer.JSONToObject(AJSON, temp);
    // Cascading
    Self.BeginUpdate;
    Self.Assign(temp);
    Self.StateNormal.Assign(temp.StateNormal);
    Self.StateHover.Assign(temp.StateNormal);
    Self.StateClicked.Assign(temp.StateNormal);
    // All other properties
    DeStreamer.JSONToObject(AJSON, Self);
    Self.EndUpdate;
  finally
    temp.Free;
    DeStreamer.Destroy;
  end;
end;

procedure TCustomBCButton.AssignFromFile(AFileName: string);
var
  AStream: TMemoryStream;
  AButton: TBCButton;
begin
  AButton := TBCButton.Create(nil);
  AStream := TMemoryStream.Create;
  try
    AStream.LoadFromFile(AFileName);
    ReadComponentFromTextStream(AStream, TComponent(AButton), OnFindClass);
    Assign(AButton);
  finally
    AStream.Free;
    AButton.Free;
  end;
end;

procedure TCustomBCButton.AssignFromResource(AResourceName: string);
var
  AStream : TStream;
  AButton : TBCButton;
begin
  AButton := TBCButton.Create(nil);
  try
    AStream := BGRAResource.GetResourceStream(AResourceName);
    ReadComponentFromTextStream(AStream, TComponent(AButton), OnFindClass);
    Assign(AButton);
  finally
    AStream.Free;
    AButton.Free;
  end;
end;

{$ENDIF}

procedure TCustomBCButton.OnFindClass(Reader: TReader; const AClassName: string;
  var ComponentClass: TComponentClass);
begin
  if CompareText(AClassName, 'TBCButton') = 0 then
    ComponentClass := TBCButton;
end;

{$IFDEF INDEBUG}
function TCustomBCButton.GetDebugText: string;
begin
  Result := 'R: ' + IntToStr(FRenderCount);
end;

{$ENDIF}

procedure TCustomBCButton.ComputeScaling;
begin
  // Scaling relative to screen coordinates
  if (CanvasScaleMode = csmFullResolution) or
    ((CanvasScaleMode = csmAuto) and not Assigned(OnAfterRenderBCButton)) then
    FCanvasScale := GetCanvasScaleFactor
    else FCanvasScale := 1;

  // Scaling relative to DPI and or screen coordinates
  if Scaled then
    FRenderScale := (Screen.PixelsPerInch / GetDesignTimePPI(self)) * FCanvasScale
  else
    FRenderScale := FCanvasScale;
end;

procedure TCustomBCButton.DrawControl;
var
  bgra: TBGRABitmapEx;
  r: TRect;
begin
  ComputeScaling;

  // If style is without dropdown button or state of each button
  // is the same (possible only for msNone) or static button then
  // we can draw whole BGRABitmap
  if (FStyle = bbtButton) or (FButtonState = FDownButtonState) or FStaticButton then
  begin
    // Main button
    if FStaticButton then
      bgra := BGRANormal
    else
    if FDown then
      bgra := BGRAClick
    else
      case FButtonState of
        msNone: bgra := BGRANormal;
        msHover: bgra := BGRAHover;
        msClicked: bgra := BGRAClick;
      end;
    if {%H-}bgra.NeedRender then
      Render(bgra, TBCButtonState(bgra.CustomData));
    bgra.Draw(Self.Canvas, rect(0, 0, Width, Height), False);
  end
  // Otherwise we must draw part of state for each button
  else
  begin
    // The active button must be draw as last because right edge of button and
    // left edge of dropdown are overlapping each other, so we must draw edge
    // for current state of active button
    case FActiveButt of
      bbtButton:
      begin
        // Drop down button
        case FDownButtonState of
          msNone: bgra := BGRANormal;
          msHover: bgra := BGRAHover;
          msClicked: bgra := BGRAClick;
        end;
        if bgra.NeedRender then
          Render(bgra, TBCButtonState(bgra.CustomData));
        r := GetDropDownRect;
        bgra.DrawPart(ScaleRect(r, FCanvasScale), Self.Canvas, r, False);
        // Main button
        if FDown then
          bgra := BGRAClick
        else
          case FButtonState of
            msNone: bgra := BGRANormal;
            msHover: bgra := BGRAHover;
            msClicked: bgra := BGRAClick;
          end;
        if bgra.NeedRender then
          Render(bgra, TBCButtonState(bgra.CustomData));
        r := GetButtonRect;
        bgra.DrawPart(ScaleRect(r, FCanvasScale), Self.Canvas, r, False);
      end;
      bbtDropDown:
      begin
        // Main button
        if FDown then
          bgra := BGRAClick
        else
          case FButtonState of
            msNone: bgra := BGRANormal;
            msHover: bgra := BGRAHover;
            msClicked: bgra := BGRAClick;
          end;
        if bgra.NeedRender then
          Render(bgra, TBCButtonState(bgra.CustomData));
        r := GetButtonRect;
        bgra.DrawPart(ScaleRect(r, FCanvasScale), Self.Canvas, r, False);
        // Drop down button
        case FDownButtonState of
          msNone: bgra := BGRANormal;
          msHover: bgra := BGRAHover;
          msClicked: bgra := BGRAClick;
        end;
        if bgra.NeedRender then
          Render(bgra, TBCButtonState(bgra.CustomData));
        r := GetDropDownRect;
        bgra.DrawPart(ScaleRect(r, FCanvasScale), Self.Canvas, r, False);
      end;
    end;
  end;

  LimitMemoryUsage;
end;

procedure TCustomBCButton.RenderControl;
begin
  inherited RenderControl;
  RenderAll;
end;

procedure TCustomBCButton.SetGlobalOpacity(const AValue: byte);
begin
  if FGlobalOpacity = AValue then
    exit;
  FGlobalOpacity := AValue;

  RenderControl;
  Invalidate;
end;

procedure TCustomBCButton.SetTextApplyGlobalOpacity(const AValue: boolean);
begin
  if FTextApplyGlobalOpacity = AValue then
    exit;
  FTextApplyGlobalOpacity := AValue;

  RenderControl;
  Invalidate;
end;

constructor TCustomBCButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF INDEBUG}
  FRenderCount := 0;
  {$ENDIF}
  FMemoryUsage := bmuHigh;
  {$IFDEF FPC}
  DisableAutoSizing;
  Include(FControlState, csCreating);
  {$ELSE} //#

  {$ENDIF}
  //{$IFDEF WINDOWS}
  // default sizes under different dpi settings
  //SetSizeVariables(ScaleX(8,96), ScaleX(16,96), ScaleY(8,96), ScaleX(24,96));
  //{$ELSE}
  // default sizes
  SetSizeVariables(16, 8, 8, 24);
  //{$ENDIF}
  BeginUpdate;
  try
    with GetControlClassDefaultSize do
      SetInitialBounds(0, 0, CX, CY);
    ControlStyle := ControlStyle + [csAcceptsControls];

    ParentColor := False;
    Color := clNone;
    FCanvasScale:= 1; //will be updated after control is created

    FStateNormal := TBCButtonState.Create(Self);
    FStateHover := TBCButtonState.Create(Self);
    FStateClicked := TBCButtonState.Create(Self);
    FStateNormal.OnChange := OnChangeState;
    FStateHover.OnChange := OnChangeState;
    FStateClicked.OnChange := OnChangeState;

    FRounding := TBCRounding.Create(Self);
    FRounding.OnChange := OnChangeState;

    FRoundingDropDown := TBCRounding.Create(Self);
    FRoundingDropDown.OnChange := OnChangeState;

    FButtonState := msNone;
    FDownButtonState := msNone;
    FFlipArrow := False;
    FGlyph := TBitmap.Create;
    FGlyph.OnChange := OnChangeGlyph;
    FGlyphMargin := 5;
    FGlyphAlignment:= bcaCenter;
    FGlyphOldPlacement:= true;
    FGlyphScale:= 1;
    FStyle := bbtButton;
    FStaticButton := False;
    FActiveButt := bbtButton;
    FGlobalOpacity := 255;
    FTextApplyGlobalOpacity := False;
    //FStates := [];
    FDown := False;

    { Default style }
    AssignDefaultStyle;

    FImageChangeLink := TChangeLink.Create;
    FImageChangeLink.OnChange := ImageListChange;
    FImageIndex := -1;

    FShowCaption := True;
    FPreserveGlyphOnAssign := True;
  finally
    {$IFDEF FPC}
    Exclude(FControlState, csCreating);
    EnableAutoSizing;
    {$ELSE} //#
    {$ENDIF}
    EndUpdate;
  end;
end;

destructor TCustomBCButton.Destroy;
begin
  FImageChangeLink.Free;
  FStateNormal.Free;
  FStateHover.Free;
  FStateClicked.Free;
  FBGRANormal.Free;
  FBGRAHover.Free;
  FBGRAClick.Free;
  FreeAndNil(FGlyph);
  FRounding.Free;
  FRoundingDropDown.Free;
  inherited Destroy;
end;

procedure TCustomBCButton.Assign(Source: TPersistent);
begin
  if Source is TCustomBCButton then
  begin
    if not PreserveGlyphOnAssign then
      Glyph := TCustomBCButton(Source).Glyph;
    FGlyphMargin := TCustomBCButton(Source).FGlyphMargin;
    FStyle := TCustomBCButton(Source).FStyle;
    FFlipArrow := TCustomBCButton(Source).FFlipArrow;
    FStaticButton := TCustomBCButton(Source).FStaticButton;
    FGlobalOpacity := TCustomBCButton(Source).FGlobalOpacity;
    FTextApplyGlobalOpacity := TCustomBCButton(Source).FTextApplyGlobalOpacity;
    FStateNormal.Assign(TCustomBCButton(Source).FStateNormal);
    FStateHover.Assign(TCustomBCButton(Source).FStateHover);
    FStateClicked.Assign(TCustomBCButton(Source).FStateClicked);
    FDropDownArrowSize := TCustomBCButton(Source).FDropDownArrowSize;
    FDropDownWidth := TCustomBCButton(Source).FDropDownWidth;
    AutoSizeExtraX := TCustomBCButton(Source).AutoSizeExtraX;
    AutoSizeExtraY := TCustomBCButton(Source).AutoSizeExtraY;
    FDown := TCustomBCButton(Source).FDown;
    FRounding.Assign(TCustomBCButton(Source).FRounding);
    FRoundingDropDown.Assign(TCustomBCButton(Source).FRoundingDropDown);

    RenderControl;
    Invalidate;
    UpdateSize;
  end
  else
    inherited Assign(Source);
end;

procedure TCustomBCButton.SetSizeVariables(newDropDownWidth,
  newDropDownArrowSize, newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
begin
  FDropDownArrowSize := newDropDownArrowSize;
  FDropDownWidth := newDropDownWidth;
  AutoSizeExtraY := newAutoSizeExtraVertical;
  AutoSizeExtraX := newAutoSizeExtraHorizontal;

  if csCreating in ControlState then
    Exit;

  RenderControl;
  UpdateSize;
  Invalidate;
end;

function TCustomBCButton.GetStyleExtension: string;
begin
  Result := 'bcbtn';
end;

end.