FMX bunte Polygone zeichnen

[philipp.hofmann]

Ich mache es mit folgendem Code (ist aber eine Vereinfachung, da meine Polygon-Form relativ fix ist):

Delphi-Quellcode:

unit SimplePolygon;

interface

uses
  System.Classes, System.Types, FMX.Objects, System.Math.Vectors;

type
  TSimplePolygon = class(TShape)
  private
    FPoints: TPolygon;
  protected
    procedure Paint; override;
  public
    heightEnd:single;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;

procedure Register;

implementation

uses MyLog;

procedure Register;
begin
  RegisterComponents('Shapes', [TSimplePolygon]);
end;

{ TSimpleTriangle }

constructor TSimplePolygon.Create(AOwner: TComponent);
begin
  inherited;
  SetLength(FPoints, 5);
end;

destructor TSimplePolygon.Destroy;
begin
  Finalize(FPoints);
  inherited;
end;

procedure TSimplePolygon.Paint;
var
  R: TRectF;
begin
  R := GetShapeRect;
  FPoints[0] := PointF(R.Left, R.Bottom);
  FPoints[1] := PointF(R.Left, R.Top);
  FPoints[2] := PointF(R.Right, R.Top-(heightEnd-height));
  FPoints[3] := PointF(R.Right, R.Bottom);
  FPoints[4] := PointF(R.Left, R.Bottom);
  Canvas.Fill.Assign(Self.Fill);
  Canvas.FillPolygon(FPoints, AbsoluteOpacity);
  Canvas.DrawPolygon(FPoints, AbsoluteOpacity);
end;

end.

Delphi-Quellcode:

            polygon:=TSimplePolygon.Create(self);
            polygon.Parent:=myRExercise;
            polygon.beginUpdate;
            polygon.Name:='RECT_'+IntToStr(i)+'_'+IntToStr(j)+'_'+IntToStr(k);
            polygon.OnClick:=btRectClick;
            polygon.Fill.Color:=myExercise.sequenceList[i].legList[k].getLegLevelColor();
            polygon.Stroke.Dash:=TStrokeDash.Solid;
            polygon.Stroke.Color:=TAlphaColors.Black;
            polygon.Stroke.Thickness:=1;
            polygon.Width:=width;
            polygon.Height:=height;
            polygon.HeightEnd:=heightEnd;
            polygon.Position.X:=lastX;
            polygon.Position.Y:=myRExercise.Height-polygon.Height;
            polygon.EndUpdate;