FireMonkey2：为什么原始组件不响应Fill属性

时间：2013-10-08 01:36:38

标签： delphi-xe2 firemonkey-fm2

我已经从Embarcadero网站上的例子中创建了一个名为：TRegularPolygon的新组件。此组件在FM1（XE2）上运行良好，但在XE3及更高版本上，Fill.Color属性不响应。 在XE4和XE5的设计时，组件填充为黑色，在运行时，组件填充为白色。如果我们在运行程序上以编程方式更改fill.color属性，fill.color属性将起作用。该组件源自TShape。我试图与其他Tshape组件比较，如TRectangular和TCircle，这些组件在所有XEx版本中运行良好。

以下是组件的代码（对于XE5） - ＆gt; 

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.

1 个答案:

答案 0 :(得分：1)

I.ve找到了让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.
相关问题
最新问题