mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
1912 lines
56 KiB
ObjectPascal
1912 lines
56 KiB
ObjectPascal
unit Img32.SVG.Path;
|
|
|
|
(*******************************************************************************
|
|
* Author : Angus Johnson *
|
|
* Version : 4.7 *
|
|
* Date : 6 January 2025 *
|
|
* Website : http://www.angusj.com *
|
|
* Copyright : Angus Johnson 2019-2025 *
|
|
* *
|
|
* Purpose : Essential structures and functions to read SVG Path elements *
|
|
* *
|
|
* License : Use, modification & distribution is subject to *
|
|
* Boost Software License Ver 1 *
|
|
* http://www.boost.org/LICENSE_1_0.txt *
|
|
*******************************************************************************)
|
|
|
|
interface
|
|
|
|
{$I Img32.inc}
|
|
|
|
uses
|
|
SysUtils, Classes, Types, Math,
|
|
{$IFDEF XPLAT_GENERICS} Generics.Collections, Generics.Defaults,{$ENDIF}
|
|
Img32, Img32.SVG.Core, Img32.Vector, Img32.Text;
|
|
|
|
{$IFDEF ZEROBASEDSTR}
|
|
{$ZEROBASEDSTRINGS OFF}
|
|
{$ENDIF}
|
|
|
|
type
|
|
|
|
TSvgPathSegType =
|
|
(stUnknown, stMove, stLine, stHorz, stVert, stArc,
|
|
stQBezier, stCBezier, stQSpline, stCSpline, stClose);
|
|
|
|
TArcInfo = record
|
|
rec : TRectD;
|
|
startPos : TPointD;
|
|
endPos : TPointD;
|
|
rectAngle : double;
|
|
sweepClockW : Boolean;
|
|
end;
|
|
TArcInfos = array of TArcInfo;
|
|
|
|
TSvgPath = class;
|
|
TSvgSubPath = class;
|
|
|
|
TSvgPathSeg = class
|
|
private
|
|
fParent : TSvgSubPath;
|
|
fOwner : TSvgPath;
|
|
fIdx : integer;
|
|
fFirstPt : TPointD;
|
|
fFlatPath : TPathD;
|
|
fSegType : TSvgPathSegType;
|
|
fCtrlPts : TPathD;
|
|
fExtend : integer;
|
|
protected
|
|
procedure Changed; {$IFDEF INLINE} inline; {$ENDIF}
|
|
procedure RequireFlattened; virtual;
|
|
function GetFlattened: TPathD; overload;
|
|
procedure GetFlattened2(var Result: TPathD); overload;
|
|
procedure GetFlattenedInternal; virtual; abstract;
|
|
procedure Scale(value: double); virtual;
|
|
function DescaleAndOffset(const pt: TPointD): TPointD; overload;
|
|
function DescaleAndOffset(const p: TPathD): TPathD; overload;
|
|
procedure SetCtrlPts(const pts: TPathD); virtual;
|
|
public
|
|
constructor Create(parent: TSvgSubPath;
|
|
idx: integer; const firstPt : TPointD); virtual;
|
|
function GetCtrlBounds: TRectD; virtual;
|
|
function GetOnPathCtrlPts: TPathD; virtual;
|
|
procedure Offset(dx, dy: double); virtual;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; virtual;
|
|
function ExtendSeg(const pts: TPathD): Boolean; virtual;
|
|
|
|
property Parent : TSvgSubPath read fParent;
|
|
property Owner : TSvgPath read fOwner;
|
|
property CtrlPts : TPathD read fCtrlPts write SetCtrlPts;
|
|
property FirstPt : TPointD read fFirstPt;
|
|
property FlatPath : TPathD read GetFlattened;
|
|
property Index : integer read fIdx;
|
|
property SegType : TSvgPathSegType read fSegType;
|
|
end;
|
|
|
|
TSvgStraightSeg = class(TSvgPathSeg)
|
|
protected
|
|
procedure GetFlattenedInternal; override;
|
|
end;
|
|
|
|
TSvgCurvedSeg = class(TSvgPathSeg)
|
|
protected
|
|
pendingScale: double;
|
|
procedure RequireFlattened; override;
|
|
function GetPreviousCtrlPt: TPointD;
|
|
public
|
|
function GetLastCtrlPt: TPointD; virtual;
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
end;
|
|
|
|
TSvgASegment = class(TSvgCurvedSeg)
|
|
private
|
|
fRectTop : Boolean;
|
|
fRectLeft : Boolean;
|
|
fArcInfo : TArcInfo;
|
|
procedure SetArcInfo(ai: TArcInfo);
|
|
procedure GetRectBtnPoints(out pt1, pt2, pt3: TPointD);
|
|
procedure SetCtrlPtsFromArcInfo;
|
|
protected
|
|
procedure SetCtrlPts(const ctrlPts: TPathD); override;
|
|
procedure GetFlattenedInternal; override;
|
|
procedure Scale(value: double); override;
|
|
public
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
procedure Offset(dx, dy: double); override;
|
|
procedure ReverseArc;
|
|
function GetStartAngle: double;
|
|
function GetEndAngle: double;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
property ArcInfo: TArcInfo read fArcInfo write SetArcInfo;
|
|
property IsLeftCtrl: Boolean read fRectLeft;
|
|
property IsTopCtrl: Boolean read fRectTop;
|
|
end;
|
|
|
|
TSvgCSegment = class(TSvgCurvedSeg)
|
|
protected
|
|
procedure GetFlattenedInternal; override;
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetOnPathCtrlPts: TPathD; override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgHSegment = class(TSvgStraightSeg)
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgLSegment = class(TSvgStraightSeg)
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgQSegment = class(TSvgCurvedSeg)
|
|
protected
|
|
procedure GetFlattenedInternal; override;
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetOnPathCtrlPts: TPathD; override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgSSegment = class(TSvgCurvedSeg)
|
|
protected
|
|
procedure GetFlattenedInternal; override;
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetOnPathCtrlPts: TPathD; override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgTSegment = class(TSvgCurvedSeg)
|
|
protected
|
|
procedure GetFlattenedInternal; override;
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetLastCtrlPt: TPointD; override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgVSegment = class(TSvgStraightSeg)
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgZSegment = class(TSvgStraightSeg)
|
|
public
|
|
constructor Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD); override;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
|
|
end;
|
|
|
|
TSvgSegmentClass = class of TSvgPathSeg;
|
|
|
|
TSvgSubPath = class
|
|
private
|
|
fParent : TSvgPath;
|
|
fSegs : array of TSvgPathSeg;
|
|
fPendingScale : double;
|
|
fPathOffset : TPointD;
|
|
fSegsCount : integer;
|
|
function GetCount: integer;
|
|
function GetSeg(index: integer): TSvgPathSeg;
|
|
function AddSeg(segType: TSvgPathSegType;
|
|
const startPt: TPointD; const pts: TPathD): TSvgPathSeg;
|
|
protected
|
|
procedure GrowSegs;
|
|
procedure SegsLoaded;
|
|
procedure InitSegs(Capacity: Integer);
|
|
public
|
|
isClosed : Boolean;
|
|
constructor Create(parent: TSvgPath);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Offset(dx, dy: double);
|
|
function GetFirstPt: TPointD;
|
|
function GetLastPt: TPointD;
|
|
function GetBounds: TRectD;
|
|
|
|
function AddASeg(const startPt, endPt: TPointD; const rect: TRectD;
|
|
angle: double; isClockwise: Boolean): TSvgASegment;
|
|
function AddCSeg(const startPt: TPointD; const pts: TPathD): TSvgCSegment;
|
|
function AddHSeg(const startPt: TPointD; const pts: TPathD): TSvgHSegment;
|
|
function AddLSeg(const startPt: TPointD; const pts: TPathD): TSvgLSegment;
|
|
function AddQSeg(const startPt: TPointD; const pts: TPathD): TSvgQSegment;
|
|
function AddSSeg(const startPt: TPointD; const pts: TPathD): TSvgSSegment;
|
|
function AddTSeg(const startPt: TPointD; const pts: TPathD): TSvgTSegment;
|
|
function AddVSeg(const startPt: TPointD; const pts: TPathD): TSvgVSegment;
|
|
function AddZSeg(const endPt, firstPt: TPointD): TSvgZSegment;
|
|
|
|
function GetLastSeg: TSvgPathSeg;
|
|
function DeleteLastSeg: Boolean;
|
|
//pendingScale: allows 'flattening' to occur with curve precision
|
|
//that will accommodate future (anticipated) scaling.
|
|
//Eg: a native image is 32x32 px but will be displayed at 512x512,
|
|
//so pendingScale should be 16 to ensure a smooth curve
|
|
function GetFlattenedPath(pendingScale: double = 1.0): TPathD;
|
|
//GetSimplePath - only used for markers
|
|
function GetSimplePath: TPathD;
|
|
function GetMoveStrDef(relative: Boolean; decimalPrec: integer): string;
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
property Count : integer read GetCount;
|
|
property Parent : TSvgPath read fParent;
|
|
property PathOffset : TPointD read fPathOffset;
|
|
property Seg[index: integer]: TSvgPathSeg read GetSeg; default;
|
|
end;
|
|
|
|
TSvgPath = class
|
|
private
|
|
fPathScale : double;
|
|
fPathOffs : TPointD;
|
|
fSubPaths: array of TSvgSubPath;
|
|
function GetPath(index: integer): TSvgSubPath;
|
|
function GetBounds: TRectD;
|
|
function GetControlBounds: TRectD;
|
|
function GetCount: integer;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Parse(const value: UTF8String);
|
|
procedure ScaleAndOffset(scale: double; dx, dy: integer);
|
|
function GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
|
|
function AddPath(SegsCapacity: Integer = 0): TSvgSubPath;
|
|
procedure DeleteSubPath(subPath: TSvgSubPath);
|
|
property Bounds: TRectD read GetBounds;
|
|
property CtrlBounds: TRectD read GetControlBounds;
|
|
property Count: integer read GetCount;
|
|
property Path[index: integer]: TSvgSubPath read GetPath; default;
|
|
property Scale: double read fPathScale;
|
|
property Offset : TPointD read fPathOffs;
|
|
end;
|
|
|
|
UTF8Strings = array of UTF8String;
|
|
|
|
function GetSvgArcInfoRect(const p1, p2: TPointD;
|
|
radii: TPointD; phi_rads: double; fA, fS: boolean): TRectD;
|
|
|
|
implementation
|
|
|
|
resourcestring
|
|
rsSvgPathRangeError = 'TSvgPath.GetPath range error';
|
|
rsSvgSubPathRangeError = 'TSvgSubPath.GetSeg range error';
|
|
|
|
//------------------------------------------------------------------------------
|
|
// Miscellaneous functions ...
|
|
//------------------------------------------------------------------------------
|
|
|
|
function CheckPathLen(const p: TPathD; modLength: integer): TPathD;
|
|
var
|
|
i, len: integer;
|
|
begin
|
|
Result := nil;
|
|
len := Length(p);
|
|
if (len < modLength) then Exit;
|
|
Result := p;
|
|
i := len mod modLength;
|
|
SetLength(Result, len -i);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TrimTrailingZeros(const floatValStr: string): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := floatValStr;
|
|
if Pos('.', floatValStr) = 0 then Exit;
|
|
i := Length(Result);
|
|
while Result[i] = '0' do dec(i);
|
|
if Result[i] = '.' then dec(i);
|
|
SetLength(Result, i);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function AsIntStr(val: double): string;
|
|
begin
|
|
Result := Format('%1.0n ', [val]);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function AsFloatStr(val: double; precision: integer): string;
|
|
begin
|
|
Result := TrimTrailingZeros(Format('%1.*f', [precision, val]));
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function AsCoordStr(pt: TPointD;
|
|
const relPt: TPointD; relative: Boolean; precision: integer): string;
|
|
var
|
|
s1, s2: string;
|
|
begin
|
|
if relative then
|
|
begin
|
|
pt.X := pt.X - relPt.X;
|
|
pt.Y := pt.Y - relPt.Y;
|
|
end;
|
|
s1 := TrimTrailingZeros(Format('%1.*f', [precision, pt.x]));
|
|
s2 := TrimTrailingZeros(Format('%1.*f', [precision, pt.y]));
|
|
Result := s1 + ',' + s2 + ' ';
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function GetSingleDigit(var c, endC: PUTF8Char;
|
|
out digit: integer): Boolean;
|
|
var
|
|
cc: PUTF8Char;
|
|
ch: UTF8Char;
|
|
begin
|
|
cc := SkipBlanksAndComma(c, endC);
|
|
Result := cc < endC;
|
|
if not Result then
|
|
begin
|
|
c := cc;
|
|
Exit;
|
|
end;
|
|
ch := cc^;
|
|
Result := (ch >= '0') and (ch <= '9');
|
|
if not Result then Exit;
|
|
digit := Ord(ch) - Ord('0');
|
|
c := cc + 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
const
|
|
SegTypeMap: array['A'..'Z'] of TSvgPathSegType = (
|
|
stArc, // A
|
|
stUnknown, // B
|
|
stCBezier, // C
|
|
stUnknown, // D
|
|
stUnknown, // E
|
|
stUnknown, // F
|
|
stUnknown, // G
|
|
stHorz, // H
|
|
stUnknown, // I
|
|
stUnknown, // J
|
|
stUnknown, // K
|
|
stLine, // L
|
|
stMove, // M
|
|
stUnknown, // N
|
|
stUnknown, // O
|
|
stUnknown, // P
|
|
stQBezier, // Q
|
|
stUnknown, // R
|
|
stCSpline, // S
|
|
stQSpline, // T
|
|
stUnknown, // U
|
|
stVert, // V
|
|
stUnknown, // W
|
|
stUnknown, // X
|
|
stUnknown, // Y
|
|
stClose // Z
|
|
);
|
|
|
|
function GetSegType(var c, endC: PUTF8Char; out isRelative: Boolean): TSvgPathSegType;
|
|
var
|
|
ch: UTF8Char;
|
|
begin
|
|
Result := stUnknown;
|
|
if not SkipBlanks(c, endC) then Exit;
|
|
ch := c^;
|
|
case ch of
|
|
'a'..'z': Result := SegTypeMap[UTF8Char(Byte(ch) and not $20)];
|
|
'A'..'Z': Result := SegTypeMap[ch];
|
|
end;
|
|
if Result = stUnknown then Exit;
|
|
isRelative := ch >= 'a';
|
|
inc(c);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function Parse2Num(var c, endC: PUTF8Char;
|
|
out pt: TPointD; const relPt: TPointD): Boolean;
|
|
begin
|
|
Result := ParseNextNum(c, endC, true, pt.X) and
|
|
ParseNextNum(c, endC, true, pt.Y);
|
|
if not Result or (relPt.X = InvalidD) then Exit;
|
|
pt.X := pt.X + relPt.X;
|
|
pt.Y := pt.Y + relPt.Y;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function Parse1Num(var c: PUTF8Char; endC: PUTF8Char;
|
|
out val: double; relVal: double): Boolean;
|
|
begin
|
|
Result := ParseNextNum(c, endC, true, val);
|
|
if Result and (relVal <> InvalidD) then
|
|
val := val + relVal;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgPathSeg
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgPathSeg.Create(parent: TSvgSubPath;
|
|
idx: integer; const firstPt : TPointD);
|
|
begin
|
|
Self.fParent := parent;
|
|
Self.fOwner := parent.fParent;
|
|
Self.fIdx := idx;
|
|
Self.fFirstPt := firstPt;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPathSeg.Scale(value: double);
|
|
begin
|
|
if (value <> 0) and (value <> 1) then
|
|
begin
|
|
fCtrlPts := ScalePath(fCtrlPts, value);
|
|
fFirstPt := ScalePoint(fFirstPt, value);
|
|
Changed;
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.DescaleAndOffset(const pt: TPointD): TPointD;
|
|
begin
|
|
Result := TranslatePoint(pt, -parent.PathOffset.X, -parent.PathOffset.Y);
|
|
Result := ScalePoint(Result, 1/Owner.Scale);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.DescaleAndOffset(const p: TPathD): TPathD;
|
|
begin
|
|
Result := TranslatePath(p, -parent.PathOffset.X, -parent.PathOffset.Y);
|
|
Result := ScalePath(Result, 1/Owner.Scale);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPathSeg.Offset(dx, dy: double);
|
|
begin
|
|
fFirstPt := TranslatePoint(fFirstPt, dx, dy);
|
|
fCtrlPts := TranslatePath(fCtrlPts, dx, dy);
|
|
Changed;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPathSeg.SetCtrlPts(const pts: TPathD);
|
|
begin
|
|
fCtrlPts := pts;
|
|
Changed;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.ExtendSeg(const pts: TPathD): Boolean;
|
|
var
|
|
len: integer;
|
|
begin
|
|
len := Length(pts);
|
|
Result := (len <> 0) and (fExtend <> 0) and (len mod fExtend = 0);
|
|
if Result then ConcatPaths(fCtrlPts, pts);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.GetCtrlBounds: TRectD;
|
|
begin
|
|
Result := GetBoundsD(PrePendPoint(fFirstPt, CtrlPts));
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPathSeg.Changed;
|
|
begin
|
|
if fFlatPath <> nil then
|
|
fFlatPath := nil; // DynArrayClear
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
procedure TSvgPathSeg.RequireFlattened;
|
|
begin
|
|
if fFlatPath = nil then
|
|
GetFlattenedInternal;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
function TSvgPathSeg.GetFlattened: TPathD;
|
|
begin
|
|
RequireFlattened;
|
|
Result := fFlatPath;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPathSeg.GetFlattened2(var Result: TPathD);
|
|
begin // uses less DynArrayAsg and DynArrayClear calls
|
|
RequireFlattened;
|
|
Result := fFlatPath;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.GetOnPathCtrlPts: TPathD;
|
|
begin
|
|
Result := fCtrlPts;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPathSeg.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgStraightSeg
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgStraightSeg.GetFlattenedInternal;
|
|
begin
|
|
PrePendPoint(fFirstPt, fCtrlPts, fFlatPath);
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgCurvedSeg
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgCurvedSeg.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
pendingScale := 1.0;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgCurvedSeg.RequireFlattened;
|
|
begin
|
|
//if the image has been rendered previously at a lower resolution, then
|
|
//redo the flattening otherwise curves my look very rough.
|
|
if (pendingScale < Parent.fPendingScale) then
|
|
begin
|
|
pendingScale := Parent.fPendingScale;
|
|
Changed;
|
|
end;
|
|
inherited RequireFlattened;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgCurvedSeg.GetLastCtrlPt: TPointD;
|
|
begin
|
|
Result := CtrlPts[High(CtrlPts) -1];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgCurvedSeg.GetPreviousCtrlPt: TPointD;
|
|
var
|
|
UseParentLastCtrlPt: Boolean;
|
|
begin
|
|
UseParentLastCtrlPt := False;
|
|
if fIdx > 0 then
|
|
begin
|
|
case fSegType of
|
|
stQSpline:
|
|
case fParent[fIdx -1].fSegType of
|
|
stQBezier, stQSpline: UseParentLastCtrlPt := True;
|
|
end;
|
|
stCSpline:
|
|
case fParent[fIdx -1].fSegType of
|
|
stCBezier, stCSpline: UseParentLastCtrlPt := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if UseParentLastCtrlPt then
|
|
Result := TSvgCurvedSeg(fParent[fIdx -1]).GetLastCtrlPt
|
|
else
|
|
Result := fFirstPt;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgASegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgASegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stArc;
|
|
fExtend := 0;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.SetArcInfo(ai: TArcInfo);
|
|
var
|
|
dx, dy: double;
|
|
begin
|
|
//make sure that all the ai fields are valid,
|
|
//otherwise adjust them and align with ai.startpos
|
|
with fArcInfo do
|
|
begin
|
|
rec := ai.rec;
|
|
rectAngle := ai.rectAngle;
|
|
startPos := GetClosestPtOnRotatedEllipse(rec, rectAngle, ai.startPos);
|
|
endPos := GetClosestPtOnRotatedEllipse(rec, rectAngle, ai.endPos);
|
|
sweepClockW := ai.sweepClockW;
|
|
if not PointsNearEqual(ai.startPos, startPos, 0.01) then
|
|
begin
|
|
dx := ai.startPos.X - startPos.X;
|
|
dy := ai.startPos.Y - startPos.Y;
|
|
TranslateRect(rec, dx, dy);
|
|
startPos := ai.startPos;
|
|
endPos := TranslatePoint(endPos, dx, dy);
|
|
end;
|
|
end;
|
|
SetCtrlPtsFromArcInfo;
|
|
Changed;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.GetRectBtnPoints(out pt1, pt2, pt3: TPointD);
|
|
var
|
|
d : double;
|
|
pt, sp : TPointD;
|
|
begin
|
|
with fArcInfo do
|
|
begin
|
|
//keep rec oriented to the XY axis and rotate startpos
|
|
sp := startPos;
|
|
pt2 := rec.MidPoint;
|
|
|
|
if rectAngle <> 0 then
|
|
RotatePoint(sp, pt2, -rectAngle);
|
|
|
|
pt := PointD(rec.Left, pt2.Y);
|
|
pt3 := PointD(rec.Right, pt2.Y);
|
|
|
|
d := DistanceSqrd(pt, sp) - DistanceSqrd(pt3, sp);
|
|
if not ValueAlmostZero(d, 0.01) then
|
|
fRectLeft := d > 0;
|
|
if fRectLeft then
|
|
pt1 := PointD(rec.Left, pt2.Y) else
|
|
pt1 := PointD(rec.Right, pt2.Y);
|
|
|
|
pt := PointD(pt2.X, rec.Top);
|
|
pt3 := PointD(pt2.X, rec.Bottom);
|
|
d := DistanceSqrd(pt, sp) - DistanceSqrd(pt3, sp);
|
|
if not ValueAlmostZero(d, 0.01) then fRectTop := d > 0;
|
|
if fRectTop then
|
|
pt3 := PointD(pt2.X, rec.Top) else
|
|
pt3 := PointD(pt2.X, rec.Bottom);
|
|
|
|
RotatePoint(pt1, pt2, rectAngle);
|
|
RotatePoint(pt3, pt2, rectAngle);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.SetCtrlPtsFromArcInfo;
|
|
begin
|
|
NewPointDArray(fCtrlPts, 5, True);
|
|
with fArcInfo do
|
|
begin
|
|
fCtrlPts[0] := startPos;
|
|
GetRectBtnPoints(fCtrlPts[1], fCtrlPts[2], fCtrlPts[3]);
|
|
fCtrlPts[4] := endPos;
|
|
end;
|
|
Changed;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.GetFlattenedInternal;
|
|
var
|
|
a1,a2: double;
|
|
p: TPathD;
|
|
begin
|
|
fFlatPath := nil;
|
|
with fArcInfo do
|
|
begin
|
|
a1 := GetStartAngle;
|
|
a2 := GetEndAngle;
|
|
if not sweepClockW then
|
|
begin
|
|
p := Arc(rec, a2, a1, pendingScale);
|
|
p := ReversePath(p);
|
|
end else
|
|
p := Arc(rec, a1, a2, pendingScale);
|
|
if rectAngle <> 0 then
|
|
p := RotatePath(p, rec.MidPoint, rectAngle);
|
|
ConcatPaths(fFlatPath, p);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgASegment.GetStartAngle: double;
|
|
begin
|
|
with fArcInfo do
|
|
Result := GetRotatedEllipticalAngleFromPoint(rec, rectAngle, startPos);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgASegment.GetEndAngle: double;
|
|
begin
|
|
with fArcInfo do
|
|
Result := GetRotatedEllipticalAngleFromPoint(rec, rectAngle, endPos);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.ReverseArc;
|
|
begin
|
|
fArcInfo.sweepClockW := not fArcInfo.sweepClockW;
|
|
Changed;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.Offset(dx, dy: double);
|
|
begin
|
|
inherited; // calls Changed
|
|
with fArcInfo do
|
|
begin
|
|
TranslateRect(rec, dx, dy);
|
|
startPos := TranslatePoint(startPos, dx, dy);
|
|
endPos := TranslatePoint(endPos, dx, dy);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.Scale(value: Double);
|
|
begin
|
|
if (value = 0) or (value = 1) then Exit;
|
|
inherited; // calls Changed
|
|
with fArcInfo do
|
|
begin
|
|
rec := ScaleRect(rec, value);
|
|
startPos := ScalePoint(startPos, value);
|
|
endPos := ScalePoint(endPos, value);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgASegment.SetCtrlPts(const ctrlPts: TPathD);
|
|
begin
|
|
//SetCtrlPtsFromArcInfo; // calls Changed
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgASegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
a, a1,a2: double;
|
|
sp, ep: TPointD;
|
|
begin
|
|
with fArcInfo do
|
|
begin
|
|
if relative then Result := 'a ' else Result := 'A ';
|
|
|
|
Result := Result +
|
|
AsFloatStr(rec.Width *0.5 /Owner.Scale, decimalPrec) + ',';
|
|
Result := Result +
|
|
AsFloatStr(rec.Height *0.5 /Owner.Scale, decimalPrec) + ' ';
|
|
//angle as degrees
|
|
Result := Result + AsIntStr(RadToDeg(rectAngle));
|
|
|
|
a1 := GetStartAngle;
|
|
a2 := GetEndAngle;
|
|
|
|
//large arce and direction flags
|
|
a := a2 - a1;
|
|
if a < 0 then a := a + angle360;
|
|
|
|
if sweepClockW then
|
|
begin
|
|
if a >= angle180 then
|
|
Result := Result + '1 1 ' else
|
|
Result := Result + '0 1 ';
|
|
end else
|
|
begin
|
|
if a >= angle180 then
|
|
Result := Result + '0 0 ' else
|
|
Result := Result + '1 0 ';
|
|
end;
|
|
//descaled and de-offset end position
|
|
ep := DescaleAndOffset(endPos);
|
|
sp := DescaleAndOffset(startPos);
|
|
Result := Result + AsCoordStr(ep, sp, relative, decimalPrec);
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgCSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgCSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stCBezier;
|
|
fExtend := 3;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgCSegment.GetOnPathCtrlPts: TPathD;
|
|
var
|
|
i, len: integer;
|
|
begin
|
|
len := Length(fCtrlPts) div 3;
|
|
NewPointDArray(Result, len, True);
|
|
for i := 0 to High(Result) do
|
|
Result[i] := fCtrlPts[i*3 +2];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgCSegment.GetFlattenedInternal;
|
|
var
|
|
bt : double;
|
|
p: TPathD;
|
|
begin
|
|
bt := BezierTolerance / pendingScale;
|
|
p := CheckPathLen(fCtrlPts, 3);
|
|
if p = nil then
|
|
fFlatPath := nil else
|
|
fFlatPath := FlattenCBezier(fFirstPt, p, bt);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgCSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then Result := 'c ' else Result := 'C ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt:= DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
|
|
if relative and (i mod 3 = 2) then relPt := pt;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgHSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgHSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stHorz;
|
|
fExtend := 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgHSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then
|
|
begin
|
|
Result := 'h ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsFloatStr(pt.X - relPt.X, decimalPrec) + ' ';
|
|
relPt := pt;
|
|
end;
|
|
end else
|
|
begin
|
|
Result := 'H ';
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsFloatStr(pt.X, decimalPrec) + ' ';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgLSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgLSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stLine;
|
|
fExtend := 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgLSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then Result := 'l ' else Result := 'L ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt:= DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
|
|
relPt := pt;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgQSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgQSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stQBezier;
|
|
fExtend := 2;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgQSegment.GetOnPathCtrlPts: TPathD;
|
|
var
|
|
i, len: integer;
|
|
begin
|
|
len := Length(fCtrlPts) div 2;
|
|
NewPointDArray(Result, len, True);
|
|
for i := 0 to High(Result) do
|
|
Result[i] := fCtrlPts[i*2+1];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgQSegment.GetFlattenedInternal;
|
|
var
|
|
bt : double;
|
|
p: TPathD;
|
|
begin
|
|
bt := BezierTolerance / pendingScale;
|
|
p := CheckPathLen(fCtrlPts, 2);
|
|
if p = nil then
|
|
fFlatPath := nil else
|
|
fFlatPath := FlattenQBezier(fFirstPt, fCtrlPts, bt);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgQSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then Result := 'q ' else Result := 'Q ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
|
|
if (i mod 2) = 1 then relPt := pt;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgSSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgSSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stCSpline;
|
|
fExtend := 2;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSSegment.GetFlattenedInternal;
|
|
var
|
|
bt : double;
|
|
p: TPathD;
|
|
begin
|
|
bt := BezierTolerance / pendingScale;
|
|
p := CheckPathLen(fCtrlPts, 2);
|
|
if p = nil then
|
|
fFlatPath := nil else
|
|
fFlatPath := FlattenCSpline(GetPreviousCtrlPt, fFirstPt, fCtrlPts, bt);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSSegment.GetOnPathCtrlPts: TPathD;
|
|
var
|
|
i, len: integer;
|
|
begin
|
|
len := Length(fCtrlPts) div 2;
|
|
NewPointDArray(Result, len, True);
|
|
for i := 0 to High(Result) do
|
|
Result[i] := fCtrlPts[i*2+1];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then Result := 's ' else Result := 'S ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
|
|
if relative and (i mod 2 = 1) then relPt := pt;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgTSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgTSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stQSpline;
|
|
fExtend := 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgTSegment.GetFlattenedInternal;
|
|
var
|
|
bt: double;
|
|
begin
|
|
bt := BezierTolerance / pendingScale;
|
|
if fCtrlPts = nil then
|
|
fFlatPath := nil else
|
|
fFlatPath := FlattenQSpline(GetPreviousCtrlPt, fFirstPt, fCtrlPts, bt);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgTSegment.GetLastCtrlPt: TPointD;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := ReflectPoint(GetPreviousCtrlPt, fFirstPt);
|
|
for i := 0 to High(CtrlPts) -1 do
|
|
Result := ReflectPoint(Result, CtrlPts[i]);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
|
|
function TSvgTSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then Result := 't ' else Result := 'T ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
|
|
if relative then relPt := pt;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgVSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgVSegment.Create(parent: TSvgSubPath; idx: integer;
|
|
const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stVert;
|
|
fExtend := 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgVSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
pt, relPt: TPointD;
|
|
begin
|
|
if relative then
|
|
begin
|
|
Result := 'v ';
|
|
relPt := DescaleAndOffset(fFirstPt);
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsFloatStr(pt.Y - relPt.Y, decimalPrec) + ' ';
|
|
relPt := pt;
|
|
end;
|
|
end else
|
|
begin
|
|
Result := 'V ';
|
|
for i := 0 to High(fCtrlPts) do
|
|
begin
|
|
pt := DescaleAndOffset(fCtrlPts[i]);
|
|
Result := Result + AsFloatStr(pt.Y, decimalPrec) + ' ';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgZSegment
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgZSegment.Create(parent: TSvgSubPath;
|
|
idx: integer; const firstPt : TPointD);
|
|
begin
|
|
inherited;
|
|
fSegType := stClose;
|
|
fExtend := 0;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgZSegment.GetStringDef(relative: Boolean;
|
|
decimalPrec: integer): string;
|
|
begin
|
|
Result := 'Z ';
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgSubPath
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetFlattenedPath(pendingScale: double): TPathD;
|
|
var
|
|
i: integer;
|
|
flattenedPaths: TPathsD;
|
|
begin
|
|
if pendingScale <= 0 then pendingScale := 1.0;
|
|
if (pendingScale > fPendingScale) then
|
|
fPendingScale := pendingScale;
|
|
|
|
Result := nil;
|
|
SetLength(flattenedPaths, fSegsCount);
|
|
for i := 0 to fSegsCount - 1 do
|
|
fSegs[i].GetFlattened2(flattenedPaths[i]);
|
|
ConcatPaths(Result, flattenedPaths);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddSeg(segType: TSvgPathSegType;
|
|
const startPt: TPointD; const pts: TPathD): TSvgPathSeg;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := fSegsCount;
|
|
if i = Length(fSegs) then
|
|
GrowSegs;
|
|
inc(fSegsCount);
|
|
|
|
case segType of
|
|
stCBezier : Result := TSvgCSegment.Create(self, i, startPt);
|
|
stHorz : Result := TSvgHSegment.Create(self, i, startPt);
|
|
stLine : Result := TSvgLSegment.Create(self, i, startPt);
|
|
stQBezier : Result := TSvgQSegment.Create(self, i, startPt);
|
|
stCSpline : Result := TSvgSSegment.Create(self, i, startPt);
|
|
stQSpline : Result := TSvgTSegment.Create(self, i, startPt);
|
|
stVert : Result := TSvgVSegment.Create(self, i, startPt);
|
|
else raise Exception.Create('TSvgSubPath.AddSeg error');
|
|
end;
|
|
fSegs[i] := Result;
|
|
Result.fCtrlPts := pts;
|
|
Result.fFlatPath := nil;
|
|
if Result is TSvgCurvedSeg then
|
|
TSvgCurvedSeg(Result).pendingScale := fPendingScale;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddASeg(const startPt, endPt: TPointD; const rect: TRectD;
|
|
angle: double; isClockwise: Boolean): TSvgASegment;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := fSegsCount;
|
|
if i = Length(fSegs) then
|
|
GrowSegs;
|
|
inc(fSegsCount);
|
|
|
|
Result := TSvgASegment.Create(self, i, startPt);
|
|
fSegs[i] := Result;
|
|
Result.pendingScale := self.fPendingScale;
|
|
with Result.fArcInfo do
|
|
begin
|
|
rec := rect;
|
|
startPos := startPt;
|
|
endPos := endPt;
|
|
rectAngle := angle;
|
|
sweepClockW := isClockwise;
|
|
end;
|
|
Result.SetCtrlPtsFromArcInfo; // calls Changed
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddHSeg(const startPt: TPointD; const pts: TPathD): TSvgHSegment;
|
|
begin
|
|
Result := AddSeg(stHorz, startPt, pts) as TSvgHSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddCSeg(const startPt: TPointD; const pts: TPathD): TSvgCSegment;
|
|
begin
|
|
Result := AddSeg(stCBezier, startPt, pts) as TSvgCSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddLSeg(const startPt: TPointD; const pts: TPathD): TSvgLSegment;
|
|
begin
|
|
Result := AddSeg(stLine, startPt, pts) as TSvgLSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddQSeg(const startPt: TPointD; const pts: TPathD): TSvgQSegment;
|
|
begin
|
|
Result := AddSeg(stQBezier, startPt, pts) as TSvgQSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddSSeg(const startPt: TPointD; const pts: TPathD): TSvgSSegment;
|
|
begin
|
|
Result := AddSeg(stCSpline, startPt, pts) as TSvgSSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddTSeg(const startPt: TPointD; const pts: TPathD): TSvgTSegment;
|
|
begin
|
|
Result := AddSeg(stQSpline, startPt, pts) as TSvgTSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddVSeg(const startPt: TPointD; const pts: TPathD): TSvgVSegment;
|
|
begin
|
|
Result := AddSeg(stVert, startPt, pts) as TSvgVSegment;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.AddZSeg(const endPt, firstPt: TPointD): TSvgZSegment;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := fSegsCount;
|
|
if i = Length(fSegs) then
|
|
GrowSegs;
|
|
inc(fSegsCount);
|
|
|
|
Result := TSvgZSegment.Create(self, i, endPt);
|
|
fSegs[i] := Result;
|
|
NewPointDArray(Result.fCtrlPts, 1, True);
|
|
Result.fCtrlPts[0] := firstPt;
|
|
isClosed := true;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetLastSeg: TSvgPathSeg;
|
|
var
|
|
cnt: integer;
|
|
begin
|
|
cnt := Count;
|
|
if cnt = 0 then
|
|
Result := nil else
|
|
Result := seg[cnt -1];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.DeleteLastSeg: Boolean;
|
|
var
|
|
cnt: integer;
|
|
begin
|
|
cnt := Count;
|
|
Result := cnt > 0;
|
|
if not Result then Exit;
|
|
seg[cnt -1].Free;
|
|
SetLength(fSegs, cnt -1);
|
|
fSegsCount := cnt - 1;
|
|
if isClosed then isClosed := false;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetSimplePath: TPathD;
|
|
var
|
|
i: integer;
|
|
paths: TPathsD;
|
|
begin
|
|
if fSegsCount <= 1 then
|
|
begin
|
|
Result := Img32.Vector.MakePath(GetFirstPt);
|
|
for i := 0 to fSegsCount - 1 do
|
|
ConcatPaths(Result, fSegs[i].GetOnPathCtrlPts);
|
|
end
|
|
else
|
|
begin
|
|
SetLength(paths, 1 + fSegsCount);
|
|
paths[0] := Img32.Vector.MakePath(GetFirstPt);
|
|
for i := 0 to fSegsCount - 1 do
|
|
paths[1 + i] := fSegs[i].GetOnPathCtrlPts;
|
|
ConcatPaths(Result, paths);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetMoveStrDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
pt: TPointD;
|
|
begin
|
|
Result := '';
|
|
if fSegsCount = 0 then Exit;
|
|
|
|
if decimalPrec < -3 then decimalPrec := -3
|
|
else if decimalPrec > 4 then decimalPrec := 4;
|
|
|
|
with fParent do
|
|
begin
|
|
pt.X := (fSegs[0].fFirstPt.X - self.PathOffset.X - Offset.X)/fPathScale;
|
|
pt.Y := (fSegs[0].fFirstPt.Y - self.PathOffset.Y - Offset.Y)/fPathScale;
|
|
end;
|
|
Result := 'M ' + AsCoordStr(pt, NullPointD, false, decimalPrec);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if decimalPrec < -3 then decimalPrec := -3
|
|
else if decimalPrec > 4 then decimalPrec := 4;
|
|
if Count = 0 then Exit;
|
|
|
|
Result := GetMoveStrDef(relative, decimalPrec);
|
|
for i := 0 to Count -1 do
|
|
Result := Result + fSegs[i].GetStringDef(relative, decimalPrec);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TSvgSubPath.Create(parent: TSvgPath);
|
|
begin
|
|
fParent := parent;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
destructor TSvgSubPath.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSubPath.Clear;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count -1 do
|
|
fSegs[i].Free;
|
|
fSegs := nil;
|
|
fSegsCount := 0;
|
|
fPathOffset := NullPointD;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSubPath.GrowSegs;
|
|
begin
|
|
SetLength(fSegs, (fSegsCount * 2) + 1);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSubPath.SegsLoaded;
|
|
begin
|
|
// Trim the array to the actual used size
|
|
if Length(fSegs) <> fSegsCount then
|
|
SetLength(fSegs, fSegsCount);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSubPath.InitSegs(Capacity: Integer);
|
|
begin
|
|
if Capacity > fSegsCount then
|
|
SetLength(fSegs, Capacity);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetCount: integer;
|
|
begin
|
|
Result := fSegsCount;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgSubPath.Offset(dx, dy: double);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to fSegsCount - 1 do fSegs[i].Offset(dx, dy);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetSeg(index: integer): TSvgPathSeg;
|
|
begin
|
|
if (index < 0) or (index >= Count) then
|
|
raise Exception.Create(rsSvgSubPathRangeError);
|
|
Result := fSegs[index];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetFirstPt: TPointD;
|
|
begin
|
|
if Count = 0 then Result := NullPointD
|
|
else Result := fSegs[0].FirstPt;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetLastPt: TPointD;
|
|
begin
|
|
if Count = 0 then
|
|
Result := NullPointD
|
|
else with fSegs[Count -1] do
|
|
Result := CtrlPts[High(CtrlPts)];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgSubPath.GetBounds: TRectD;
|
|
var
|
|
i: integer;
|
|
p: TPathD;
|
|
begin
|
|
p := nil;
|
|
for i := 0 to Count -1 do
|
|
ConcatPaths(p, fSegs[i].fFlatPath);
|
|
Result := Img32.Vector.GetBoundsD(p);
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// TSvgPath
|
|
//------------------------------------------------------------------------------
|
|
|
|
destructor TSvgPath.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPath.ScaleAndOffset(scale: double; dx, dy: integer);
|
|
var
|
|
i,j: integer;
|
|
begin
|
|
if fPathScale = 0 then fPathScale := 1;
|
|
if scale = 0 then scale := 1;
|
|
fPathScale := fPathScale * scale;
|
|
|
|
fPathOffs := PointD(dx, dy);
|
|
for i := 0 to Count -1 do
|
|
with fSubPaths[i] do
|
|
begin
|
|
if scale <> 1 then
|
|
for j := 0 to fSegsCount - 1 do
|
|
fSegs[j].Scale(scale);
|
|
Offset(dx,dy);
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.GetStringDef(relative: Boolean; decimalPrec: integer): string;
|
|
var
|
|
i : integer;
|
|
begin
|
|
result := '';
|
|
if fPathScale = 0 then fPathScale := 1;
|
|
for i := 0 to High(fSubPaths) do
|
|
Result := Result + fSubPaths[i].GetStringDef(relative, decimalPrec);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPath.Parse(const value: UTF8String);
|
|
var
|
|
c, endC : PUTF8Char;
|
|
firstPt : TPointD;
|
|
lastPt : TPointD;
|
|
currPt : TPointD;
|
|
pt2, pt3 : TPointD;
|
|
angle : double;
|
|
sweepCW : integer;
|
|
largeArc : integer;
|
|
arcRec : TRectD;
|
|
isRelative : Boolean;
|
|
currSegType : TSvgPathSegType;
|
|
currSubPath : TSvgSubPath;
|
|
pts : TPathD;
|
|
ptCap : integer;
|
|
ptCnt : integer;
|
|
|
|
procedure AddPt(const pt: TPointD);
|
|
begin
|
|
if ptCnt = ptCap then
|
|
begin
|
|
inc(ptCap, 8);
|
|
SetLengthUninit(pts, ptCap);
|
|
end;
|
|
pts[ptCnt] := pt;
|
|
inc(ptCnt);
|
|
end;
|
|
|
|
procedure AllocEstimatedPtsCount(c, endC: PUTF8Char);
|
|
begin
|
|
// Count the numbers before the next segment type char
|
|
ptCap := 0;
|
|
while c < endC do
|
|
begin
|
|
// skip whitespaces
|
|
while (c < endC) and (c^ <= space) do
|
|
inc(c);
|
|
|
|
if c >= endC then
|
|
break;
|
|
|
|
case c^ of
|
|
'0'..'9', '-', '.', 'E', 'e':
|
|
begin
|
|
while (c < endC) and (c^ > space) do
|
|
inc(c);
|
|
Inc(ptCap);
|
|
end;
|
|
else
|
|
Break;
|
|
end;
|
|
end;
|
|
ptCap := ptCap div 2; // two numbers are one point
|
|
SetLength(pts, ptCap);
|
|
end;
|
|
|
|
function EstimateSegs(c, endC: PUTF8Char): Integer;
|
|
var
|
|
ch: UTF8Char;
|
|
begin
|
|
Result := 0;
|
|
while True do
|
|
begin
|
|
if c >= endC then
|
|
Break;
|
|
ch := c^;
|
|
inc(c);
|
|
|
|
case ch of
|
|
'A'..'Z', 'a'..'z':
|
|
begin
|
|
case ch of
|
|
'M', 'm': // move / close
|
|
Break;
|
|
'Z', 'z':
|
|
begin
|
|
Inc(Result);
|
|
Break;
|
|
end;
|
|
'E', 'e': ; // Exponent of a number
|
|
else
|
|
Inc(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ExpectedSegCount: Integer;
|
|
begin
|
|
Clear;
|
|
currSubPath := nil;
|
|
ExpectedSegCount := 1;
|
|
|
|
c := PUTF8Char(value);
|
|
endC := c + Length(value);
|
|
isRelative := false;
|
|
currPt := NullPointD;
|
|
|
|
while true do
|
|
begin
|
|
currSegType := GetSegType(c, endC, isRelative);
|
|
if currSegType = stUnknown then Break;
|
|
|
|
if currSegType = stMove then
|
|
begin
|
|
if currSubPath <> nil then
|
|
currSubPath.SegsLoaded; // Trim the segs array to the actual count
|
|
currSubPath := nil;
|
|
|
|
ExpectedSegCount := EstimateSegs(c, endc);
|
|
|
|
if isRelative then
|
|
lastPt := currPt else
|
|
lastPt := InvalidPointD;
|
|
|
|
if not Parse2Num(c, endC, currPt, lastPt) then break;
|
|
lastPt := currPt;
|
|
//values immediately following a Move are implicitly Line statements
|
|
if IsNumPending(c, endC, true) then
|
|
currSegType := stLine else
|
|
Continue;
|
|
Inc(ExpectedSegCount);
|
|
end
|
|
else if (currSegType = stClose) then
|
|
begin
|
|
if currPt.X = InvalidD then Continue;
|
|
|
|
if Assigned(currSubPath) and (currSubPath.Count > 0) then
|
|
begin
|
|
lastPt := currPt;
|
|
currPt := currSubPath.GetFirstPt;
|
|
currSubPath.AddZSeg(lastPt, currPt);
|
|
end else
|
|
begin
|
|
if not Assigned(currSubPath) then
|
|
currSubPath := AddPath(1);
|
|
currSubPath.AddZSeg(currPt, currPt);
|
|
end;
|
|
currSubPath.SegsLoaded; // Trim the segs array to the actual count
|
|
currSubPath := nil;
|
|
ExpectedSegCount := 1;
|
|
Continue;
|
|
end;
|
|
|
|
if not Assigned(currSubPath) then
|
|
currSubPath := AddPath(ExpectedSegCount);
|
|
|
|
pts := nil;
|
|
ptCnt := 0; ptCap := 0;
|
|
firstPt := currPt;
|
|
if isRelative then
|
|
lastPt := firstPt else
|
|
lastPt := InvalidPointD;
|
|
|
|
case currSegType of
|
|
stArc:
|
|
begin
|
|
//nb: unlike other segment types,
|
|
//consecutive arc segs are separated.
|
|
while IsNumPending(c, endC, true) and
|
|
Parse2Num(c, endC, pt2, InvalidPointD) and
|
|
ParseNextNum(c, endC, true, angle) and
|
|
GetSingleDigit(c, endC, largeArc) and
|
|
GetSingleDigit(c, endC, sweepCW) and
|
|
Parse2Num(c, endC, currPt, lastPt) do
|
|
begin
|
|
angle := DegToRad(angle);
|
|
arcRec := GetSvgArcInfoRect(firstPt, currPt, pt2,
|
|
angle, largeArc <> 0, sweepCW <> 0);
|
|
if arcRec.IsEmpty then break;
|
|
|
|
currSubPath.AddASeg(firstPt, currPt,
|
|
arcRec, angle, sweepCW <> 0);
|
|
|
|
if isRelative then lastPt := currPt;
|
|
firstPt := currPt;
|
|
end;
|
|
end;
|
|
stCBezier:
|
|
begin
|
|
AllocEstimatedPtsCount(c, endC);
|
|
while IsNumPending(c, endC, true) and
|
|
Parse2Num(c, endC, pt2, lastPt) and
|
|
Parse2Num(c, endC, pt3, lastPt) and
|
|
Parse2Num(c, endC, currPt, lastPt) do
|
|
begin
|
|
AddPt(pt2);
|
|
AddPt(pt3);
|
|
AddPt(currPt);
|
|
if isRelative then lastPt := currPt;
|
|
end;
|
|
if Length(pts) <> ptCnt then
|
|
SetLength(pts, ptCnt);
|
|
currSubPath.AddSeg(stCBezier, firstPt, pts);
|
|
end;
|
|
stHorz:
|
|
begin
|
|
AllocEstimatedPtsCount(c, endC);
|
|
while IsNumPending(c, endC, true) and
|
|
Parse1Num(c, endC, currPt.X, lastPt.X) do
|
|
begin
|
|
AddPt(currPt);
|
|
if isRelative then lastPt.X := currPt.X;
|
|
end;
|
|
if Length(pts) <> ptCnt then
|
|
SetLength(pts, ptCnt);
|
|
currSubPath.AddHSeg(firstPt, pts);
|
|
end;
|
|
stQBezier, stCSpline:
|
|
begin
|
|
AllocEstimatedPtsCount(c, endC);
|
|
while IsNumPending(c, endC, true) and
|
|
Parse2Num(c, endC, pt2, lastPt) and
|
|
Parse2Num(c, endC, currPt, lastPt) do
|
|
begin
|
|
AddPt(pt2);
|
|
AddPt(currPt);
|
|
if isRelative then lastPt := currPt;
|
|
end;
|
|
if Length(pts) <> ptCnt then
|
|
SetLength(pts, ptCnt);
|
|
currSubPath.AddSeg(currSegType, firstPt, pts);
|
|
end;
|
|
stLine, stQSpline:
|
|
begin
|
|
AllocEstimatedPtsCount(c, endC);
|
|
while IsNumPending(c, endC, true) and
|
|
Parse2Num(c, endC, currPt, lastPt) do
|
|
begin
|
|
AddPt(currPt);
|
|
if isRelative then lastPt := currPt;
|
|
end;
|
|
if Length(pts) <> ptCnt then
|
|
SetLength(pts, ptCnt);
|
|
currSubPath.AddSeg(currSegType, firstPt, pts);
|
|
end;
|
|
stVert:
|
|
begin
|
|
AllocEstimatedPtsCount(c, endC);
|
|
while IsNumPending(c, endC, true) and
|
|
Parse1Num(c, endC, currPt.Y, lastPt.Y) do
|
|
begin
|
|
AddPt(currPt);
|
|
if isRelative then lastPt.Y := currPt.Y;
|
|
end;
|
|
if Length(pts) <> ptCnt then
|
|
SetLength(pts, ptCnt);
|
|
currSubPath.AddVSeg(firstPt, pts);
|
|
end;
|
|
end;
|
|
end;
|
|
if currSubPath <> nil then
|
|
currSubPath.SegsLoaded; // Trim the segs array to the actual count
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.GetCount: integer;
|
|
begin
|
|
Result := Length(fSubPaths);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.GetPath(index: integer): TSvgSubPath;
|
|
begin
|
|
if (index < 0) or (index >= Count) then
|
|
raise Exception.Create(rsSvgPathRangeError);
|
|
Result := fSubPaths[index];
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPath.Clear;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count -1 do
|
|
fSubPaths[i].Free;
|
|
fSubPaths := nil;
|
|
fPathScale := 1;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.GetBounds: TRectD;
|
|
var
|
|
i: integer;
|
|
p: TPathD;
|
|
begin
|
|
p := nil;
|
|
for i := 0 to Count -1 do
|
|
ConcatPaths(p, fSubPaths[i].GetFlattenedPath);
|
|
Result := Img32.Vector.GetBoundsD(p);
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.GetControlBounds: TRectD;
|
|
var
|
|
i,j: integer;
|
|
p: TPathD;
|
|
begin
|
|
p := nil;
|
|
for i := 0 to Count -1 do
|
|
with fSubPaths[i] do
|
|
begin
|
|
AppendPoint(p, GetFirstPt);
|
|
for j := 0 to fSegsCount - 1 do
|
|
ConcatPaths(p, fSegs[j].fCtrlPts);
|
|
end;
|
|
Result := GetBoundsD(p);
|
|
|
|
//watch out for straight horizontal or vertical lines
|
|
if IsEmptyRect(Result) then
|
|
begin
|
|
if Result.Width = 0 then
|
|
begin
|
|
Result.Left := Result.Left - 0.5;
|
|
Result.Right := Result.Left + 1.0;
|
|
end
|
|
else if Result.Height = 0 then
|
|
begin
|
|
Result.Top := Result.Top - 0.5;
|
|
Result.Bottom := Result.Top + 1.0;
|
|
end;
|
|
end;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TSvgPath.AddPath(SegsCapacity: Integer): TSvgSubPath;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := Count;
|
|
Result := TSvgSubPath.Create(self);
|
|
Result.InitSegs(SegsCapacity);
|
|
SetLength(fSubPaths, i + 1);
|
|
fSubPaths[i] := Result;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
procedure TSvgPath.DeleteSubPath(subPath: TSvgSubPath);
|
|
var
|
|
i, len: integer;
|
|
begin
|
|
len := Length(fSubPaths);
|
|
for i := 0 to len -1 do
|
|
if subPath = fSubPaths[i] then
|
|
begin
|
|
fSubPaths[i].Free;
|
|
if i < len -1 then
|
|
Move(fSubPaths[i+1], fSubPaths[i],
|
|
(len - i -1) * SizeOf(Pointer));
|
|
SetLength(fSubPaths, len -1);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
// GetSvgArcInfoRect
|
|
//------------------------------------------------------------------------------
|
|
|
|
//https://stackoverflow.com/a/12329083
|
|
function GetSvgArcInfoRect(const p1, p2: TPointD; radii: TPointD;
|
|
phi_rads: double; fA, fS: boolean): TRectD;
|
|
var
|
|
x1_, y1_, rxry, rxy1_, ryx1_, s_phi, c_phi: double;
|
|
hd_x, hd_y, hs_x, hs_y, sum_of_sq, lambda, coe: double;
|
|
cx, cy, cx_, cy_: double;
|
|
begin
|
|
Result := NullRectD;
|
|
if (radii.X < 0) then radii.X := -radii.X;
|
|
if (radii.Y < 0) then radii.Y := -radii.Y;
|
|
if (radii.X = 0) or (radii.Y = 0) then Exit;
|
|
|
|
GetSinCos(phi_rads, s_phi, c_phi);;
|
|
hd_x := (p1.X - p2.X) / 2.0; // half diff of x
|
|
hd_y := (p1.Y - p2.Y) / 2.0; // half diff of y
|
|
hs_x := (p1.X + p2.X) / 2.0; // half sum of x
|
|
hs_y := (p1.Y + p2.Y) / 2.0; // half sum of y
|
|
|
|
// F6.5.1
|
|
x1_ := c_phi * hd_x + s_phi * hd_y;
|
|
y1_ := c_phi * hd_y - s_phi * hd_x;
|
|
|
|
// F.6.6 Correction of out-of-range radii
|
|
// Step 3: Ensure radii are large enough
|
|
lambda := (x1_ * x1_) / (radii.X * radii.X) +
|
|
(y1_ * y1_) / (radii.Y * radii.Y);
|
|
if (lambda > 1) then
|
|
begin
|
|
radii.X := radii.X * Sqrt(lambda);
|
|
radii.Y := radii.Y * Sqrt(lambda);
|
|
end;
|
|
|
|
rxry := radii.X * radii.Y;
|
|
rxy1_ := radii.X * y1_;
|
|
ryx1_ := radii.Y * x1_;
|
|
sum_of_sq := rxy1_ * rxy1_ + ryx1_ * ryx1_; // sum of square
|
|
if (sum_of_sq = 0) then Exit;
|
|
|
|
coe := Sqrt(Abs((rxry * rxry - sum_of_sq) / sum_of_sq));
|
|
if (fA = fS) then coe := -coe;
|
|
|
|
// F6.5.2
|
|
cx_ := coe * rxy1_ / radii.Y;
|
|
cy_ := -coe * ryx1_ / radii.X;
|
|
|
|
// F6.5.3
|
|
cx := c_phi * cx_ - s_phi * cy_ + hs_x;
|
|
cy := s_phi * cx_ + c_phi * cy_ + hs_y;
|
|
|
|
Result.Left := cx - radii.X;
|
|
Result.Right := cx + radii.X;
|
|
Result.Top := cy - radii.Y;
|
|
Result.Bottom := cy + radii.Y;
|
|
end;
|
|
//------------------------------------------------------------------------------
|
|
|
|
end.
|