2120 lines
59 KiB
ObjectPascal
2120 lines
59 KiB
ObjectPascal
// 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 | mailedivando@gmail.com
|
|
(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: Single;
|
|
FCanvasScaleMode: TBCCanvasScaleMode;
|
|
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 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 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;
|
|
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);
|
|
NeededHeight := ceil(FGlyph.Height * FGlyphScale);
|
|
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 := FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width);
|
|
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 := FCanvasScale * 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);
|
|
ABitmap := AScale;
|
|
{$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 FCanvasScale <> 1 then
|
|
begin
|
|
scaledState := TBCButtonState.Create(nil);
|
|
scaledState.Assign(AState);
|
|
scaledState.Scale(FCanvasScale, false);
|
|
scaledRounding := TBCRounding.Create(nil);
|
|
scaledRounding.Assign(Rounding);
|
|
scaledRounding.Scale(FCanvasScale);
|
|
scaledRoundingDropDown := TBCRounding.Create(nil);
|
|
scaledRoundingDropDown.Assign(RoundingDropDown);
|
|
scaledRoundingDropDown.Scale(FCanvasScale);
|
|
freeScaled := true;
|
|
end
|
|
else
|
|
begin
|
|
scaledState := AState;
|
|
scaledRounding := Rounding;
|
|
scaledRoundingDropDown := RoundingDropDown;
|
|
freeScaled := false;
|
|
end;
|
|
scaledArrowSize := round(DropDownArrowSize * FCanvasScale);
|
|
scaledGlyphMargin := round(GlyphMargin * FCanvasScale);
|
|
scaledInnerMargin := round(InnerMargin * FCanvasScale);
|
|
|
|
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 * FCanvasScale), round(1 * FCanvasScale));
|
|
|
|
// DropDown arrow
|
|
if FDropDownArrow and (FStyle <> bbtDropDown) then
|
|
begin
|
|
r_a := r;
|
|
r_a.Left := r_a.Right - round(FDropDownWidth * FCanvasScale);
|
|
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 * FCanvasScale));
|
|
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 * FCanvasScale));
|
|
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: integer;
|
|
actualCaption: TCaption;
|
|
horizAlign, relHorizAlign: TAlignment;
|
|
vertAlign, relVertAlign: TTextLayout;
|
|
glyphHorzMargin, glyphVertMargin: integer;
|
|
tw, th, availW: integer;
|
|
canvasScale: single;
|
|
scaledFont: TBCFont;
|
|
ownScaledFont: Boolean;
|
|
begin
|
|
if (Parent = nil) or (not Parent.HandleAllocated) then
|
|
Exit;
|
|
|
|
FLastBorderWidth := FStateNormal.Border.Width;
|
|
CalculateGlyphSize(gw, gh);
|
|
|
|
// more precise computation of font with Retina scaling
|
|
canvasScale := GetCanvasScaleFactor;
|
|
if (canvasScale <> 1) and FShowCaption then
|
|
begin
|
|
scaledFont := TBCFont.Create(nil);
|
|
scaledFont.Assign(FStateNormal.FontEx);
|
|
scaledFont.Scale(canvasScale, false);
|
|
ownScaledFont := true;
|
|
end else
|
|
begin
|
|
scaledFont := FStateNormal.FontEx;
|
|
ownScaledFont := false;
|
|
canvasScale := 1;
|
|
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);
|
|
PreferredWidth := ceil(PreferredWidth/canvasScale);
|
|
PreferredHeight := ceil(PreferredHeight/canvasScale);
|
|
end;
|
|
|
|
// Extra pixels for DropDown
|
|
if Style = bbtDropDown then
|
|
if FDropDownPosition in [bdpBottom] then
|
|
Inc(PreferredHeight, GetDropDownWidth)
|
|
else
|
|
Inc(PreferredWidth, GetDropDownWidth);
|
|
|
|
if (Style = bbtButton) and FDropDownArrow then
|
|
Inc(PreferredWidth, FDropDownArrowSize);// GetDropDownWidth);
|
|
|
|
|
|
//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 + FGlyphMargin);
|
|
if gh > PreferredHeight then
|
|
PreferredHeight := gh;
|
|
end;
|
|
end;
|
|
|
|
// Extra pixels for AutoSize
|
|
Inc(PreferredWidth, AutoSizeExtraX);
|
|
Inc(PreferredHeight, AutoSizeExtraY);
|
|
end else
|
|
begin
|
|
if ShowCaption then actualCaption := Caption else actualCaption := '';
|
|
PreferredWidth := round(InnerMargin);
|
|
PreferredHeight := round(InnerMargin);
|
|
case FStyle of
|
|
bbtDropDown:
|
|
case FDropDownPosition of
|
|
bdpBottom: inc(PreferredHeight, GetDropDownWidth(False));
|
|
else{bdpLeft} inc(PreferredWidth, GetDropDownWidth(False));
|
|
end;
|
|
else{bbtButton} if FDropDownArrow then
|
|
inc(PreferredWidth, FDropDownWidth);
|
|
end;
|
|
inc(PreferredWidth, FStateNormal.Border.Width);
|
|
inc(PreferredHeight, FStateNormal.Border.Width);
|
|
|
|
if actualCaption='' then
|
|
begin
|
|
inc(PreferredWidth,gw);
|
|
inc(PreferredHeight,gh);
|
|
if gw>0 then inc(PreferredWidth, GlyphMargin*2);
|
|
if gh>0 then inc(PreferredHeight, GlyphMargin*2);
|
|
end else
|
|
begin
|
|
GetGlyphActualLayout(actualCaption, FStateNormal.FontEx, GlyphAlignment, GlyphMargin,
|
|
horizAlign, vertAlign, relHorizAlign, relVertAlign, glyphHorzMargin, glyphVertMargin);
|
|
availW := 65535;
|
|
if (Align in [alTop,alBottom]) and (Parent <> nil) then
|
|
availW := Parent.ClientWidth - PreferredWidth;
|
|
CalculateTextSizeEx(actualCaption, scaledFont, tw, th, availW);
|
|
tw := ceil(tw/canvasScale);
|
|
th := ceil(th/canvasScale);
|
|
|
|
if (tw<>0) and FStateNormal.FontEx.WordBreak then inc(tw);
|
|
if vertAlign<>relVertAlign then
|
|
begin
|
|
inc(PreferredWidth, max(gw+2*GlyphMargin,tw));
|
|
inc(PreferredHeight, GlyphMargin+gh+th);
|
|
end
|
|
else
|
|
begin
|
|
inc(PreferredWidth, GlyphMargin+gw+tw);
|
|
inc(PreferredHeight, max(gh+2*GlyphMargin,th));
|
|
end;
|
|
end;
|
|
end;
|
|
if ownScaledFont then scaledFont.Free;
|
|
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.DrawControl;
|
|
var
|
|
bgra: TBGRABitmapEx;
|
|
r: TRect;
|
|
begin
|
|
if (CanvasScaleMode = csmFullResolution) or
|
|
((CanvasScaleMode = csmAuto) and not Assigned(OnAfterRenderBCButton)) then
|
|
FCanvasScale := GetCanvasScaleFactor
|
|
else FCanvasScale := 1;
|
|
|
|
// 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;
|
|
{$IFDEF FPC}FreeThenNil(FGlyph);{$ELSE}FreeAndNil(FGlyph);{$ENDIF}
|
|
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.
|