1919 lines
54 KiB
ObjectPascal
1919 lines
54 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 BCButtonFocus;
|
|
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, {$IFDEF FPC}LCLType, LResources, LMessages,{$ENDIF} Controls, Dialogs,
|
|
ActnList, ImgList, Menus, // MORA
|
|
Buttons, Graphics, types,
|
|
{$IFNDEF FPC}Windows, Messages, BGRAGraphics, GraphType, FPImage, {$ENDIF}
|
|
BGRABitmap, BGRABitmapTypes, BCTypes, Forms, BCBasectrls, BCThemeManager;
|
|
|
|
{off $DEFINE DEBUG}
|
|
|
|
type
|
|
TBCButtonFocusMemoryUsage = (bmuLowF, bmuMediumF, bmuHighF);
|
|
TBCButtonFocusState = class;
|
|
TBCButtonFocusStyle = (bbtButtonF, bbtDropDownF);
|
|
TOnAfterRenderBCButtonFocus = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
|
|
AState: TBCButtonFocusState; ARect: TRect) of object;
|
|
TBCButtonFocusPropertyData = (pdNoneF, pdUpdateSizeF);
|
|
|
|
// MORA: DropDown styles
|
|
TBCButtonFocusDropDownStyle = (
|
|
bdsSeparateF, // DropDown is a separate button (default)
|
|
bdsCommonF // DropDown is same as main button
|
|
);
|
|
TBCButtonFocusDropDownPosition = (
|
|
bdpLeftF, // default
|
|
bdpBottomF);
|
|
|
|
{ TBCButtonFocusState }
|
|
|
|
TBCButtonFocusState = 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;
|
|
published
|
|
property Background: TBCBackground read FBackground write SetBackground;
|
|
property Border: TBCBorder read FBorder write SetBorder;
|
|
property FontEx: TBCFont read FFontEx write SetFontEx;
|
|
end;
|
|
|
|
{ TCustomBCButtonFocus }
|
|
|
|
TCustomBCButtonFocus = class(TBCStyleCustomControl)
|
|
private
|
|
{ Private declarations }
|
|
{$IFDEF INDEBUG}
|
|
FRenderCount: integer;
|
|
{$ENDIF}
|
|
FDropDownArrowSize: integer;
|
|
FDropDownWidth: integer;
|
|
FFlipArrow: boolean;
|
|
FActiveButt: TBCButtonFocusStyle;
|
|
FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
|
|
FGlyphAlignment: TBCAlignment;
|
|
FGlyphOldPlacement: boolean;
|
|
FInnerMargin: single;
|
|
FMemoryUsage: TBCButtonFocusMemoryUsage;
|
|
FOnPaintButton: TNotifyEvent;
|
|
FPreserveGlyphOnAssign: boolean;
|
|
FRounding: TBCRounding;
|
|
FRoundingDropDown: TBCRounding;
|
|
FStateClicked: TBCButtonFocusState;
|
|
FStateHover: TBCButtonFocusState;
|
|
FStateNormal: TBCButtonFocusState;
|
|
FDown: boolean;
|
|
FGlyph: TBitmap;
|
|
FGlyphMargin: integer;
|
|
FButtonState: TBCMouseState;
|
|
FDownButtonState: TBCMouseState;
|
|
FOnAfterRenderBCButton: TOnAfterRenderBCButtonFocus;
|
|
FOnButtonClick: TNotifyEvent;
|
|
FStaticButton: boolean;
|
|
FStyle: TBCButtonFocusStyle;
|
|
FGlobalOpacity: byte;
|
|
FTextApplyGlobalOpacity: boolean;
|
|
AutoSizeExtraY: integer;
|
|
AutoSizeExtraX: integer;
|
|
FLastBorderWidth: integer;
|
|
// MORA
|
|
FClickOffset: boolean;
|
|
FDropDownArrow: boolean;
|
|
FDropDownMenu: TPopupMenu;
|
|
FDropDownMenuVisible: boolean;
|
|
FDropDownClosingTime: TDateTime;
|
|
FDropDownPosition: TBCButtonFocusDropDownPosition;
|
|
FDropDownStyle: TBCButtonFocusDropDownStyle;
|
|
FImageChangeLink: TChangeLink;
|
|
FImageIndex: integer;
|
|
FImages: TCustomImageList;
|
|
FSaveDropDownClosed: TNotifyEvent;
|
|
FShowCaption: boolean;
|
|
procedure AssignDefaultStyle;
|
|
procedure CalculateGlyphSize(out NeededWidth, NeededHeight: integer);
|
|
procedure DropDownClosed(Sender: TObject);
|
|
procedure RenderAll(ANow: boolean = False);
|
|
function GetButtonRect: TRect;
|
|
function GetDropDownWidth(AFull: boolean = True): integer;
|
|
function GetDropDownRect(AFull: boolean = True): TRect;
|
|
procedure SeTBCButtonStateClicked(const AValue: TBCButtonFocusState);
|
|
procedure SeTBCButtonStateHover(const AValue: TBCButtonFocusState);
|
|
procedure SeTBCButtonStateNormal(const AValue: TBCButtonFocusState);
|
|
procedure SetClickOffset(AValue: boolean);
|
|
procedure SetDown(AValue: boolean);
|
|
procedure SetDropDownArrow(AValue: boolean);
|
|
procedure SetDropDownArrowSize(AValue: integer);
|
|
procedure SetDropDownPosition(AValue: TBCButtonFocusDropDownPosition);
|
|
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 SetImageIndex(AValue: integer);
|
|
procedure SetImages(AValue: TCustomImageList);
|
|
procedure SetInnerMargin(AValue: single);
|
|
procedure SetMemoryUsage(AValue: TBCButtonFocusMemoryUsage);
|
|
procedure SetRounding(AValue: TBCRounding);
|
|
procedure SetRoundingDropDown(AValue: TBCRounding);
|
|
procedure SetShowCaption(AValue: boolean);
|
|
procedure SetStaticButton(const AValue: boolean);
|
|
procedure SetStyle(const AValue: TBCButtonFocusStyle);
|
|
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;
|
|
procedure KeyDown(var Key: word; Shift: TShiftState); override;
|
|
procedure KeyUp(var Key: word; Shift: TShiftState); 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: TBCButtonFocusState); virtual;
|
|
procedure RenderState(ABGRA: TBGRABitmapEx; AState: TBCButtonFocusState;
|
|
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: TBCButtonFocusDropDownStyle
|
|
read FDropDownStyle write FDropDownStyle default bdsSeparateF;
|
|
property DropDownPosition: TBCButtonFocusDropDownPosition
|
|
read FDropDownPosition write SetDropDownPosition default bdpLeftF;
|
|
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;
|
|
protected
|
|
procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
|
|
procedure WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF}); message {$IFDEF FPC}LM_KILLFOCUS{$ELSE}WM_KILLFOCUS{$ENDIF};
|
|
procedure UpdateFocus(AFocused: boolean);
|
|
property AutoSizeExtraVertical: integer read AutoSizeExtraY;
|
|
property AutoSizeExtraHorizontal: integer read AutoSizeExtraX;
|
|
property StateNormal: TBCButtonFocusState read FStateNormal write SeTBCButtonStateNormal;
|
|
property StateHover: TBCButtonFocusState read FStateHover write SeTBCButtonStateHover;
|
|
property StateClicked: TBCButtonFocusState 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 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: TBCButtonFocusStyle read FStyle write SetStyle default bbtButtonF;
|
|
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: TOnAfterRenderBCButtonFocus
|
|
read FOnAfterRenderBCButton write FOnAfterRenderBCButton;
|
|
property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
|
|
property MemoryUsage: TBCButtonFocusMemoryUsage read FMemoryUsage write SetMemoryUsage;
|
|
property InnerMargin: single read FInnerMargin write SetInnerMargin;
|
|
property OnPaintButton: TNotifyEvent read FOnPaintButton write FOnPaintButton;
|
|
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;
|
|
public
|
|
{$IFDEF FPC}
|
|
{ Save all published settings to file }
|
|
procedure SaveToFile(AFileName: string);
|
|
{ Load and assign all published settings from file }
|
|
procedure LoadFromFile(AFileName: string);
|
|
{ Assign the properties from AFileName to this instance }
|
|
procedure AssignFromFile(AFileName: string);
|
|
{$ENDIF}
|
|
{ Used by SaveToFile/LoadFromFile }
|
|
procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
end;
|
|
|
|
TBCButtonFocus = class(TCustomBCButtonFocus)
|
|
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 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 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 bbtDropDownF. }
|
|
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: bmuHighF. }
|
|
property MemoryUsage;
|
|
{ The unique name of the control in the form. }
|
|
property Name;
|
|
{ TabStop }
|
|
property TabOrder;
|
|
property TabStop;
|
|
property ThemeManager: TBCThemeManager read FBCThemeManager write SetFBCThemeManager;
|
|
property OnPaintButton;
|
|
end;
|
|
|
|
{ TBCButtonFocusActionLink }
|
|
|
|
TBCButtonFocusActionLink = 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, LCLProc, GraphPropEdits,{$ENDIF} Math, BCTools, SysUtils;
|
|
|
|
const
|
|
DropDownReopenDelay = 0.2/(24*60*60);
|
|
|
|
{$IFDEF FPC}//#
|
|
type
|
|
TBCButtonImageIndexPropertyEditor = class(TImageIndexPropertyEditor)
|
|
protected
|
|
function GetImageList: TCustomImageList; override;
|
|
end;
|
|
|
|
function TBCButtonImageIndexPropertyEditor.GetImageList: TCustomImageList;
|
|
var
|
|
Component: TPersistent;
|
|
begin
|
|
Component := GetComponent(0);
|
|
if Component is TCustomBCButtonFocus then
|
|
Result := TCustomBCButtonFocus(Component).Images
|
|
else
|
|
Result := nil;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TBCButtonFocus }
|
|
procedure TBCButtonFocus.SetFBCThemeManager(AValue: TBCThemeManager);
|
|
begin
|
|
if FBCThemeManager=AValue then Exit;
|
|
FBCThemeManager:=AValue;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Button Controls', [TBCButtonFocus]);
|
|
{$IFDEF FPC}
|
|
RegisterPropertyEditor(TypeInfo(integer), TBCButtonFocus,
|
|
'ImageIndex', TBCButtonImageIndexPropertyEditor);
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TBCButtonFocusActionLink }
|
|
|
|
procedure TBCButtonFocusActionLink.AssignClient(AClient: TObject);
|
|
begin
|
|
inherited AssignClient(AClient);
|
|
FClient := AClient as TCustomBCButtonFocus;
|
|
end;
|
|
|
|
procedure TBCButtonFocusActionLink.SetChecked(Value: boolean);
|
|
begin
|
|
if IsCheckedLinked then
|
|
TCustomBCButtonFocus(FClient).Down := Value;
|
|
end;
|
|
|
|
procedure TBCButtonFocusActionLink.SetImageIndex(Value: integer);
|
|
begin
|
|
if IsImageIndexLinked then
|
|
TCustomBCButtonFocus(FClient).ImageIndex := Value;
|
|
end;
|
|
|
|
function TBCButtonFocusActionLink.IsCheckedLinked: boolean;
|
|
begin
|
|
Result := inherited IsCheckedLinked and (TCustomBCButtonFocus(FClient).Down =
|
|
(Action as TCustomAction).Checked);
|
|
end;
|
|
|
|
function TBCButtonFocusActionLink.IsImageIndexLinked: boolean;
|
|
begin
|
|
Result := inherited IsImageIndexLinked and
|
|
(TCustomBCButtonFocus(FClient).ImageIndex = (Action as TCustomAction).ImageIndex);
|
|
end;
|
|
|
|
{ TBCButtonFocusState }
|
|
|
|
procedure TBCButtonFocusState.SetFontEx(const AValue: TBCFont);
|
|
begin
|
|
if FFontEx = AValue then
|
|
exit;
|
|
FFontEx.Assign(AValue);
|
|
|
|
Change;
|
|
end;
|
|
|
|
procedure TBCButtonFocusState.OnChangeFont(Sender: TObject; AData: PtrInt);
|
|
begin
|
|
Change(PtrInt(pdUpdateSizeF));
|
|
end;
|
|
|
|
procedure TBCButtonFocusState.OnChangeChildProperty(Sender: TObject; AData: PtrInt);
|
|
begin
|
|
Change(AData);
|
|
end;
|
|
|
|
procedure TBCButtonFocusState.SetBackground(AValue: TBCBackground);
|
|
begin
|
|
if FBackground = AValue then
|
|
Exit;
|
|
FBackground.Assign(AValue);
|
|
|
|
Change;
|
|
end;
|
|
|
|
procedure TBCButtonFocusState.SetBorder(AValue: TBCBorder);
|
|
begin
|
|
if FBorder = AValue then
|
|
Exit;
|
|
FBorder.Assign(AValue);
|
|
|
|
Change;
|
|
end;
|
|
|
|
constructor TBCButtonFocusState.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 TBCButtonFocusState.Destroy;
|
|
begin
|
|
FBackground.Free;
|
|
FBorder.Free;
|
|
FFontEx.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBCButtonFocusState.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TBCButtonFocusState then
|
|
begin
|
|
FBackground.Assign(TBCButtonFocusState(Source).FBackground);
|
|
FBorder.Assign(TBCButtonFocusState(Source).FBorder);
|
|
FFontEx.Assign(TBCButtonFocusState(Source).FFontEx);
|
|
|
|
Change(PtrInt(pdUpdateSizeF));
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{ TCustomBCButtonFocus }
|
|
|
|
procedure TCustomBCButtonFocus.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 TCustomBCButtonFocus.CalculateGlyphSize(out NeededWidth, NeededHeight: integer);
|
|
begin
|
|
if Assigned(FGlyph) and not FGlyph.Empty then
|
|
begin
|
|
NeededWidth := FGlyph.Width;
|
|
NeededHeight := FGlyph.Height;
|
|
end
|
|
else
|
|
if Assigned(FImages) then
|
|
begin
|
|
NeededWidth := FImages.Width;
|
|
NeededHeight := FImages.Height;
|
|
end
|
|
else
|
|
begin
|
|
NeededHeight := 0;
|
|
NeededWidth := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.RenderAll(ANow: boolean);
|
|
begin
|
|
if (csCreating in ControlState) or IsUpdating or (FBGRANormal = nil) then
|
|
Exit;
|
|
|
|
if ANow then
|
|
begin
|
|
Render(FBGRANormal, FStateNormal);
|
|
Render(FBGRAHover, FStateHover);
|
|
Render(FBGRAClick, FStateClicked);
|
|
end
|
|
else
|
|
begin
|
|
FBGRANormal.NeedRender := True;
|
|
FBGRAHover.NeedRender := True;
|
|
FBGRAClick.NeedRender := True;
|
|
end;
|
|
end;
|
|
|
|
function TCustomBCButtonFocus.GetButtonRect: TRect;
|
|
begin
|
|
Result := GetClientRect;
|
|
if FStyle = bbtDropDownF then
|
|
case FDropDownPosition of
|
|
bdpBottomF:
|
|
Dec(Result.Bottom, GetDropDownWidth(False));
|
|
else
|
|
// bdpLeft:
|
|
Dec(Result.Right, GetDropDownWidth(False));
|
|
end;
|
|
end;
|
|
|
|
function TCustomBCButtonFocus.GetDropDownWidth(AFull: boolean): integer;
|
|
begin
|
|
Result := FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width);
|
|
end;
|
|
|
|
function TCustomBCButtonFocus.GetGlyph: TBitmap;
|
|
begin
|
|
Result := FGlyph as TBitmap;
|
|
end;
|
|
|
|
function TCustomBCButtonFocus.GetDropDownRect(AFull: boolean): TRect;
|
|
begin
|
|
Result := GetClientRect;
|
|
case FDropDownPosition of
|
|
bdpBottomF:
|
|
Result.Top := Result.Bottom - GetDropDownWidth(AFull);
|
|
else
|
|
// bdpLeft:
|
|
Result.Left := Result.Right - GetDropDownWidth(AFull);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.Render(ABGRA: TBGRABitmapEx; AState: TBCButtonFocusState);
|
|
|
|
function GetActualGlyph: TBitmap;
|
|
begin
|
|
if Assigned(FGlyph) and not FGlyph.Empty then result := FGlyph else
|
|
if Assigned(FImages) and (FImageIndex > -1) and (FImageIndex < FImages.Count) then
|
|
begin
|
|
result := TBitmap.Create;
|
|
{$IFDEF FPC}
|
|
FImages.GetBitmap(FImageIndex, result);
|
|
{$ELSE}
|
|
FImages.GetBitmapRaw(FImageIndex, result);
|
|
{$ENDIF}
|
|
end else exit(nil);
|
|
end;
|
|
|
|
procedure RenderGlyph(ARect: TRect; AGlyph: TBitmap);
|
|
begin
|
|
if ARect.IsEmpty or (AGlyph = nil) then exit;
|
|
ABGRA.PutImage(ARect.Left, ARect.Top, AGlyph, dmLinearBlend);
|
|
end;
|
|
|
|
var
|
|
r, r_a, r_g: TRect;
|
|
g: TBitmap;
|
|
actualCaption: TCaption;
|
|
|
|
begin
|
|
if (csCreating in ControlState) or IsUpdating then
|
|
Exit;
|
|
|
|
ABGRA.NeedRender := False;
|
|
|
|
{ Refreshing size }
|
|
ABGRA.SetSize(Width, Height);
|
|
|
|
{ Clearing previous paint }
|
|
ABGRA.Fill(BGRAPixelTransparent);
|
|
|
|
{ Basic body }
|
|
r := GetButtonRect;
|
|
RenderState(ABGRA, AState, r, FRounding);
|
|
|
|
if not GlyphOldPlacement then
|
|
r.Inflate(-round(InnerMargin),-round(InnerMargin));
|
|
|
|
{ Calculating rect }
|
|
CalculateBorderRect(AState.Border, r);
|
|
|
|
if FStyle = bbtDropDownF then
|
|
begin
|
|
r_a := GetDropDownRect;
|
|
RenderState(ABGRA, AState, r_a, FRoundingDropDown);
|
|
CalculateBorderRect(AState.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, FDropDownArrowSize, badUp,
|
|
AState.FontEx.Color)
|
|
else
|
|
RenderArrow(TBGRABitmap(ABGRA), r_a, FDropDownArrowSize, badDown,
|
|
AState.FontEx.Color);
|
|
end;
|
|
|
|
// Click offset for text and glyph
|
|
if FClickOffset and (AState = FStateClicked) then
|
|
r.Offset(1,1);
|
|
|
|
// DropDown arrow
|
|
if FDropDownArrow and (FStyle <> bbtDropDownF) then
|
|
begin
|
|
r_a := r;
|
|
r_a.Left := r_a.Right - FDropDownWidth;
|
|
if FFlipArrow then
|
|
RenderArrow(TBGRABitmap(ABGRA), r_a, FDropDownArrowSize, badUp,
|
|
AState.FontEx.Color)
|
|
else
|
|
RenderArrow(TBGRABitmap(ABGRA), r_a, FDropDownArrowSize, badDown,
|
|
AState.FontEx.Color);
|
|
Dec(R.Right, FDropDownWidth);
|
|
end;
|
|
|
|
g := GetActualGlyph;
|
|
if FShowCaption then actualCaption := self.Caption else actualCaption := '';
|
|
r_g := ComputeGlyphPosition(r, g, GlyphAlignment, GlyphMargin, actualCaption, AState.FontEx, GlyphOldPlacement);
|
|
if FTextApplyGlobalOpacity then
|
|
begin
|
|
{ Drawing text }
|
|
RenderText(r, AState.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, AState.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, AState, r);
|
|
|
|
{$IFDEF INDEBUG}
|
|
FRenderCount := FRenderCount +1;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.RenderState(ABGRA: TBGRABitmapEx;
|
|
AState: TBCButtonFocusState; const ARect: TRect; ARounding: TBCRounding);
|
|
begin
|
|
RenderBackgroundAndBorder(ARect, AState.FBackground, TBGRABitmap(ABGRA),
|
|
ARounding, AState.FBorder, FInnerMargin);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.OnChangeGlyph(Sender: TObject);
|
|
begin
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.OnChangeState(Sender: TObject; AData: PtrInt);
|
|
begin
|
|
RenderControl;
|
|
if (TBCButtonFocusPropertyData(AData) = pdUpdateSizeF) or
|
|
(FStateNormal.Border.Width <> FLastBorderWidth) then
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.ImageListChange(ASender: TObject);
|
|
begin
|
|
if ASender = Images then
|
|
begin
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.LimitMemoryUsage;
|
|
begin
|
|
{$IFNDEF FPC}//# //@ IN DELPHI NEEDRENDER NEDD TO BE TRUE. IF FALSE COMPONENT IN BGRANORMAL BE BLACK AFTER INVALIDATE.
|
|
if Assigned(FBGRAHover) then FBGRANormal.NeedRender := True;
|
|
if Assigned(FBGRAHover) then FBGRAHover.NeedRender := True;
|
|
if Assigned(FBGRAClick) then FBGRAClick.NeedRender := True;
|
|
{$ENDIF}
|
|
if (FMemoryUsage = bmuLowF) and Assigned(FBGRANormal) then FBGRANormal.Discard;
|
|
if (FMemoryUsage <> bmuHighF) then
|
|
begin
|
|
if Assigned(FBGRAHover) then FBGRAHover.Discard;
|
|
if Assigned(FBGRAClick) then FBGRAClick.Discard;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SeTBCButtonStateClicked(const AValue: TBCButtonFocusState);
|
|
begin
|
|
if FStateClicked = AValue then
|
|
exit;
|
|
FStateClicked.Assign(AValue);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SeTBCButtonStateHover(const AValue: TBCButtonFocusState);
|
|
begin
|
|
if FStateHover = AValue then
|
|
exit;
|
|
FStateHover.Assign(AValue);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SeTBCButtonStateNormal(const AValue: TBCButtonFocusState);
|
|
begin
|
|
if FStateNormal = AValue then
|
|
exit;
|
|
FStateNormal.Assign(AValue);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetClickOffset(AValue: boolean);
|
|
begin
|
|
if FClickOffset = AValue then
|
|
Exit;
|
|
FClickOffset := AValue;
|
|
RenderControl;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetDown(AValue: boolean);
|
|
begin
|
|
if FDown = AValue then
|
|
exit;
|
|
FDown := AValue;
|
|
if FDown then
|
|
FButtonState := msClicked
|
|
else
|
|
FButtonState := msNone;
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetDropDownArrow(AValue: boolean);
|
|
begin
|
|
if FDropDownArrow = AValue then
|
|
Exit;
|
|
FDropDownArrow := AValue;
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetDropDownArrowSize(AValue: integer);
|
|
begin
|
|
if FDropDownArrowSize = AValue then
|
|
Exit;
|
|
FDropDownArrowSize := AValue;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetDropDownPosition(AValue: TBCButtonFocusDropDownPosition);
|
|
begin
|
|
if FDropDownPosition = AValue then
|
|
Exit;
|
|
FDropDownPosition := AValue;
|
|
|
|
if FStyle <> bbtDropDownF then
|
|
Exit;
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetDropDownWidth(AValue: integer);
|
|
begin
|
|
if FDropDownWidth = AValue then
|
|
Exit;
|
|
FDropDownWidth := AValue;
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetFlipArrow(AValue: boolean);
|
|
begin
|
|
if FFlipArrow = AValue then
|
|
Exit;
|
|
FFlipArrow := AValue;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetGlyph(const AValue: TBitmap);
|
|
begin
|
|
if (FGlyph <> nil) and (FGlyph = AValue) then
|
|
exit;
|
|
|
|
FGlyph.Assign(AValue);
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetGlyphAlignment(AValue: TBCAlignment);
|
|
begin
|
|
if FGlyphAlignment=AValue then Exit;
|
|
FGlyphAlignment:=AValue;
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetGlyphMargin(const AValue: integer);
|
|
begin
|
|
if FGlyphMargin = AValue then
|
|
exit;
|
|
FGlyphMargin := AValue;
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetGlyphOldPlacement(AValue: boolean);
|
|
begin
|
|
if FGlyphOldPlacement=AValue then Exit;
|
|
FGlyphOldPlacement:=AValue;
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetImageIndex(AValue: integer);
|
|
begin
|
|
if FImageIndex = AValue then
|
|
Exit;
|
|
FImageIndex := AValue;
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetImages(AValue: TCustomImageList);
|
|
begin
|
|
if FImages = AValue then
|
|
Exit;
|
|
FImages := AValue;
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetInnerMargin(AValue: single);
|
|
begin
|
|
if FInnerMargin=AValue then Exit;
|
|
FInnerMargin:=AValue;
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetMemoryUsage(AValue: TBCButtonFocusMemoryUsage);
|
|
begin
|
|
if FMemoryUsage=AValue then Exit;
|
|
FMemoryUsage:=AValue;
|
|
LimitMemoryUsage;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetRounding(AValue: TBCRounding);
|
|
begin
|
|
if FRounding = AValue then
|
|
Exit;
|
|
FRounding.Assign(AValue);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetRoundingDropDown(AValue: TBCRounding);
|
|
begin
|
|
if FRoundingDropDown = AValue then
|
|
Exit;
|
|
FRoundingDropDown.Assign(AValue);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetShowCaption(AValue: boolean);
|
|
begin
|
|
if FShowCaption = AValue then
|
|
Exit;
|
|
FShowCaption := AValue;
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetStaticButton(const AValue: boolean);
|
|
begin
|
|
if FStaticButton = AValue then
|
|
exit;
|
|
FStaticButton := AValue;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetStyle(const AValue: TBCButtonFocusStyle);
|
|
begin
|
|
if FStyle = AValue then
|
|
exit;
|
|
FStyle := AValue;
|
|
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.UpdateSize;
|
|
begin
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.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;
|
|
begin
|
|
gh := 0;
|
|
gw := 0;
|
|
if (Parent = nil) or (not Parent.HandleAllocated) then
|
|
Exit;
|
|
{ if WidthIsAnchored then
|
|
AWidth := Width
|
|
else
|
|
AWidth := 10000;}
|
|
|
|
FLastBorderWidth := FStateNormal.Border.Width;
|
|
CalculateGlyphSize(gw, gh);
|
|
|
|
if GlyphOldPlacement then
|
|
begin
|
|
{ if WidthIsAnchored then
|
|
AWidth := Width
|
|
else
|
|
AWidth := 10000;}
|
|
|
|
PreferredWidth := 0;
|
|
PreferredHeight := 0;
|
|
if FShowCaption then
|
|
CalculateTextSize(Caption, FStateNormal.FontEx, PreferredWidth, PreferredHeight);
|
|
|
|
// Extra pixels for DropDown
|
|
if Style = bbtDropDownF then
|
|
if FDropDownPosition in [bdpBottomF] then
|
|
Inc(PreferredHeight, GetDropDownWidth)
|
|
else
|
|
Inc(PreferredWidth, GetDropDownWidth);
|
|
|
|
if (Style = bbtButtonF) 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
|
|
bbtDropDownF:
|
|
case FDropDownPosition of
|
|
bdpBottomF: 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, FStateNormal.FontEx, tw, th, availW);
|
|
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;
|
|
|
|
// Extra pixels for AutoSize
|
|
Inc(PreferredWidth, AutoSizeExtraX);
|
|
Inc(PreferredHeight, AutoSizeExtraY);
|
|
end;
|
|
|
|
class function TCustomBCButtonFocus.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 123;
|
|
Result.CY := 33;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.Click;
|
|
begin
|
|
if (FActiveButt = bbtDropDownF) and Assigned(FOnButtonClick) then
|
|
begin
|
|
FOnButtonClick(Self);
|
|
Exit;
|
|
end;
|
|
inherited Click;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.DropDownClosed(Sender: TObject);
|
|
begin
|
|
if Assigned(FSaveDropDownClosed) then
|
|
FSaveDropDownClosed(Sender);
|
|
{$IFDEF FPC}
|
|
if Assigned(FDropDownMenu) then
|
|
FDropDownMenu.OnClose := FSaveDropDownClosed;
|
|
{$ENDIF}
|
|
|
|
// MORA: DropDownMenu is still visible if mouse is over control
|
|
FDropDownMenuVisible := {$IFNDEF FPC}BGRAGraphics.{$ENDIF}PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos));
|
|
FDropDownClosingTime := Now;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.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 CanFocus() then SetFocus();
|
|
|
|
if (Button = mbLeft) and Enabled {and (not (FButtonState = msClicked)) } then
|
|
begin
|
|
case FActiveButt of
|
|
bbtButtonF:
|
|
if not (FButtonState = msClicked) then
|
|
begin
|
|
FButtonState := msClicked;
|
|
if FDropDownStyle = bdsCommonF then
|
|
FDownButtonState := msClicked
|
|
else
|
|
FDownButtonState := msNone;
|
|
Invalidate;
|
|
end;
|
|
bbtDropDownF:
|
|
if not (FDownButtonState = msClicked) then
|
|
begin
|
|
if FDropDownStyle = bdsCommonF 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 = bbtDropDownF) or (FStyle = bbtButtonF)) and
|
|
(FDropDownMenu <> nil) and Enabled then
|
|
begin
|
|
ClientToScreenPoint := ClientToScreen(Point(0, Height));
|
|
with ClientToScreenPoint do
|
|
begin
|
|
// normal button
|
|
if FStyle = bbtButtonF then
|
|
begin
|
|
x := x + Width * integer(FDropDownMenu.Alignment = paRight);
|
|
if FFlipArrow then
|
|
y := y -Height;
|
|
end
|
|
else
|
|
// dropdown button
|
|
begin
|
|
if FDropDownPosition = bdpBottomF 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 = bdsSeparateF 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 TCustomBCButtonFocus.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
|
|
bbtButtonF:
|
|
if FButtonState = msClicked then
|
|
begin
|
|
FButtonState := msHover;
|
|
if FDropDownStyle = bdsCommonF then
|
|
FDownButtonState := msHover
|
|
else
|
|
FDownButtonState := msNone;
|
|
Invalidate;
|
|
end;
|
|
bbtDropDownF:
|
|
if FDownButtonState = msClicked then
|
|
begin
|
|
FDownButtonState := msHover;
|
|
if FDropDownStyle = bdsCommonF then
|
|
FButtonState := msHover
|
|
else
|
|
FButtonState := msNone;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
// Old
|
|
{FButtonState := msHover;
|
|
Invalidate;}
|
|
end;
|
|
|
|
//if (FActiveButt = bbtDropDownF) 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 TCustomBCButtonFocus.MouseEnter;
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
exit;
|
|
case FActiveButt of
|
|
bbtButtonF:
|
|
begin
|
|
if FDown then
|
|
FButtonState := msClicked
|
|
else
|
|
FButtonState := msHover;
|
|
|
|
if FDropDownStyle = bdsSeparateF then
|
|
FDownButtonState := msNone
|
|
else
|
|
FDownButtonState := msHover;
|
|
end;
|
|
bbtDropDownF:
|
|
begin
|
|
if FDown then
|
|
FButtonState := msClicked
|
|
else
|
|
if FDropDownStyle = bdsSeparateF then
|
|
FButtonState := msNone
|
|
else
|
|
FButtonState := msHover;
|
|
FDownButtonState := msHover;
|
|
end;
|
|
end;
|
|
Invalidate;
|
|
// Old
|
|
{FButtonState := msHover;
|
|
Invalidate;}
|
|
{$IFDEF FPC}
|
|
inherited MouseEnter;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.MouseLeave;
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
exit;
|
|
if FDown then
|
|
begin
|
|
FButtonState := msClicked;
|
|
FActiveButt := bbtButtonF;
|
|
end
|
|
else
|
|
FButtonState := msNone;
|
|
FDownButtonState := msNone;
|
|
Invalidate;
|
|
{$IFDEF FPC} //#
|
|
inherited MouseLeave;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.MouseMove(Shift: TShiftState; X, Y: integer);
|
|
|
|
function IsOverDropDown: boolean;
|
|
begin
|
|
with GetButtonRect do
|
|
case FDropDownPosition of
|
|
bdpBottomF:
|
|
Result := Y > Bottom;
|
|
else
|
|
Result := X > GetButtonRect.Right;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
|
|
if FStyle = bbtButtonF then
|
|
FActiveButt := bbtButtonF
|
|
else
|
|
begin
|
|
// Calling invalidate only when active button changed. Otherwise, we leave
|
|
// this for LCL. This reduce paint call
|
|
if (FActiveButt = bbtButtonF) and IsOverDropDown then
|
|
begin
|
|
FActiveButt := bbtDropDownF;
|
|
if FDropDownStyle <> bdsCommonF then // Don't need invalidating
|
|
begin
|
|
FDownButtonState := msHover;
|
|
if FDown then
|
|
FButtonState := msClicked
|
|
else
|
|
FButtonState := msNone;
|
|
Invalidate;
|
|
end;
|
|
end
|
|
else
|
|
if (FActiveButt = bbtDropDownF) and not IsOverDropDown then
|
|
begin
|
|
FActiveButt := bbtButtonF;
|
|
if FDropDownStyle <> bdsCommonF then // Don't need invalidating
|
|
begin
|
|
if FDown then
|
|
FButtonState := msClicked
|
|
else
|
|
FButtonState := msHover;
|
|
FDownButtonState := msNone;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetEnabled(Value: boolean);
|
|
begin
|
|
inherited SetEnabled(Value);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.TextChanged;
|
|
begin
|
|
{$IFDEF FPC}
|
|
inherited TextChanged;
|
|
{$ENDIF}
|
|
RenderControl;
|
|
UpdateSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.KeyDown(var Key: word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
|
|
if (Key = VK_SPACE) or (Key = VK_RETURN) then
|
|
MouseDown(mbLeft, [], 0, 0);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.KeyUp(var Key: word; Shift: TShiftState);
|
|
begin
|
|
if (Key = VK_SPACE) or (Key = VK_RETURN) then
|
|
begin
|
|
MouseLeave;
|
|
Self.Click;
|
|
end;
|
|
|
|
inherited KeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.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 TCustomBCButtonFocus.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TBCButtonFocusActionLink;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent = FImages) and (Operation = opRemove) then
|
|
Images := nil;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.UpdateControl;
|
|
begin
|
|
RenderControl;
|
|
inherited UpdateControl; // indalidate
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TCustomBCButtonFocus.SaveToFile(AFileName: string);
|
|
var
|
|
AStream: TMemoryStream;
|
|
begin
|
|
AStream := TMemoryStream.Create;
|
|
try
|
|
WriteComponentAsTextToStream(AStream, Self);
|
|
AStream.SaveToFile(AFileName);
|
|
finally
|
|
AStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.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 TCustomBCButtonFocus.AssignFromFile(AFileName: string);
|
|
var
|
|
AStream: TMemoryStream;
|
|
AButton: TBCButtonFocus;
|
|
begin
|
|
AButton := TBCButtonFocus.Create(nil);
|
|
AStream := TMemoryStream.Create;
|
|
try
|
|
AStream.LoadFromFile(AFileName);
|
|
ReadComponentFromTextStream(AStream, TComponent(AButton), OnFindClass);
|
|
Assign(AButton);
|
|
finally
|
|
AStream.Free;
|
|
AButton.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomBCButtonFocus.OnFindClass(Reader: TReader; const AClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
begin
|
|
if CompareText(AClassName, 'TBCButton') = 0 then
|
|
ComponentClass := TBCButtonFocus;
|
|
end;
|
|
|
|
{$IFDEF INDEBUG}
|
|
function TCustomBCButtonFocus.GetDebugText: string;
|
|
begin
|
|
Result := 'R: ' + IntToStr(FRenderCount);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TCustomBCButtonFocus.DrawControl;
|
|
var
|
|
bgra: TBGRABitmapEx;
|
|
begin
|
|
|
|
// 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 = bbtButtonF) or (FButtonState = FDownButtonState) or FStaticButton then
|
|
begin
|
|
// Main button
|
|
if FStaticButton then
|
|
bgra := FBGRANormal
|
|
else
|
|
if FDown then
|
|
bgra := FBGRAClick
|
|
else
|
|
case FButtonState of
|
|
msNone: bgra := FBGRANormal;
|
|
msHover: bgra := FBGRAHover;
|
|
msClicked: bgra := FBGRAClick;
|
|
end;
|
|
if {%H-}bgra.NeedRender then
|
|
Render(bgra, TBCButtonFocusState(bgra.CustomData));
|
|
bgra.Draw(Self.Canvas, 0, 0, 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
|
|
bbtButtonF:
|
|
begin
|
|
// Drop down button
|
|
case FDownButtonState of
|
|
msNone: bgra := FBGRANormal;
|
|
msHover: bgra := FBGRAHover;
|
|
msClicked: bgra := FBGRAClick;
|
|
end;
|
|
if bgra.NeedRender then
|
|
Render(bgra, TBCButtonFocusState(bgra.CustomData));
|
|
bgra.DrawPart(GetDropDownRect, Self.Canvas, GetDropDownRect.Left,
|
|
GetDropDownRect.Top, False);
|
|
// Main button
|
|
if FDown then
|
|
bgra := FBGRAClick
|
|
else
|
|
case FButtonState of
|
|
msNone: bgra := FBGRANormal;
|
|
msHover: bgra := FBGRAHover;
|
|
msClicked: bgra := FBGRAClick;
|
|
end;
|
|
if bgra.NeedRender then
|
|
Render(bgra, TBCButtonFocusState(bgra.CustomData));
|
|
bgra.DrawPart(GetButtonRect, Self.Canvas, 0, 0, False);
|
|
end;
|
|
bbtDropDownF:
|
|
begin
|
|
// Main button
|
|
if FDown then
|
|
bgra := FBGRAClick
|
|
else
|
|
case FButtonState of
|
|
msNone: bgra := FBGRANormal;
|
|
msHover: bgra := FBGRAHover;
|
|
msClicked: bgra := FBGRAClick;
|
|
end;
|
|
if bgra.NeedRender then
|
|
Render(bgra, TBCButtonFocusState(bgra.CustomData));
|
|
bgra.DrawPart(GetButtonRect, Self.Canvas, 0, 0, False);
|
|
// Drop down button
|
|
case FDownButtonState of
|
|
msNone: bgra := FBGRANormal;
|
|
msHover: bgra := FBGRAHover;
|
|
msClicked: bgra := FBGRAClick;
|
|
end;
|
|
if bgra.NeedRender then
|
|
Render(bgra, TBCButtonFocusState(bgra.CustomData));
|
|
bgra.DrawPart(GetDropDownRect, Self.Canvas, GetDropDownRect.Left,
|
|
GetDropDownRect.Top, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if Assigned(FOnPaintButton) then
|
|
FOnPaintButton(Self);
|
|
|
|
LimitMemoryUsage;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.RenderControl;
|
|
begin
|
|
inherited RenderControl;
|
|
RenderAll;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
|
|
begin
|
|
inherited;
|
|
|
|
UpdateFocus(True);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF});
|
|
begin
|
|
inherited;
|
|
|
|
if Message.FocusedWnd <> Handle then
|
|
UpdateFocus(False);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.UpdateFocus(AFocused: boolean);
|
|
var
|
|
lForm: TCustomForm;
|
|
begin
|
|
lForm := GetParentForm(Self);
|
|
if lForm = nil then
|
|
exit;
|
|
|
|
{$IFDEF FPC}//#
|
|
if AFocused then
|
|
ActiveDefaultControlChanged(lForm.ActiveControl)
|
|
else
|
|
ActiveDefaultControlChanged(nil);
|
|
{$ENDIF}
|
|
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetGlobalOpacity(const AValue: byte);
|
|
begin
|
|
if FGlobalOpacity = AValue then
|
|
exit;
|
|
FGlobalOpacity := AValue;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.SetTextApplyGlobalOpacity(const AValue: boolean);
|
|
begin
|
|
if FTextApplyGlobalOpacity = AValue then
|
|
exit;
|
|
FTextApplyGlobalOpacity := AValue;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
constructor TCustomBCButtonFocus.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
ControlStyle := ControlStyle + [csParentBackground];
|
|
|
|
{$IFDEF INDEBUG}
|
|
FRenderCount := 0;
|
|
{$ENDIF}
|
|
FMemoryUsage := bmuHighF;
|
|
{$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];
|
|
FBGRANormal := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
|
|
FBGRAHover := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
|
|
FBGRAClick := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
|
|
|
|
ParentColor := False;
|
|
Color := clNone;
|
|
|
|
FStateNormal := TBCButtonFocusState.Create(Self);
|
|
FStateHover := TBCButtonFocusState.Create(Self);
|
|
FStateClicked := TBCButtonFocusState.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;
|
|
|
|
{ Connecting bitmaps with states property to easy call and access }
|
|
FBGRANormal.CustomData := PtrInt(FStateNormal);
|
|
FBGRAHover.CustomData := PtrInt(FStateHover);
|
|
FBGRAClick.CustomData := PtrInt(FStateClicked);
|
|
|
|
FButtonState := msNone;
|
|
FDownButtonState := msNone;
|
|
FFlipArrow := False;
|
|
FGlyph := TBitmap.Create;
|
|
FGlyph.OnChange := OnChangeGlyph;
|
|
FGlyphMargin := 5;
|
|
FGlyphAlignment:= bcaCenter;
|
|
FGlyphOldPlacement:= true;
|
|
FStyle := bbtButtonF;
|
|
FStaticButton := False;
|
|
FActiveButt := bbtButtonF;
|
|
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 TCustomBCButtonFocus.Destroy;
|
|
begin
|
|
FImageChangeLink.Free;
|
|
FStateNormal.Free;
|
|
FStateHover.Free;
|
|
FStateClicked.Free;
|
|
FBGRANormal.Free;
|
|
FBGRAHover.Free;
|
|
FBGRAClick.Free;
|
|
{$IFDEF FPC}FreeThenNil{$ELSE}FreeAndNil{$ENDIF}(FGlyph);
|
|
FRounding.Free;
|
|
FRoundingDropDown.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TCustomBCButtonFocus then
|
|
begin
|
|
if not PreserveGlyphOnAssign then
|
|
Glyph := TCustomBCButtonFocus(Source).Glyph;
|
|
FGlyphMargin := TCustomBCButtonFocus(Source).FGlyphMargin;
|
|
FStyle := TCustomBCButtonFocus(Source).FStyle;
|
|
FFlipArrow := TCustomBCButtonFocus(Source).FFlipArrow;
|
|
FStaticButton := TCustomBCButtonFocus(Source).FStaticButton;
|
|
FGlobalOpacity := TCustomBCButtonFocus(Source).FGlobalOpacity;
|
|
FTextApplyGlobalOpacity := TCustomBCButtonFocus(Source).FTextApplyGlobalOpacity;
|
|
FStateNormal.Assign(TCustomBCButtonFocus(Source).FStateNormal);
|
|
FStateHover.Assign(TCustomBCButtonFocus(Source).FStateHover);
|
|
FStateClicked.Assign(TCustomBCButtonFocus(Source).FStateClicked);
|
|
FDropDownArrowSize := TCustomBCButtonFocus(Source).FDropDownArrowSize;
|
|
FDropDownWidth := TCustomBCButtonFocus(Source).FDropDownWidth;
|
|
AutoSizeExtraX := TCustomBCButtonFocus(Source).AutoSizeExtraX;
|
|
AutoSizeExtraY := TCustomBCButtonFocus(Source).AutoSizeExtraY;
|
|
FDown := TCustomBCButtonFocus(Source).FDown;
|
|
FRounding.Assign(TCustomBCButtonFocus(Source).FRounding);
|
|
FRoundingDropDown.Assign(TCustomBCButtonFocus(Source).FRoundingDropDown);
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
UpdateSize;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TCustomBCButtonFocus.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 TCustomBCButtonFocus.GetStyleExtension: string;
|
|
begin
|
|
Result := 'bcbtn';
|
|
end;
|
|
|
|
end.
|