FireMonkey2：为什么原始组件不响应填充属性答案

【问题标题】：FireMonkey2: Why the primitive component do not respond to the Fill PropertyFireMonkey2：为什么原始组件不响应填充属性
【发布时间】：2013-10-08 01:36:37
【问题描述】：

我根据 Embarcadero 网站上的示例创建了一个名为：TRegularPolygon 的新组件。该组件在 FM1 (XE2) 上运行良好，但在 XE3 及更高版本上，Fill.Color 属性没有响应。在 XE4 和 XE5 的设计时，组件被填充为黑色，而在运行时，组件被填充为白色。如果我们在正在运行的程序上以编程方式更改 fill.color 属性，则 fill.color 属性会起作用。该组件源自 TShape。我尝试与 TRectangular 和 TCircle 等其他 Tshape 组件进行比较，这些组件在所有 XEx 版本中都运行良好。

这是组件的代码（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.

【问题讨论】：

标签： delphi-xe2 firemonkey-fm2

【解决方案1】：

我找到了一种让 Fill.color 属性工作的方法，我重新实现了 TShape 通常提供的 TBrush (FFill) 并更改了 Paint 过程的实现来自

Canvas.FillPath(FPath, AbsoluteOpacity);

到

Canvas.FillPath(FPath, AbsoluteOpacity, FFill);

这是新代码：

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.

【讨论】：