530 lines
14 KiB
ObjectPascal
530 lines
14 KiB
ObjectPascal
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
|
{******************************* CONTRIBUTOR(S) ******************************
|
|
- Edivando S. Santos Brasil | mailedivando@gmail.com
|
|
(Compatibility with delphi VCL 11/2018)
|
|
|
|
***************************** END CONTRIBUTOR(S) *****************************}
|
|
unit BCMaterialDesignButton;
|
|
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, {$IFDEF FPC}LResources,{$ENDIF}
|
|
Types, Controls, Graphics, ExtCtrls, BCBaseCtrls, BGRABitmap, BGRABitmapTypes;
|
|
|
|
type
|
|
|
|
{ TBCMaterialDesignButton }
|
|
|
|
TBCMaterialDesignButton = class(TBGRAGraphicCtrl)
|
|
private
|
|
FNormalColor: TColor;
|
|
FNormalColorEffect: TColor;
|
|
FRoundBorders: single;
|
|
FShadow: boolean;
|
|
FShadowColor: TColor;
|
|
FShadowSize: integer;
|
|
FTextColor: TColor;
|
|
FTextFont: string;
|
|
FTextQuality: TBGRAFontQuality;
|
|
FTextShadow: boolean;
|
|
FTextShadowColor: TColor;
|
|
FTextShadowOffsetX: integer;
|
|
FTextShadowOffsetY: integer;
|
|
FTextShadowSize: integer;
|
|
FTextSize: integer;
|
|
FTextStyle: TFontStyles;
|
|
FTimer: TTimer;
|
|
FBGRA: TBGRABitmap;
|
|
FBGRAShadow: TBGRABitmap;
|
|
FMousePos: TPoint;
|
|
FCircleSize: single;
|
|
FCircleAlpha: byte;
|
|
procedure SetFNormalColor(AValue: TColor);
|
|
procedure SetFNormalColorEffect(AValue: TColor);
|
|
procedure SetFRoundBorders(AValue: single);
|
|
procedure SetFShadow(AValue: boolean);
|
|
procedure SetFShadowColor(AValue: TColor);
|
|
procedure SetFShadowSize(AValue: integer);
|
|
procedure SetFTextColor(AValue: TColor);
|
|
procedure SetFTextFont(AValue: string);
|
|
procedure SetFTextQuality(AValue: TBGRAFontQuality);
|
|
procedure SetFTextShadow(AValue: boolean);
|
|
procedure SetFTextShadowColor(AValue: TColor);
|
|
procedure SetFTextShadowOffsetX(AValue: integer);
|
|
procedure SetFTextShadowOffsetY(AValue: integer);
|
|
procedure SetFTextShadowSize(AValue: integer);
|
|
procedure SetFTextSize(AValue: integer);
|
|
procedure SetFTextStyle(AValue: TFontStyles);
|
|
protected
|
|
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
|
|
{%H-}WithThemeSpace: boolean); override;
|
|
procedure OnStartTimer({%H-}Sender: TObject);
|
|
procedure OnTimer({%H-}Sender: TObject);
|
|
procedure Paint; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure TextChanged; override;
|
|
procedure UpdateShadow;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ClickMe;
|
|
published
|
|
property RoundBorders: single read FRoundBorders write SetFRoundBorders {$IFDEF FPC}default 5{$ENDIF};
|
|
property NormalColor: TColor read FNormalColor write SetFNormalColor default clWhite;
|
|
property NormalColorEffect: TColor read FNormalColorEffect
|
|
write SetFNormalColorEffect default clSilver;
|
|
property Shadow: boolean read FShadow write SetFShadow default True;
|
|
property ShadowColor: TColor read FShadowColor write SetFShadowColor default clGray;
|
|
property ShadowSize: integer read FShadowSize write SetFShadowSize default 5;
|
|
property TextColor: TColor read FTextColor write SetFTextColor default clBlack;
|
|
property TextSize: integer read FTextSize write SetFTextSize default 16;
|
|
property TextShadow: boolean read FTextShadow write SetFTextShadow default True;
|
|
property TextShadowColor: TColor read FTextShadowColor
|
|
write SetFTextShadowColor default clBlack;
|
|
property TextShadowSize: integer read FTextShadowSize
|
|
write SetFTextShadowSize default 2;
|
|
property TextShadowOffsetX: integer read FTextShadowOffsetX
|
|
write SetFTextShadowOffsetX default 0;
|
|
property TextShadowOffsetY: integer read FTextShadowOffsetY
|
|
write SetFTextShadowOffsetY default 0;
|
|
property TextStyle: TFontStyles read FTextStyle write SetFTextStyle default [];
|
|
property TextFont: string read FTextFont write SetFTextFont;
|
|
property TextQuality: TBGRAFontQuality read FTextQuality
|
|
write SetFTextQuality default fqFineAntialiasing;
|
|
published
|
|
property Action;
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
{$IFDEF FPC} //#
|
|
property OnChangeBounds;
|
|
{$ENDIF}
|
|
property Caption;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property ParentBidiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Visible;
|
|
end;
|
|
|
|
{$IFDEF FPC}procedure Register;{$ENDIF}
|
|
|
|
implementation
|
|
|
|
function DrawTextShadow(AWidth, AHeight: integer; AText: string;
|
|
AFontHeight: integer; ATextColor, AShadowColor: TBGRAPixel;
|
|
AOffSetX, AOffSetY: integer; ARadius: integer = 0; AFontStyle: TFontStyles = [];
|
|
AFontName: string = 'Default'; AShowShadow: boolean = True;
|
|
AFontQuality: TBGRAFontQuality = fqFineAntialiasing): TBGRACustomBitmap;
|
|
var
|
|
bmpOut, bmpSdw: TBGRABitmap;
|
|
begin
|
|
bmpOut := TBGRABitmap.Create(AWidth, AHeight);
|
|
bmpOut.FontAntialias := True;
|
|
bmpOut.FontHeight := AFontHeight;
|
|
bmpOut.FontStyle := AFontStyle;
|
|
bmpOut.FontName := AFontName;
|
|
bmpOut.FontQuality := AFontQuality;
|
|
|
|
if AShowShadow then
|
|
begin
|
|
bmpSdw := TBGRABitmap.Create(AWidth, AHeight);
|
|
bmpSdw.FontAntialias := True;
|
|
bmpSdw.FontHeight := AFontHeight;
|
|
bmpSdw.FontStyle := AFontStyle;
|
|
bmpSdw.FontName := AFontName;
|
|
bmpSdw.FontQuality := AFontQuality;
|
|
|
|
bmpSdw.TextRect(Rect(0, 0, bmpSdw.Width, bmpSdw.Height), AText, taCenter, tlCenter, AShadowColor);
|
|
BGRAReplace(bmpSdw, bmpSdw.FilterBlurRadial(ARadius, rbFast));
|
|
bmpOut.PutImage(0 + AOffSetX, 0 + AOffSetY, bmpSdw,
|
|
dmDrawWithTransparency);
|
|
bmpSdw.Free;
|
|
end;
|
|
|
|
bmpOut.TextRect(Rect(0, 0, bmpOut.Width, bmpOut.Height), AText, taCenter, tlCenter, ATextColor);
|
|
|
|
Result := bmpOut;
|
|
end;
|
|
|
|
{$IFDEF FPC}procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Button Controls', [TBCMaterialDesignButton]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TBCMaterialDesignButton }
|
|
|
|
procedure TBCMaterialDesignButton.SetFRoundBorders(AValue: single);
|
|
begin
|
|
if FRoundBorders = AValue then
|
|
Exit;
|
|
FRoundBorders := AValue;
|
|
UpdateShadow;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFShadow(AValue: boolean);
|
|
begin
|
|
if FShadow = AValue then
|
|
Exit;
|
|
FShadow := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
UpdateShadow;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFShadowColor(AValue: TColor);
|
|
begin
|
|
if FShadowColor = AValue then
|
|
Exit;
|
|
FShadowColor := AValue;
|
|
UpdateShadow;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFShadowSize(AValue: integer);
|
|
begin
|
|
if FShadowSize = AValue then
|
|
Exit;
|
|
FShadowSize := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
UpdateShadow;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextColor(AValue: TColor);
|
|
begin
|
|
if FTextColor = AValue then
|
|
Exit;
|
|
FTextColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextFont(AValue: string);
|
|
begin
|
|
if FTextFont = AValue then
|
|
Exit;
|
|
FTextFont := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextQuality(AValue: TBGRAFontQuality);
|
|
begin
|
|
if FTextQuality = AValue then
|
|
Exit;
|
|
FTextQuality := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextShadow(AValue: boolean);
|
|
begin
|
|
if FTextShadow = AValue then
|
|
Exit;
|
|
FTextShadow := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextShadowColor(AValue: TColor);
|
|
begin
|
|
if FTextShadowColor = AValue then
|
|
Exit;
|
|
FTextShadowColor := AValue;
|
|
UpdateShadow;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextShadowOffsetX(AValue: integer);
|
|
begin
|
|
if FTextShadowOffsetX = AValue then
|
|
Exit;
|
|
FTextShadowOffsetX := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextShadowOffsetY(AValue: integer);
|
|
begin
|
|
if FTextShadowOffsetY = AValue then
|
|
Exit;
|
|
FTextShadowOffsetY := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextShadowSize(AValue: integer);
|
|
begin
|
|
if FTextShadowSize = AValue then
|
|
Exit;
|
|
FTextShadowSize := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextSize(AValue: integer);
|
|
begin
|
|
if FTextSize = AValue then
|
|
Exit;
|
|
FTextSize := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFTextStyle(AValue: TFontStyles);
|
|
begin
|
|
if FTextStyle = AValue then
|
|
Exit;
|
|
FTextStyle := AValue;
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.CalculatePreferredSize(
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
|
|
var
|
|
ts: TSize;
|
|
begin
|
|
inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
|
|
WithThemeSpace);
|
|
if Caption <> '' then
|
|
begin
|
|
FBGRA.FontQuality := FTextQuality;
|
|
FBGRA.FontName := FTextFont;
|
|
FBGRA.FontStyle := FTextStyle;
|
|
FBGRA.FontHeight := FTextSize;
|
|
FBGRA.FontAntialias := True;
|
|
|
|
ts := FBGRA.TextSize(Caption);
|
|
Inc(PreferredWidth, ts.cx + 26);
|
|
Inc(PreferredHeight, ts.cy + 10);
|
|
end;
|
|
|
|
if FShadow then
|
|
begin
|
|
Inc(PreferredWidth, FShadowSize * 2);
|
|
Inc(PreferredHeight, FShadowSize * 2);
|
|
end;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFNormalColor(AValue: TColor);
|
|
begin
|
|
if FNormalColor = AValue then
|
|
Exit;
|
|
FNormalColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.SetFNormalColorEffect(AValue: TColor);
|
|
begin
|
|
if FNormalColorEffect = AValue then
|
|
Exit;
|
|
FNormalColorEffect := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.OnStartTimer(Sender: TObject);
|
|
begin
|
|
FCircleAlpha := 255;
|
|
FCircleSize := 5;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.OnTimer(Sender: TObject);
|
|
begin
|
|
FCircleSize := FCircleSize + 8;
|
|
if FCircleAlpha - 10 > 0 then
|
|
FCircleAlpha := FCircleAlpha - 10
|
|
else
|
|
FCircleAlpha := 0;
|
|
if FCircleAlpha <= 0 then
|
|
FTimer.Enabled := False;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.Paint;
|
|
var
|
|
temp: TBGRABitmap;
|
|
round_rect_left: integer;
|
|
round_rect_width: integer;
|
|
round_rect_height: integer;
|
|
text_height: integer;
|
|
begin
|
|
if (FBGRA.Width <> Width) or (FBGRA.Height <> Height) then
|
|
begin
|
|
FBGRA.SetSize(Width, Height);
|
|
FBGRAShadow.SetSize(Width, Height);
|
|
UpdateShadow;
|
|
end;
|
|
|
|
FBGRA.FillTransparent;
|
|
if FShadow then
|
|
FBGRA.PutImage(0, 0, FBGRAShadow, dmDrawWithTransparency);
|
|
|
|
temp := TBGRABitmap.Create(Width, Height, FNormalColor);
|
|
temp.EllipseAntialias(FMousePos.X, FMousePos.Y, FCircleSize, FCircleSize,
|
|
ColorToBGRA(FNormalColorEffect, FCircleAlpha), 1,
|
|
ColorToBGRA(FNormalColorEffect, FCircleAlpha));
|
|
|
|
if FShadow then
|
|
begin
|
|
round_rect_left := FShadowSize;
|
|
round_rect_width := Width - FShadowSize;
|
|
round_rect_height := Height - FShadowSize;
|
|
end
|
|
else
|
|
begin
|
|
round_rect_left := 0;
|
|
round_rect_width := width;
|
|
round_rect_height := height;
|
|
end;
|
|
|
|
FBGRA.FillRoundRectAntialias(round_rect_left, 0, round_rect_width, round_rect_height,
|
|
FRoundBorders, FRoundBorders, temp, [rrDefault], False);
|
|
|
|
temp.Free;
|
|
|
|
if Caption <> '' then
|
|
begin
|
|
if FShadow then
|
|
text_height := Height - FShadowSize
|
|
else
|
|
text_height := Height;
|
|
temp := DrawTextShadow(Width, text_height, Caption,
|
|
FTextSize, FTextColor, FTextShadowColor, FTextShadowOffsetX,
|
|
FTextShadowOffsetY, FTextShadowSize, FTextStyle, FTextFont,
|
|
FTextShadow, FTextQuality) as TBGRABitmap;
|
|
FBGRA.PutImage(0, 0, temp, dmDrawWithTransparency);
|
|
temp.Free;
|
|
end;
|
|
|
|
FBGRA.Draw(Canvas, 0, 0, False);
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: integer);
|
|
begin
|
|
FTimer.Enabled := False;
|
|
FMousePos := Point(X, Y);
|
|
FTimer.Enabled := True;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
class function TBCMaterialDesignButton.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result.CX := 123;
|
|
Result.CY := 33;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.TextChanged;
|
|
begin
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.UpdateShadow;
|
|
begin
|
|
FBGRAShadow.FillTransparent;
|
|
if FShadow then
|
|
begin
|
|
FBGRAShadow.RoundRectAntialias(FShadowSize, FShadowSize, Width - FShadowSize,
|
|
Height - FShadowSize, FRoundBorders, FRoundBorders,
|
|
FShadowColor, 1, FShadowColor, [rrDefault]);
|
|
BGRAReplace(FBGRAShadow, FBGRAShadow.FilterBlurRadial(FShadowSize,
|
|
FShadowSize, rbFast) as TBGRABitmap);
|
|
end;
|
|
end;
|
|
|
|
constructor TBCMaterialDesignButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
FTimer := TTimer.Create(Self);
|
|
FTimer.Interval := 15;
|
|
FTimer.Enabled := False;
|
|
{$IFDEF FPC}//#
|
|
FTimer.OnStartTimer := OnStartTimer;
|
|
{$ENDIF}
|
|
FTimer.OnTimer := OnTimer;
|
|
FBGRA := TBGRABitmap.Create(Width, Height);
|
|
FBGRAShadow := TBGRABitmap.Create(Width, Height);
|
|
FRoundBorders := 5;
|
|
FNormalColor := clWhite;
|
|
FNormalColorEffect := clSilver;
|
|
FShadow := True;
|
|
FShadowColor := clGray;
|
|
FShadowSize := 5;
|
|
FTextColor := clBlack;
|
|
FTextSize := 16;
|
|
FTextShadow := True;
|
|
FTextShadowColor := clBlack;
|
|
FTextShadowSize := 2;
|
|
FTextShadowOffsetX := 0;
|
|
FTextShadowOffsetY := 0;
|
|
FTextStyle := [];
|
|
FTextFont := 'default';
|
|
FTextQuality := fqFineAntialiasing;
|
|
end;
|
|
|
|
destructor TBCMaterialDesignButton.Destroy;
|
|
begin
|
|
FTimer.Enabled := False;
|
|
{$IFDEF FPC}//#
|
|
FTimer.OnStartTimer := nil;
|
|
{$ENDIF}
|
|
FTimer.OnTimer := nil;
|
|
FreeAndNil(FBGRA);
|
|
FreeAndNil(FBGRAShadow);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBCMaterialDesignButton.ClickMe;
|
|
begin
|
|
FMousePos := Point(Width div 2, Height div 2);
|
|
FTimer.Enabled := True;
|
|
inherited Click;
|
|
end;
|
|
|
|
end.
|