FMX TPath für SVG Patchen

[QuickAndDirty]

TPath aus FMX.Objects kann
von folgenden SVG Path commands

Code:

    MoveTo: M, m
    LineTo: L, l, H, h, V, v
    Cubic Bézier Curve: C, c, S, s
    Quadratic Bézier Curve: Q, q, T, t
    Elliptical Arc Curve: A, a
    ClosePath: Z, z

Quelle: https://developer.mozilla.org/en-US/...#path_commands

QqTt nicht.

Ich denke die Ursache ist, dass FMX.Graphics.TPathData.SetPathString alle PathCommands rendert außer eben QqTt...
'C' wird wie folgt gerendert:

Delphi-Quellcode:

'C':
begin
  CurvePoint1 := GetPointFromString(PathString, Pos);
  CurvePoint2 := GetPointFromString(PathString, Pos);
  CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
  while HasRelativeOffset(PathString, Pos) do
  begin
    CurvePoint1 := GetPointFromString(PathString, Pos);
    CurvePoint2 := GetPointFromString(PathString, Pos);
    CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
  end;
end;

wäre es dann richtig 'Q' ebenso zu rendern nur eben eben mit Curvepoint2 := Curvepoint1 ?

Delphi-Quellcode:

'Q':
begin
  CurvePoint1 := GetPointFromString(PathString, Pos);
  CurvePoint2 := CurvePoint1;
  CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
  while HasRelativeOffset(PathString, Pos) do
  begin
    CurvePoint1 := GetPointFromString(PathString, Pos);
    CurvePoint2 := CurvePoint1;
    CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
  end;
end;

Muss noch eine andere Stelle gepatched werden?

[Redeemer]

Siehe hier.

Ansonsten siehe Quelltext verschiedener SVG-Renderer für Delphi, z.B. meinen (RedeemerSVG).

[QuickAndDirty]

Es gibt FMX.Graphics.TPathData.QuadCurveTo(const ControlPoint, EndPoint: TPointF);
Wird irgendwie nur nicht verwendet.

Die sieht so aus für 'Q':

Delphi-Quellcode:

procedure TPathData.QuadCurveTo(const ControlPoint, EndPoint: TPointF);
const
  OneThird = 1 / 3;
  TwoThirds = 2 / 3;
var
  LP, CP1, CP2: TPointF;
begin
  LP := LastPoint;
  CP1.X := OneThird * LP.X + TwoThirds * ControlPoint.X;
  CP1.Y := OneThird * LP.Y + TwoThirds * ControlPoint.Y;
  CP2.X := TwoThirds * ControlPoint.X + OneThird * EndPoint.X;
  CP2.Y := TwoThirds * ControlPoint.Y + OneThird * EndPoint.Y;
  CurveTo(CP1, CP2, EndPoint);
end;

Ich habe dann mal darauf aufbauend folgende weitere methoden "abgeleitet":

Für 'q':

Delphi-Quellcode:

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

für 'T':

Delphi-Quellcode:

procedure TPathData.SmoothQuadCurveTo(const EndPoint: TPointF);                      
var                                                                                  
  ControlPoint1: TPointF;                                                            
begin                                                                                
  if Count > 2 then                                                                  
    ControlPoint1 := LastPoint + (LastPoint - FPathData[FPathData.Count - 2].Point)  
  else                                                                               
    ControlPoint1 := LastPoint;                                                      
  QuadCurveTo(ControlPoint1, EndPoint);                                              
end;

für 't':

Delphi-Quellcode:

procedure TPathData.SmoothQuadCurveToRel(const EndPoint: TPointF);                   
var                                                                                  
  ControlPoint1: TPointF;                                                            
begin                                                                                
  if Count > 2 then                                                                  
    ControlPoint1 := LastPoint + (LastPoint - FPathData[FPathData.Count - 2].Point)  
  else                                                                               
    ControlPoint1 := LastPoint;                                                      
  QuadCurveToRel(ControlPoint1, EndPoint);                                           
end;

Und dann entsprechend TPathData.SetPathString gepatcht

