delphi-xe2firemonkey-fm2

FireMonkey2: Why the primitive component do not respond to the Fill Property

I've created a new component named : TRegularPolygon from the exemple on the Embarcadero web site. This component work well on FM1 (XE2) but on XE3 and above, the Fill.Color property do not respond. At design-time in XE4 and XE5 the component is filled black and in run-time the component is filled in white. If we change the fill.color property programatically on the running program, the fill.color property work. This component is derivated from TShape. I've tried to compare with other Tshape components like TRectangular and TCircle and those components work well in all XEx version.

Here is the code of the component (for XE5) -->

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;
    procedure SetNumberOfSides(const Value: Integer);

  protected
    { Protected declarations }
    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 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;
  FNumberOfSides := 3;
  FPath := TPathData.Create;
end;

destructor TRegularPolygon.Destroy;
begin
  FreeAndNil(FPath);
  inherited;
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);
  Canvas.DrawPath(FPath, AbsoluteOpacity);
  //Canvas.FillRect(R, XRadius, YRadius, FCorners, AbsoluteOpacity, FFill, CornerType);
  //Canvas.DrawRect(R, XRadius, YRadius, FCorners, AbsoluteOpacity, FStroke, CornerType);
end;

function TRegularPolygon.PointInObject(X, Y: Single): Boolean;
begin
  CreatePath;
  Result := Canvas.PtInPath(AbsoluteToLocal(PointF(X, Y)), FPath);
end;

end.
Solution

  • 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.