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