unit FlatCircleButton;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics, LCLType,
BGRABitmap, BGRABitmapTypes, Math;
type
TFlatCircleButton = class(TCustomControl)
private
FHover: Boolean;
FNormalColor: TColor;
FHoverColor: TColor;
FPicture: TPicture;
FOnClick: TNotifyEvent;
FMargin: Integer;
procedure SetNormalColor(AValue: TColor);
procedure SetHoverColor(AValue: TColor);
procedure SetPicture(AValue: TPicture);
procedure SetMargin(AValue: Integer);
protected
procedure Paint; override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property NormalColor: TColor read FNormalColor write SetNormalColor default clBtnFace;
property HoverColor: TColor read FHoverColor write SetHoverColor default clSilver;
property Picture: TPicture read FPicture write SetPicture;
property Margin: Integer read FMargin write SetMargin default 4;
property Align;
property Anchors;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property Width;
property Height;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('FlatControls', [TFlatCircleButton]);
end;
{ TFlatCircleButton }
constructor TFlatCircleButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 64;
Height := 64;
FNormalColor := clBtnFace;
FHoverColor := clSilver;
FPicture := TPicture.Create;
FMargin := 4;
end;
destructor TFlatCircleButton.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
procedure TFlatCircleButton.SetNormalColor(AValue: TColor);
begin
if FNormalColor <> AValue then
begin
FNormalColor := AValue;
Invalidate;
end;
end;
procedure TFlatCircleButton.SetHoverColor(AValue: TColor);
begin
if FHoverColor <> AValue then
begin
FHoverColor := AValue;
Invalidate;
end;
end;
procedure TFlatCircleButton.SetPicture(AValue: TPicture);
begin
FPicture.Assign(AValue);
Invalidate;
end;
procedure TFlatCircleButton.SetMargin(AValue: Integer);
begin
if FMargin <> AValue then
begin
FMargin := AValue;
Invalidate;
end;
end;
procedure TFlatCircleButton.Paint;
var
bmp: TBGRABitmap;
cx, cy, radius: Integer;
fillColor: TBGRAPixel;
img: TBGRABitmap;
bmpSource: TBitmap;
ImgW, ImgH, ImgX, ImgY: Integer;
begin
bmp := TBGRABitmap.Create(Width, Height, BGRABlack);
try
bmp.FillTransparent;
cx := Width div 2;
cy := Height div 2;
radius := Min(Width, Height) div 2 - FMargin;
fillColor := ColorToBGRA(IfThen(FHover, FHoverColor, FNormalColor));
bmp.FillEllipseAntialias(cx, cy, radius, radius, fillColor);
// Rysowanie ikony, jeśli jest
if Assigned(FPicture.Graphic) and not FPicture.Graphic.Empty then
begin
bmpSource := TBitmap.Create;
try
bmpSource.Assign(FPicture.Graphic);
ImgW := bmpSource.Width;
ImgH := bmpSource.Height;
// Skaluj do rozmiaru koła
if (ImgW > radius * 2) or (ImgH > radius * 2) then
begin
if ImgW > ImgH then
begin
ImgH := Round((radius * 2) * ImgH / ImgW);
ImgW := radius * 2;
end
else
begin
ImgW := Round((radius * 2) * ImgW / ImgH);
ImgH := radius * 2;
end;
end;
img := TBGRABitmap.Create(bmpSource);
try
img := img.Resample(ImgW, ImgH, rmLanczos3);
ImgX := cx - ImgW div 2;
ImgY := cy - ImgH div 2;
bmp.PutImage(ImgX, ImgY, img, dmDrawWithTransparency);
finally
img.Free;
end;
finally
bmpSource.Free;
end;
end;
bmp.Draw(Canvas, 0, 0, True);
finally
bmp.Free;
end;
end;
procedure TFlatCircleButton.MouseEnter;
begin
inherited MouseEnter;
FHover := True;
Invalidate;
end;
procedure TFlatCircleButton.MouseLeave;
begin
inherited MouseLeave;
FHover := False;
Invalidate;
end;
procedure TFlatCircleButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if Assigned(FOnClick) then
FOnClick(Self);
end;
end.
Recent
