Eigene Komponente, Paint in FireMonkey überschreiben

[wurzelzwerg]

Schon ziemlich alt, vielleicht interessierts noch:

Delphi-Quellcode:

unit Pfeil;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  FMX.Types, FMX.Controls;

type
  TRichtung = (Links, Rechts, Unten, Oben);

type
  TPfeil = class(TControl)
  private
    { Private-Deklarationen }
    FRichtung: TRichtung;
    FVisible: Boolean;
    FColor: TAlphaColor;
    procedure SetRichtung(value: TRichtung);
    procedure SetColor(value: TAlphaColor);
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
  published
    { Published-Deklarationen }
    property Richtung: TRichtung read FRichtung write SetRichtung;
    property Color: TAlphaColor read FColor write SetColor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('AfwBackup', [TPfeil]);
end;

procedure TPfeil.SetColor(value: TAlphaColor);
begin
  if value <> FColor then
  begin
    FColor:= value;
    InvalidateRect(Self.BoundsRect);
  end;
end;

procedure TPfeil.SetRichtung(value: TRichtung);
begin
  if value <> FRichtung then
  begin
    FRichtung:= value;
    InvalidateRect(Self.BoundsRect);
  end;
end;

constructor TPfeil.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.Height:= 25;
  Self.Width:= 25;
  Self.FVisible:= true;
  Self.FColor:= claBlack;
  Self.FRichtung:= Links;
end;

procedure TPfeil.Paint;
var
  pol: TPolygon;
begin
  if Visible then
    with Self.Canvas do
    begin
      Stroke.Color:= FColor;
      Fill.Color:= FColor;
      Stroke.Kind:= TBrushKind.bkSolid;
      Fill.Kind:= TBrushKind.bkSolid;
      { Pfeil zeichnen }
      SetLength(pol, 3);
      case FRichtung of
        Links:
          begin
            pol[0]:= PointF(Self.Width, 0);
            pol[1]:= PointF(0, Self.Height / 2);
            pol[2]:= PointF(Self.Width, Self.Height);
          end;
        Rechts:
          begin
            pol[0]:= PointF(0, 0);
            pol[1]:= PointF(Self.Width / 2, Self.Height);
            pol[2]:= PointF(0, Self.Height);
          end;
        Unten:
          begin
            pol[0]:= PointF(0, 0);
            pol[1]:= PointF(Self.Width / 2, Self.Height);
            pol[2]:= PointF(Self.Width, 0);
          end;
        Oben:
          begin
            pol[0]:= PointF(0, Self.Height);
            pol[1]:= PointF(Self.Width / 2, 0);
            pol[2]:= PointF(Self.Width, Self.Height);
          end;
      end;

      DrawPolygon(pol, 1);
      SetLength(pol, 0);
    end;
end;

end.