Img32.SVG.Path.pas 56 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912
  1. unit Img32.SVG.Path;
  2. (*******************************************************************************
  3. * Author : Angus Johnson *
  4. * Version : 4.7 *
  5. * Date : 6 January 2025 *
  6. * Website : http://www.angusj.com *
  7. * Copyright : Angus Johnson 2019-2025 *
  8. * *
  9. * Purpose : Essential structures and functions to read SVG Path elements *
  10. * *
  11. * License : Use, modification & distribution is subject to *
  12. * Boost Software License Ver 1 *
  13. * http://www.boost.org/LICENSE_1_0.txt *
  14. *******************************************************************************)
  15. interface
  16. {$I Img32.inc}
  17. uses
  18. SysUtils, Classes, Types, Math,
  19. {$IFDEF XPLAT_GENERICS} Generics.Collections, Generics.Defaults,{$ENDIF}
  20. Img32, Img32.SVG.Core, Img32.Vector, Img32.Text;
  21. {$IFDEF ZEROBASEDSTR}
  22. {$ZEROBASEDSTRINGS OFF}
  23. {$ENDIF}
  24. type
  25. TSvgPathSegType =
  26. (stUnknown, stMove, stLine, stHorz, stVert, stArc,
  27. stQBezier, stCBezier, stQSpline, stCSpline, stClose);
  28. TArcInfo = record
  29. rec : TRectD;
  30. startPos : TPointD;
  31. endPos : TPointD;
  32. rectAngle : double;
  33. sweepClockW : Boolean;
  34. end;
  35. TArcInfos = array of TArcInfo;
  36. TSvgPath = class;
  37. TSvgSubPath = class;
  38. TSvgPathSeg = class
  39. private
  40. fParent : TSvgSubPath;
  41. fOwner : TSvgPath;
  42. fIdx : integer;
  43. fFirstPt : TPointD;
  44. fFlatPath : TPathD;
  45. fSegType : TSvgPathSegType;
  46. fCtrlPts : TPathD;
  47. fExtend : integer;
  48. protected
  49. procedure Changed; {$IFDEF INLINE} inline; {$ENDIF}
  50. procedure RequireFlattened; virtual;
  51. function GetFlattened: TPathD; overload;
  52. procedure GetFlattened2(var Result: TPathD); overload;
  53. procedure GetFlattenedInternal; virtual; abstract;
  54. procedure Scale(value: double); virtual;
  55. function DescaleAndOffset(const pt: TPointD): TPointD; overload;
  56. function DescaleAndOffset(const p: TPathD): TPathD; overload;
  57. procedure SetCtrlPts(const pts: TPathD); virtual;
  58. public
  59. constructor Create(parent: TSvgSubPath;
  60. idx: integer; const firstPt : TPointD); virtual;
  61. function GetCtrlBounds: TRectD; virtual;
  62. function GetOnPathCtrlPts: TPathD; virtual;
  63. procedure Offset(dx, dy: double); virtual;
  64. function GetStringDef(relative: Boolean; decimalPrec: integer): string; virtual;
  65. function ExtendSeg(const pts: TPathD): Boolean; virtual;
  66. property Parent : TSvgSubPath read fParent;
  67. property Owner : TSvgPath read fOwner;
  68. property CtrlPts : TPathD read fCtrlPts write SetCtrlPts;
  69. property FirstPt : TPointD read fFirstPt;
  70. property FlatPath : TPathD read GetFlattened;
  71. property Index : integer read fIdx;
  72. property SegType : TSvgPathSegType read fSegType;
  73. end;
  74. TSvgStraightSeg = class(TSvgPathSeg)
  75. protected
  76. procedure GetFlattenedInternal; override;
  77. end;
  78. TSvgCurvedSeg = class(TSvgPathSeg)
  79. protected
  80. pendingScale: double;
  81. procedure RequireFlattened; override;
  82. function GetPreviousCtrlPt: TPointD;
  83. public
  84. function GetLastCtrlPt: TPointD; virtual;
  85. constructor Create(parent: TSvgSubPath; idx: integer;
  86. const firstPt : TPointD); override;
  87. end;
  88. TSvgASegment = class(TSvgCurvedSeg)
  89. private
  90. fRectTop : Boolean;
  91. fRectLeft : Boolean;
  92. fArcInfo : TArcInfo;
  93. procedure SetArcInfo(ai: TArcInfo);
  94. procedure GetRectBtnPoints(out pt1, pt2, pt3: TPointD);
  95. procedure SetCtrlPtsFromArcInfo;
  96. protected
  97. procedure SetCtrlPts(const ctrlPts: TPathD); override;
  98. procedure GetFlattenedInternal; override;
  99. procedure Scale(value: double); override;
  100. public
  101. public
  102. constructor Create(parent: TSvgSubPath; idx: integer;
  103. const firstPt : TPointD); override;
  104. procedure Offset(dx, dy: double); override;
  105. procedure ReverseArc;
  106. function GetStartAngle: double;
  107. function GetEndAngle: double;
  108. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  109. property ArcInfo: TArcInfo read fArcInfo write SetArcInfo;
  110. property IsLeftCtrl: Boolean read fRectLeft;
  111. property IsTopCtrl: Boolean read fRectTop;
  112. end;
  113. TSvgCSegment = class(TSvgCurvedSeg)
  114. protected
  115. procedure GetFlattenedInternal; override;
  116. public
  117. constructor Create(parent: TSvgSubPath; idx: integer;
  118. const firstPt : TPointD); override;
  119. function GetOnPathCtrlPts: TPathD; override;
  120. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  121. end;
  122. TSvgHSegment = class(TSvgStraightSeg)
  123. public
  124. constructor Create(parent: TSvgSubPath; idx: integer;
  125. const firstPt : TPointD); override;
  126. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  127. end;
  128. TSvgLSegment = class(TSvgStraightSeg)
  129. public
  130. constructor Create(parent: TSvgSubPath; idx: integer;
  131. const firstPt : TPointD); override;
  132. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  133. end;
  134. TSvgQSegment = class(TSvgCurvedSeg)
  135. protected
  136. procedure GetFlattenedInternal; override;
  137. public
  138. constructor Create(parent: TSvgSubPath; idx: integer;
  139. const firstPt : TPointD); override;
  140. function GetOnPathCtrlPts: TPathD; override;
  141. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  142. end;
  143. TSvgSSegment = class(TSvgCurvedSeg)
  144. protected
  145. procedure GetFlattenedInternal; override;
  146. public
  147. constructor Create(parent: TSvgSubPath; idx: integer;
  148. const firstPt : TPointD); override;
  149. function GetOnPathCtrlPts: TPathD; override;
  150. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  151. end;
  152. TSvgTSegment = class(TSvgCurvedSeg)
  153. protected
  154. procedure GetFlattenedInternal; override;
  155. public
  156. constructor Create(parent: TSvgSubPath; idx: integer;
  157. const firstPt : TPointD); override;
  158. function GetLastCtrlPt: TPointD; override;
  159. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  160. end;
  161. TSvgVSegment = class(TSvgStraightSeg)
  162. public
  163. constructor Create(parent: TSvgSubPath; idx: integer;
  164. const firstPt : TPointD); override;
  165. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  166. end;
  167. TSvgZSegment = class(TSvgStraightSeg)
  168. public
  169. constructor Create(parent: TSvgSubPath; idx: integer;
  170. const firstPt : TPointD); override;
  171. function GetStringDef(relative: Boolean; decimalPrec: integer): string; override;
  172. end;
  173. TSvgSegmentClass = class of TSvgPathSeg;
  174. TSvgSubPath = class
  175. private
  176. fParent : TSvgPath;
  177. fSegs : array of TSvgPathSeg;
  178. fPendingScale : double;
  179. fPathOffset : TPointD;
  180. fSegsCount : integer;
  181. function GetCount: integer;
  182. function GetSeg(index: integer): TSvgPathSeg;
  183. function AddSeg(segType: TSvgPathSegType;
  184. const startPt: TPointD; const pts: TPathD): TSvgPathSeg;
  185. protected
  186. procedure GrowSegs;
  187. procedure SegsLoaded;
  188. procedure InitSegs(Capacity: Integer);
  189. public
  190. isClosed : Boolean;
  191. constructor Create(parent: TSvgPath);
  192. destructor Destroy; override;
  193. procedure Clear;
  194. procedure Offset(dx, dy: double);
  195. function GetFirstPt: TPointD;
  196. function GetLastPt: TPointD;
  197. function GetBounds: TRectD;
  198. function AddASeg(const startPt, endPt: TPointD; const rect: TRectD;
  199. angle: double; isClockwise: Boolean): TSvgASegment;
  200. function AddCSeg(const startPt: TPointD; const pts: TPathD): TSvgCSegment;
  201. function AddHSeg(const startPt: TPointD; const pts: TPathD): TSvgHSegment;
  202. function AddLSeg(const startPt: TPointD; const pts: TPathD): TSvgLSegment;
  203. function AddQSeg(const startPt: TPointD; const pts: TPathD): TSvgQSegment;
  204. function AddSSeg(const startPt: TPointD; const pts: TPathD): TSvgSSegment;
  205. function AddTSeg(const startPt: TPointD; const pts: TPathD): TSvgTSegment;
  206. function AddVSeg(const startPt: TPointD; const pts: TPathD): TSvgVSegment;
  207. function AddZSeg(const endPt, firstPt: TPointD): TSvgZSegment;
  208. function GetLastSeg: TSvgPathSeg;
  209. function DeleteLastSeg: Boolean;
  210. //pendingScale: allows 'flattening' to occur with curve precision
  211. //that will accommodate future (anticipated) scaling.
  212. //Eg: a native image is 32x32 px but will be displayed at 512x512,
  213. //so pendingScale should be 16 to ensure a smooth curve
  214. function GetFlattenedPath(pendingScale: double = 1.0): TPathD;
  215. //GetSimplePath - only used for markers
  216. function GetSimplePath: TPathD;
  217. function GetMoveStrDef(relative: Boolean; decimalPrec: integer): string;
  218. function GetStringDef(relative: Boolean; decimalPrec: integer): string;
  219. property Count : integer read GetCount;
  220. property Parent : TSvgPath read fParent;
  221. property PathOffset : TPointD read fPathOffset;
  222. property Seg[index: integer]: TSvgPathSeg read GetSeg; default;
  223. end;
  224. TSvgPath = class
  225. private
  226. fPathScale : double;
  227. fPathOffs : TPointD;
  228. fSubPaths: array of TSvgSubPath;
  229. function GetPath(index: integer): TSvgSubPath;
  230. function GetBounds: TRectD;
  231. function GetControlBounds: TRectD;
  232. function GetCount: integer;
  233. public
  234. destructor Destroy; override;
  235. procedure Clear;
  236. procedure Parse(const value: UTF8String);
  237. procedure ScaleAndOffset(scale: double; dx, dy: integer);
  238. function GetStringDef(relative: Boolean; decimalPrec: integer): string;
  239. function AddPath(SegsCapacity: Integer = 0): TSvgSubPath;
  240. procedure DeleteSubPath(subPath: TSvgSubPath);
  241. property Bounds: TRectD read GetBounds;
  242. property CtrlBounds: TRectD read GetControlBounds;
  243. property Count: integer read GetCount;
  244. property Path[index: integer]: TSvgSubPath read GetPath; default;
  245. property Scale: double read fPathScale;
  246. property Offset : TPointD read fPathOffs;
  247. end;
  248. UTF8Strings = array of UTF8String;
  249. function GetSvgArcInfoRect(const p1, p2: TPointD;
  250. radii: TPointD; phi_rads: double; fA, fS: boolean): TRectD;
  251. implementation
  252. resourcestring
  253. rsSvgPathRangeError = 'TSvgPath.GetPath range error';
  254. rsSvgSubPathRangeError = 'TSvgSubPath.GetSeg range error';
  255. //------------------------------------------------------------------------------
  256. // Miscellaneous functions ...
  257. //------------------------------------------------------------------------------
  258. function CheckPathLen(const p: TPathD; modLength: integer): TPathD;
  259. var
  260. i, len: integer;
  261. begin
  262. Result := nil;
  263. len := Length(p);
  264. if (len < modLength) then Exit;
  265. Result := p;
  266. i := len mod modLength;
  267. SetLength(Result, len -i);
  268. end;
  269. //------------------------------------------------------------------------------
  270. function TrimTrailingZeros(const floatValStr: string): string;
  271. var
  272. i: integer;
  273. begin
  274. Result := floatValStr;
  275. if Pos('.', floatValStr) = 0 then Exit;
  276. i := Length(Result);
  277. while Result[i] = '0' do dec(i);
  278. if Result[i] = '.' then dec(i);
  279. SetLength(Result, i);
  280. end;
  281. //------------------------------------------------------------------------------
  282. function AsIntStr(val: double): string;
  283. begin
  284. Result := Format('%1.0n ', [val]);
  285. end;
  286. //------------------------------------------------------------------------------
  287. function AsFloatStr(val: double; precision: integer): string;
  288. begin
  289. Result := TrimTrailingZeros(Format('%1.*f', [precision, val]));
  290. end;
  291. //------------------------------------------------------------------------------
  292. function AsCoordStr(pt: TPointD;
  293. const relPt: TPointD; relative: Boolean; precision: integer): string;
  294. var
  295. s1, s2: string;
  296. begin
  297. if relative then
  298. begin
  299. pt.X := pt.X - relPt.X;
  300. pt.Y := pt.Y - relPt.Y;
  301. end;
  302. s1 := TrimTrailingZeros(Format('%1.*f', [precision, pt.x]));
  303. s2 := TrimTrailingZeros(Format('%1.*f', [precision, pt.y]));
  304. Result := s1 + ',' + s2 + ' ';
  305. end;
  306. //------------------------------------------------------------------------------
  307. function GetSingleDigit(var c, endC: PUTF8Char;
  308. out digit: integer): Boolean;
  309. var
  310. cc: PUTF8Char;
  311. ch: UTF8Char;
  312. begin
  313. cc := SkipBlanksAndComma(c, endC);
  314. Result := cc < endC;
  315. if not Result then
  316. begin
  317. c := cc;
  318. Exit;
  319. end;
  320. ch := cc^;
  321. Result := (ch >= '0') and (ch <= '9');
  322. if not Result then Exit;
  323. digit := Ord(ch) - Ord('0');
  324. c := cc + 1;
  325. end;
  326. //------------------------------------------------------------------------------
  327. const
  328. SegTypeMap: array['A'..'Z'] of TSvgPathSegType = (
  329. stArc, // A
  330. stUnknown, // B
  331. stCBezier, // C
  332. stUnknown, // D
  333. stUnknown, // E
  334. stUnknown, // F
  335. stUnknown, // G
  336. stHorz, // H
  337. stUnknown, // I
  338. stUnknown, // J
  339. stUnknown, // K
  340. stLine, // L
  341. stMove, // M
  342. stUnknown, // N
  343. stUnknown, // O
  344. stUnknown, // P
  345. stQBezier, // Q
  346. stUnknown, // R
  347. stCSpline, // S
  348. stQSpline, // T
  349. stUnknown, // U
  350. stVert, // V
  351. stUnknown, // W
  352. stUnknown, // X
  353. stUnknown, // Y
  354. stClose // Z
  355. );
  356. function GetSegType(var c, endC: PUTF8Char; out isRelative: Boolean): TSvgPathSegType;
  357. var
  358. ch: UTF8Char;
  359. begin
  360. Result := stUnknown;
  361. if not SkipBlanks(c, endC) then Exit;
  362. ch := c^;
  363. case ch of
  364. 'a'..'z': Result := SegTypeMap[UTF8Char(Byte(ch) and not $20)];
  365. 'A'..'Z': Result := SegTypeMap[ch];
  366. end;
  367. if Result = stUnknown then Exit;
  368. isRelative := ch >= 'a';
  369. inc(c);
  370. end;
  371. //------------------------------------------------------------------------------
  372. function Parse2Num(var c, endC: PUTF8Char;
  373. out pt: TPointD; const relPt: TPointD): Boolean;
  374. begin
  375. Result := ParseNextNum(c, endC, true, pt.X) and
  376. ParseNextNum(c, endC, true, pt.Y);
  377. if not Result or (relPt.X = InvalidD) then Exit;
  378. pt.X := pt.X + relPt.X;
  379. pt.Y := pt.Y + relPt.Y;
  380. end;
  381. //------------------------------------------------------------------------------
  382. function Parse1Num(var c: PUTF8Char; endC: PUTF8Char;
  383. out val: double; relVal: double): Boolean;
  384. begin
  385. Result := ParseNextNum(c, endC, true, val);
  386. if Result and (relVal <> InvalidD) then
  387. val := val + relVal;
  388. end;
  389. //------------------------------------------------------------------------------
  390. // TSvgPathSeg
  391. //------------------------------------------------------------------------------
  392. constructor TSvgPathSeg.Create(parent: TSvgSubPath;
  393. idx: integer; const firstPt : TPointD);
  394. begin
  395. Self.fParent := parent;
  396. Self.fOwner := parent.fParent;
  397. Self.fIdx := idx;
  398. Self.fFirstPt := firstPt;
  399. end;
  400. //------------------------------------------------------------------------------
  401. procedure TSvgPathSeg.Scale(value: double);
  402. begin
  403. if (value <> 0) and (value <> 1) then
  404. begin
  405. fCtrlPts := ScalePath(fCtrlPts, value);
  406. fFirstPt := ScalePoint(fFirstPt, value);
  407. Changed;
  408. end;
  409. end;
  410. //------------------------------------------------------------------------------
  411. function TSvgPathSeg.DescaleAndOffset(const pt: TPointD): TPointD;
  412. begin
  413. Result := TranslatePoint(pt, -parent.PathOffset.X, -parent.PathOffset.Y);
  414. Result := ScalePoint(Result, 1/Owner.Scale);
  415. end;
  416. //------------------------------------------------------------------------------
  417. function TSvgPathSeg.DescaleAndOffset(const p: TPathD): TPathD;
  418. begin
  419. Result := TranslatePath(p, -parent.PathOffset.X, -parent.PathOffset.Y);
  420. Result := ScalePath(Result, 1/Owner.Scale);
  421. end;
  422. //------------------------------------------------------------------------------
  423. procedure TSvgPathSeg.Offset(dx, dy: double);
  424. begin
  425. fFirstPt := TranslatePoint(fFirstPt, dx, dy);
  426. fCtrlPts := TranslatePath(fCtrlPts, dx, dy);
  427. Changed;
  428. end;
  429. //------------------------------------------------------------------------------
  430. procedure TSvgPathSeg.SetCtrlPts(const pts: TPathD);
  431. begin
  432. fCtrlPts := pts;
  433. Changed;
  434. end;
  435. //------------------------------------------------------------------------------
  436. function TSvgPathSeg.ExtendSeg(const pts: TPathD): Boolean;
  437. var
  438. len: integer;
  439. begin
  440. len := Length(pts);
  441. Result := (len <> 0) and (fExtend <> 0) and (len mod fExtend = 0);
  442. if Result then ConcatPaths(fCtrlPts, pts);
  443. end;
  444. //------------------------------------------------------------------------------
  445. function TSvgPathSeg.GetCtrlBounds: TRectD;
  446. begin
  447. Result := GetBoundsD(PrePendPoint(fFirstPt, CtrlPts));
  448. end;
  449. //------------------------------------------------------------------------------
  450. procedure TSvgPathSeg.Changed;
  451. begin
  452. if fFlatPath <> nil then
  453. fFlatPath := nil; // DynArrayClear
  454. end;
  455. //------------------------------------------------------------------------------
  456. procedure TSvgPathSeg.RequireFlattened;
  457. begin
  458. if fFlatPath = nil then
  459. GetFlattenedInternal;
  460. end;
  461. //------------------------------------------------------------------------------
  462. function TSvgPathSeg.GetFlattened: TPathD;
  463. begin
  464. RequireFlattened;
  465. Result := fFlatPath;
  466. end;
  467. //------------------------------------------------------------------------------
  468. procedure TSvgPathSeg.GetFlattened2(var Result: TPathD);
  469. begin // uses less DynArrayAsg and DynArrayClear calls
  470. RequireFlattened;
  471. Result := fFlatPath;
  472. end;
  473. //------------------------------------------------------------------------------
  474. function TSvgPathSeg.GetOnPathCtrlPts: TPathD;
  475. begin
  476. Result := fCtrlPts;
  477. end;
  478. //------------------------------------------------------------------------------
  479. function TSvgPathSeg.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  480. begin
  481. Result := '';
  482. end;
  483. //------------------------------------------------------------------------------
  484. // TSvgStraightSeg
  485. //------------------------------------------------------------------------------
  486. procedure TSvgStraightSeg.GetFlattenedInternal;
  487. begin
  488. PrePendPoint(fFirstPt, fCtrlPts, fFlatPath);
  489. end;
  490. //------------------------------------------------------------------------------
  491. // TSvgCurvedSeg
  492. //------------------------------------------------------------------------------
  493. constructor TSvgCurvedSeg.Create(parent: TSvgSubPath; idx: integer;
  494. const firstPt : TPointD);
  495. begin
  496. inherited;
  497. pendingScale := 1.0;
  498. end;
  499. //------------------------------------------------------------------------------
  500. procedure TSvgCurvedSeg.RequireFlattened;
  501. begin
  502. //if the image has been rendered previously at a lower resolution, then
  503. //redo the flattening otherwise curves my look very rough.
  504. if (pendingScale < Parent.fPendingScale) then
  505. begin
  506. pendingScale := Parent.fPendingScale;
  507. Changed;
  508. end;
  509. inherited RequireFlattened;
  510. end;
  511. //------------------------------------------------------------------------------
  512. function TSvgCurvedSeg.GetLastCtrlPt: TPointD;
  513. begin
  514. Result := CtrlPts[High(CtrlPts) -1];
  515. end;
  516. //------------------------------------------------------------------------------
  517. function TSvgCurvedSeg.GetPreviousCtrlPt: TPointD;
  518. var
  519. UseParentLastCtrlPt: Boolean;
  520. begin
  521. UseParentLastCtrlPt := False;
  522. if fIdx > 0 then
  523. begin
  524. case fSegType of
  525. stQSpline:
  526. case fParent[fIdx -1].fSegType of
  527. stQBezier, stQSpline: UseParentLastCtrlPt := True;
  528. end;
  529. stCSpline:
  530. case fParent[fIdx -1].fSegType of
  531. stCBezier, stCSpline: UseParentLastCtrlPt := True;
  532. end;
  533. end;
  534. end;
  535. if UseParentLastCtrlPt then
  536. Result := TSvgCurvedSeg(fParent[fIdx -1]).GetLastCtrlPt
  537. else
  538. Result := fFirstPt;
  539. end;
  540. //------------------------------------------------------------------------------
  541. // TSvgASegment
  542. //------------------------------------------------------------------------------
  543. constructor TSvgASegment.Create(parent: TSvgSubPath; idx: integer;
  544. const firstPt : TPointD);
  545. begin
  546. inherited;
  547. fSegType := stArc;
  548. fExtend := 0;
  549. end;
  550. //------------------------------------------------------------------------------
  551. procedure TSvgASegment.SetArcInfo(ai: TArcInfo);
  552. var
  553. dx, dy: double;
  554. begin
  555. //make sure that all the ai fields are valid,
  556. //otherwise adjust them and align with ai.startpos
  557. with fArcInfo do
  558. begin
  559. rec := ai.rec;
  560. rectAngle := ai.rectAngle;
  561. startPos := GetClosestPtOnRotatedEllipse(rec, rectAngle, ai.startPos);
  562. endPos := GetClosestPtOnRotatedEllipse(rec, rectAngle, ai.endPos);
  563. sweepClockW := ai.sweepClockW;
  564. if not PointsNearEqual(ai.startPos, startPos, 0.01) then
  565. begin
  566. dx := ai.startPos.X - startPos.X;
  567. dy := ai.startPos.Y - startPos.Y;
  568. TranslateRect(rec, dx, dy);
  569. startPos := ai.startPos;
  570. endPos := TranslatePoint(endPos, dx, dy);
  571. end;
  572. end;
  573. SetCtrlPtsFromArcInfo;
  574. Changed;
  575. end;
  576. //------------------------------------------------------------------------------
  577. procedure TSvgASegment.GetRectBtnPoints(out pt1, pt2, pt3: TPointD);
  578. var
  579. d : double;
  580. pt, sp : TPointD;
  581. begin
  582. with fArcInfo do
  583. begin
  584. //keep rec oriented to the XY axis and rotate startpos
  585. sp := startPos;
  586. pt2 := rec.MidPoint;
  587. if rectAngle <> 0 then
  588. RotatePoint(sp, pt2, -rectAngle);
  589. pt := PointD(rec.Left, pt2.Y);
  590. pt3 := PointD(rec.Right, pt2.Y);
  591. d := DistanceSqrd(pt, sp) - DistanceSqrd(pt3, sp);
  592. if not ValueAlmostZero(d, 0.01) then
  593. fRectLeft := d > 0;
  594. if fRectLeft then
  595. pt1 := PointD(rec.Left, pt2.Y) else
  596. pt1 := PointD(rec.Right, pt2.Y);
  597. pt := PointD(pt2.X, rec.Top);
  598. pt3 := PointD(pt2.X, rec.Bottom);
  599. d := DistanceSqrd(pt, sp) - DistanceSqrd(pt3, sp);
  600. if not ValueAlmostZero(d, 0.01) then fRectTop := d > 0;
  601. if fRectTop then
  602. pt3 := PointD(pt2.X, rec.Top) else
  603. pt3 := PointD(pt2.X, rec.Bottom);
  604. RotatePoint(pt1, pt2, rectAngle);
  605. RotatePoint(pt3, pt2, rectAngle);
  606. end;
  607. end;
  608. //------------------------------------------------------------------------------
  609. procedure TSvgASegment.SetCtrlPtsFromArcInfo;
  610. begin
  611. NewPointDArray(fCtrlPts, 5, True);
  612. with fArcInfo do
  613. begin
  614. fCtrlPts[0] := startPos;
  615. GetRectBtnPoints(fCtrlPts[1], fCtrlPts[2], fCtrlPts[3]);
  616. fCtrlPts[4] := endPos;
  617. end;
  618. Changed;
  619. end;
  620. //------------------------------------------------------------------------------
  621. procedure TSvgASegment.GetFlattenedInternal;
  622. var
  623. a1,a2: double;
  624. p: TPathD;
  625. begin
  626. fFlatPath := nil;
  627. with fArcInfo do
  628. begin
  629. a1 := GetStartAngle;
  630. a2 := GetEndAngle;
  631. if not sweepClockW then
  632. begin
  633. p := Arc(rec, a2, a1, pendingScale);
  634. p := ReversePath(p);
  635. end else
  636. p := Arc(rec, a1, a2, pendingScale);
  637. if rectAngle <> 0 then
  638. p := RotatePath(p, rec.MidPoint, rectAngle);
  639. ConcatPaths(fFlatPath, p);
  640. end;
  641. end;
  642. //------------------------------------------------------------------------------
  643. function TSvgASegment.GetStartAngle: double;
  644. begin
  645. with fArcInfo do
  646. Result := GetRotatedEllipticalAngleFromPoint(rec, rectAngle, startPos);
  647. end;
  648. //------------------------------------------------------------------------------
  649. function TSvgASegment.GetEndAngle: double;
  650. begin
  651. with fArcInfo do
  652. Result := GetRotatedEllipticalAngleFromPoint(rec, rectAngle, endPos);
  653. end;
  654. //------------------------------------------------------------------------------
  655. procedure TSvgASegment.ReverseArc;
  656. begin
  657. fArcInfo.sweepClockW := not fArcInfo.sweepClockW;
  658. Changed;
  659. end;
  660. //------------------------------------------------------------------------------
  661. procedure TSvgASegment.Offset(dx, dy: double);
  662. begin
  663. inherited; // calls Changed
  664. with fArcInfo do
  665. begin
  666. TranslateRect(rec, dx, dy);
  667. startPos := TranslatePoint(startPos, dx, dy);
  668. endPos := TranslatePoint(endPos, dx, dy);
  669. end;
  670. end;
  671. //------------------------------------------------------------------------------
  672. procedure TSvgASegment.Scale(value: Double);
  673. begin
  674. if (value = 0) or (value = 1) then Exit;
  675. inherited; // calls Changed
  676. with fArcInfo do
  677. begin
  678. rec := ScaleRect(rec, value);
  679. startPos := ScalePoint(startPos, value);
  680. endPos := ScalePoint(endPos, value);
  681. end;
  682. end;
  683. //------------------------------------------------------------------------------
  684. procedure TSvgASegment.SetCtrlPts(const ctrlPts: TPathD);
  685. begin
  686. //SetCtrlPtsFromArcInfo; // calls Changed
  687. end;
  688. //------------------------------------------------------------------------------
  689. function TSvgASegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  690. var
  691. a, a1,a2: double;
  692. sp, ep: TPointD;
  693. begin
  694. with fArcInfo do
  695. begin
  696. if relative then Result := 'a ' else Result := 'A ';
  697. Result := Result +
  698. AsFloatStr(rec.Width *0.5 /Owner.Scale, decimalPrec) + ',';
  699. Result := Result +
  700. AsFloatStr(rec.Height *0.5 /Owner.Scale, decimalPrec) + ' ';
  701. //angle as degrees
  702. Result := Result + AsIntStr(RadToDeg(rectAngle));
  703. a1 := GetStartAngle;
  704. a2 := GetEndAngle;
  705. //large arce and direction flags
  706. a := a2 - a1;
  707. if a < 0 then a := a + angle360;
  708. if sweepClockW then
  709. begin
  710. if a >= angle180 then
  711. Result := Result + '1 1 ' else
  712. Result := Result + '0 1 ';
  713. end else
  714. begin
  715. if a >= angle180 then
  716. Result := Result + '0 0 ' else
  717. Result := Result + '1 0 ';
  718. end;
  719. //descaled and de-offset end position
  720. ep := DescaleAndOffset(endPos);
  721. sp := DescaleAndOffset(startPos);
  722. Result := Result + AsCoordStr(ep, sp, relative, decimalPrec);
  723. end;
  724. end;
  725. //------------------------------------------------------------------------------
  726. // TSvgCSegment
  727. //------------------------------------------------------------------------------
  728. constructor TSvgCSegment.Create(parent: TSvgSubPath; idx: integer;
  729. const firstPt : TPointD);
  730. begin
  731. inherited;
  732. fSegType := stCBezier;
  733. fExtend := 3;
  734. end;
  735. //------------------------------------------------------------------------------
  736. function TSvgCSegment.GetOnPathCtrlPts: TPathD;
  737. var
  738. i, len: integer;
  739. begin
  740. len := Length(fCtrlPts) div 3;
  741. NewPointDArray(Result, len, True);
  742. for i := 0 to High(Result) do
  743. Result[i] := fCtrlPts[i*3 +2];
  744. end;
  745. //------------------------------------------------------------------------------
  746. procedure TSvgCSegment.GetFlattenedInternal;
  747. var
  748. bt : double;
  749. p: TPathD;
  750. begin
  751. bt := BezierTolerance / pendingScale;
  752. p := CheckPathLen(fCtrlPts, 3);
  753. if p = nil then
  754. fFlatPath := nil else
  755. fFlatPath := FlattenCBezier(fFirstPt, p, bt);
  756. end;
  757. //------------------------------------------------------------------------------
  758. function TSvgCSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  759. var
  760. i: integer;
  761. pt, relPt: TPointD;
  762. begin
  763. if relative then Result := 'c ' else Result := 'C ';
  764. relPt := DescaleAndOffset(fFirstPt);
  765. for i := 0 to High(fCtrlPts) do
  766. begin
  767. pt:= DescaleAndOffset(fCtrlPts[i]);
  768. Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
  769. if relative and (i mod 3 = 2) then relPt := pt;
  770. end;
  771. end;
  772. //------------------------------------------------------------------------------
  773. // TSvgHSegment
  774. //------------------------------------------------------------------------------
  775. constructor TSvgHSegment.Create(parent: TSvgSubPath; idx: integer;
  776. const firstPt : TPointD);
  777. begin
  778. inherited;
  779. fSegType := stHorz;
  780. fExtend := 1;
  781. end;
  782. //------------------------------------------------------------------------------
  783. function TSvgHSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  784. var
  785. i: integer;
  786. pt, relPt: TPointD;
  787. begin
  788. if relative then
  789. begin
  790. Result := 'h ';
  791. relPt := DescaleAndOffset(fFirstPt);
  792. for i := 0 to High(fCtrlPts) do
  793. begin
  794. pt := DescaleAndOffset(fCtrlPts[i]);
  795. Result := Result + AsFloatStr(pt.X - relPt.X, decimalPrec) + ' ';
  796. relPt := pt;
  797. end;
  798. end else
  799. begin
  800. Result := 'H ';
  801. for i := 0 to High(fCtrlPts) do
  802. begin
  803. pt := DescaleAndOffset(fCtrlPts[i]);
  804. Result := Result + AsFloatStr(pt.X, decimalPrec) + ' ';
  805. end;
  806. end;
  807. end;
  808. //------------------------------------------------------------------------------
  809. // TSvgLSegment
  810. //------------------------------------------------------------------------------
  811. constructor TSvgLSegment.Create(parent: TSvgSubPath; idx: integer;
  812. const firstPt : TPointD);
  813. begin
  814. inherited;
  815. fSegType := stLine;
  816. fExtend := 1;
  817. end;
  818. //------------------------------------------------------------------------------
  819. function TSvgLSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  820. var
  821. i: integer;
  822. pt, relPt: TPointD;
  823. begin
  824. if relative then Result := 'l ' else Result := 'L ';
  825. relPt := DescaleAndOffset(fFirstPt);
  826. for i := 0 to High(fCtrlPts) do
  827. begin
  828. pt:= DescaleAndOffset(fCtrlPts[i]);
  829. Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
  830. relPt := pt;
  831. end;
  832. end;
  833. //------------------------------------------------------------------------------
  834. // TSvgQSegment
  835. //------------------------------------------------------------------------------
  836. constructor TSvgQSegment.Create(parent: TSvgSubPath; idx: integer;
  837. const firstPt : TPointD);
  838. begin
  839. inherited;
  840. fSegType := stQBezier;
  841. fExtend := 2;
  842. end;
  843. //------------------------------------------------------------------------------
  844. function TSvgQSegment.GetOnPathCtrlPts: TPathD;
  845. var
  846. i, len: integer;
  847. begin
  848. len := Length(fCtrlPts) div 2;
  849. NewPointDArray(Result, len, True);
  850. for i := 0 to High(Result) do
  851. Result[i] := fCtrlPts[i*2+1];
  852. end;
  853. //------------------------------------------------------------------------------
  854. procedure TSvgQSegment.GetFlattenedInternal;
  855. var
  856. bt : double;
  857. p: TPathD;
  858. begin
  859. bt := BezierTolerance / pendingScale;
  860. p := CheckPathLen(fCtrlPts, 2);
  861. if p = nil then
  862. fFlatPath := nil else
  863. fFlatPath := FlattenQBezier(fFirstPt, fCtrlPts, bt);
  864. end;
  865. //------------------------------------------------------------------------------
  866. function TSvgQSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  867. var
  868. i: integer;
  869. pt, relPt: TPointD;
  870. begin
  871. if relative then Result := 'q ' else Result := 'Q ';
  872. relPt := DescaleAndOffset(fFirstPt);
  873. for i := 0 to High(fCtrlPts) do
  874. begin
  875. pt := DescaleAndOffset(fCtrlPts[i]);
  876. Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
  877. if (i mod 2) = 1 then relPt := pt;
  878. end;
  879. end;
  880. //------------------------------------------------------------------------------
  881. // TSvgSSegment
  882. //------------------------------------------------------------------------------
  883. constructor TSvgSSegment.Create(parent: TSvgSubPath; idx: integer;
  884. const firstPt : TPointD);
  885. begin
  886. inherited;
  887. fSegType := stCSpline;
  888. fExtend := 2;
  889. end;
  890. //------------------------------------------------------------------------------
  891. procedure TSvgSSegment.GetFlattenedInternal;
  892. var
  893. bt : double;
  894. p: TPathD;
  895. begin
  896. bt := BezierTolerance / pendingScale;
  897. p := CheckPathLen(fCtrlPts, 2);
  898. if p = nil then
  899. fFlatPath := nil else
  900. fFlatPath := FlattenCSpline(GetPreviousCtrlPt, fFirstPt, fCtrlPts, bt);
  901. end;
  902. //------------------------------------------------------------------------------
  903. function TSvgSSegment.GetOnPathCtrlPts: TPathD;
  904. var
  905. i, len: integer;
  906. begin
  907. len := Length(fCtrlPts) div 2;
  908. NewPointDArray(Result, len, True);
  909. for i := 0 to High(Result) do
  910. Result[i] := fCtrlPts[i*2+1];
  911. end;
  912. //------------------------------------------------------------------------------
  913. function TSvgSSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  914. var
  915. i: integer;
  916. pt, relPt: TPointD;
  917. begin
  918. if relative then Result := 's ' else Result := 'S ';
  919. relPt := DescaleAndOffset(fFirstPt);
  920. for i := 0 to High(fCtrlPts) do
  921. begin
  922. pt := DescaleAndOffset(fCtrlPts[i]);
  923. Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
  924. if relative and (i mod 2 = 1) then relPt := pt;
  925. end;
  926. end;
  927. //------------------------------------------------------------------------------
  928. // TSvgTSegment
  929. //------------------------------------------------------------------------------
  930. constructor TSvgTSegment.Create(parent: TSvgSubPath; idx: integer;
  931. const firstPt : TPointD);
  932. begin
  933. inherited;
  934. fSegType := stQSpline;
  935. fExtend := 1;
  936. end;
  937. //------------------------------------------------------------------------------
  938. procedure TSvgTSegment.GetFlattenedInternal;
  939. var
  940. bt: double;
  941. begin
  942. bt := BezierTolerance / pendingScale;
  943. if fCtrlPts = nil then
  944. fFlatPath := nil else
  945. fFlatPath := FlattenQSpline(GetPreviousCtrlPt, fFirstPt, fCtrlPts, bt);
  946. end;
  947. //------------------------------------------------------------------------------
  948. function TSvgTSegment.GetLastCtrlPt: TPointD;
  949. var
  950. i: integer;
  951. begin
  952. Result := ReflectPoint(GetPreviousCtrlPt, fFirstPt);
  953. for i := 0 to High(CtrlPts) -1 do
  954. Result := ReflectPoint(Result, CtrlPts[i]);
  955. end;
  956. //------------------------------------------------------------------------------
  957. function TSvgTSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  958. var
  959. i: integer;
  960. pt, relPt: TPointD;
  961. begin
  962. if relative then Result := 't ' else Result := 'T ';
  963. relPt := DescaleAndOffset(fFirstPt);
  964. for i := 0 to High(fCtrlPts) do
  965. begin
  966. pt := DescaleAndOffset(fCtrlPts[i]);
  967. Result := Result + AsCoordStr(pt, relPt, relative, decimalPrec);
  968. if relative then relPt := pt;
  969. end;
  970. end;
  971. //------------------------------------------------------------------------------
  972. // TSvgVSegment
  973. //------------------------------------------------------------------------------
  974. constructor TSvgVSegment.Create(parent: TSvgSubPath; idx: integer;
  975. const firstPt : TPointD);
  976. begin
  977. inherited;
  978. fSegType := stVert;
  979. fExtend := 1;
  980. end;
  981. //------------------------------------------------------------------------------
  982. function TSvgVSegment.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  983. var
  984. i: integer;
  985. pt, relPt: TPointD;
  986. begin
  987. if relative then
  988. begin
  989. Result := 'v ';
  990. relPt := DescaleAndOffset(fFirstPt);
  991. for i := 0 to High(fCtrlPts) do
  992. begin
  993. pt := DescaleAndOffset(fCtrlPts[i]);
  994. Result := Result + AsFloatStr(pt.Y - relPt.Y, decimalPrec) + ' ';
  995. relPt := pt;
  996. end;
  997. end else
  998. begin
  999. Result := 'V ';
  1000. for i := 0 to High(fCtrlPts) do
  1001. begin
  1002. pt := DescaleAndOffset(fCtrlPts[i]);
  1003. Result := Result + AsFloatStr(pt.Y, decimalPrec) + ' ';
  1004. end;
  1005. end;
  1006. end;
  1007. //------------------------------------------------------------------------------
  1008. // TSvgZSegment
  1009. //------------------------------------------------------------------------------
  1010. constructor TSvgZSegment.Create(parent: TSvgSubPath;
  1011. idx: integer; const firstPt : TPointD);
  1012. begin
  1013. inherited;
  1014. fSegType := stClose;
  1015. fExtend := 0;
  1016. end;
  1017. //------------------------------------------------------------------------------
  1018. function TSvgZSegment.GetStringDef(relative: Boolean;
  1019. decimalPrec: integer): string;
  1020. begin
  1021. Result := 'Z ';
  1022. end;
  1023. //------------------------------------------------------------------------------
  1024. // TSvgSubPath
  1025. //------------------------------------------------------------------------------
  1026. function TSvgSubPath.GetFlattenedPath(pendingScale: double): TPathD;
  1027. var
  1028. i: integer;
  1029. flattenedPaths: TPathsD;
  1030. begin
  1031. if pendingScale <= 0 then pendingScale := 1.0;
  1032. if (pendingScale > fPendingScale) then
  1033. fPendingScale := pendingScale;
  1034. Result := nil;
  1035. SetLength(flattenedPaths, fSegsCount);
  1036. for i := 0 to fSegsCount - 1 do
  1037. fSegs[i].GetFlattened2(flattenedPaths[i]);
  1038. ConcatPaths(Result, flattenedPaths);
  1039. end;
  1040. //------------------------------------------------------------------------------
  1041. function TSvgSubPath.AddSeg(segType: TSvgPathSegType;
  1042. const startPt: TPointD; const pts: TPathD): TSvgPathSeg;
  1043. var
  1044. i: integer;
  1045. begin
  1046. i := fSegsCount;
  1047. if i = Length(fSegs) then
  1048. GrowSegs;
  1049. inc(fSegsCount);
  1050. case segType of
  1051. stCBezier : Result := TSvgCSegment.Create(self, i, startPt);
  1052. stHorz : Result := TSvgHSegment.Create(self, i, startPt);
  1053. stLine : Result := TSvgLSegment.Create(self, i, startPt);
  1054. stQBezier : Result := TSvgQSegment.Create(self, i, startPt);
  1055. stCSpline : Result := TSvgSSegment.Create(self, i, startPt);
  1056. stQSpline : Result := TSvgTSegment.Create(self, i, startPt);
  1057. stVert : Result := TSvgVSegment.Create(self, i, startPt);
  1058. else raise Exception.Create('TSvgSubPath.AddSeg error');
  1059. end;
  1060. fSegs[i] := Result;
  1061. Result.fCtrlPts := pts;
  1062. Result.fFlatPath := nil;
  1063. if Result is TSvgCurvedSeg then
  1064. TSvgCurvedSeg(Result).pendingScale := fPendingScale;
  1065. end;
  1066. //------------------------------------------------------------------------------
  1067. function TSvgSubPath.AddASeg(const startPt, endPt: TPointD; const rect: TRectD;
  1068. angle: double; isClockwise: Boolean): TSvgASegment;
  1069. var
  1070. i: integer;
  1071. begin
  1072. i := fSegsCount;
  1073. if i = Length(fSegs) then
  1074. GrowSegs;
  1075. inc(fSegsCount);
  1076. Result := TSvgASegment.Create(self, i, startPt);
  1077. fSegs[i] := Result;
  1078. Result.pendingScale := self.fPendingScale;
  1079. with Result.fArcInfo do
  1080. begin
  1081. rec := rect;
  1082. startPos := startPt;
  1083. endPos := endPt;
  1084. rectAngle := angle;
  1085. sweepClockW := isClockwise;
  1086. end;
  1087. Result.SetCtrlPtsFromArcInfo; // calls Changed
  1088. end;
  1089. //------------------------------------------------------------------------------
  1090. function TSvgSubPath.AddHSeg(const startPt: TPointD; const pts: TPathD): TSvgHSegment;
  1091. begin
  1092. Result := AddSeg(stHorz, startPt, pts) as TSvgHSegment;
  1093. end;
  1094. //------------------------------------------------------------------------------
  1095. function TSvgSubPath.AddCSeg(const startPt: TPointD; const pts: TPathD): TSvgCSegment;
  1096. begin
  1097. Result := AddSeg(stCBezier, startPt, pts) as TSvgCSegment;
  1098. end;
  1099. //------------------------------------------------------------------------------
  1100. function TSvgSubPath.AddLSeg(const startPt: TPointD; const pts: TPathD): TSvgLSegment;
  1101. begin
  1102. Result := AddSeg(stLine, startPt, pts) as TSvgLSegment;
  1103. end;
  1104. //------------------------------------------------------------------------------
  1105. function TSvgSubPath.AddQSeg(const startPt: TPointD; const pts: TPathD): TSvgQSegment;
  1106. begin
  1107. Result := AddSeg(stQBezier, startPt, pts) as TSvgQSegment;
  1108. end;
  1109. //------------------------------------------------------------------------------
  1110. function TSvgSubPath.AddSSeg(const startPt: TPointD; const pts: TPathD): TSvgSSegment;
  1111. begin
  1112. Result := AddSeg(stCSpline, startPt, pts) as TSvgSSegment;
  1113. end;
  1114. //------------------------------------------------------------------------------
  1115. function TSvgSubPath.AddTSeg(const startPt: TPointD; const pts: TPathD): TSvgTSegment;
  1116. begin
  1117. Result := AddSeg(stQSpline, startPt, pts) as TSvgTSegment;
  1118. end;
  1119. //------------------------------------------------------------------------------
  1120. function TSvgSubPath.AddVSeg(const startPt: TPointD; const pts: TPathD): TSvgVSegment;
  1121. begin
  1122. Result := AddSeg(stVert, startPt, pts) as TSvgVSegment;
  1123. end;
  1124. //------------------------------------------------------------------------------
  1125. function TSvgSubPath.AddZSeg(const endPt, firstPt: TPointD): TSvgZSegment;
  1126. var
  1127. i: integer;
  1128. begin
  1129. i := fSegsCount;
  1130. if i = Length(fSegs) then
  1131. GrowSegs;
  1132. inc(fSegsCount);
  1133. Result := TSvgZSegment.Create(self, i, endPt);
  1134. fSegs[i] := Result;
  1135. NewPointDArray(Result.fCtrlPts, 1, True);
  1136. Result.fCtrlPts[0] := firstPt;
  1137. isClosed := true;
  1138. end;
  1139. //------------------------------------------------------------------------------
  1140. function TSvgSubPath.GetLastSeg: TSvgPathSeg;
  1141. var
  1142. cnt: integer;
  1143. begin
  1144. cnt := Count;
  1145. if cnt = 0 then
  1146. Result := nil else
  1147. Result := seg[cnt -1];
  1148. end;
  1149. //------------------------------------------------------------------------------
  1150. function TSvgSubPath.DeleteLastSeg: Boolean;
  1151. var
  1152. cnt: integer;
  1153. begin
  1154. cnt := Count;
  1155. Result := cnt > 0;
  1156. if not Result then Exit;
  1157. seg[cnt -1].Free;
  1158. SetLength(fSegs, cnt -1);
  1159. fSegsCount := cnt - 1;
  1160. if isClosed then isClosed := false;
  1161. end;
  1162. //------------------------------------------------------------------------------
  1163. function TSvgSubPath.GetSimplePath: TPathD;
  1164. var
  1165. i: integer;
  1166. paths: TPathsD;
  1167. begin
  1168. if fSegsCount <= 1 then
  1169. begin
  1170. Result := Img32.Vector.MakePath(GetFirstPt);
  1171. for i := 0 to fSegsCount - 1 do
  1172. ConcatPaths(Result, fSegs[i].GetOnPathCtrlPts);
  1173. end
  1174. else
  1175. begin
  1176. SetLength(paths, 1 + fSegsCount);
  1177. paths[0] := Img32.Vector.MakePath(GetFirstPt);
  1178. for i := 0 to fSegsCount - 1 do
  1179. paths[1 + i] := fSegs[i].GetOnPathCtrlPts;
  1180. ConcatPaths(Result, paths);
  1181. end;
  1182. end;
  1183. //------------------------------------------------------------------------------
  1184. function TSvgSubPath.GetMoveStrDef(relative: Boolean; decimalPrec: integer): string;
  1185. var
  1186. pt: TPointD;
  1187. begin
  1188. Result := '';
  1189. if fSegsCount = 0 then Exit;
  1190. if decimalPrec < -3 then decimalPrec := -3
  1191. else if decimalPrec > 4 then decimalPrec := 4;
  1192. with fParent do
  1193. begin
  1194. pt.X := (fSegs[0].fFirstPt.X - self.PathOffset.X - Offset.X)/fPathScale;
  1195. pt.Y := (fSegs[0].fFirstPt.Y - self.PathOffset.Y - Offset.Y)/fPathScale;
  1196. end;
  1197. Result := 'M ' + AsCoordStr(pt, NullPointD, false, decimalPrec);
  1198. end;
  1199. //------------------------------------------------------------------------------
  1200. function TSvgSubPath.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  1201. var
  1202. i: integer;
  1203. begin
  1204. if decimalPrec < -3 then decimalPrec := -3
  1205. else if decimalPrec > 4 then decimalPrec := 4;
  1206. if Count = 0 then Exit;
  1207. Result := GetMoveStrDef(relative, decimalPrec);
  1208. for i := 0 to Count -1 do
  1209. Result := Result + fSegs[i].GetStringDef(relative, decimalPrec);
  1210. end;
  1211. //------------------------------------------------------------------------------
  1212. constructor TSvgSubPath.Create(parent: TSvgPath);
  1213. begin
  1214. fParent := parent;
  1215. end;
  1216. //------------------------------------------------------------------------------
  1217. destructor TSvgSubPath.Destroy;
  1218. begin
  1219. Clear;
  1220. inherited;
  1221. end;
  1222. //------------------------------------------------------------------------------
  1223. procedure TSvgSubPath.Clear;
  1224. var
  1225. i: integer;
  1226. begin
  1227. for i := 0 to Count -1 do
  1228. fSegs[i].Free;
  1229. fSegs := nil;
  1230. fSegsCount := 0;
  1231. fPathOffset := NullPointD;
  1232. end;
  1233. //------------------------------------------------------------------------------
  1234. procedure TSvgSubPath.GrowSegs;
  1235. begin
  1236. SetLength(fSegs, (fSegsCount * 2) + 1);
  1237. end;
  1238. //------------------------------------------------------------------------------
  1239. procedure TSvgSubPath.SegsLoaded;
  1240. begin
  1241. // Trim the array to the actual used size
  1242. if Length(fSegs) <> fSegsCount then
  1243. SetLength(fSegs, fSegsCount);
  1244. end;
  1245. //------------------------------------------------------------------------------
  1246. procedure TSvgSubPath.InitSegs(Capacity: Integer);
  1247. begin
  1248. if Capacity > fSegsCount then
  1249. SetLength(fSegs, Capacity);
  1250. end;
  1251. //------------------------------------------------------------------------------
  1252. function TSvgSubPath.GetCount: integer;
  1253. begin
  1254. Result := fSegsCount;
  1255. end;
  1256. //------------------------------------------------------------------------------
  1257. procedure TSvgSubPath.Offset(dx, dy: double);
  1258. var
  1259. i: integer;
  1260. begin
  1261. for i := 0 to fSegsCount - 1 do fSegs[i].Offset(dx, dy);
  1262. end;
  1263. //------------------------------------------------------------------------------
  1264. function TSvgSubPath.GetSeg(index: integer): TSvgPathSeg;
  1265. begin
  1266. if (index < 0) or (index >= Count) then
  1267. raise Exception.Create(rsSvgSubPathRangeError);
  1268. Result := fSegs[index];
  1269. end;
  1270. //------------------------------------------------------------------------------
  1271. function TSvgSubPath.GetFirstPt: TPointD;
  1272. begin
  1273. if Count = 0 then Result := NullPointD
  1274. else Result := fSegs[0].FirstPt;
  1275. end;
  1276. //------------------------------------------------------------------------------
  1277. function TSvgSubPath.GetLastPt: TPointD;
  1278. begin
  1279. if Count = 0 then
  1280. Result := NullPointD
  1281. else with fSegs[Count -1] do
  1282. Result := CtrlPts[High(CtrlPts)];
  1283. end;
  1284. //------------------------------------------------------------------------------
  1285. function TSvgSubPath.GetBounds: TRectD;
  1286. var
  1287. i: integer;
  1288. p: TPathD;
  1289. begin
  1290. p := nil;
  1291. for i := 0 to Count -1 do
  1292. ConcatPaths(p, fSegs[i].fFlatPath);
  1293. Result := Img32.Vector.GetBoundsD(p);
  1294. end;
  1295. //------------------------------------------------------------------------------
  1296. // TSvgPath
  1297. //------------------------------------------------------------------------------
  1298. destructor TSvgPath.Destroy;
  1299. begin
  1300. Clear;
  1301. inherited;
  1302. end;
  1303. //------------------------------------------------------------------------------
  1304. procedure TSvgPath.ScaleAndOffset(scale: double; dx, dy: integer);
  1305. var
  1306. i,j: integer;
  1307. begin
  1308. if fPathScale = 0 then fPathScale := 1;
  1309. if scale = 0 then scale := 1;
  1310. fPathScale := fPathScale * scale;
  1311. fPathOffs := PointD(dx, dy);
  1312. for i := 0 to Count -1 do
  1313. with fSubPaths[i] do
  1314. begin
  1315. if scale <> 1 then
  1316. for j := 0 to fSegsCount - 1 do
  1317. fSegs[j].Scale(scale);
  1318. Offset(dx,dy);
  1319. end;
  1320. end;
  1321. //------------------------------------------------------------------------------
  1322. function TSvgPath.GetStringDef(relative: Boolean; decimalPrec: integer): string;
  1323. var
  1324. i : integer;
  1325. begin
  1326. result := '';
  1327. if fPathScale = 0 then fPathScale := 1;
  1328. for i := 0 to High(fSubPaths) do
  1329. Result := Result + fSubPaths[i].GetStringDef(relative, decimalPrec);
  1330. end;
  1331. //------------------------------------------------------------------------------
  1332. procedure TSvgPath.Parse(const value: UTF8String);
  1333. var
  1334. c, endC : PUTF8Char;
  1335. firstPt : TPointD;
  1336. lastPt : TPointD;
  1337. currPt : TPointD;
  1338. pt2, pt3 : TPointD;
  1339. angle : double;
  1340. sweepCW : integer;
  1341. largeArc : integer;
  1342. arcRec : TRectD;
  1343. isRelative : Boolean;
  1344. currSegType : TSvgPathSegType;
  1345. currSubPath : TSvgSubPath;
  1346. pts : TPathD;
  1347. ptCap : integer;
  1348. ptCnt : integer;
  1349. procedure AddPt(const pt: TPointD);
  1350. begin
  1351. if ptCnt = ptCap then
  1352. begin
  1353. inc(ptCap, 8);
  1354. SetLengthUninit(pts, ptCap);
  1355. end;
  1356. pts[ptCnt] := pt;
  1357. inc(ptCnt);
  1358. end;
  1359. procedure AllocEstimatedPtsCount(c, endC: PUTF8Char);
  1360. begin
  1361. // Count the numbers before the next segment type char
  1362. ptCap := 0;
  1363. while c < endC do
  1364. begin
  1365. // skip whitespaces
  1366. while (c < endC) and (c^ <= space) do
  1367. inc(c);
  1368. if c >= endC then
  1369. break;
  1370. case c^ of
  1371. '0'..'9', '-', '.', 'E', 'e':
  1372. begin
  1373. while (c < endC) and (c^ > space) do
  1374. inc(c);
  1375. Inc(ptCap);
  1376. end;
  1377. else
  1378. Break;
  1379. end;
  1380. end;
  1381. ptCap := ptCap div 2; // two numbers are one point
  1382. SetLength(pts, ptCap);
  1383. end;
  1384. function EstimateSegs(c, endC: PUTF8Char): Integer;
  1385. var
  1386. ch: UTF8Char;
  1387. begin
  1388. Result := 0;
  1389. while True do
  1390. begin
  1391. if c >= endC then
  1392. Break;
  1393. ch := c^;
  1394. inc(c);
  1395. case ch of
  1396. 'A'..'Z', 'a'..'z':
  1397. begin
  1398. case ch of
  1399. 'M', 'm': // move / close
  1400. Break;
  1401. 'Z', 'z':
  1402. begin
  1403. Inc(Result);
  1404. Break;
  1405. end;
  1406. 'E', 'e': ; // Exponent of a number
  1407. else
  1408. Inc(Result);
  1409. end;
  1410. end;
  1411. end;
  1412. end;
  1413. end;
  1414. var
  1415. ExpectedSegCount: Integer;
  1416. begin
  1417. Clear;
  1418. currSubPath := nil;
  1419. ExpectedSegCount := 1;
  1420. c := PUTF8Char(value);
  1421. endC := c + Length(value);
  1422. isRelative := false;
  1423. currPt := NullPointD;
  1424. while true do
  1425. begin
  1426. currSegType := GetSegType(c, endC, isRelative);
  1427. if currSegType = stUnknown then Break;
  1428. if currSegType = stMove then
  1429. begin
  1430. if currSubPath <> nil then
  1431. currSubPath.SegsLoaded; // Trim the segs array to the actual count
  1432. currSubPath := nil;
  1433. ExpectedSegCount := EstimateSegs(c, endc);
  1434. if isRelative then
  1435. lastPt := currPt else
  1436. lastPt := InvalidPointD;
  1437. if not Parse2Num(c, endC, currPt, lastPt) then break;
  1438. lastPt := currPt;
  1439. //values immediately following a Move are implicitly Line statements
  1440. if IsNumPending(c, endC, true) then
  1441. currSegType := stLine else
  1442. Continue;
  1443. Inc(ExpectedSegCount);
  1444. end
  1445. else if (currSegType = stClose) then
  1446. begin
  1447. if currPt.X = InvalidD then Continue;
  1448. if Assigned(currSubPath) and (currSubPath.Count > 0) then
  1449. begin
  1450. lastPt := currPt;
  1451. currPt := currSubPath.GetFirstPt;
  1452. currSubPath.AddZSeg(lastPt, currPt);
  1453. end else
  1454. begin
  1455. if not Assigned(currSubPath) then
  1456. currSubPath := AddPath(1);
  1457. currSubPath.AddZSeg(currPt, currPt);
  1458. end;
  1459. currSubPath.SegsLoaded; // Trim the segs array to the actual count
  1460. currSubPath := nil;
  1461. ExpectedSegCount := 1;
  1462. Continue;
  1463. end;
  1464. if not Assigned(currSubPath) then
  1465. currSubPath := AddPath(ExpectedSegCount);
  1466. pts := nil;
  1467. ptCnt := 0; ptCap := 0;
  1468. firstPt := currPt;
  1469. if isRelative then
  1470. lastPt := firstPt else
  1471. lastPt := InvalidPointD;
  1472. case currSegType of
  1473. stArc:
  1474. begin
  1475. //nb: unlike other segment types,
  1476. //consecutive arc segs are separated.
  1477. while IsNumPending(c, endC, true) and
  1478. Parse2Num(c, endC, pt2, InvalidPointD) and
  1479. ParseNextNum(c, endC, true, angle) and
  1480. GetSingleDigit(c, endC, largeArc) and
  1481. GetSingleDigit(c, endC, sweepCW) and
  1482. Parse2Num(c, endC, currPt, lastPt) do
  1483. begin
  1484. angle := DegToRad(angle);
  1485. arcRec := GetSvgArcInfoRect(firstPt, currPt, pt2,
  1486. angle, largeArc <> 0, sweepCW <> 0);
  1487. if arcRec.IsEmpty then break;
  1488. currSubPath.AddASeg(firstPt, currPt,
  1489. arcRec, angle, sweepCW <> 0);
  1490. if isRelative then lastPt := currPt;
  1491. firstPt := currPt;
  1492. end;
  1493. end;
  1494. stCBezier:
  1495. begin
  1496. AllocEstimatedPtsCount(c, endC);
  1497. while IsNumPending(c, endC, true) and
  1498. Parse2Num(c, endC, pt2, lastPt) and
  1499. Parse2Num(c, endC, pt3, lastPt) and
  1500. Parse2Num(c, endC, currPt, lastPt) do
  1501. begin
  1502. AddPt(pt2);
  1503. AddPt(pt3);
  1504. AddPt(currPt);
  1505. if isRelative then lastPt := currPt;
  1506. end;
  1507. if Length(pts) <> ptCnt then
  1508. SetLength(pts, ptCnt);
  1509. currSubPath.AddSeg(stCBezier, firstPt, pts);
  1510. end;
  1511. stHorz:
  1512. begin
  1513. AllocEstimatedPtsCount(c, endC);
  1514. while IsNumPending(c, endC, true) and
  1515. Parse1Num(c, endC, currPt.X, lastPt.X) do
  1516. begin
  1517. AddPt(currPt);
  1518. if isRelative then lastPt.X := currPt.X;
  1519. end;
  1520. if Length(pts) <> ptCnt then
  1521. SetLength(pts, ptCnt);
  1522. currSubPath.AddHSeg(firstPt, pts);
  1523. end;
  1524. stQBezier, stCSpline:
  1525. begin
  1526. AllocEstimatedPtsCount(c, endC);
  1527. while IsNumPending(c, endC, true) and
  1528. Parse2Num(c, endC, pt2, lastPt) and
  1529. Parse2Num(c, endC, currPt, lastPt) do
  1530. begin
  1531. AddPt(pt2);
  1532. AddPt(currPt);
  1533. if isRelative then lastPt := currPt;
  1534. end;
  1535. if Length(pts) <> ptCnt then
  1536. SetLength(pts, ptCnt);
  1537. currSubPath.AddSeg(currSegType, firstPt, pts);
  1538. end;
  1539. stLine, stQSpline:
  1540. begin
  1541. AllocEstimatedPtsCount(c, endC);
  1542. while IsNumPending(c, endC, true) and
  1543. Parse2Num(c, endC, currPt, lastPt) do
  1544. begin
  1545. AddPt(currPt);
  1546. if isRelative then lastPt := currPt;
  1547. end;
  1548. if Length(pts) <> ptCnt then
  1549. SetLength(pts, ptCnt);
  1550. currSubPath.AddSeg(currSegType, firstPt, pts);
  1551. end;
  1552. stVert:
  1553. begin
  1554. AllocEstimatedPtsCount(c, endC);
  1555. while IsNumPending(c, endC, true) and
  1556. Parse1Num(c, endC, currPt.Y, lastPt.Y) do
  1557. begin
  1558. AddPt(currPt);
  1559. if isRelative then lastPt.Y := currPt.Y;
  1560. end;
  1561. if Length(pts) <> ptCnt then
  1562. SetLength(pts, ptCnt);
  1563. currSubPath.AddVSeg(firstPt, pts);
  1564. end;
  1565. end;
  1566. end;
  1567. if currSubPath <> nil then
  1568. currSubPath.SegsLoaded; // Trim the segs array to the actual count
  1569. end;
  1570. //------------------------------------------------------------------------------
  1571. function TSvgPath.GetCount: integer;
  1572. begin
  1573. Result := Length(fSubPaths);
  1574. end;
  1575. //------------------------------------------------------------------------------
  1576. function TSvgPath.GetPath(index: integer): TSvgSubPath;
  1577. begin
  1578. if (index < 0) or (index >= Count) then
  1579. raise Exception.Create(rsSvgPathRangeError);
  1580. Result := fSubPaths[index];
  1581. end;
  1582. //------------------------------------------------------------------------------
  1583. procedure TSvgPath.Clear;
  1584. var
  1585. i: integer;
  1586. begin
  1587. for i := 0 to Count -1 do
  1588. fSubPaths[i].Free;
  1589. fSubPaths := nil;
  1590. fPathScale := 1;
  1591. end;
  1592. //------------------------------------------------------------------------------
  1593. function TSvgPath.GetBounds: TRectD;
  1594. var
  1595. i: integer;
  1596. p: TPathD;
  1597. begin
  1598. p := nil;
  1599. for i := 0 to Count -1 do
  1600. ConcatPaths(p, fSubPaths[i].GetFlattenedPath);
  1601. Result := Img32.Vector.GetBoundsD(p);
  1602. end;
  1603. //------------------------------------------------------------------------------
  1604. function TSvgPath.GetControlBounds: TRectD;
  1605. var
  1606. i,j: integer;
  1607. p: TPathD;
  1608. begin
  1609. p := nil;
  1610. for i := 0 to Count -1 do
  1611. with fSubPaths[i] do
  1612. begin
  1613. AppendPoint(p, GetFirstPt);
  1614. for j := 0 to fSegsCount - 1 do
  1615. ConcatPaths(p, fSegs[j].fCtrlPts);
  1616. end;
  1617. Result := GetBoundsD(p);
  1618. //watch out for straight horizontal or vertical lines
  1619. if IsEmptyRect(Result) then
  1620. begin
  1621. if Result.Width = 0 then
  1622. begin
  1623. Result.Left := Result.Left - 0.5;
  1624. Result.Right := Result.Left + 1.0;
  1625. end
  1626. else if Result.Height = 0 then
  1627. begin
  1628. Result.Top := Result.Top - 0.5;
  1629. Result.Bottom := Result.Top + 1.0;
  1630. end;
  1631. end;
  1632. end;
  1633. //------------------------------------------------------------------------------
  1634. function TSvgPath.AddPath(SegsCapacity: Integer): TSvgSubPath;
  1635. var
  1636. i: integer;
  1637. begin
  1638. i := Count;
  1639. Result := TSvgSubPath.Create(self);
  1640. Result.InitSegs(SegsCapacity);
  1641. SetLength(fSubPaths, i + 1);
  1642. fSubPaths[i] := Result;
  1643. end;
  1644. //------------------------------------------------------------------------------
  1645. procedure TSvgPath.DeleteSubPath(subPath: TSvgSubPath);
  1646. var
  1647. i, len: integer;
  1648. begin
  1649. len := Length(fSubPaths);
  1650. for i := 0 to len -1 do
  1651. if subPath = fSubPaths[i] then
  1652. begin
  1653. fSubPaths[i].Free;
  1654. if i < len -1 then
  1655. Move(fSubPaths[i+1], fSubPaths[i],
  1656. (len - i -1) * SizeOf(Pointer));
  1657. SetLength(fSubPaths, len -1);
  1658. break;
  1659. end;
  1660. end;
  1661. //------------------------------------------------------------------------------
  1662. // GetSvgArcInfoRect
  1663. //------------------------------------------------------------------------------
  1664. //https://stackoverflow.com/a/12329083
  1665. function GetSvgArcInfoRect(const p1, p2: TPointD; radii: TPointD;
  1666. phi_rads: double; fA, fS: boolean): TRectD;
  1667. var
  1668. x1_, y1_, rxry, rxy1_, ryx1_, s_phi, c_phi: double;
  1669. hd_x, hd_y, hs_x, hs_y, sum_of_sq, lambda, coe: double;
  1670. cx, cy, cx_, cy_: double;
  1671. begin
  1672. Result := NullRectD;
  1673. if (radii.X < 0) then radii.X := -radii.X;
  1674. if (radii.Y < 0) then radii.Y := -radii.Y;
  1675. if (radii.X = 0) or (radii.Y = 0) then Exit;
  1676. GetSinCos(phi_rads, s_phi, c_phi);;
  1677. hd_x := (p1.X - p2.X) / 2.0; // half diff of x
  1678. hd_y := (p1.Y - p2.Y) / 2.0; // half diff of y
  1679. hs_x := (p1.X + p2.X) / 2.0; // half sum of x
  1680. hs_y := (p1.Y + p2.Y) / 2.0; // half sum of y
  1681. // F6.5.1
  1682. x1_ := c_phi * hd_x + s_phi * hd_y;
  1683. y1_ := c_phi * hd_y - s_phi * hd_x;
  1684. // F.6.6 Correction of out-of-range radii
  1685. // Step 3: Ensure radii are large enough
  1686. lambda := (x1_ * x1_) / (radii.X * radii.X) +
  1687. (y1_ * y1_) / (radii.Y * radii.Y);
  1688. if (lambda > 1) then
  1689. begin
  1690. radii.X := radii.X * Sqrt(lambda);
  1691. radii.Y := radii.Y * Sqrt(lambda);
  1692. end;
  1693. rxry := radii.X * radii.Y;
  1694. rxy1_ := radii.X * y1_;
  1695. ryx1_ := radii.Y * x1_;
  1696. sum_of_sq := rxy1_ * rxy1_ + ryx1_ * ryx1_; // sum of square
  1697. if (sum_of_sq = 0) then Exit;
  1698. coe := Sqrt(Abs((rxry * rxry - sum_of_sq) / sum_of_sq));
  1699. if (fA = fS) then coe := -coe;
  1700. // F6.5.2
  1701. cx_ := coe * rxy1_ / radii.Y;
  1702. cy_ := -coe * ryx1_ / radii.X;
  1703. // F6.5.3
  1704. cx := c_phi * cx_ - s_phi * cy_ + hs_x;
  1705. cy := s_phi * cx_ + c_phi * cy_ + hs_y;
  1706. Result.Left := cx - radii.X;
  1707. Result.Right := cx + radii.X;
  1708. Result.Top := cy - radii.Y;
  1709. Result.Bottom := cy + radii.Y;
  1710. end;
  1711. //------------------------------------------------------------------------------
  1712. end.