FMX TPath für SVG Patchen

[Rollo62]

Ich hatte mich auch schon gefragt, warum Embarcadero das wundervolle TPath nur halb implementiert hat.

Wo kommt denn das "GetPointFromString" her ?

Als Anregung habe ich mal versucht das etwas umzustellen und vieleicht etwas zu optimieren, ohne Gewähr.
Habe es nicht kompiliert und getestet, kannst Du ja vielleicht schnell mal probieren, wenn Du schon dabei bist.
Ich denke da sollte man noch einiges an Performance optimieren, gerade bei so einer wichtigen, zentralen Funktion.

Delphi-Quellcode:

function TPathData.LastPoint: TPointF;
begin
  if Count > 0 then
    Result := FPathData[FPathData.Count - 1].Point
  else
    Result := TPointF.Zero;
end;

procedure TPathData.QuadCurveTo(const ControlPoint, EndPoint: TPointF);
const
  OneThird = 1 / 3;
  TwoThirds = 2 / 3;
var
  LP: TPointF;
begin
  // Cache LastPoint as it might be computationally expensive if accessed frequently
  LP := LastPoint;
  CurveTo(
    TPointF.Create(OneThird * LP.X + TwoThirds * ControlPoint.X, OneThird * LP.Y + TwoThirds * ControlPoint.Y),
    TPointF.Create(TwoThirds * ControlPoint.X + OneThird * EndPoint.X, TwoThirds * ControlPoint.Y + OneThird * EndPoint.Y),
    EndPoint
  );
end;

procedure TPathData.QuadCurveToRel(const ControlPoint, EndPoint: TPointF);
var
  LP: TPointF;
begin
  // Cache LastPoint for efficiency
  LP := LastPoint;
  QuadCurveTo(LP + ControlPoint, LP + EndPoint);
end;

procedure TPathData.SmoothQuadCurveTo(const EndPoint: TPointF);
var
  ControlPoint1: TPointF;
begin
  // Count > 2 ensures enough data for a reflected control point.
  // This maintains path continuity.
  if Count > 2 then
    ControlPoint1 := LastPoint + (LastPoint - FPathData[FPathData.Count - 2].Point)
  else
    ControlPoint1 := LastPoint;
  QuadCurveTo(ControlPoint1, EndPoint);
end;

procedure TPathData.SmoothQuadCurveToRel(const EndPoint: TPointF);
var
  ControlPoint1: TPointF;
begin
  // Same logic as SmoothQuadCurveTo, but uses relative coordinates.
  if Count > 2 then
    ControlPoint1 := LastPoint + (LastPoint - FPathData[FPathData.Count - 2].Point)
  else
    ControlPoint1 := LastPoint;
  QuadCurveToRel(ControlPoint1, EndPoint);
end;

// Utility to simulate GetTokensFromString functionality
function GetTokensFromString(const S: string; var Pos: Integer): string;
var
  StartPos: Integer;
begin
  // Extract tokens starting from Pos
  StartPos := Pos;
  while (Pos <= Length(S)) and not S[Pos].IsWhiteSpace do
    Inc(Pos);
  Result := S.Substring(StartPos - 1, Pos - StartPos);
  while (Pos <= Length(S)) and S[Pos].IsWhiteSpace do
    Inc(Pos);
end;

procedure TPathData.SetPathString(const Value: string);
var
  PathString, Tokens: string;
  Radius, CurvePoint1, CurvePoint2, TempPoint: TPointF;
  Large, Sweet: Boolean;
  Pos, LastLength, Index: Integer;
  Angle: Single;
  Token: Char;
begin
  try
    // Replace unwanted characters efficiently using StringReplace
    PathString := StringReplace(StringReplace(StringReplace(Value, #9, ' ', [rfReplaceAll]), #10, ' ', [rfReplaceAll]), #13, ' ', [rfReplaceAll]);

    FPathData.Clear;
    Pos := 1;
    LastLength := -1;
    while (Length(PathString) >= Pos) and (LastLength <> Pos) do
    begin
      LastLength := Pos;

      //An index based operation is probably faster
      Tokens := GetTokensFromString(PathString, Pos); // Extract tokens

      Index := 1;
      while Index <= Length(Tokens) do
      begin
        Token := Tokens[Index];
        Inc(Index);
        case Token of
          'z', 'Z': ClosePath;
          'M', 'm', 'L', 'l', 'C', 'c', 'Q', 'q', 'T', 't':
            begin
              repeat
                case Token of
                  'M': MoveTo(GetPointFromString(PathString, Pos));
                  'm': MoveToRel(GetPointFromString(PathString, Pos));
                  'L': LineTo(GetPointFromString(PathString, Pos));
                  'l': LineToRel(GetPointFromString(PathString, Pos));
                  'C':
                    begin
                      CurvePoint1 := GetPointFromString(PathString, Pos);
                      CurvePoint2 := GetPointFromString(PathString, Pos);
                      CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
                    end;
                  'c':
                    begin
                      CurvePoint1 := GetPointFromString(PathString, Pos);
                      CurvePoint2 := GetPointFromString(PathString, Pos);
                      CurveToRel(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
                    end;
                  'Q':
                    begin
                      CurvePoint1 := GetPointFromString(PathString, Pos);
                      QuadCurveTo(CurvePoint1, GetPointFromString(PathString, Pos));
                    end;
                  'q':
                    begin
                      CurvePoint1 := GetPointFromString(PathString, Pos);
                      QuadCurveToRel(CurvePoint1, GetPointFromString(PathString, Pos));
                    end;
                  'T': SmoothQuadCurveTo(GetPointFromString(PathString, Pos));
                  't': SmoothQuadCurveToRel(GetPointFromString(PathString, Pos));
                end;
              until not HasRelativeOffset(PathString, Pos);
            end;
        end;
      end;
    end;
    DoChanged;
  except
    on E: Exception do
    begin
      raise;
    end;
  end;
end;

Zur Integration in den Designer, vielleicht reicht ein Interposer so oder ähnlich dazu aus, glaube ich aber nicht wirklich:

Delphi-Quellcode:

type
  TPathData = class(Vcl.Graphics.TPathData) // Interposer-Klasse
  private
    FPathString: string;
    procedure SetPathString(const Value: string);
    function GetPathString: string;
  published
    property PathString: string read GetPathString write SetPathString;
  end;

procedure TPathData.SetPathString(const Value: string);
begin
  FPathString := Value;
  inherited SetPathString(Value); // Originalmethode verwenden
end;

function TPathData.GetPathString: string;
begin
  Result := FPathString;
end;

Vielleicht funktioniert Obiges, oer zusammen mit einen eigenen Property Editor:

Delphi-Quellcode:

type
  TPathStringProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TPathStringProperty.Edit;
begin
  // Hier könnte ein eigener Dialog zur Bearbeitung geöffnet werden
end;

function TPathStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;


//

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(string), TPathData, 'PathString', TPathStringProperty);
end;

Ich meine aber, das TPath müsste zu tief verwurzelt sein, das könnte an zig Stellen krachen.