I.ve found a way to have the Fill.color property working, I've reimplemented the TBrush (FFill) normally provided by TShape and change the implementation of the Paint procedure from
Canvas.FillPath(FPath, AbsoluteOpacity);
to
Canvas.FillPath(FPath, AbsoluteOpacity, FFill);
here is the new code:
unit RegularPolygon;
interface
uses
System.SysUtils, System.Classes, System.Types, System.Math, System.UITypes, FMX.Types, FMX.Controls, FMX.Objects, FMX.Graphics;
type
TRegularPolygon = class(TShape)
private
{ Private declarations }
FNumberOfSides: Integer;
FPath: TPathData;
FFill: TBrush;
procedure SetFill(const Value: TBrush);
procedure SetNumberOfSides(const Value: Integer);
protected
{ Protected declarations }
procedure FillChangedNT(Sender: TObject); virtual;
procedure CreatePath;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function PointInObject(X, Y: Single): Boolean; override;
published
{ Published declarations }
property NumberOfSides: Integer read FNumberOfSides write SetNumberOfSides;
property Align;
property Anchors;
property ClipChildren default False;
property ClipParent default False;
property Cursor default crDefault;
property DesignVisible default True;
property DragMode default TDragMode.dmManual;
property EnableDragHighlight default True;
property Enabled default True;
//property Fill;
property Fill: TBrush read FFill write SetFill;
property Locked default False;
property Height;
property HitTest default True;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property StrokeThickness stored false;
property StrokeCap stored false;
property StrokeDash stored false;
property StrokeJoin stored false;
property Stroke;
property Visible default True;
property Width;
end;
procedure Register;
////////////////////////////////////////////////////////////////////////////////
implementation
procedure Register;
begin
RegisterComponents('Shape2', [TRegularPolygon]);
end;
{ TRegularPolygon }
constructor TRegularPolygon.Create(AOwner: TComponent);
begin
inherited;
FFill := TBrush.Create(TBrushKind.bkSolid, $FFE0E0E0);
FFill.OnChanged := FillChanged;
//FStroke := TStrokeBrush.Create(TBrushKind.bkSolid, $FF000000);
//FStroke.OnChanged := StrokeChanged;
FNumberOfSides := 3;
FPath := TPathData.Create;
end;
destructor TRegularPolygon.Destroy;
begin
//FStroke.Free;
FFill.Free;
FreeAndNil(FPath);
inherited;
end;
procedure TRegularPolygon.FillChangedNT(Sender: TObject);
begin
if FUpdating = 0 then
Repaint;
end;
procedure TRegularPolygon.SetFill(const Value: TBrush);
begin
FFill.Assign(Value);
end;
procedure TRegularPolygon.SetNumberOfSides(const Value: Integer);
begin
if (FNumberOfSides <> Value) and (Value >= 3) then
begin
FNumberOfSides := Value;
Repaint;
end;
end;
procedure TRegularPolygon.CreatePath;
procedure GoToAVertex(n: Integer; Angle, CircumRadius: Double;
IsLineTo: Boolean = True);
var
NewLocation: TPointF;
begin
NewLocation.X := Width / 2 + Cos(n * Angle) * CircumRadius;
NewLocation.Y := Height / 2 - Sin(n * Angle) * CircumRadius;
if IsLineTo then
FPath.LineTo(NewLocation)
else
FPath.MoveTo(NewLocation);
end;
var
i: Integer;
Angle, CircumRadius: Double;
begin
Angle := 2 * PI / FNumberOfSides;
CircumRadius := Min(ShapeRect.Width / 2, ShapeRect.Height / 2);
// Create a new Path
FPath.Clear;
// MoveTo the first point
GoToAVertex(0, Angle, CircumRadius, False);
// LineTo each Vertex
for i := 1 to FNumberOfSides do
GoToAVertex(i, Angle, CircumRadius);
FPath.ClosePath;
end;
procedure TRegularPolygon.Paint;
begin
CreatePath;
Canvas.FillPath(FPath, AbsoluteOpacity, FFill);
Canvas.DrawPath(FPath, AbsoluteOpacity);
//Canvas.DrawPath(FPath, AbsoluteOpacity, FStroke);
end;
function TRegularPolygon.PointInObject(X, Y: Single): Boolean;
begin
CreatePath;
Result := Canvas.PtInPath(AbsoluteToLocal(PointF(X, Y)), FPath);
end;
end.