Delphi-Quellcode:

procedure TPathData.SetPathString(const Value: string);
var
  Builder, TokenBuilder: TStringBuilder;
  PathString, Tokens: string;
  Radius, CurvePoint1, CurvePoint2, TempPoint: TPointF;
  Large, Sweet: Boolean;
  Pos, I, LastLength: Integer;
  Angle: Single;
  Token: Char;
begin
  Builder := TStringBuilder.Create;
  TokenBuilder := TStringBuilder.Create;
  try
    for I := 0 to Value.Length - 1 do
    begin
      if Value.Chars[I].IsInArray([#9, #10, #13]) then
        Builder.Append(' ')
      else
        Builder.Append(Value.Chars[I]);
    end;
    PathString := Builder.ToString;
    FPathData.Clear;
    Pos := 0;
    LastLength := -1;
    while (Builder.Length > Pos) and (LastLength <> Pos) do
    begin
      LastLength := Pos;
      Tokens := GetTokensFromString(PathString, Pos);
      TokenBuilder.Clear;
      TokenBuilder.Append(Tokens);
      while TokenBuilder.Length > 0 do
      begin
        Token := TokenBuilder.Chars[0];
        TokenBuilder.Remove(0, 1);
        case Token of
          'z', 'Z':
            ClosePath;
          'M':
            begin
              MoveTo(GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
                LineTo(GetPointFromString(PathString, Pos));
            end;
          'm':
            begin
              MoveToRel(GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
                LineToRel(GetPointFromString(PathString, Pos));
            end;
          'L':
            begin
              LineTo(GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
                LineTo(GetPointFromString(PathString, Pos));
            end;
          'l':
            begin
              LineToRel(GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
                LineToRel(GetPointFromString(PathString, Pos));
            end;
          'C':
            begin
              CurvePoint1 := GetPointFromString(PathString, Pos);
              CurvePoint2 := GetPointFromString(PathString, Pos);
              CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint1 := GetPointFromString(PathString, Pos);
                CurvePoint2 := GetPointFromString(PathString, Pos);
                CurveTo(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
              end;
            end;
          'c':
            begin
              CurvePoint1 := GetPointFromString(PathString, Pos);
              CurvePoint2 := GetPointFromString(PathString, Pos);
              CurveToRel(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint1 := GetPointFromString(PathString, Pos);
                CurvePoint2 := GetPointFromString(PathString, Pos);
                CurveToRel(CurvePoint1, CurvePoint2, GetPointFromString(PathString, Pos));
              end;
            end;
          'S':
            begin
              CurvePoint2 := GetPointFromString(PathString, Pos);
              SmoothCurveTo(CurvePoint2, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint2 := GetPointFromString(PathString, Pos);
                SmoothCurveTo(CurvePoint2, GetPointFromString(PathString, Pos));
              end;
            end;
          's':
            begin
              CurvePoint2 := GetPointFromString(PathString, Pos);
              SmoothCurveToRel(CurvePoint2, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint2 := GetPointFromString(PathString, Pos);
                SmoothCurveToRel(CurvePoint2, GetPointFromString(PathString, Pos));
              end;
            end;
          'H':
            HLineTo(StrToFloat(GetNumberFromString(PathString, Pos), USFormatSettings));
          'h':
            HLineToRel(StrToFloat(GetNumberFromString(PathString, Pos), USFormatSettings));
          'V':
            VLineTo(StrToFloat(GetNumberFromString(PathString, Pos), USFormatSettings));
          'v':
            VLineToRel(StrToFloat(GetNumberFromString(PathString, Pos), USFormatSettings));
          'Q':  //A.R. //Quadratic Bezier Curve
            Begin
              CurvePoint1 := GetPointFromString(PathString, Pos);
              QuadCurveTo(CurvePoint1, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint1 := GetPointFromString(PathString, Pos);
                QuadCurveTo(CurvePoint1, GetPointFromString(PathString, Pos));
              end;
            End;
          'q':  //A.R. //Quadratic Bezier Curve
            begin
              CurvePoint1 := GetPointFromString(PathString, Pos);
              QuadCurveToRel(CurvePoint1, GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint1 := GetPointFromString(PathString, Pos);
                QuadCurveToRel(CurvePoint1, GetPointFromString(PathString, Pos));
              end;
            end;
          'T':  //A.R. //Smooth Quadratic Bezier Curve
            begin 
              SmoothQuadCurveTo(GetPointFromString(PathString, Pos));
              while HasRelativeOffset(PathString, Pos) do
                SmoothQuadCurveTo(GetPointFromString(PathString, Pos));
            end;
          't': //A.R. //Smooth Quadratic Bezier Curve 
            Begin  
              CurvePoint2 := GetPointFromString(PathString, Pos);
              SmoothCurveToRel(CurvePoint2, CurvePoint2);
              while HasRelativeOffset(PathString, Pos) do
              begin
                CurvePoint2 := GetPointFromString(PathString, Pos);
                SmoothCurveToRel(CurvePoint2, CurvePoint2);
              end;
            End;
          'A', 'a':
            begin
              if Count > 0 then
                CurvePoint1 := FPathData[FPathData.Count - 1].Point
              else
                CurvePoint1 := TPointF.Zero;
              Radius := GetPointFromString(PathString, Pos);
              Angle := StrToFloat(GetNumberFromString(PathString, Pos), USFormatSettings);
              TempPoint := GetPointFromString(PathString, Pos);
              Large := TempPoint.X = 1;
              Sweet := TempPoint.Y = 1;
              CurvePoint2 := GetPointFromString(PathString, Pos);
              if Token = 'a' then
                CurvePoint2 := CurvePoint1 + CurvePoint2;
              AddArcSvg(CurvePoint1, Radius, Angle, Large, Sweet, CurvePoint2);
            end;
        end;
      end;
    end;
    DoChanged;
  finally
    TokenBuilder.Free;
    Builder.Free;
  end;
end;

Dann geht das hier

Delphi-Quellcode:

Path2.Data.Data := 'M24,40'+
                     'Q23,40 22.3,39.3'+
                     'Q21.6,38.6 21.6,37.6'+
                     'Q21.6,36.6 22.3,35.9'+
                     'Q23,35.2 24,35.2'+
                     'Q25,35.2 25.7,35.9'+
                     'Q26.4,36.6 26.4,37.6'+
                     'Q26.4,38.6 25.7,39.3'+
                     'Q25,40 24,40'+
                     'Z'+
                     'M24,26.4'+
                     'Q23,26.4 22.3,25.7'+
                     'Q21.6,25 21.6,24'+
                     'Q21.6,23 22.3,22.3'+
                     'Q23,21.6 24,21.6'+
                     'Q25,21.6 25.7,22.3'+
                     'Q26.4,23 26.4,24'+
                     'Q26.4,25 25.7,25.7'+
                     'Q25,26.4 24,26.4'+
                     'Z'+
                     'M24,12.8'+
                     'Q23,12.8 22.3,12.1'+
                     'Q21.6,11.4 21.6,10.4'+
                     'Q21.6,9.4 22.3,8.7'+
                     'Q23,8 24,8'+
                     'Q25,8 25.7,8.7'+
                     'Q26.4,9.4 26.4,10.4'+
                     'Q26.4,11.4 25.7,12.1'+
                     'Q25,12.8 24,12.8'+
                     'Z';

Keine Ahnung wie man macht das es im Objekt Inspector oder zur designzeit schon funktioniert.

Probiert es aus , bitte. Und feedback oder direkt Verbesserungen!

[nursenight]

thanks for answer. It very useful for me
Snow Rider 3D

[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.

[TurboMagic]

Zitat von QuickAndDirty:

Es gibt FMX.Graphics.TPathData.QuadCurveTo(const ControlPoint, EndPoint: TPointF);
Wird irgendwie nur nicht verwendet.

Könnte man das als "feature request" samt deinem Code in qp.embarcadero.com erfassen?
Evtl. haben wir die Chance das direkt ins Produkt zu bekommen...