Img32.Vector.pas 126 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202
  1. unit Img32.Vector;
  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 : Vector drawing for TImage32 *
  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, Math, Types, Img32;
  19. type
  20. TArrowStyle = (asNone, asSimple, asFancy, asDiamond, asCircle, asTail);
  21. // TJoinStyle:
  22. // jsSquare - Convex joins will be truncated using a 'squaring' edge.
  23. // The mid-points of these squaring edges will also be exactly the offset
  24. // (ie delta) distance away from their origins (ie the starting vertices).
  25. // jsButt - joins are similar to 'squared' joins except that squaring
  26. // won't occur at a fixed distance. While bevelled joins may not be as
  27. // pretty as squared joins, bevelling will be much faster than squaring.
  28. // And perhaps this is why bevelling (rather than squaring) is preferred
  29. // in numerous graphics display formats (including SVG & PDF documents).
  30. TJoinStyle = (jsAuto, jsSquare, jsButt, jsMiter, jsRound);
  31. TEndStyle = (esPolygon = 0, esClosed = 0, esButt, esSquare, esRound);
  32. TPathEnd = (peStart, peEnd, peBothEnds);
  33. TSplineType = (stQuadratic, stCubic);
  34. TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);
  35. TImg32FillRule = TFillRule; //useful whenever there's ambiguity with Clipper
  36. TSizeD = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
  37. cx : double;
  38. cy : double;
  39. function average: double;
  40. property Width: Double read cx write cx;
  41. property Height: Double read cy write cy;
  42. end;
  43. TRectWH = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
  44. public
  45. Left, Top, Width, Height: double;
  46. function IsEmpty: Boolean;
  47. function IsValid: Boolean;
  48. function Right: double;
  49. function Bottom: double;
  50. function Contains(const Pt: TPoint): Boolean; overload;
  51. function Contains(const Pt: TPointD): Boolean; overload;
  52. function MidPoint: TPointD;
  53. function RectD: TRectD;
  54. function Rect: TRect;
  55. end;
  56. function RectWH(left, top, width, height: integer): TRectWH; overload;
  57. function RectWH(left, top, width, height: double ): TRectWH; overload;
  58. function RectWH(const rec: TRectD): TRectWH; overload;
  59. //InflateRect: missing in Delphi 7
  60. procedure InflateRect(var rec: TRect; dx, dy: integer); overload;
  61. procedure InflateRect(var rec: TRectD; dx, dy: double); overload;
  62. function NormalizeRect(var rect: TRect): Boolean;
  63. function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD; overload;
  64. procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD); overload;
  65. function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
  66. function Rectangle(const rec: TRect): TPathD; overload;
  67. function Rectangle(const rec: TRectD): TPathD; overload;
  68. function Rectangle(l, t, r, b: double): TPathD; overload;
  69. function RoundRect(const rec: TRect; radius: integer): TPathD; overload;
  70. function RoundRect(const rec: TRectD; radius: double): TPathD; overload;
  71. function RoundRect(const rec: TRect; radius: TPoint): TPathD; overload;
  72. function RoundRect(const rec: TRectD; radius: TPointD): TPathD; overload;
  73. function Ellipse(const rec: TRect; steps: integer = 0): TPathD; overload;
  74. function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload;
  75. function Ellipse(const rec: TRectD; pendingScale: double): TPathD; overload;
  76. function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD; overload;
  77. function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD; overload;
  78. function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
  79. function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
  80. function Circle(const pt: TPoint; radius: double): TPathD; overload;
  81. function Circle(const pt: TPointD; radius: double): TPathD; overload;
  82. function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD; overload;
  83. function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
  84. out centre: TPointD; out radius: double): Boolean;
  85. function Star(const rec: TRectD; points: integer; indentFrac: double = 0.4): TPathD; overload;
  86. function Star(const focalPt: TPointD;
  87. innerRadius, outerRadius: double; points: integer): TPathD; overload;
  88. function Arc(const rec: TRectD;
  89. startAngle, endAngle: double; scale: double = 0): TPathD;
  90. function Pie(const rec: TRectD;
  91. StartAngle, EndAngle: double; scale: double = 0): TPathD;
  92. function FlattenQBezier(const pt1, pt2, pt3: TPointD;
  93. tolerance: double = 0.0): TPathD; overload;
  94. function FlattenQBezier(const pts: TPathD;
  95. tolerance: double = 0.0): TPathD; overload;
  96. function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
  97. tolerance: double = 0.0): TPathD; overload;
  98. function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
  99. function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
  100. tolerance: double = 0.0): TPathD; overload;
  101. function FlattenCBezier(const path: TPathD;
  102. tolerance: double = 0.0): TPathD; overload;
  103. function FlattenCBezier(const paths: TPathsD;
  104. tolerance: double = 0.0): TPathsD; overload;
  105. function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
  106. tolerance: double = 0.0): TPathD; overload;
  107. function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
  108. //FlattenCSpline: Approximates the 'S' command inside the 'd' property of an
  109. //SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
  110. function FlattenCSpline(const pts: TPathD;
  111. tolerance: double = 0.0): TPathD; overload;
  112. function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
  113. const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
  114. //FlattenQSpline: Approximates the 'T' command inside the 'd' property of an
  115. //SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
  116. function FlattenQSpline(const pts: TPathD;
  117. tolerance: double = 0.0): TPathD; overload;
  118. function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
  119. const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
  120. //ArrowHead: The ctrlPt's only function is to control the angle of the arrow.
  121. function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
  122. arrowStyle: TArrowStyle): TPathD;
  123. function GetDefaultArrowHeadSize(lineWidth: double): double;
  124. procedure AdjustPoint(var pt: TPointD;
  125. const referencePt: TPointD; delta: double);
  126. function ShortenPath(const path: TPathD;
  127. pathEnd: TPathEnd; amount: double): TPathD;
  128. //GetDashPath: Returns a polyline (not polygons)
  129. function GetDashedPath(const path: TPathD;
  130. closed: Boolean; const pattern: TArrayOfDouble;
  131. patternOffset: PDouble): TPathsD;
  132. function GetDashedOutLine(const path: TPathD;
  133. closed: Boolean; const pattern: TArrayOfDouble;
  134. patternOffset: PDouble; lineWidth: double;
  135. joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
  136. function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint; overload;
  137. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload;
  138. function TranslatePath(const path: TPathD;
  139. dx, dy: double): TPathD; overload;
  140. function TranslatePath(const paths: TPathsD;
  141. dx, dy: double): TPathsD; overload;
  142. function TranslatePath(const ppp: TArrayOfPathsD;
  143. dx, dy: double): TArrayOfPathsD; overload;
  144. function Paths(const path: TPathD): TPathsD;
  145. {$IFDEF INLINING} inline; {$ENDIF}
  146. //CopyPath: note that only dynamic string arrays are copy-on-write
  147. function CopyPath(const path: TPathD): TPathD;
  148. {$IFDEF INLINING} inline; {$ENDIF}
  149. function CopyPaths(const paths: TPathsD): TPathsD;
  150. function ScalePoint(const pt: TPointD; scale: double): TPointD; overload;
  151. {$IFDEF INLINING} inline; {$ENDIF}
  152. function ScalePoint(const pt: TPointD; sx, sy: double): TPointD; overload;
  153. {$IFDEF INLINING} inline; {$ENDIF}
  154. function ScalePath(const path: TPathD;
  155. sx, sy: double): TPathD; overload;
  156. function ScalePath(const path: TPathD;
  157. scale: double): TPathD; overload;
  158. function ScalePath(const paths: TPathsD;
  159. sx, sy: double): TPathsD; overload;
  160. function ScalePath(const paths: TPathsD;
  161. scale: double): TPathsD; overload;
  162. function ScaleRect(const rec: TRect; scale: double): TRect; overload;
  163. function ScaleRect(const rec: TRectD; scale: double): TRectD; overload;
  164. function ScaleRect(const rec: TRect; sx, sy: double): TRect; overload;
  165. function ScaleRect(const rec: TRectD; sx, sy: double): TRectD; overload;
  166. function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
  167. function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
  168. function ReversePath(const path: TPathD): TPathD; overload;
  169. function ReversePath(const paths: TPathsD): TPathsD; overload;
  170. function OpenPathToFlatPolygon(const path: TPathD): TPathD;
  171. procedure AppendPoint(var path: TPathD; const extra: TPointD);
  172. // AppendPath - adds TPathD & TPathsD objects to the end of
  173. // TPathsD (or TArrayOfPathsD) objects
  174. procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload;
  175. procedure AppendPath(var paths: TPathsD; const extra: TPathsD); overload;
  176. procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD); overload;
  177. // ConcatPaths - concats multiple paths into a single path.
  178. // It also avoids point duplicates where path joins
  179. procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
  180. procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD); overload;
  181. function GetAngle(const origin, pt: TPoint): double; overload;
  182. function GetAngle(const origin, pt: TPointD): double; overload;
  183. function GetAngle(const a, b, c: TPoint): double; overload;
  184. function GetAngle(const a, b, c: TPointD): double; overload;
  185. procedure GetSinCos(angle: double; out sinA, cosA: double);
  186. function GetPointAtAngleAndDist(const origin: TPointD;
  187. angle, distance: double): TPointD;
  188. function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; overload;
  189. function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD; out ip: TPointD): Boolean; overload;
  190. function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
  191. function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
  192. out ip: TPointD): Boolean;
  193. procedure RotatePoint(var pt: TPointD;
  194. const focalPoint: TPointD; sinA, cosA: double); overload;
  195. procedure RotatePoint(var pt: TPointD;
  196. const focalPoint: TPointD; angleRad: double); overload;
  197. function RotatePath(const path: TPathD;
  198. const focalPoint: TPointD; angleRads: double): TPathD; overload;
  199. function RotatePath(const paths: TPathsD;
  200. const focalPoint: TPointD; angleRads: double): TPathsD; overload;
  201. //function MakePath(const pts: array of integer): TPathD; overload;
  202. function MakePath(const pts: array of double): TPathD; overload;
  203. function MakePath(const pt: TPointD): TPathD; overload;
  204. function GetBounds(const path: TPathD): TRect; overload;
  205. function GetBounds(const paths: TPathsD): TRect; overload;
  206. function GetBoundsD(const path: TPathD): TRectD; overload;
  207. function GetBoundsD(const paths: TPathsD): TRectD; overload;
  208. function GetBoundsD(const paths: TArrayOfPathsD): TRectD; overload;
  209. function GetRotatedRectBounds(const rec: TRect; angle: double): TRect; overload;
  210. function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD; overload;
  211. function Rect(const recD: TRectD): TRect; overload;
  212. function Rect(const left,top,right,bottom: integer): TRect; overload;
  213. function PtInRect(const rec: TRectD; const pt: TPointD): Boolean; overload;
  214. function Size(cx, cy: integer): TSize;
  215. function SizeD(cx, cy: double): TSizeD;
  216. function IsClockwise(const path: TPathD): Boolean;
  217. // IsSimpleRectanglePath returns true if the specified path has only one polygon
  218. // with 4 points that describe a rectangle.
  219. function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean; overload;
  220. function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean; overload;
  221. function Area(const path: TPathD): Double; overload;
  222. function RectsEqual(const rec1, rec2: TRect): Boolean;
  223. procedure TranslateRect(var rec: TRect; dx, dy: integer); overload;
  224. procedure TranslateRect(var rec: TRectD; dx, dy: double); overload;
  225. function MakeSquare(rec: TRect): TRect;
  226. function IsValid(value: integer): Boolean; overload;
  227. function IsValid(value: double): Boolean; overload;
  228. function IsValid(const pt: TPoint): Boolean; overload;
  229. function IsValid(const pt: TPointD): Boolean; overload;
  230. function IsValid(const rec: TRect): Boolean; overload;
  231. function Point(X,Y: Integer): TPoint; overload;
  232. function Point(const pt: TPointD): TPoint; overload;
  233. function PointsEqual(const pt1, pt2: TPointD): Boolean; overload;
  234. {$IFDEF INLINING} inline; {$ENDIF}
  235. function PointsNearEqual(const pt1, pt2: TPoint;
  236. dist: integer): Boolean; overload;
  237. function PointsNearEqual(const pt1, pt2: TPointD;
  238. distSqrd: double): Boolean; overload;
  239. {$IFDEF INLINING} inline; {$ENDIF}
  240. function StripNearDuplicates(const path: TPathD;
  241. minDist: double; isClosedPath: Boolean): TPathD; overload;
  242. function StripNearDuplicates(const paths: TPathsD;
  243. minLength: double; isClosedPaths: Boolean): TPathsD; overload;
  244. function MidPoint(const rec: TRect): TPoint; overload;
  245. function MidPoint(const rec: TRectD): TPointD; overload;
  246. function MidPoint(const pt1, pt2: TPoint): TPoint; overload;
  247. function MidPoint(const pt1, pt2: TPointD): TPointD; overload;
  248. function Average(val1, val2: integer): integer; overload;
  249. function Average(val1, val2: double): double; overload;
  250. function ReflectPoint(const pt, pivot: TPointD): TPointD;
  251. {$IFDEF INLINING} inline; {$ENDIF}
  252. function RectsOverlap(const rec1, rec2: TRect): Boolean;
  253. function IsSameRect(const rec1, rec2: TRect): Boolean;
  254. function RectsIntersect(const rec1, rec2: TRect): Boolean; overload;
  255. function RectsIntersect(const rec1, rec2: TRectD): Boolean; overload;
  256. function IntersectRect(const rec1, rec2: TRectD): TRectD; overload;
  257. // UnionRect: this behaves differently to types.UnionRect
  258. // in that if either parameter is empty the other parameter is returned
  259. function UnionRect(const rec1, rec2: TRect): TRect; overload;
  260. function UnionRect(const rec1, rec2: TRectD): TRectD; overload;
  261. //these 2 functions are only needed to support older versions of Delphi
  262. function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
  263. function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
  264. function CrossProduct(const vector1, vector2: TPointD): double; overload;
  265. {$IFDEF INLINING} inline; {$ENDIF}
  266. function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload;
  267. {$IFDEF INLINING} inline; {$ENDIF}
  268. function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double; overload;
  269. {$IFDEF INLINING} inline; {$ENDIF}
  270. function DotProduct(const vector1, vector2: TPointD): double; overload;
  271. {$IFDEF INLINING} inline; {$ENDIF}
  272. function DotProduct(const pt1, pt2, pt3: TPointD): double; overload;
  273. {$IFDEF INLINING} inline; {$ENDIF}
  274. function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
  275. {$IFDEF INLINING} inline; {$ENDIF}
  276. function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
  277. {$IFDEF INLINING} inline; {$ENDIF}
  278. function IsPathConvex(const path: TPathD): Boolean;
  279. function NormalizeVector(const vec: TPointD): TPointD;
  280. {$IFDEF INLINING} inline; {$ENDIF}
  281. //GetUnitVector: Used internally
  282. function GetUnitVector(const pt1, pt2: TPointD): TPointD;
  283. //GetUnitNormal: Used internally
  284. function GetUnitNormal(const pt1, pt2: TPointD): TPointD; overload;
  285. {$IFDEF INLINING} inline; {$ENDIF}
  286. function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean; overload;
  287. {$IFDEF INLINING} inline; {$ENDIF}
  288. function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
  289. {$IFDEF INLINING} inline; {$ENDIF}
  290. //GetVectors: Used internally
  291. function GetVectors(const path: TPathD): TPathD;
  292. //GetNormals: Used internally
  293. function GetNormals(const path: TPathD): TPathD;
  294. //DistanceSqrd: Used internally
  295. function DistanceSqrd(const pt1, pt2: TPoint): double; overload;
  296. {$IFDEF INLINE} inline; {$ENDIF}
  297. //DistanceSqrd: Used internally
  298. function DistanceSqrd(const pt1, pt2: TPointD): double; overload;
  299. {$IFDEF INLINE} inline; {$ENDIF}
  300. function Distance(const pt1, pt2: TPoint): double; overload;
  301. {$IFDEF INLINE} inline; {$ENDIF}
  302. function Distance(const pt1, pt2: TPointD): double; overload;
  303. {$IFDEF INLINE} inline; {$ENDIF}
  304. function Distance(const path: TPathD; stopAt: integer = 0): double; overload;
  305. function GetDistances(const path: TPathD): TArrayOfDouble;
  306. function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
  307. function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
  308. function PointInPolygon(const pt: TPointD;
  309. const polygon: TPathD; fillRule: TFillRule): Boolean;
  310. function PointInPolygons(const pt: TPointD;
  311. const polygons: TPathsD; fillRule: TFillRule): Boolean;
  312. function PerpendicularDist(const pt, line1, line2: TPointD): double;
  313. function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
  314. function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
  315. function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
  316. //GetLineEllipseIntersects: Gets the intersection of a line and
  317. //an ellipse. The function succeeds when the line either touches
  318. //tangentially or passes through the ellipse. If the line touches
  319. //tangentially, the coordintates returned in pt1 and pt2 will match.
  320. function GetLineEllipseIntersects(const ellipseRec: TRect;
  321. var linePt1, linePt2: TPointD): Boolean;
  322. function GetPtOnEllipseFromAngle(const ellipseRect: TRectD; angle: double): TPointD;
  323. function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
  324. ellipseRotAngle, angle: double): TPointD;
  325. function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
  326. const pt: TPointD): double;
  327. function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
  328. ellipseRotAngle: double; pt: TPointD): double;
  329. function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
  330. ellipseRotation: double; const pt: TPointD): TPointD;
  331. // RoughOutline: outlines are **rough** because they will contain numerous
  332. // self-intersections and negative area regions. (This untidiness will be
  333. // hidden as long as the NonZero fill rule is applied when rendering, and
  334. // this function will be **much** faster than Img32.Clipper.InflatePaths.)
  335. // The 'scale' parameter doesn't actually scale the returned outline, it's
  336. // only a warning of future scaling and used to guide the returned precision.
  337. // RoughOutline is intended mostly for internal use.
  338. function RoughOutline(const line: TPathD; lineWidth: double;
  339. joinStyle: TJoinStyle; endStyle: TEndStyle;
  340. miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
  341. function RoughOutline(const lines: TPathsD; lineWidth: double;
  342. joinStyle: TJoinStyle; endStyle: TEndStyle;
  343. miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
  344. // Grow: For the same reasons stated in RoughOutline's comments above,
  345. // this function is also intended mostly for internal use
  346. function Grow(const path, normals: TPathD; delta: double;
  347. joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0; isOpen: Boolean = false): TPathD;
  348. function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
  349. function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
  350. const
  351. Invalid = -MaxInt;
  352. InvalidD = -Infinity;
  353. NullPoint : TPoint = (X: 0; Y: 0);
  354. NullPointD : TPointD = (X: 0; Y: 0);
  355. InvalidPoint : TPoint = (X: -MaxInt; Y: -MaxInt);
  356. InvalidPointD : TPointD = (X: -Infinity; Y: -Infinity);
  357. NullRect : TRect = (left: 0; top: 0; right: 0; Bottom: 0);
  358. NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0);
  359. InvalidRect : TRect = (left: MaxInt; top: MaxInt; right: 0; Bottom: 0);
  360. BezierTolerance: double = 0.25;
  361. DoubleTolerance: double = 1.0e-12;
  362. var
  363. //AutoWidthThreshold: When JoinStyle = jsAuto, this is the threshold at
  364. //which line joins will be rounded instead of squared. With wider strokes,
  365. //rounded joins generally look better, but as rounding is more complex it
  366. //also requries more processing and hence is slower to execute.
  367. AutoWidthThreshold: double = 5.0;
  368. //When lines are too narrow, they become too faint to sensibly draw
  369. MinStrokeWidth: double = 0.5;
  370. //Miter limit avoids excessive spikes when line offsetting
  371. DefaultMiterLimit: double = 4.0;
  372. resourcestring
  373. rsInvalidMatrix = 'Invalid matrix.'; //nb: always start with IdentityMatrix
  374. implementation
  375. uses
  376. Img32.Transform;
  377. resourcestring
  378. rsInvalidQBezier = 'Invalid number of control points for a QBezier';
  379. rsInvalidCBezier = 'Invalid number of control points for a CBezier';
  380. const
  381. BuffSize = 64;
  382. {$IFDEF CPUX86}
  383. // Use faster Trunc for x86 code in this unit.
  384. Trunc: function(Value: Double): Integer = __Trunc;
  385. {$ENDIF CPUX86}
  386. //------------------------------------------------------------------------------
  387. // TSizeD
  388. //------------------------------------------------------------------------------
  389. function TSizeD.average: double;
  390. begin
  391. Result := (cx + cy) * 0.5;
  392. end;
  393. //------------------------------------------------------------------------------
  394. // TRectWH record/object.
  395. //------------------------------------------------------------------------------
  396. function TRectWH.IsEmpty: Boolean;
  397. begin
  398. Result := (Width <= 0) or (Height <= 0);
  399. end;
  400. //------------------------------------------------------------------------------
  401. function TRectWH.IsValid: Boolean;
  402. begin
  403. Result := (Left <> InvalidD) and (Top <> InvalidD)
  404. and (Width >= 0) and (Height >= 0);
  405. end;
  406. //------------------------------------------------------------------------------
  407. function TRectWH.Right: double;
  408. begin
  409. Result := Left + Width;
  410. end;
  411. //------------------------------------------------------------------------------
  412. function TRectWH.Bottom: double;
  413. begin
  414. Result := Top + Height;
  415. end;
  416. //------------------------------------------------------------------------------
  417. function TRectWH.Contains(const Pt: TPoint): Boolean;
  418. begin
  419. Result := (pt.X >= Left) and (pt.X <= Left + Width) and
  420. (pt.Y >= Top) and (pt.Y <= Top + Height)
  421. end;
  422. //------------------------------------------------------------------------------
  423. function TRectWH.Contains(const Pt: TPointD): Boolean;
  424. begin
  425. Result := (pt.X >= Left) and (pt.X <= Left + Width) and
  426. (pt.Y >= Top) and (pt.Y <= Top + Height)
  427. end;
  428. //------------------------------------------------------------------------------
  429. function TRectWH.MidPoint: TPointD;
  430. begin
  431. Result := PointD(left + Width * 0.5, top + Height * 0.5);
  432. end;
  433. //------------------------------------------------------------------------------
  434. function TRectWH.RectD: TRectD;
  435. begin
  436. Result := Img32.RectD(left, top, left + Width, top + Height);
  437. end;
  438. //------------------------------------------------------------------------------
  439. function TRectWH.Rect: TRect;
  440. begin
  441. Result := Img32.Vector.Rect(RectD);
  442. end;
  443. //------------------------------------------------------------------------------
  444. function RectWH(left, top, width, height: integer): TRectWH;
  445. begin
  446. Result.Left := left;
  447. Result.Top := top;
  448. Result.Width := width;
  449. Result.Height := height;
  450. end;
  451. //------------------------------------------------------------------------------
  452. function RectWH(left, top, width, height: double): TRectWH;
  453. begin
  454. Result.Left := left;
  455. Result.Top := top;
  456. Result.Width := width;
  457. Result.Height := height;
  458. end;
  459. //------------------------------------------------------------------------------
  460. function RectWH(const rec: TRectD): TRectWH;
  461. begin
  462. Result.Left := rec.left;
  463. Result.Top := rec.top;
  464. Result.Width := rec.width;
  465. Result.Height := rec.height;
  466. end;
  467. //------------------------------------------------------------------------------
  468. function RectsEqual(const rec1, rec2: TRect): Boolean;
  469. begin
  470. result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
  471. (rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
  472. end;
  473. //------------------------------------------------------------------------------
  474. function Rect(const left, top, right, bottom: integer): TRect;
  475. begin
  476. Result.Left := left;
  477. Result.Top := top;
  478. Result.Right := right;
  479. Result.Bottom := bottom;
  480. end;
  481. //------------------------------------------------------------------------------
  482. function IsValid(value: integer): Boolean;
  483. begin
  484. Result := value <> -MaxInt;
  485. end;
  486. //------------------------------------------------------------------------------
  487. function IsValid(value: double): Boolean;
  488. begin
  489. Result := value <> InvalidD;
  490. end;
  491. //------------------------------------------------------------------------------
  492. function IsValid(const pt: TPoint): Boolean;
  493. begin
  494. result := (pt.X <> Invalid) and (pt.Y <> Invalid);
  495. end;
  496. //------------------------------------------------------------------------------
  497. function IsValid(const pt: TPointD): Boolean;
  498. begin
  499. result := (pt.X <> -Infinity) and (pt.Y <> -Infinity);
  500. end;
  501. //------------------------------------------------------------------------------
  502. function IsValid(const rec: TRect): Boolean;
  503. begin
  504. result := (rec.Left <> MaxInt) and (rec.Top <> MaxInt);
  505. end;
  506. //------------------------------------------------------------------------------
  507. function Point(X,Y: Integer): TPoint;
  508. begin
  509. result.X := X;
  510. result.Y := Y;
  511. end;
  512. //------------------------------------------------------------------------------
  513. function Point(const pt: TPointD): TPoint;
  514. begin
  515. result.X := Round(pt.x);
  516. result.Y := Round(pt.y);
  517. end;
  518. //------------------------------------------------------------------------------
  519. function PointsEqual(const pt1, pt2: TPointD): Boolean;
  520. begin
  521. result := (pt1.X = pt2.X) and (pt1.Y = pt2.Y);
  522. end;
  523. //------------------------------------------------------------------------------
  524. function PointsNearEqual(const pt1, pt2: TPoint; dist: integer): Boolean;
  525. begin
  526. Result := (Abs(pt1.X - pt2.X) <= dist) and (Abs(pt1.Y - pt2.Y) < dist);
  527. end;
  528. //------------------------------------------------------------------------------
  529. function PointsNearEqual(const pt1, pt2: TPointD; distSqrd: double): Boolean;
  530. begin
  531. Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distSqrd;
  532. end;
  533. //------------------------------------------------------------------------------
  534. function StripNearDuplicates(const path: TPathD;
  535. minDist: double; isClosedPath: Boolean): TPathD;
  536. var
  537. i,j, len: integer;
  538. begin
  539. len := length(path);
  540. NewPointDArray(Result, len, True);
  541. if len = 0 then Exit;
  542. Result[0] := path[0];
  543. j := 0;
  544. minDist := minDist * minDist;
  545. for i := 1 to len -1 do
  546. if not PointsNearEqual(Result[j], path[i], minDist) then
  547. begin
  548. inc(j);
  549. Result[j] := path[i];
  550. end;
  551. if isClosedPath and
  552. PointsNearEqual(Result[j], Result[0], minDist) then dec(j);
  553. SetLength(Result, j +1);
  554. end;
  555. //------------------------------------------------------------------------------
  556. function StripNearDuplicates(const paths: TPathsD;
  557. minLength: double; isClosedPaths: Boolean): TPathsD;
  558. var
  559. i, len: integer;
  560. begin
  561. len := Length(paths);
  562. SetLength(Result, len);
  563. for i := 0 to len -1 do
  564. Result[i] := StripNearDuplicates(paths[i], minLength, isClosedPaths);
  565. end;
  566. //------------------------------------------------------------------------------
  567. function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
  568. {$IFDEF INLINE} inline; {$ENDIF}
  569. begin
  570. Result := Abs(val) < epsilon;
  571. end;
  572. //------------------------------------------------------------------------------
  573. function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
  574. {$IFDEF INLINE} inline; {$ENDIF}
  575. begin
  576. Result := Abs(val-1) < epsilon;
  577. end;
  578. //------------------------------------------------------------------------------
  579. procedure GetSinCos(angle: double; out sinA, cosA: double);
  580. {$IFDEF INLINE} inline; {$ENDIF}
  581. {$IFNDEF FPC}
  582. var s, c: extended;
  583. {$ENDIF}
  584. begin
  585. {$IFDEF FPC}
  586. Math.SinCos(angle, sinA, cosA);
  587. {$ELSE}
  588. Math.SinCos(angle, s, c);
  589. sinA := s; cosA := c;
  590. {$ENDIF}
  591. end;
  592. //------------------------------------------------------------------------------
  593. function GetRotatedRectBounds(const rec: TRect; angle: double): TRect;
  594. var
  595. p: TPathD;
  596. mp: TPointD;
  597. begin
  598. p := Rectangle(rec);
  599. mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
  600. if angle <> 0 then
  601. p := RotatePath(p, mp, angle);
  602. Result := GetBounds(p);
  603. end;
  604. //------------------------------------------------------------------------------
  605. function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD;
  606. var
  607. p: TPathD;
  608. mp: TPointD;
  609. begin
  610. p := Rectangle(rec);
  611. mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
  612. if angle <> 0 then
  613. p := RotatePath(p, mp, angle);
  614. Result := GetBoundsD(p);
  615. end;
  616. //------------------------------------------------------------------------------
  617. function Rect(const recD: TRectD): TRect;
  618. begin
  619. // see https://github.com/AngusJohnson/Image32/issues/15
  620. Result.Left := Floor(recD.Left + DoubleTolerance);
  621. Result.Top := Floor(recD.Top + DoubleTolerance);
  622. Result.Right := Ceil(recD.Right - DoubleTolerance);
  623. Result.Bottom := Ceil(recD.Bottom - DoubleTolerance);
  624. end;
  625. //------------------------------------------------------------------------------
  626. function PtInRect(const rec: TRectD; const pt: TPointD): Boolean;
  627. begin
  628. Result := (pt.X >= rec.Left) and (pt.X < rec.Right) and
  629. (pt.Y >= rec.Top) and (pt.Y < rec.Bottom);
  630. end;
  631. //------------------------------------------------------------------------------
  632. function Size(cx, cy: integer): TSize;
  633. begin
  634. Result.cx := cx;
  635. Result.cy := cy;
  636. end;
  637. //------------------------------------------------------------------------------
  638. function SizeD(cx, cy: double): TSizeD;
  639. begin
  640. Result.cx := cx;
  641. Result.cy := cy;
  642. end;
  643. //------------------------------------------------------------------------------
  644. function IsClockwise(const path: TPathD): Boolean;
  645. begin
  646. Result := Area(path) > 0;
  647. end;
  648. //------------------------------------------------------------------------------
  649. function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean;
  650. type
  651. TLastMatch = (lmX, lmY);
  652. var
  653. i: Integer;
  654. lastMatch: TLastMatch;
  655. begin
  656. Result := False;
  657. // If we have a single path with 4 points, it could be a rectangle
  658. if Length(path) = 4 then
  659. begin
  660. // For a rectangle the X and Y coordinates of the points alternate
  661. // in being equal
  662. if path[0].X = path[3].X then
  663. lastMatch := lmX
  664. else if path[0].Y = path[3].Y then
  665. lastMatch := lmY
  666. else
  667. Exit;
  668. R.Left := Trunc(path[0].X);
  669. R.Top := Trunc(path[0].Y);
  670. R.Right := Ceil(path[0].X);
  671. R.Bottom := Ceil(path[0].Y);
  672. for i := 1 to 3 do
  673. begin
  674. case lastMatch of
  675. lmY: // now the X-coordinates must be equal
  676. begin
  677. if path[i].X <> path[i - 1].X then Exit;
  678. lastMatch := lmX;
  679. R.Top := Min(R.Top, Trunc(path[i].Y));
  680. R.Bottom := Max(R.Bottom, Ceil(path[i].Y));
  681. end;
  682. lmX: // now the Y-coordinates must be equal
  683. begin
  684. if path[i].Y <> path[i - 1].Y then Exit;
  685. lastMatch := lmY;
  686. R.Left := Min(R.Left, Trunc(path[i].X));
  687. R.Right := Max(R.Right, Ceil(path[i].X));
  688. end;
  689. end;
  690. end;
  691. Result := True;
  692. end;
  693. end;
  694. //------------------------------------------------------------------------------
  695. function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean;
  696. begin
  697. if (Length(paths) = 1) and (Length(paths[0]) = 4) then
  698. Result := IsSimpleRectanglePath(paths[0], r)
  699. else
  700. Result := False;
  701. end;
  702. //------------------------------------------------------------------------------
  703. function Area(const path: TPathD): Double;
  704. var
  705. i, j, highI: Integer;
  706. d: Double;
  707. begin
  708. Result := 0.0;
  709. highI := High(path);
  710. if (highI < 2) then Exit;
  711. j := highI;
  712. for i := 0 to highI do
  713. begin
  714. d := (path[j].X + path[i].X);
  715. Result := Result + d * (path[j].Y - path[i].Y);
  716. j := i;
  717. end;
  718. Result := -Result * 0.5;
  719. end;
  720. //------------------------------------------------------------------------------
  721. procedure TranslateRect(var rec: TRect; dx, dy: integer);
  722. begin
  723. rec.Left := rec.Left + dx;
  724. rec.Top := rec.Top + dy;
  725. rec.Right := rec.Right + dx;
  726. rec.Bottom := rec.Bottom + dy;
  727. end;
  728. //------------------------------------------------------------------------------
  729. procedure TranslateRect(var rec: TRectD; dx, dy: double);
  730. begin
  731. rec.Left := rec.Left + dx;
  732. rec.Top := rec.Top + dy;
  733. rec.Right := rec.Right + dx;
  734. rec.Bottom := rec.Bottom + dy;
  735. end;
  736. //------------------------------------------------------------------------------
  737. function MakeSquare(rec: TRect): TRect;
  738. var
  739. i: integer;
  740. begin
  741. Result := rec;
  742. i := ((rec.Right - rec.Left) + (rec.Bottom - rec.Top)) div 2;
  743. Result.Right := Result.Left + i;
  744. Result.Bottom := Result.Top + i;
  745. end;
  746. //------------------------------------------------------------------------------
  747. function MidPoint(const rec: TRect): TPoint;
  748. begin
  749. Result.X := (rec.Left + rec.Right) div 2;
  750. Result.Y := (rec.Top + rec.Bottom) div 2;
  751. end;
  752. //------------------------------------------------------------------------------
  753. function MidPoint(const rec: TRectD): TPointD;
  754. begin
  755. Result.X := (rec.Left + rec.Right) * 0.5;
  756. Result.Y := (rec.Top + rec.Bottom) * 0.5;
  757. end;
  758. //------------------------------------------------------------------------------
  759. function MidPoint(const pt1, pt2: TPoint): TPoint;
  760. begin
  761. Result.X := (pt1.X + pt2.X) div 2;
  762. Result.Y := (pt1.Y + pt2.Y) div 2;
  763. end;
  764. //------------------------------------------------------------------------------
  765. function MidPoint(const pt1, pt2: TPointD): TPointD;
  766. begin
  767. Result.X := (pt1.X + pt2.X) * 0.5;
  768. Result.Y := (pt1.Y + pt2.Y) * 0.5;
  769. end;
  770. //------------------------------------------------------------------------------
  771. function Average(val1, val2: integer): integer;
  772. begin
  773. Result := (val1 + val2) div 2;
  774. end;
  775. //------------------------------------------------------------------------------
  776. function Average(val1, val2: double): double;
  777. begin
  778. Result := (val1 + val2) * 0.5;
  779. end;
  780. //------------------------------------------------------------------------------
  781. function RectsOverlap(const rec1, rec2: TRect): Boolean;
  782. begin
  783. Result := (rec1.Left < rec2.Right) and (rec1.Right > rec2.Left) and
  784. (rec1.Top < rec2.Bottom) and (rec1.Bottom > rec2.Top);
  785. end;
  786. //------------------------------------------------------------------------------
  787. function IsSameRect(const rec1, rec2: TRect): Boolean;
  788. begin
  789. Result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
  790. (rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
  791. end;
  792. //------------------------------------------------------------------------------
  793. function RectsIntersect(const rec1, rec2: TRect): Boolean;
  794. var
  795. dummy: TRect;
  796. begin
  797. Result := Types.IntersectRect(dummy, rec1, rec2);
  798. end;
  799. //------------------------------------------------------------------------------
  800. function RectsIntersect(const rec1, rec2: TRectD): Boolean;
  801. begin
  802. Result := not IntersectRect(rec1, rec2).IsEmpty;
  803. end;
  804. //------------------------------------------------------------------------------
  805. function IntersectRect(const rec1, rec2: TRectD): TRectD;
  806. begin
  807. result.Left := Max(rec1.Left, rec2.Left);
  808. result.Top := Max(rec1.Top, rec2.Top);
  809. result.Right := Min(rec1.Right, rec2.Right);
  810. result.Bottom := Min(rec1.Bottom, rec2.Bottom);
  811. end;
  812. //------------------------------------------------------------------------------
  813. function UnionRect(const rec1, rec2: TRect): TRect;
  814. begin
  815. if IsEmptyRect(rec1) then
  816. Result := rec2
  817. else if IsEmptyRect(rec2) then
  818. Result := rec1
  819. else
  820. begin
  821. result.Left := Min(rec1.Left, rec2.Left);
  822. result.Top := Min(rec1.Top, rec2.Top);
  823. result.Right := Max(rec1.Right, rec2.Right);
  824. result.Bottom := Max(rec1.Bottom, rec2.Bottom);
  825. end;
  826. end;
  827. //------------------------------------------------------------------------------
  828. function UnionRect(const rec1, rec2: TRectD): TRectD;
  829. begin
  830. if IsEmptyRect(rec1) then
  831. Result := rec2
  832. else if IsEmptyRect(rec2) then
  833. Result := rec1
  834. else
  835. begin
  836. result.Left := Min(rec1.Left, rec2.Left);
  837. result.Top := Min(rec1.Top, rec2.Top);
  838. result.Right := Max(rec1.Right, rec2.Right);
  839. result.Bottom := Max(rec1.Bottom, rec2.Bottom);
  840. end;
  841. end;
  842. //------------------------------------------------------------------------------
  843. function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
  844. var
  845. i, len: integer;
  846. begin
  847. len := Length(ints);
  848. NewIntegerArray(Result, len, True);
  849. for i := 0 to len -1 do Result[i] := ints[i];
  850. end;
  851. //------------------------------------------------------------------------------
  852. function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
  853. var
  854. i, len: integer;
  855. begin
  856. len := Length(doubles);
  857. SetLength(Result, len);
  858. for i := 0 to len -1 do Result[i] := doubles[i];
  859. end;
  860. //------------------------------------------------------------------------------
  861. function CrossProduct(const vector1, vector2: TPointD): double;
  862. begin
  863. result := vector1.X * vector2.Y - vector2.X * vector1.Y;
  864. end;
  865. //------------------------------------------------------------------------------
  866. function CrossProduct(const pt1, pt2, pt3: TPointD): double;
  867. var
  868. x1,x2,y1,y2: double;
  869. begin
  870. x1 := pt2.X - pt1.X;
  871. y1 := pt2.Y - pt1.Y;
  872. x2 := pt3.X - pt2.X;
  873. y2 := pt3.Y - pt2.Y;
  874. result := (x1 * y2 - y1 * x2);
  875. end;
  876. //---------------------------------------------------------------------------
  877. function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double;
  878. var
  879. x1,x2,y1,y2: double;
  880. begin
  881. x1 := pt2.X - pt1.X;
  882. y1 := pt2.Y - pt1.Y;
  883. x2 := pt4.X - pt3.X;
  884. y2 := pt4.Y - pt3.Y;
  885. result := (x1 * y2 - y1 * x2);
  886. end;
  887. //---------------------------------------------------------------------------
  888. function DotProduct(const vector1, vector2: TPointD): double;
  889. begin
  890. result := vector1.X * vector2.X + vector1.Y * vector2.Y;
  891. end;
  892. //------------------------------------------------------------------------------
  893. function DotProduct(const pt1, pt2, pt3: TPointD): double;
  894. var
  895. x1,x2,y1,y2: double;
  896. begin
  897. x1 := pt2.X - pt1.X;
  898. y1 := pt2.Y - pt1.Y;
  899. x2 := pt2.X - pt3.X;
  900. y2 := pt2.Y - pt3.Y;
  901. result := (x1 * x2 + y1 * y2);
  902. end;
  903. //------------------------------------------------------------------------------
  904. function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
  905. begin
  906. result := CrossProduct(pt1, pt2, pt3) < 0;
  907. end;
  908. //------------------------------------------------------------------------------
  909. function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
  910. begin
  911. result := CrossProduct(pt1, pt2, pt3) > 0;
  912. end;
  913. //------------------------------------------------------------------------------
  914. function IsPathConvex(const path: TPathD): Boolean;
  915. var
  916. i, pathLen: integer;
  917. dir: boolean;
  918. begin
  919. result := false;
  920. pathLen := length(path);
  921. if pathLen < 3 then Exit;
  922. //get the winding direction of the first angle
  923. dir := TurnsRight(path[0], path[1], path[2]);
  924. //check that each other angle has the same winding direction
  925. for i := 1 to pathLen -1 do
  926. if TurnsRight(path[i], path[(i+1) mod pathLen],
  927. path[(i+2) mod pathLen]) <> dir then Exit;
  928. result := true;
  929. end;
  930. //------------------------------------------------------------------------------
  931. function GetUnitVector(const pt1, pt2: TPointD): TPointD;
  932. var
  933. dx, dy, inverseHypot: Double;
  934. begin
  935. if (pt1.x = pt2.x) and (pt1.y = pt2.y) then
  936. begin
  937. Result.X := 0;
  938. Result.Y := 0;
  939. Exit;
  940. end;
  941. dx := (pt2.X - pt1.X);
  942. dy := (pt2.Y - pt1.Y);
  943. inverseHypot := 1 / Hypot(dx, dy);
  944. dx := dx * inverseHypot;
  945. dy := dy * inverseHypot;
  946. Result.X := dx;
  947. Result.Y := dy;
  948. end;
  949. //------------------------------------------------------------------------------
  950. function GetUnitNormal(const pt1, pt2: TPointD): TPointD;
  951. begin
  952. if not GetUnitNormal(pt1, pt2, Result) then
  953. Result := NullPointD;
  954. end;
  955. //------------------------------------------------------------------------------
  956. function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean;
  957. var
  958. dx, dy, inverseHypot: Double;
  959. begin
  960. result := not PointsNearEqual(pt1, pt2, 0.001);
  961. if not result then Exit;
  962. dx := (pt2.X - pt1.X);
  963. dy := (pt2.Y - pt1.Y);
  964. inverseHypot := 1 / Hypot(dx, dy);
  965. dx := dx * inverseHypot;
  966. dy := dy * inverseHypot;
  967. norm.X := dy;
  968. norm.Y := -dx
  969. end;
  970. //------------------------------------------------------------------------------
  971. function NormalizeVector(const vec: TPointD): TPointD;
  972. var
  973. h, inverseHypot: Double;
  974. begin
  975. h := Hypot(vec.X, vec.Y);
  976. if ValueAlmostZero(h, 0.001) then
  977. begin
  978. Result := NullPointD;
  979. Exit;
  980. end;
  981. inverseHypot := 1 / h;
  982. Result.X := vec.X * inverseHypot;
  983. Result.Y := vec.Y * inverseHypot;
  984. end;
  985. //------------------------------------------------------------------------------
  986. function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
  987. begin
  988. Result := NormalizeVector(PointD(vec1.X + vec2.X, vec1.Y + vec2.Y));
  989. end;
  990. //------------------------------------------------------------------------------
  991. function Paths(const path: TPathD): TPathsD;
  992. begin
  993. SetLength(Result, 1);
  994. result[0] := Copy(path, 0, length(path));
  995. end;
  996. //------------------------------------------------------------------------------
  997. function CopyPath(const path: TPathD): TPathD;
  998. begin
  999. Result := Copy(path, 0, Length(path));
  1000. end;
  1001. //------------------------------------------------------------------------------
  1002. function CopyPaths(const paths: TPathsD): TPathsD;
  1003. var
  1004. i, len1: integer;
  1005. begin
  1006. len1 := length(paths);
  1007. setLength(result, len1);
  1008. for i := 0 to len1 -1 do
  1009. result[i] := Copy(paths[i], 0, length(paths[i]));
  1010. end;
  1011. //------------------------------------------------------------------------------
  1012. function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint;
  1013. begin
  1014. result.x := pt.x + dx;
  1015. result.y := pt.y + dy;
  1016. end;
  1017. //------------------------------------------------------------------------------
  1018. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD;
  1019. begin
  1020. result.x := pt.x + dx;
  1021. result.y := pt.y + dy;
  1022. end;
  1023. //------------------------------------------------------------------------------
  1024. function TranslatePath(const path: TPathD; dx, dy: double): TPathD;
  1025. var
  1026. i, len: integer;
  1027. begin
  1028. len := length(path);
  1029. NewPointDArray(result, len, True);
  1030. for i := 0 to len -1 do
  1031. begin
  1032. result[i].x := path[i].x + dx;
  1033. result[i].y := path[i].y + dy;
  1034. end;
  1035. end;
  1036. //------------------------------------------------------------------------------
  1037. function TranslatePath(const paths: TPathsD;
  1038. dx, dy: double): TPathsD;
  1039. var
  1040. i,len: integer;
  1041. begin
  1042. len := length(paths);
  1043. setLength(result, len);
  1044. for i := 0 to len -1 do
  1045. result[i] := TranslatePath(paths[i], dx, dy);
  1046. end;
  1047. //------------------------------------------------------------------------------
  1048. function TranslatePath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD;
  1049. var
  1050. i,len: integer;
  1051. begin
  1052. len := length(ppp);
  1053. setLength(result, len);
  1054. for i := 0 to len -1 do
  1055. result[i] := TranslatePath(ppp[i], dx, dy);
  1056. end;
  1057. //------------------------------------------------------------------------------
  1058. function ScalePoint(const pt: TPointD; scale: double): TPointD;
  1059. begin
  1060. Result.X := pt.X * scale;
  1061. Result.Y := pt.Y * scale;
  1062. end;
  1063. //------------------------------------------------------------------------------
  1064. function ScalePoint(const pt: TPointD; sx, sy: double): TPointD;
  1065. begin
  1066. Result.X := pt.X * sx;
  1067. Result.Y := pt.Y * sy;
  1068. end;
  1069. //------------------------------------------------------------------------------
  1070. function ScalePath(const path: TPathD; sx, sy: double): TPathD;
  1071. var
  1072. i, len: integer;
  1073. begin
  1074. if (sx = 0) or (sy = 0) then
  1075. Result := nil
  1076. else if ((sx = 1) and (sy = 1)) then
  1077. begin
  1078. Result := Copy(path, 0, Length(path));
  1079. end else
  1080. begin
  1081. len := length(path);
  1082. NewPointDArray(result, len, True);
  1083. for i := 0 to len -1 do
  1084. begin
  1085. result[i].x := path[i].x * sx;
  1086. result[i].y := path[i].y * sy;
  1087. end;
  1088. end;
  1089. end;
  1090. //------------------------------------------------------------------------------
  1091. function ScalePath(const path: TPathD;
  1092. scale: double): TPathD;
  1093. begin
  1094. result := ScalePath(path, scale, scale);
  1095. end;
  1096. //------------------------------------------------------------------------------
  1097. function ScalePath(const paths: TPathsD;
  1098. sx, sy: double): TPathsD;
  1099. var
  1100. i,len: integer;
  1101. begin
  1102. len := length(paths);
  1103. setLength(result, len);
  1104. for i := 0 to len -1 do
  1105. result[i] := ScalePath(paths[i], sx, sy);
  1106. end;
  1107. //------------------------------------------------------------------------------
  1108. function ScalePath(const paths: TPathsD;
  1109. scale: double): TPathsD;
  1110. begin
  1111. result := ScalePath(paths, scale, scale);
  1112. end;
  1113. //------------------------------------------------------------------------------
  1114. function ScaleRect(const rec: TRect; scale: double): TRect;
  1115. begin
  1116. result := rec;
  1117. Result.Left := Round(Result.Left * scale);
  1118. Result.Top := Round(Result.Top * scale);
  1119. Result.Right := Round(Result.Right * scale);
  1120. Result.Bottom := Round(Result.Bottom * scale);
  1121. end;
  1122. //------------------------------------------------------------------------------
  1123. function ScaleRect(const rec: TRect; sx, sy: double): TRect;
  1124. begin
  1125. result := rec;
  1126. Result.Left := Round(Result.Left * sx);
  1127. Result.Top := Round(Result.Top * sy);
  1128. Result.Right := Round(Result.Right * sx);
  1129. Result.Bottom := Round(Result.Bottom * sy);
  1130. end;
  1131. //------------------------------------------------------------------------------
  1132. function ScaleRect(const rec: TRectD; scale: double): TRectD;
  1133. begin
  1134. result := rec;
  1135. Result.Left := Result.Left * scale;
  1136. Result.Top := Result.Top * scale;
  1137. Result.Right := Result.Right * scale;
  1138. Result.Bottom := Result.Bottom * scale;
  1139. end;
  1140. //------------------------------------------------------------------------------
  1141. function ScaleRect(const rec: TRectD; sx, sy: double): TRectD;
  1142. begin
  1143. result := rec;
  1144. Result.Left := Result.Left * sx;
  1145. Result.Top := Result.Top * sy;
  1146. Result.Right := Result.Right * sx;
  1147. Result.Bottom := Result.Bottom * sy;
  1148. end;
  1149. //------------------------------------------------------------------------------
  1150. function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
  1151. var
  1152. pathWidth, pathHeight, outHeight, outWidth: integer;
  1153. pathBounds: TRect;
  1154. scale: double;
  1155. begin
  1156. pathBounds := GetBounds(path);
  1157. RectWidthHeight(pathBounds, pathWidth, pathHeight);
  1158. RectWidthHeight(rec, outWidth, outHeight);
  1159. Result := TranslatePath(path,
  1160. rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
  1161. if outWidth / pathWidth < outHeight / pathHeight then
  1162. scale := outWidth / pathWidth else
  1163. scale := outHeight / pathHeight;
  1164. Result := ScalePath(Result, scale, scale);
  1165. end;
  1166. //------------------------------------------------------------------------------
  1167. function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
  1168. var
  1169. pathWidth, pathHeight, outHeight, outWidth: integer;
  1170. pathBounds: TRect;
  1171. scale: double;
  1172. begin
  1173. pathBounds := GetBounds(paths);
  1174. RectWidthHeight(pathBounds, pathWidth, pathHeight);
  1175. RectWidthHeight(rec, outWidth, outHeight);
  1176. Result := TranslatePath(paths,
  1177. rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
  1178. if outWidth / pathWidth < outHeight / pathHeight then
  1179. scale := outWidth / pathWidth else
  1180. scale := outHeight / pathHeight;
  1181. Result := ScalePath(Result, scale, scale);
  1182. end;
  1183. //------------------------------------------------------------------------------
  1184. function ReversePath(const path: TPathD): TPathD;
  1185. var
  1186. i, highI: integer;
  1187. begin
  1188. highI := High(path);
  1189. NewPointDArray(result, highI +1, True);
  1190. for i := 0 to highI do
  1191. result[i] := path[highI -i];
  1192. end;
  1193. //------------------------------------------------------------------------------
  1194. function ReversePath(const paths: TPathsD): TPathsD;
  1195. var
  1196. i, len: integer;
  1197. begin
  1198. len := Length(paths);
  1199. SetLength(result, len);
  1200. for i := 0 to len -1 do
  1201. result[i] := ReversePath(paths[i]);
  1202. end;
  1203. //------------------------------------------------------------------------------
  1204. function OpenPathToFlatPolygon(const path: TPathD): TPathD;
  1205. var
  1206. i, len, len2: integer;
  1207. begin
  1208. len := Length(path);
  1209. len2 := Max(0, len - 2);
  1210. NewPointDArray(Result, len + len2, True);
  1211. if len = 0 then Exit;
  1212. Move(path[0], Result[0], len * SizeOf(TPointD));
  1213. if len2 = 0 then Exit;
  1214. for i := 0 to len - 3 do
  1215. result[len + i] := path[len - 2 -i];
  1216. end;
  1217. //------------------------------------------------------------------------------
  1218. function GetVectors(const path: TPathD): TPathD;
  1219. var
  1220. i,j, len: cardinal;
  1221. pt: TPointD;
  1222. begin
  1223. len := length(path);
  1224. NewPointDArray(result, len, True);
  1225. if len = 0 then Exit;
  1226. pt := path[0];
  1227. //skip duplicates
  1228. i := len -1;
  1229. while (i > 0) and
  1230. (path[i].X = pt.X) and (path[i].Y = pt.Y) do dec(i);
  1231. if (i = 0) then
  1232. begin
  1233. //all points are equal!
  1234. for i := 0 to len -1 do result[i] := PointD(0,0);
  1235. Exit;
  1236. end;
  1237. result[i] := GetUnitVector(path[i], pt);
  1238. //fix up any duplicates at the end of the path
  1239. for j := i +1 to len -1 do
  1240. result[j] := result[j-1];
  1241. //with at least one valid vector, we can now
  1242. //safely get the remaining vectors
  1243. pt := path[i];
  1244. for i := i -1 downto 0 do
  1245. begin
  1246. if (path[i].X <> pt.X) or (path[i].Y <> pt.Y) then
  1247. begin
  1248. result[i] := GetUnitVector(path[i], pt);
  1249. pt := path[i];
  1250. end else
  1251. result[i] := result[i+1]
  1252. end;
  1253. end;
  1254. //------------------------------------------------------------------------------
  1255. function GetNormals(const path: TPathD): TPathD;
  1256. var
  1257. i, highI: integer;
  1258. last: TPointD;
  1259. begin
  1260. highI := High(path);
  1261. NewPointDArray(result, highI+1, True);
  1262. if highI < 0 then Exit;
  1263. last := NullPointD;
  1264. for i := 0 to highI -1 do
  1265. begin
  1266. if GetUnitNormal(path[i], path[i+1], result[i]) then
  1267. last := result[i] else
  1268. result[i] := last;
  1269. end;
  1270. if GetUnitNormal(path[highI], path[0], result[highI]) then
  1271. last := result[highI];
  1272. for i := 0 to highI do
  1273. begin
  1274. if (result[i].X <> 0) or (result[i].Y <> 0) then Break;
  1275. result[i] := last;
  1276. end;
  1277. end;
  1278. //------------------------------------------------------------------------------
  1279. function DistanceSqrd(const pt1, pt2: TPoint): double;
  1280. begin
  1281. result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
  1282. end;
  1283. //------------------------------------------------------------------------------
  1284. function DistanceSqrd(const pt1, pt2: TPointD): double;
  1285. begin
  1286. result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
  1287. end;
  1288. //------------------------------------------------------------------------------
  1289. function Distance(const pt1, pt2: TPoint): double;
  1290. begin
  1291. Result := Sqrt(DistanceSqrd(pt1, pt2));
  1292. end;
  1293. //------------------------------------------------------------------------------
  1294. function Distance(const pt1, pt2: TPointD): double;
  1295. begin
  1296. Result := Sqrt(DistanceSqrd(pt1, pt2));
  1297. end;
  1298. //------------------------------------------------------------------------------
  1299. function Distance(const path: TPathD; stopAt: integer): double;
  1300. var
  1301. i, highI: integer;
  1302. begin
  1303. Result := 0;
  1304. highI := High(path);
  1305. if (stopAt > 0) and (stopAt < HighI) then highI := stopAt;
  1306. for i := 1 to highI do
  1307. Result := Result + Distance(path[i-1],path[i]);
  1308. end;
  1309. //------------------------------------------------------------------------------
  1310. function GetDistances(const path: TPathD): TArrayOfDouble;
  1311. var
  1312. i, len: integer;
  1313. begin
  1314. len := Length(path);
  1315. SetLength(Result, len);
  1316. if len = 0 then Exit;
  1317. Result[0] := 0;
  1318. for i := 1 to len -1 do
  1319. Result[i] := Distance(path[i-1], path[i]);
  1320. end;
  1321. //------------------------------------------------------------------------------
  1322. function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
  1323. var
  1324. i, len: integer;
  1325. begin
  1326. len := Length(path);
  1327. SetLength(Result, len);
  1328. if len = 0 then Exit;
  1329. Result[0] := 0;
  1330. for i := 1 to len -1 do
  1331. Result[i] := Result[i-1] + Distance(path[i-1], path[i]);
  1332. end;
  1333. //------------------------------------------------------------------------------
  1334. function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
  1335. var
  1336. a,b,c,d: double;
  1337. begin
  1338. if PointsEqual(line1, line2) then
  1339. begin
  1340. Result := DistanceSqrd(pt, line1);
  1341. end else
  1342. begin
  1343. a := pt.X - line1.X;
  1344. b := pt.Y - line1.Y;
  1345. c := line2.X - line1.X;
  1346. d := line2.Y - line1.Y;
  1347. if (c = 0) and (d = 0) then
  1348. result := 0 else
  1349. result := Sqr(a * d - c * b) / (c * c + d * d);
  1350. end;
  1351. end;
  1352. //------------------------------------------------------------------------------
  1353. function PointInPolyWindingCount(const pt: TPointD;
  1354. const path: TPathD; out PointOnEdgeDir: integer): integer;
  1355. var
  1356. i, len: integer;
  1357. prevPt: TPointD;
  1358. isAbove: Boolean;
  1359. crossProd: double;
  1360. begin
  1361. //nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
  1362. Result := 0;
  1363. PointOnEdgeDir := 0;
  1364. i := 0;
  1365. len := Length(path);
  1366. if len = 0 then Exit;
  1367. prevPt := path[len-1];
  1368. while (i < len) and (path[i].Y = prevPt.Y) do inc(i);
  1369. if i = len then Exit;
  1370. isAbove := (prevPt.Y < pt.Y);
  1371. while (i < len) do
  1372. begin
  1373. if isAbove then
  1374. begin
  1375. while (i < len) and (path[i].Y < pt.Y) do inc(i);
  1376. if i = len then break
  1377. else if i > 0 then prevPt := path[i -1];
  1378. crossProd := CrossProduct(prevPt, path[i], pt);
  1379. if crossProd = 0 then
  1380. begin
  1381. PointOnEdgeDir := -1;
  1382. //nb: could safely exit here with frNonZero or frEvenOdd fill rules
  1383. end
  1384. else if crossProd < 0 then dec(Result);
  1385. end else
  1386. begin
  1387. while (i < len) and (path[i].Y > pt.Y) do inc(i);
  1388. if i = len then break
  1389. else if i > 0 then prevPt := path[i -1];
  1390. crossProd := CrossProduct(prevPt, path[i], pt);
  1391. if crossProd = 0 then
  1392. begin
  1393. PointOnEdgeDir := 1;
  1394. //nb: could safely exit here with frNonZero or frEvenOdd fill rules
  1395. end
  1396. else if crossProd > 0 then inc(Result);
  1397. end;
  1398. inc(i);
  1399. isAbove := not isAbove;
  1400. end;
  1401. end;
  1402. //------------------------------------------------------------------------------
  1403. function PointInPolygon(const pt: TPointD;
  1404. const polygon: TPathD; fillRule: TFillRule): Boolean;
  1405. var
  1406. wc: integer;
  1407. PointOnEdgeDir: integer;
  1408. begin
  1409. wc := PointInPolyWindingCount(pt, polygon, PointOnEdgeDir);
  1410. case fillRule of
  1411. frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
  1412. frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
  1413. frPositive: result := (PointOnEdgeDir + wc > 0);
  1414. else {frNegative} result := (PointOnEdgeDir + wc < 0);
  1415. end;
  1416. end;
  1417. //------------------------------------------------------------------------------
  1418. function PointInPolysWindingCount(const pt: TPointD;
  1419. const paths: TPathsD; out PointOnEdgeDir: integer): integer;
  1420. var
  1421. i,j, len: integer;
  1422. p: TPathD;
  1423. prevPt: TPointD;
  1424. isAbove: Boolean;
  1425. crossProd: double;
  1426. begin
  1427. //nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
  1428. Result := 0;
  1429. PointOnEdgeDir := 0;
  1430. for i := 0 to High(paths) do
  1431. begin
  1432. j := 0;
  1433. p := paths[i];
  1434. len := Length(p);
  1435. if len < 3 then Continue;
  1436. prevPt := p[len-1];
  1437. while (j < len) and (p[j].Y = prevPt.Y) do inc(j);
  1438. if j = len then continue;
  1439. isAbove := (prevPt.Y < pt.Y);
  1440. while (j < len) do
  1441. begin
  1442. if isAbove then
  1443. begin
  1444. while (j < len) and (p[j].Y < pt.Y) do inc(j);
  1445. if j = len then break
  1446. else if j > 0 then prevPt := p[j -1];
  1447. crossProd := CrossProduct(prevPt, p[j], pt);
  1448. if crossProd = 0 then PointOnEdgeDir := -1
  1449. else if crossProd < 0 then dec(Result);
  1450. end else
  1451. begin
  1452. while (j < len) and (p[j].Y > pt.Y) do inc(j);
  1453. if j = len then break
  1454. else if j > 0 then prevPt := p[j -1];
  1455. crossProd := CrossProduct(prevPt, p[j], pt);
  1456. if crossProd = 0 then PointOnEdgeDir := 1
  1457. else if crossProd > 0 then inc(Result);
  1458. end;
  1459. inc(j);
  1460. isAbove := not isAbove;
  1461. end;
  1462. end;
  1463. end;
  1464. //------------------------------------------------------------------------------
  1465. function PointInPolygons(const pt: TPointD;
  1466. const polygons: TPathsD; fillRule: TFillRule): Boolean;
  1467. var
  1468. wc: integer;
  1469. PointOnEdgeDir: integer;
  1470. begin
  1471. wc := PointInPolysWindingCount(pt, polygons, PointOnEdgeDir);
  1472. case fillRule of
  1473. frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
  1474. frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
  1475. frPositive: result := (PointOnEdgeDir + wc > 0);
  1476. else {frNegative} result := (PointOnEdgeDir + wc < 0);
  1477. end;
  1478. end;
  1479. //------------------------------------------------------------------------------
  1480. function PerpendicularDist(const pt, line1, line2: TPointD): double;
  1481. var
  1482. a,b,c,d: double;
  1483. begin
  1484. //given: cross product of 2 vectors = area of parallelogram
  1485. //and given: area of parallelogram = length base * height
  1486. //height (ie perpendic. dist.) = cross product of 2 vectors / length base
  1487. a := pt.X - line1.X;
  1488. b := pt.Y - line1.Y;
  1489. c := line2.X - line1.X;
  1490. d := line2.Y - line1.Y;
  1491. result := abs(a * d - c * b) / Sqrt(c * c + d * d);
  1492. end;
  1493. //------------------------------------------------------------------------------
  1494. function ClosestPoint(const pt, linePt1, linePt2: TPointD;
  1495. constrainToSegment: Boolean): TPointD;
  1496. var
  1497. q: double;
  1498. begin
  1499. if (linePt1.X = linePt2.X) and (linePt1.Y = linePt2.Y) then
  1500. begin
  1501. Result := linePt1;
  1502. end else
  1503. begin
  1504. q := ((pt.X-linePt1.X)*(linePt2.X-linePt1.X) +
  1505. (pt.Y-linePt1.Y)*(linePt2.Y-linePt1.Y)) /
  1506. (sqr(linePt2.X-linePt1.X) + sqr(linePt2.Y-linePt1.Y));
  1507. if constrainToSegment then
  1508. begin
  1509. if q < 0 then q := 0 else if q > 1 then q := 1;
  1510. end;
  1511. Result.X := (1-q)*linePt1.X + q*linePt2.X;
  1512. Result.Y := (1-q)*linePt1.Y + q*linePt2.Y;
  1513. end;
  1514. end;
  1515. //------------------------------------------------------------------------------
  1516. function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
  1517. begin
  1518. result := ClosestPoint(pt, linePt1, linePt2, false);
  1519. end;
  1520. //------------------------------------------------------------------------------
  1521. function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
  1522. begin
  1523. result := ClosestPoint(pt, segPt1, segPt2, true);
  1524. end;
  1525. //------------------------------------------------------------------------------
  1526. function GetPtOnEllipseFromAngle(const ellipseRect: TRectD;
  1527. angle: double): TPointD;
  1528. var
  1529. sn, co: double;
  1530. begin
  1531. NormalizeAngle(angle);
  1532. GetSinCos(angle, sn, co);
  1533. Result.X := ellipseRect.MidPoint.X + ellipseRect.Width/2 * co;
  1534. Result.Y := ellipseRect.MidPoint.Y + ellipseRect.Height/2 * sn;
  1535. end;
  1536. //------------------------------------------------------------------------------
  1537. function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
  1538. const pt: TPointD): double;
  1539. begin
  1540. with ellipseRect do
  1541. Result := ArcTan2(Width/Height * (pt.Y - MidPoint.Y), (pt.X - MidPoint.X));
  1542. end;
  1543. //------------------------------------------------------------------------------
  1544. function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
  1545. ellipseRotAngle: double; pt: TPointD): double;
  1546. begin
  1547. Result := 0;
  1548. if ellipseRect.IsEmpty then Exit;
  1549. RotatePoint(pt, ellipseRect.MidPoint, -ellipseRotAngle);
  1550. Result := GetEllipticalAngleFromPoint(ellipseRect, pt);
  1551. end;
  1552. //------------------------------------------------------------------------------
  1553. function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
  1554. ellipseRotAngle, angle: double): TPointD;
  1555. begin
  1556. Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
  1557. if ellipseRotAngle <> 0 then
  1558. img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotAngle);
  1559. end;
  1560. //------------------------------------------------------------------------------
  1561. function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
  1562. ellipseRotation: double; const pt: TPointD): TPointD;
  1563. var
  1564. pt2: TPointD;
  1565. angle: double;
  1566. begin
  1567. pt2 := pt;
  1568. Img32.Vector.RotatePoint(pt2, ellipseRect.MidPoint, -ellipseRotation);
  1569. angle := GetEllipticalAngleFromPoint(ellipseRect, pt2);
  1570. Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
  1571. Img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotation);
  1572. end;
  1573. //------------------------------------------------------------------------------
  1574. function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
  1575. var
  1576. rec: TRectD;
  1577. w,h: integer;
  1578. x,y, y2, a,b, dx,dy: double;
  1579. begin
  1580. RectWidthHeight(ellipseRec, w, h);
  1581. a := w * 0.5;
  1582. b := h * 0.5;
  1583. dx := ellipseRec.Left + a;
  1584. dy := ellipseRec.Top + b;
  1585. rec := RectD(ellipseRec);
  1586. TranslateRect(rec, -dx, -dy);
  1587. x := pt.X -dx; y := pt.Y -dy;
  1588. //first make sure pt is inside rect
  1589. Result := (abs(x) <= a) and (abs(y) <= b);
  1590. if not result then Exit;
  1591. //given (x*x)/(a*a) + (y*y)/(b*b) = 1
  1592. //then y*y = b*b(1 - (x*x)/(a*a))
  1593. //nb: contents of Sqrt below will always be positive
  1594. //since the substituted x must be within ellipseRec bounds
  1595. y2 := Sqrt((b*b*(1 - (x*x)/(a*a))));
  1596. Result := (y >= -y2) and (y <= y2);
  1597. end;
  1598. //------------------------------------------------------------------------------
  1599. function GetLineEllipseIntersects(const ellipseRec: TRect;
  1600. var linePt1, linePt2: TPointD): Boolean;
  1601. var
  1602. dx, dy, m,a,b,c,q: double;
  1603. qa,qb,qc,qs: double;
  1604. rec: TRectD;
  1605. pt1, pt2: TPointD;
  1606. begin
  1607. rec := RectD(ellipseRec);
  1608. a := rec.Width *0.5;
  1609. b := rec.Height *0.5;
  1610. //offset ellipseRect so it's centered over the coordinate origin
  1611. dx := ellipseRec.Left + a; dy := ellipseRec.Top + b;
  1612. TranslateRect(rec, -dx, -dy);
  1613. pt1 := TranslatePoint(linePt1, -dx, -dy);
  1614. pt2 := TranslatePoint(linePt2, -dx, -dy);
  1615. //equation of ellipse = (x*x)/(a*a) + (y*y)/(b*b) = 1
  1616. //equation of line = y = mx + c;
  1617. if (pt1.X = pt2.X) then //vertical line (ie infinite slope)
  1618. begin
  1619. //given x = K, then y*y = b*b(1 - (x*x)/(a*a))
  1620. q := (b*b)*(1 - Sqr(pt1.X)/(a*a));
  1621. result := q >= 0;
  1622. if not result then Exit;
  1623. q := Sqrt(q);
  1624. pt1.Y := q;
  1625. pt2.Y := -q;
  1626. end else
  1627. begin
  1628. //using simultaneous equations and substitution
  1629. //given y = mx + c
  1630. m := (pt1.Y - pt2.Y)/(pt1.X - pt2.X);
  1631. c := pt1.Y - m * pt1.X;
  1632. //given (x*x)/(a*a) + (y*y)/(b*b) = 1
  1633. //(x*x)/(a*a)*(b*b) + (y*y) = (b*b)
  1634. //(b*b)/(a*a) *(x*x) + Sqr(m*x +c) = (b*b)
  1635. //(b*b)/(a*a) *(x*x) + (m*m)*(x*x) + 2*m*x*c +c*c = b*b
  1636. //((b*b)/(a*a) +(m*m)) *(x*x) + 2*m*c*(x) + (c*c) - (b*b) = 0
  1637. //solving quadratic equation
  1638. qa := ((b*b)/(a*a) +(m*m));
  1639. qb := 2*m*c;
  1640. qc := (c*c) - (b*b);
  1641. qs := (qb*qb) - 4*qa*qc;
  1642. Result := qs >= 0;
  1643. if not result then Exit;
  1644. qs := Sqrt(qs);
  1645. pt1.X := (-qb +qs)/(2 * qa);
  1646. pt1.Y := m * pt1.X + c;
  1647. pt2.X := (-qb -qs)/(2 * qa);
  1648. pt2.Y := m * pt2.X + c;
  1649. end;
  1650. //finally reverse initial offset
  1651. linePt1 := TranslatePoint(pt1, dx, dy);
  1652. linePt2 := TranslatePoint(pt2, dx, dy);
  1653. end;
  1654. //------------------------------------------------------------------------------
  1655. function Sign(const value: Double): integer; {$IFDEF INLINE} inline; {$ENDIF}
  1656. begin
  1657. if value < 0 then Result := -1
  1658. else if value > 0 then Result := 1
  1659. else Result := 0;
  1660. end;
  1661. //------------------------------------------------------------------------------
  1662. function ApplyNormal(const pt, norm: TPointD; delta: double): TPointD;
  1663. {$IFDEF INLINE} inline; {$ENDIF}
  1664. begin
  1665. result := PointD(pt.X + norm.X * delta, pt.Y + norm.Y * delta);
  1666. end;
  1667. //------------------------------------------------------------------------------
  1668. procedure AppendPoint(var path: TPathD; const extra: TPointD);
  1669. var
  1670. len: integer;
  1671. begin
  1672. len := length(path);
  1673. SetLengthUninit(path, len +1);
  1674. path[len] := extra;
  1675. end;
  1676. //------------------------------------------------------------------------------
  1677. procedure AppendPath(var paths: TPathsD; const extra: TPathD);
  1678. var
  1679. len1, len2: integer;
  1680. begin
  1681. len2 := length(extra);
  1682. if len2 = 0 then Exit;
  1683. len1 := length(paths);
  1684. setLength(paths, len1 + 1);
  1685. paths[len1] := Copy(extra, 0, len2);
  1686. end;
  1687. //------------------------------------------------------------------------------
  1688. procedure AppendPath(var paths: TPathsD; const extra: TPathsD);
  1689. var
  1690. i, len1, len2: integer;
  1691. begin
  1692. len2 := length(extra);
  1693. if len2 = 0 then Exit;
  1694. len1 := length(paths);
  1695. setLength(paths, len1 + len2);
  1696. for i := 0 to len2 -1 do
  1697. paths[len1+i] := Copy(extra[i], 0, length(extra[i]));
  1698. end;
  1699. //------------------------------------------------------------------------------
  1700. procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD);
  1701. var
  1702. len: integer;
  1703. begin
  1704. len := length(ppp);
  1705. setLength(ppp, len + 1);
  1706. if Assigned(extra) then
  1707. AppendPath(ppp[len], extra) else
  1708. ppp[len] := nil;
  1709. end;
  1710. //------------------------------------------------------------------------------
  1711. procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
  1712. var
  1713. len, pathLen: integer;
  1714. begin
  1715. // calculate the length of the final array
  1716. len := Length(dstPath);
  1717. pathLen := Length(path);
  1718. if pathLen = 0 then Exit;
  1719. // Avoid point duplicates where paths join
  1720. if (len > 0) and PointsEqual(dstPath[len -1], path[0]) then dec(len);
  1721. // fill the array
  1722. SetLengthUninit(dstPath, len + pathLen);
  1723. Move(path[0], dstPath[len], pathLen * SizeOf(TPointD));
  1724. end;
  1725. //------------------------------------------------------------------------------
  1726. procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD);
  1727. var
  1728. i, len, pathLen, offset: integer;
  1729. begin
  1730. // calculate the length of the final array
  1731. len := 0;
  1732. for i := 0 to high(paths) do
  1733. begin
  1734. pathLen := Length(paths[i]);
  1735. if pathLen > 0 then
  1736. begin
  1737. // Skip the start-point if it matches the previous path's end-point
  1738. if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then
  1739. dec(pathLen);
  1740. inc(len, pathLen);
  1741. end;
  1742. end;
  1743. SetLengthUninit(dstPath, len);
  1744. // fill the array
  1745. len := 0;
  1746. for i := 0 to high(paths) do
  1747. begin
  1748. pathLen := Length(paths[i]);
  1749. if pathLen > 0 then
  1750. begin
  1751. offset := 0;
  1752. // Skip the start-point if it matches the previous path's end-point
  1753. if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then
  1754. begin
  1755. dec(pathLen);
  1756. offset := 1;
  1757. end;
  1758. // Skip if we have a path with only one point and that point also matches
  1759. // the previous path's end-point.
  1760. if pathLen > 0 then
  1761. begin
  1762. Move(paths[i][offset], dstPath[len], pathLen * SizeOf(TPointD));
  1763. inc(len, pathLen);
  1764. end;
  1765. end;
  1766. end;
  1767. end;
  1768. //------------------------------------------------------------------------------
  1769. procedure RotatePoint(var pt: TPointD;
  1770. const focalPoint: TPointD; sinA, cosA: double);
  1771. var
  1772. tmpX, tmpY: double;
  1773. begin
  1774. tmpX := pt.X-focalPoint.X;
  1775. tmpY := pt.Y-focalPoint.Y;
  1776. pt.X := tmpX * cosA - tmpY * sinA + focalPoint.X;
  1777. pt.Y := tmpX * sinA + tmpY * cosA + focalPoint.Y;
  1778. end;
  1779. //------------------------------------------------------------------------------
  1780. procedure RotatePoint(var pt: TPointD;
  1781. const focalPoint: TPointD; angleRad: double);
  1782. var
  1783. sinA, cosA: double;
  1784. begin
  1785. if angleRad = 0 then Exit;
  1786. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1787. angleRad := -angleRad;
  1788. {$ENDIF}
  1789. GetSinCos(angleRad, sinA, cosA);
  1790. RotatePoint(pt, focalPoint, sinA, cosA);
  1791. end;
  1792. //------------------------------------------------------------------------------
  1793. function RotatePathInternal(const path: TPathD;
  1794. const focalPoint: TPointD; sinA, cosA: double): TPathD;
  1795. var
  1796. i: integer;
  1797. x,y: double;
  1798. begin
  1799. NewPointDArray(Result, length(path), True);
  1800. for i := 0 to high(path) do
  1801. begin
  1802. x := path[i].X - focalPoint.X;
  1803. y := path[i].Y - focalPoint.Y;
  1804. Result[i].X := x * cosA - y * sinA + focalPoint.X;
  1805. Result[i].Y := x * sinA + y * cosA + focalPoint.Y;
  1806. end;
  1807. end;
  1808. //------------------------------------------------------------------------------
  1809. function RotatePath(const path: TPathD;
  1810. const focalPoint: TPointD; angleRads: double): TPathD;
  1811. var
  1812. sinA, cosA: double;
  1813. begin
  1814. if angleRads = 0 then
  1815. begin
  1816. Result := path;
  1817. Exit;
  1818. end;
  1819. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1820. angleRads := -angleRads;
  1821. {$ENDIF}
  1822. GetSinCos(angleRads, sinA, cosA);
  1823. Result := RotatePathInternal(path, focalPoint, sinA, cosA);
  1824. end;
  1825. //------------------------------------------------------------------------------
  1826. function RotatePath(const paths: TPathsD;
  1827. const focalPoint: TPointD; angleRads: double): TPathsD;
  1828. var
  1829. i: integer;
  1830. sinA, cosA: double;
  1831. fp: TPointD;
  1832. begin
  1833. Result := paths;
  1834. if not IsValid(angleRads) then Exit;
  1835. NormalizeAngle(angleRads);
  1836. if angleRads = 0 then Exit;
  1837. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1838. angleRads := -angleRads;
  1839. {$ENDIF}
  1840. GetSinCos(angleRads, sinA, cosA);
  1841. SetLength(Result, length(paths));
  1842. if IsValid(focalPoint) then
  1843. fp := focalPoint else
  1844. fp := GetBoundsD(paths).MidPoint;
  1845. for i := 0 to high(paths) do
  1846. Result[i] := RotatePathInternal(paths[i], fp, sinA, cosA);
  1847. end;
  1848. //------------------------------------------------------------------------------
  1849. function GetAngle(const origin, pt: TPoint): double;
  1850. var
  1851. x,y: double;
  1852. begin
  1853. x := pt.X - origin.X;
  1854. y := pt.Y - origin.Y;
  1855. if x = 0 then
  1856. begin
  1857. if y > 0 then result := angle90
  1858. else result := -angle90;
  1859. end
  1860. else if y = 0 then
  1861. begin
  1862. if x > 0 then result := 0
  1863. else result := angle180;
  1864. end else
  1865. result := arctan2(y, x); //range between -Pi and Pi
  1866. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1867. Result := -Result;
  1868. {$ENDIF}
  1869. end;
  1870. //------------------------------------------------------------------------------
  1871. function GetAngle(const origin, pt: TPointD): double;
  1872. var
  1873. x,y: double;
  1874. begin
  1875. x := pt.X - origin.X;
  1876. y := pt.Y - origin.Y;
  1877. if x = 0 then
  1878. begin
  1879. if y > 0 then result := angle90
  1880. else result := -angle90;
  1881. end
  1882. else if y = 0 then
  1883. begin
  1884. if x > 0 then result := 0
  1885. else result := angle180;
  1886. end else
  1887. result := arctan2(y, x); //range between -Pi and Pi
  1888. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1889. Result := -Result;
  1890. {$ENDIF}
  1891. end;
  1892. //------------------------------------------------------------------------------
  1893. function GetAngle(const a, b, c: TPoint): double;
  1894. var
  1895. ab, bc: TPointD;
  1896. dp, cp: double;
  1897. begin
  1898. //https://stackoverflow.com/a/3487062/359538
  1899. ab := PointD(b.x - a.x, b.y - a.y);
  1900. bc := PointD(b.x - c.x, b.y - c.y);
  1901. dp := (ab.x * bc.x + ab.y * bc.y);
  1902. cp := (ab.x * bc.y - ab.y * bc.x);
  1903. Result := arctan2(cp, dp); //range between -Pi and Pi
  1904. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1905. Result := -Result;
  1906. {$ENDIF}
  1907. end;
  1908. //------------------------------------------------------------------------------
  1909. function GetAngle(const a, b, c: TPointD): double;
  1910. var
  1911. ab, bc: TPointD;
  1912. dp, cp: double;
  1913. begin
  1914. //https://stackoverflow.com/a/3487062/359538
  1915. ab := PointD(b.x - a.x, b.y - a.y);
  1916. bc := PointD(b.x - c.x, b.y - c.y);
  1917. dp := (ab.x * bc.x + ab.y * bc.y);
  1918. cp := (ab.x * bc.y - ab.y * bc.x);
  1919. Result := arctan2(cp, dp); //range between -Pi and Pi
  1920. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  1921. Result := -Result;
  1922. {$ENDIF}
  1923. end;
  1924. //------------------------------------------------------------------------------
  1925. function GetPointAtAngleAndDist(const origin: TPointD;
  1926. angle, distance: double): TPointD;
  1927. begin
  1928. Result := origin;
  1929. Result.X := Result.X + distance;
  1930. RotatePoint(Result, origin, angle);
  1931. end;
  1932. //------------------------------------------------------------------------------
  1933. function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
  1934. var
  1935. m1,b1,m2,b2: double;
  1936. begin
  1937. result := InvalidPointD;
  1938. //see http://paulbourke.net/geometry/pointlineplane/
  1939. if (ln1B.X = ln1A.X) then
  1940. begin
  1941. if (ln2B.X = ln2A.X) then exit; //parallel lines
  1942. m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
  1943. b2 := ln2A.Y - m2 * ln2A.X;
  1944. Result.X := ln1A.X;
  1945. Result.Y := m2*ln1A.X + b2;
  1946. end
  1947. else if (ln2B.X = ln2A.X) then
  1948. begin
  1949. m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
  1950. b1 := ln1A.Y - m1 * ln1A.X;
  1951. Result.X := ln2A.X;
  1952. Result.Y := m1*ln2A.X + b1;
  1953. end else
  1954. begin
  1955. m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
  1956. b1 := ln1A.Y - m1 * ln1A.X;
  1957. m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
  1958. b2 := ln2A.Y - m2 * ln2A.X;
  1959. if m1 = m2 then exit; //parallel lines
  1960. Result.X := (b2 - b1)/(m1 - m2);
  1961. Result.Y := m1 * Result.X + b1;
  1962. end;
  1963. end;
  1964. //------------------------------------------------------------------------------
  1965. function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD;
  1966. out ip: TPointD): Boolean;
  1967. begin
  1968. ip := IntersectPoint(ln1a, ln1b, ln2a, ln2b);
  1969. Result := IsValid(ip);
  1970. end;
  1971. //------------------------------------------------------------------------------
  1972. function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
  1973. var
  1974. pqd,r,s : TPointD; //scalar vectors;
  1975. rs, t : double;
  1976. begin
  1977. //https://stackoverflow.com/a/565282/359538
  1978. Result := InvalidPointD;
  1979. r := PointD(ln1b.X - ln1a.X, ln1b.Y - ln1a.Y);
  1980. s := PointD(ln2b.X - ln2a.X, ln2b.Y - ln2a.Y);
  1981. rs := CrossProduct(r,s);
  1982. if Abs(rs) < 1 then Exit;
  1983. pqd.X := ln2a.X - ln1a.X;
  1984. pqd.y := ln2a.Y - ln1a.Y;
  1985. t := CrossProduct(pqd, s) / rs;
  1986. if (t < -0.025) or (t > 1.025) then Exit;
  1987. Result.X := ln1a.X + t * r.X;
  1988. Result.Y := ln1a.Y + t * r.Y;
  1989. // pqd.X := -pqd.X; pqd.Y := -pqd.Y;
  1990. // u := CrossProduct(pqd, r) / rs;
  1991. // if (u < -0.05) or (u > 1.05) then Exit;
  1992. end;
  1993. //------------------------------------------------------------------------------
  1994. function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
  1995. out ip: TPointD): Boolean;
  1996. begin
  1997. ip := SegmentIntersectPt(ln1a, ln1b, ln2a, ln2b);
  1998. Result := IsValid(ip);
  1999. end;
  2000. //------------------------------------------------------------------------------
  2001. function CalcRoundingSteps(radius: double): double;
  2002. begin
  2003. //the results of this function have been derived empirically
  2004. //and may need further adjustment
  2005. if radius < 0.55 then result := 4
  2006. else result := Pi * Sqrt(radius *2);
  2007. end;
  2008. //------------------------------------------------------------------------------
  2009. function Grow(const path, normals: TPathD; delta: double;
  2010. joinStyle: TJoinStyle; miterLim: double; scale: double; isOpen: Boolean): TPathD;
  2011. var
  2012. resCnt, resCap : integer;
  2013. norms : TPathD;
  2014. stepsPerRadian : double;
  2015. stepSin, stepCos : double;
  2016. asin, acos : double;
  2017. procedure AddPoint(const pt: TPointD);
  2018. begin
  2019. if resCnt >= resCap then
  2020. begin
  2021. inc(resCap, 64);
  2022. SetLengthUninit(result, resCap);
  2023. end;
  2024. result[resCnt] := pt;
  2025. inc(resCnt);
  2026. end;
  2027. procedure DoMiter(j, k: Integer; cosA: Double);
  2028. var
  2029. q: Double;
  2030. begin
  2031. q := delta / (cosA +1);
  2032. AddPoint(PointD(
  2033. path[j].X + (norms[k].X + norms[j].X) *q,
  2034. path[j].Y + (norms[k].Y + norms[j].Y) *q));
  2035. end;
  2036. procedure DoBevel(j, k: Integer);
  2037. var
  2038. absDelta: double;
  2039. begin
  2040. if k = j then
  2041. begin
  2042. absDelta := Abs(delta);
  2043. AddPoint(PointD(
  2044. path[j].x - absDelta * norms[j].x,
  2045. path[j].y - absDelta * norms[j].y));
  2046. AddPoint(PointD(
  2047. path[j].x + absDelta * norms[j].x,
  2048. path[j].y + absDelta * norms[j].y));
  2049. end else
  2050. begin
  2051. AddPoint(PointD(
  2052. path[j].x + delta * norms[k].x,
  2053. path[j].y + delta * norms[k].y));
  2054. AddPoint(PointD(
  2055. path[j].x + delta * norms[j].x,
  2056. path[j].y + delta * norms[j].y));
  2057. end;
  2058. end;
  2059. procedure DoSquare(j, k: Integer);
  2060. var
  2061. vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
  2062. absDelta: double;
  2063. begin
  2064. if k = j then
  2065. begin
  2066. vec.X := norms[j].Y; //squaring a line end
  2067. vec.Y := -norms[j].X;
  2068. end else
  2069. begin
  2070. // using the reciprocal of unit normals (as unit vectors)
  2071. // get the average unit vector ...
  2072. vec := GetAvgUnitVector(
  2073. PointD(-norms[k].Y, norms[k].X),
  2074. PointD(norms[j].Y, -norms[j].X));
  2075. end;
  2076. absDelta := Abs(delta);
  2077. ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
  2078. ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
  2079. ptS := ReflectPoint(ptR, ptQ);
  2080. // get 2 vertices along one edge offset
  2081. ptT := PointD(
  2082. path[k].X + norms[k].X * delta,
  2083. path[k].Y + norms[k].Y * delta);
  2084. if (j = k) then
  2085. begin
  2086. ptU.X := ptT.X + vec.X * delta;
  2087. ptU.Y := ptT.Y + vec.Y * delta;
  2088. ip := IntersectPoint(ptR, ptS, ptT, ptU);
  2089. AddPoint(ReflectPoint(ip, ptQ));
  2090. AddPoint(ip);
  2091. end else
  2092. begin
  2093. ptU := PointD(
  2094. path[j].X + norms[k].X * delta,
  2095. path[j].Y + norms[k].Y * delta);
  2096. ip := IntersectPoint(ptR, ptS, ptT, ptU);
  2097. AddPoint(ip);
  2098. AddPoint(ReflectPoint(ip, ptQ));
  2099. end;
  2100. end;
  2101. procedure DoRound(j, k: Integer);
  2102. var
  2103. i, steps: Integer;
  2104. pt: TPointD;
  2105. dx, dy, oldDx: double;
  2106. angle: double;
  2107. begin
  2108. // nb: angles may be negative but this will always be a convex join
  2109. pt := path[j];
  2110. if j = k then
  2111. begin
  2112. dx := -norms[k].X * delta;
  2113. dy := -norms[k].Y * delta;
  2114. end else
  2115. begin
  2116. dx := norms[k].X * delta;
  2117. dy := norms[k].Y * delta;
  2118. end;
  2119. AddPoint(PointD(pt.X + dx, pt.Y + dy));
  2120. angle := ArcTan2(asin, acos);
  2121. steps := Ceil(stepsPerRadian * abs(angle));
  2122. for i := 2 to steps do
  2123. begin
  2124. oldDx := dx;
  2125. dx := oldDx * stepCos - stepSin * dy;
  2126. dy := oldDx * stepSin + stepCos * dy;
  2127. AddPoint(PointD(pt.X + dx, pt.Y + dy));
  2128. end;
  2129. AddPoint(PointD(
  2130. pt.X + norms[j].X * delta,
  2131. pt.Y + norms[j].Y * delta));
  2132. end;
  2133. var
  2134. j, k : cardinal;
  2135. len : cardinal;
  2136. steps : double;
  2137. highI : cardinal;
  2138. iLo,iHi : cardinal;
  2139. absDelta : double;
  2140. begin
  2141. Result := nil;
  2142. if not Assigned(path) then exit;
  2143. len := Length(path);
  2144. if not isOpen then
  2145. while (len > 2) and
  2146. PointsNearEqual(path[len -1], path[0], 0.001) do
  2147. dec(len);
  2148. if len < 2 then Exit;
  2149. if scale = 0 then scale := 1.0;
  2150. absDelta := Abs(delta);
  2151. if absDelta * scale < 1 then
  2152. joinStyle := jsButt
  2153. else if joinStyle = jsAuto then
  2154. begin
  2155. if delta < AutoWidthThreshold / 2 then
  2156. joinStyle := jsSquare else
  2157. joinStyle := jsRound;
  2158. end;
  2159. if absDelta < MinStrokeWidth/2 then
  2160. begin
  2161. if delta < 0 then
  2162. delta := -MinStrokeWidth/2 else
  2163. delta := MinStrokeWidth/2;
  2164. end;
  2165. if assigned(normals) then
  2166. norms := normals else
  2167. norms := GetNormals(path);
  2168. highI := len -1;
  2169. stepsPerRadian := 0;
  2170. if joinStyle = jsRound then
  2171. begin
  2172. steps := CalcRoundingSteps(delta * scale);
  2173. stepSin := sin(TwoPi/steps);
  2174. stepCos := cos(TwoPi/steps);
  2175. if (delta < 0) then stepSin := -stepSin;
  2176. stepsPerRadian := steps / TwoPi;
  2177. end;
  2178. if miterLim <= 0 then miterLim := DefaultMiterLimit
  2179. else if miterLim < 2 then miterLim := 2;
  2180. miterLim := 2 /(sqr(miterLim));
  2181. resCnt := 0;
  2182. resCap := 0;
  2183. if isOpen then
  2184. begin
  2185. iLo := 1; iHi := highI -1;
  2186. k := 0;
  2187. AddPoint(PointD(
  2188. path[0].X + norms[0].X * delta,
  2189. path[0].Y + norms[0].Y * delta));
  2190. end else
  2191. begin
  2192. iLo := 0; iHi := highI;
  2193. k := highI;
  2194. end;
  2195. for j := iLo to iHi do
  2196. begin
  2197. if PointsNearEqual(path[j], path[k], 0.01) then
  2198. begin
  2199. k := j; // todo - check if needed
  2200. Continue;
  2201. end;
  2202. asin := CrossProduct(norms[k], norms[j]);
  2203. if (asin > 1.0) then asin := 1.0
  2204. else if (asin < -1.0) then asin := -1.0;
  2205. acos := DotProduct(norms[k], norms[j]);
  2206. if (acos > -0.999) and (asin * delta < 0) then
  2207. begin
  2208. // is concave
  2209. AddPoint(PointD(
  2210. path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
  2211. AddPoint(path[j]);
  2212. AddPoint(PointD(
  2213. path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
  2214. end
  2215. else if (acos > 0.999) and (joinStyle <> jsRound) then
  2216. begin
  2217. // almost straight - less than 2.5 degree, so miter
  2218. DoMiter(j, k, acos);
  2219. end
  2220. else if (joinStyle = jsMiter) then
  2221. begin
  2222. if (1 + acos > miterLim) then
  2223. DoMiter(j, k, acos) else
  2224. DoSquare(j, k);
  2225. end
  2226. else if (joinStyle = jsRound) then
  2227. DoRound(j, k)
  2228. else if (joinStyle = jsSquare) then
  2229. DoSquare(j, k)
  2230. else
  2231. DoBevel(j, k);
  2232. k := j;
  2233. end;
  2234. if isOpen then
  2235. AddPoint(PointD(
  2236. path[highI].X + norms[highI].X * delta, //todo - check this !!!
  2237. path[highI].Y + norms[highI].Y * delta));
  2238. SetLength(Result, resCnt);
  2239. end;
  2240. //------------------------------------------------------------------------------
  2241. function GrowOpenLine(const line: TPathD; delta: double;
  2242. joinStyle: TJoinStyle; endStyle: TEndStyle;
  2243. miterLim: double = 0; scale: double = 1.0): TPathD;
  2244. var
  2245. len : integer;
  2246. resCnt, resCap : integer;
  2247. asin, acos : double;
  2248. stepSin, stepCos : double;
  2249. stepsPerRadian : double;
  2250. path, norms : TPathD;
  2251. procedure AddPoint(const pt: TPointD);
  2252. begin
  2253. if resCnt >= resCap then
  2254. begin
  2255. inc(resCap, 64);
  2256. SetLengthUninit(result, resCap);
  2257. end;
  2258. result[resCnt] := pt;
  2259. inc(resCnt);
  2260. end;
  2261. procedure DoMiter(j, k: Integer; cosA: Double);
  2262. var
  2263. q: Double;
  2264. begin
  2265. q := delta / (cosA +1);
  2266. AddPoint(PointD(
  2267. path[j].X + (norms[k].X + norms[j].X) *q,
  2268. path[j].Y + (norms[k].Y + norms[j].Y) *q));
  2269. end;
  2270. procedure DoBevel(j, k: Integer);
  2271. var
  2272. absDelta: double;
  2273. begin
  2274. if k = j then
  2275. begin
  2276. absDelta := Abs(delta);
  2277. AddPoint(PointD(
  2278. path[j].x - absDelta * norms[j].x,
  2279. path[j].y - absDelta * norms[j].y));
  2280. AddPoint(PointD(
  2281. path[j].x + absDelta * norms[j].x,
  2282. path[j].y + absDelta * norms[j].y));
  2283. end else
  2284. begin
  2285. AddPoint(PointD(
  2286. path[j].x + delta * norms[k].x,
  2287. path[j].y + delta * norms[k].y));
  2288. AddPoint(PointD(
  2289. path[j].x + delta * norms[j].x,
  2290. path[j].y + delta * norms[j].y));
  2291. end;
  2292. end;
  2293. procedure DoSquare(j, k: Integer);
  2294. var
  2295. vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
  2296. absDelta: double;
  2297. begin
  2298. if k = j then
  2299. begin
  2300. vec.X := norms[j].Y; //squaring a line end
  2301. vec.Y := -norms[j].X;
  2302. end else
  2303. begin
  2304. // using the reciprocal of unit normals (as unit vectors)
  2305. // get the average unit vector ...
  2306. vec := GetAvgUnitVector(
  2307. PointD(-norms[k].Y, norms[k].X),
  2308. PointD(norms[j].Y, -norms[j].X));
  2309. end;
  2310. absDelta := Abs(delta);
  2311. ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
  2312. ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
  2313. ptS := ReflectPoint(ptR, ptQ);
  2314. // get 2 vertices along one edge offset
  2315. ptT := PointD(
  2316. path[k].X + norms[k].X * delta,
  2317. path[k].Y + norms[k].Y * delta);
  2318. if (j = k) then
  2319. begin
  2320. ptU.X := ptT.X + vec.X * delta;
  2321. ptU.Y := ptT.Y + vec.Y * delta;
  2322. ip := IntersectPoint(ptR, ptS, ptT, ptU);
  2323. AddPoint(ReflectPoint(ip, ptQ));
  2324. AddPoint(ip);
  2325. end else
  2326. begin
  2327. ptU := PointD(
  2328. path[j].X + norms[k].X * delta,
  2329. path[j].Y + norms[k].Y * delta);
  2330. ip := IntersectPoint(ptR, ptS, ptT, ptU);
  2331. AddPoint(ip);
  2332. AddPoint(ReflectPoint(ip, ptQ));
  2333. end;
  2334. end;
  2335. procedure DoRound(j, k: Integer);
  2336. var
  2337. i, steps: Integer;
  2338. pt: TPointD;
  2339. dx, dy, oldDx: double;
  2340. angle: double;
  2341. begin
  2342. // nb: angles may be negative but this will always be a convex join
  2343. pt := path[j];
  2344. if j = k then
  2345. begin
  2346. dx := -norms[k].X * delta;
  2347. dy := -norms[k].Y * delta;
  2348. angle := PI;
  2349. end else
  2350. begin
  2351. dx := norms[k].X * delta;
  2352. dy := norms[k].Y * delta;
  2353. angle := ArcTan2(asin, acos);
  2354. end;
  2355. AddPoint(PointD(pt.X + dx, pt.Y + dy));
  2356. steps := Ceil(stepsPerRadian * abs(angle));
  2357. for i := 2 to steps do
  2358. begin
  2359. oldDx := dx;
  2360. dx := oldDx * stepCos - stepSin * dy;
  2361. dy := oldDx * stepSin + stepCos * dy;
  2362. AddPoint(PointD(pt.X + dx, pt.Y + dy));
  2363. end;
  2364. AddPoint(PointD(
  2365. pt.X + norms[j].X * delta,
  2366. pt.Y + norms[j].Y * delta));
  2367. end;
  2368. procedure DoPoint(j: Cardinal; var k: Cardinal);
  2369. begin
  2370. asin := CrossProduct(norms[k], norms[j]);
  2371. if (asin > 1.0) then asin := 1.0
  2372. else if (asin < -1.0) then asin := -1.0;
  2373. acos := DotProduct(norms[k], norms[j]);
  2374. if (acos > -0.999) and (asin * delta < 0) then
  2375. begin
  2376. // is concave
  2377. AddPoint(PointD(
  2378. path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
  2379. AddPoint(path[j]);
  2380. AddPoint(PointD(
  2381. path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
  2382. end
  2383. else if (acos > 0.999) and (joinStyle <> jsRound) then
  2384. // almost straight - less than 2.5 degree, so miter
  2385. DoMiter(j, k, acos)
  2386. else if (joinStyle = jsMiter) then
  2387. begin
  2388. if (1 + acos > miterLim) then
  2389. DoMiter(j, k, acos) else
  2390. DoSquare(j, k);
  2391. end
  2392. else if (joinStyle = jsRound) then
  2393. DoRound(j, k)
  2394. else if (joinStyle = jsSquare) then
  2395. DoSquare(j, k)
  2396. else
  2397. DoBevel(j, k);
  2398. k := j;
  2399. end;
  2400. var
  2401. highJ : cardinal;
  2402. j, k : cardinal;
  2403. steps : double;
  2404. begin
  2405. Result := nil;
  2406. path := StripNearDuplicates(line, 0.1, false);
  2407. len := length(path);
  2408. if (len = 0) or (delta <= 0) then Exit;
  2409. // don't specify a minimum delta as this path may be scaled later
  2410. // if delta < MinStrokeWidth then
  2411. // delta := MinStrokeWidth;
  2412. delta := delta * 0.5;
  2413. if len = 1 then
  2414. begin
  2415. with path[0] do
  2416. result := Ellipse(RectD(x-delta, y-delta, x+delta, y+delta));
  2417. Exit;
  2418. end;
  2419. //Assert(endStyle <> esClosed);
  2420. //with very narrow lines, don't get fancy with joins and line ends
  2421. if (delta <= 1) then
  2422. begin
  2423. if (joinStyle = jsRound) and (delta * scale <= 1) then
  2424. joinStyle := jsButt;
  2425. if (endStyle = esRound) and (delta * scale <= 1) then
  2426. endStyle := esSquare;
  2427. end
  2428. else if joinStyle = jsAuto then
  2429. begin
  2430. if (endStyle = esRound) and (delta * scale >= AutoWidthThreshold) then
  2431. joinStyle := jsRound else
  2432. joinStyle := jsSquare;
  2433. end;
  2434. stepsPerRadian := 0;
  2435. if (joinStyle = jsRound) or (endStyle = esRound) then
  2436. begin
  2437. steps := CalcRoundingSteps(delta * scale);
  2438. stepSin := sin(TwoPi/steps);
  2439. stepCos := cos(TwoPi/steps);
  2440. if (delta < 0) then stepSin := -stepSin;
  2441. stepsPerRadian := steps / TwoPi;
  2442. end;
  2443. if miterLim <= 0 then miterLim := DefaultMiterLimit
  2444. else if miterLim < 2 then miterLim := 2;
  2445. miterLim := 2 /(sqr(miterLim));
  2446. norms := GetNormals(path);
  2447. resCnt := 0; resCap := 0;
  2448. case endStyle of
  2449. esButt: DoBevel(0,0);
  2450. esRound: DoRound(0,0);
  2451. else DoSquare(0, 0);
  2452. end;
  2453. // offset the left side going **forward**
  2454. k := 0;
  2455. highJ := len -1;
  2456. for j := 1 to highJ -1 do DoPoint(j,k);
  2457. // reverse the normals ...
  2458. for j := highJ downto 1 do
  2459. begin
  2460. norms[j].X := -norms[j-1].X;
  2461. norms[j].Y := -norms[j-1].Y;
  2462. end;
  2463. norms[0] := norms[len -1];
  2464. case endStyle of
  2465. esButt: DoBevel(highJ,highJ);
  2466. esRound: DoRound(highJ,highJ);
  2467. else DoSquare(highJ,highJ);
  2468. end;
  2469. // offset the left side going **backward**
  2470. k := highJ;
  2471. for j := highJ -1 downto 1 do
  2472. DoPoint(j, k);
  2473. SetLength(Result, resCnt);
  2474. end;
  2475. //------------------------------------------------------------------------------
  2476. function GrowClosedLine(const line: TPathD; width: double;
  2477. joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0): TPathsD;
  2478. var
  2479. norms: TPathD;
  2480. rec: TRectD;
  2481. skipHole: Boolean;
  2482. begin
  2483. rec := GetBoundsD(line);
  2484. skipHole := (rec.Width <= width) or (rec.Height <= width);
  2485. if skipHole then
  2486. begin
  2487. SetLength(Result, 1);
  2488. norms := GetNormals(line);
  2489. Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
  2490. end else
  2491. begin
  2492. SetLength(Result, 2);
  2493. norms := GetNormals(line);
  2494. Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
  2495. Result[1] := ReversePath(
  2496. Grow(line, norms, -width/2, joinStyle, miterLim, scale, false));
  2497. end;
  2498. end;
  2499. //------------------------------------------------------------------------------
  2500. function RoughOutline(const line: TPathD; lineWidth: double;
  2501. joinStyle: TJoinStyle; endStyle: TEndStyle;
  2502. miterLim: double = 0; scale: double = 1.0): TPathsD;
  2503. var
  2504. lines: TPathsD;
  2505. begin
  2506. SetLength(lines,1);
  2507. lines[0] := line;
  2508. Result := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLim, scale);
  2509. end;
  2510. //------------------------------------------------------------------------------
  2511. function RoughOutline(const lines: TPathsD; lineWidth: double;
  2512. joinStyle: TJoinStyle; endStyle: TEndStyle;
  2513. miterLim: double = 0; scale: double = 1.0): TPathsD;
  2514. var
  2515. i: integer;
  2516. lwDiv2: double;
  2517. p: TPathD;
  2518. begin
  2519. result := nil;
  2520. if not assigned(lines) then exit;
  2521. if joinStyle = jsAuto then
  2522. begin
  2523. if endStyle in [esPolygon, esRound] then
  2524. joinStyle := jsRound else
  2525. joinStyle := jsSquare;
  2526. end;
  2527. if scale = 0 then scale := 1;
  2528. if endStyle = esPolygon then
  2529. begin
  2530. for i := 0 to high(lines) do
  2531. begin
  2532. if Length(lines[i]) = 1 then
  2533. begin
  2534. lwDiv2 := lineWidth/2;
  2535. with lines[i][0] do
  2536. AppendPath(Result,
  2537. Ellipse(RectD(x-lwDiv2, y-lwDiv2, x+lwDiv2, y+lwDiv2)));
  2538. end else
  2539. begin
  2540. p := StripNearDuplicates(lines[i], 0.1, true);
  2541. if Length(p) = 2 then AppendPoint(p, p[0]);
  2542. AppendPath(Result,
  2543. GrowClosedLine(p, lineWidth, joinStyle, miterLim, scale));
  2544. end;
  2545. end;
  2546. end
  2547. else
  2548. begin
  2549. SetLength(Result, Length(lines));
  2550. for i := 0 to high(lines) do
  2551. Result[i] := GrowOpenLine(lines[i], lineWidth,
  2552. joinStyle, endStyle, miterLim, scale);
  2553. end;
  2554. end;
  2555. //------------------------------------------------------------------------------
  2556. function Rectangle(const rec: TRect): TPathD;
  2557. begin
  2558. NewPointDArray(Result, 4, True);
  2559. with rec do
  2560. begin
  2561. result[0] := PointD(left, top);
  2562. result[1] := PointD(right, top);
  2563. result[2] := PointD(right, bottom);
  2564. result[3] := PointD(left, bottom);
  2565. end;
  2566. end;
  2567. //------------------------------------------------------------------------------
  2568. function Rectangle(const rec: TRectD): TPathD;
  2569. begin
  2570. NewPointDArray(Result, 4, True);
  2571. with rec do
  2572. begin
  2573. result[0] := PointD(left, top);
  2574. result[1] := PointD(right, top);
  2575. result[2] := PointD(right, bottom);
  2576. result[3] := PointD(left, bottom);
  2577. end;
  2578. end;
  2579. //------------------------------------------------------------------------------
  2580. function Rectangle(l, t, r, b: double): TPathD;
  2581. begin
  2582. NewPointDArray(Result, 4, True);
  2583. result[0] := PointD(l, t);
  2584. result[1] := PointD(r, t);
  2585. result[2] := PointD(r, b);
  2586. result[3] := PointD(l, b);
  2587. end;
  2588. //------------------------------------------------------------------------------
  2589. procedure InflateRect(var rec: TRect; dx, dy: integer);
  2590. begin
  2591. rec.Left := rec.Left - dx;
  2592. rec.Top := rec.Top - dy;
  2593. rec.Right := rec.Right + dx;
  2594. rec.Bottom := rec.Bottom + dy;
  2595. end;
  2596. //------------------------------------------------------------------------------
  2597. procedure InflateRect(var rec: TRectD; dx, dy: double);
  2598. begin
  2599. rec.Left := rec.Left - dx;
  2600. rec.Top := rec.Top - dy;
  2601. rec.Right := rec.Right + dx;
  2602. rec.Bottom := rec.Bottom + dy;
  2603. end;
  2604. //------------------------------------------------------------------------------
  2605. function NormalizeRect(var rect: TRect): Boolean;
  2606. var
  2607. i: integer;
  2608. begin
  2609. Result := False;
  2610. with rect do
  2611. begin
  2612. if Left > Right then
  2613. begin
  2614. i := Left;
  2615. Left := Right;
  2616. Right := i;
  2617. Result := True;
  2618. end;
  2619. if Top > Bottom then
  2620. begin
  2621. i := Top;
  2622. Top := Bottom;
  2623. Bottom := i;
  2624. Result := True;
  2625. end;
  2626. end;
  2627. end;
  2628. //------------------------------------------------------------------------------
  2629. function RoundRect(const rec: TRect; radius: integer): TPathD;
  2630. begin
  2631. Result := RoundRect(RectD(rec), PointD(radius, radius));
  2632. end;
  2633. //------------------------------------------------------------------------------
  2634. function RoundRect(const rec: TRect; radius: TPoint): TPathD;
  2635. begin
  2636. Result := RoundRect(RectD(rec), PointD(radius));
  2637. end;
  2638. //------------------------------------------------------------------------------
  2639. function RoundRect(const rec: TRectD; radius: double): TPathD;
  2640. begin
  2641. Result := RoundRect(rec, PointD(radius, radius));
  2642. end;
  2643. //------------------------------------------------------------------------------
  2644. function RoundRect(const rec: TRectD; radius: TPointD): TPathD;
  2645. var
  2646. i,j : integer;
  2647. corners : TPathD;
  2648. bezPts : TPathD;
  2649. magic : TPointD;
  2650. const
  2651. magicC: double = 0.55228475; // =4/3 * (sqrt(2)-1)
  2652. begin
  2653. Result := nil;
  2654. if rec.IsEmpty then Exit;
  2655. radius.X := Min(radius.X, rec.Width/2);
  2656. radius.Y := Min(radius.Y, rec.Height/2);
  2657. if (radius.X < 1) and (radius.Y < 1) then
  2658. begin
  2659. Result := Rectangle(rec);
  2660. Exit;
  2661. end;
  2662. magic.X := radius.X * magicC;
  2663. magic.Y := radius.Y * magicC;
  2664. NewPointDArray(Corners, 4, True);
  2665. with rec do
  2666. begin
  2667. corners[0] := PointD(Right, Top);
  2668. corners[1] := BottomRight;
  2669. corners[2] := PointD(Left, Bottom);
  2670. corners[3] := TopLeft;
  2671. end;
  2672. NewPointDArray(Result, 1, True);
  2673. Result[0].X := corners[3].X + radius.X;
  2674. Result[0].Y := corners[3].Y;
  2675. NewPointDArray(bezPts, 4, True);
  2676. for i := 0 to High(corners) do
  2677. begin
  2678. for j := 0 to 3 do bezPts[j] := corners[i];
  2679. case i of
  2680. 3:
  2681. begin
  2682. bezPts[0].Y := bezPts[0].Y + radius.Y;
  2683. bezPts[1].Y := bezPts[0].Y - magic.Y;
  2684. bezPts[3].X := bezPts[3].X + radius.X;
  2685. bezPts[2].X := bezPts[3].X - magic.X;
  2686. end;
  2687. 0:
  2688. begin
  2689. bezPts[0].X := bezPts[0].X - radius.X;
  2690. bezPts[1].X := bezPts[0].X + magic.X;
  2691. bezPts[3].Y := bezPts[3].Y + radius.Y;
  2692. bezPts[2].Y := bezPts[3].Y - magic.Y;
  2693. end;
  2694. 1:
  2695. begin
  2696. bezPts[0].Y := bezPts[0].Y - radius.Y;
  2697. bezPts[1].Y := bezPts[0].Y + magic.Y;
  2698. bezPts[3].X := bezPts[3].X - radius.X;
  2699. bezPts[2].X := bezPts[3].X + magic.X;
  2700. end;
  2701. 2:
  2702. begin
  2703. bezPts[0].X := bezPts[0].X + radius.X;
  2704. bezPts[1].X := bezPts[0].X - magic.X;
  2705. bezPts[3].Y := bezPts[3].Y - radius.Y;
  2706. bezPts[2].Y := bezPts[3].Y + magic.Y;
  2707. end;
  2708. end;
  2709. ConcatPaths(Result, FlattenCBezier(bezPts));
  2710. end;
  2711. end;
  2712. //------------------------------------------------------------------------------
  2713. function Circle(const pt: TPoint; radius: double): TPathD;
  2714. var
  2715. rec: TRectD;
  2716. begin
  2717. rec.Left := pt.X - radius;
  2718. rec.Right := pt.X + radius;
  2719. rec.Top := pt.Y - radius;
  2720. rec.Bottom := pt.Y + radius;
  2721. Result := Ellipse(rec);
  2722. end;
  2723. //------------------------------------------------------------------------------
  2724. function Circle(const pt: TPointD; radius: double): TPathD;
  2725. var
  2726. rec: TRectD;
  2727. begin
  2728. rec.Left := pt.X - radius;
  2729. rec.Right := pt.X + radius;
  2730. rec.Top := pt.Y - radius;
  2731. rec.Bottom := pt.Y + radius;
  2732. Result := Ellipse(rec);
  2733. end;
  2734. //------------------------------------------------------------------------------
  2735. function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD;
  2736. var
  2737. rec: TRectD;
  2738. begin
  2739. rec.Left := pt.X - radius;
  2740. rec.Right := pt.X + radius;
  2741. rec.Top := pt.Y - radius;
  2742. rec.Bottom := pt.Y + radius;
  2743. Result := Ellipse(rec, pendingScale);
  2744. end;
  2745. //------------------------------------------------------------------------------
  2746. function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
  2747. out centre: TPointD; out radius: double): Boolean;
  2748. var
  2749. mat11, mat12, mat13, mat14: TMatrixD;
  2750. m11,m12,m13,m14: double;
  2751. begin
  2752. mat11 := Matrix(p1.X, p1.Y, 1, p2.X, p2.Y, 1, p3.X, p3.Y, 1);
  2753. m11 := MatrixDeterminant(mat11);
  2754. Result := m11 <> 0;
  2755. if not Result then Exit;
  2756. mat12 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.Y, 1,
  2757. Sqr(p2.X)+Sqr(p2.Y), p2.Y, 1, Sqr(p3.X)+Sqr(p3.Y), p3.Y, 1);
  2758. mat12 := Matrix(2, 1, 1, 20, 4, 1, 34, 3, 1);
  2759. m12 := MatrixDeterminant(mat12);
  2760. mat13 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, 1,
  2761. Sqr(p2.X)+Sqr(p2.Y), p2.X, 1, Sqr(p3.X)+Sqr(p3.Y), p3.X, 1);
  2762. m13 := MatrixDeterminant(mat13);
  2763. mat14 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, p1.Y,
  2764. Sqr(p2.X)+Sqr(p2.Y), p2.X, p2.Y, Sqr(p3.X)+Sqr(p3.Y), p3.X, p3.Y);
  2765. m14 := MatrixDeterminant(mat14);
  2766. centre.X := 0.5 * m12/m11;
  2767. centre.Y := -0.5 * m13/m11;
  2768. radius := Sqrt(Sqr(centre.X) + Sqr(centre.Y) + m14/m11);
  2769. end;
  2770. //------------------------------------------------------------------------------
  2771. function Ellipse(const rec: TRectD; pendingScale: double): TPathD;
  2772. var
  2773. steps: integer;
  2774. begin
  2775. if pendingScale <= 0 then pendingScale := 1;
  2776. steps := Round(CalcRoundingSteps((rec.width + rec.Height) * pendingScale));
  2777. Result := Ellipse(rec, steps);
  2778. end;
  2779. //------------------------------------------------------------------------------
  2780. function Ellipse(const rec: TRect; steps: integer): TPathD;
  2781. begin
  2782. Result := Ellipse(RectD(rec), steps);
  2783. end;
  2784. //------------------------------------------------------------------------------
  2785. function Ellipse(const rec: TRectD; steps: integer): TPathD;
  2786. var
  2787. i: Integer;
  2788. sinA, cosA: double;
  2789. centre, radius, delta: TPointD;
  2790. begin
  2791. result := nil;
  2792. if rec.IsEmpty then Exit;
  2793. with rec do
  2794. begin
  2795. centre := rec.MidPoint;
  2796. radius := PointD(Width * 0.5, Height * 0.5);
  2797. end;
  2798. if steps < 4 then
  2799. steps := Round(CalcRoundingSteps(rec.width + rec.height));
  2800. GetSinCos(2 * Pi / Steps, sinA, cosA);
  2801. delta.x := cosA; delta.y := sinA;
  2802. NewPointDArray(Result, Steps, True);
  2803. Result[0] := PointD(centre.X + radius.X, centre.Y);
  2804. for i := 1 to steps -1 do
  2805. begin
  2806. Result[i] := PointD(centre.X + radius.X * delta.x,
  2807. centre.Y + radius.y * delta.y);
  2808. delta := PointD(delta.X * cosA - delta.Y * sinA,
  2809. delta.Y * cosA + delta.X * sinA);
  2810. end; //rotates clockwise
  2811. end;
  2812. //------------------------------------------------------------------------------
  2813. function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD;
  2814. begin
  2815. Result := Ellipse(rec, steps);
  2816. if angle = 0 then Exit;
  2817. Result := RotatePath(Result, rec.MidPoint, angle);
  2818. end;
  2819. //------------------------------------------------------------------------------
  2820. function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD;
  2821. begin
  2822. Result := Ellipse(rec, pendingScale);
  2823. if angle = 0 then Exit;
  2824. Result := RotatePath(Result, rec.MidPoint, angle);
  2825. end;
  2826. //------------------------------------------------------------------------------
  2827. function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
  2828. begin
  2829. Result := arctan2(ellRec.Height/ellRec.Width * sin(angle), cos(angle));
  2830. end;
  2831. //------------------------------------------------------------------------------
  2832. function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
  2833. begin
  2834. Result := ArcTan2(sin(angle) *ellRec.Width, cos(angle) * ellRec.Height);
  2835. end;
  2836. //------------------------------------------------------------------------------
  2837. function Star(const rec: TRectD; points: integer; indentFrac: double): TPathD;
  2838. var
  2839. i: integer;
  2840. innerOff: double;
  2841. p, p2: TPathD;
  2842. rec2: TRectD;
  2843. begin
  2844. Result := nil;
  2845. if points < 5 then points := 5
  2846. else if points > 15 then points := 15;
  2847. if indentFrac < 0.2 then indentFrac := 0.2
  2848. else if indentFrac > 0.8 then indentFrac := 0.8;
  2849. innerOff := Min(rec.Width, rec.Height) * indentFrac * 0.5;
  2850. if not Odd(points) then inc(points);
  2851. p := Ellipse(rec, points);
  2852. if not Assigned(p) then Exit;
  2853. rec2 := rec;
  2854. Img32.Vector.InflateRect(rec2, -innerOff, -innerOff);
  2855. if rec2.IsEmpty then
  2856. p2 := Ellipse(rec, points*2) else
  2857. p2 := Ellipse(rec2, points*2);
  2858. NewPointDArray(Result, points*2, True);
  2859. for i := 0 to points -1 do
  2860. begin
  2861. Result[i*2] := p[i];
  2862. Result[i*2+1] := p2[i*2+1];
  2863. end;
  2864. end;
  2865. //------------------------------------------------------------------------------
  2866. function Star(const focalPt: TPointD;
  2867. innerRadius, outerRadius: double; points: integer): TPathD;
  2868. var
  2869. i: Integer;
  2870. sinA, cosA: double;
  2871. delta: TPointD;
  2872. begin
  2873. result := nil;
  2874. if (innerRadius <= 0) or (outerRadius <= 0) then Exit;
  2875. if points <= 5 then points := 10
  2876. else points := points * 2;
  2877. GetSinCos(2 * Pi / points, sinA, cosA);
  2878. delta.x := cosA; delta.y := sinA;
  2879. NewPointDArray(Result, points, True);
  2880. Result[0] := PointD(focalPt.X + innerRadius, focalPt.Y);
  2881. for i := 1 to points -1 do
  2882. begin
  2883. if Odd(i) then
  2884. Result[i] := PointD(focalPt.X + outerRadius * delta.x,
  2885. focalPt.Y + outerRadius * delta.y)
  2886. else
  2887. Result[i] := PointD(focalPt.X + innerRadius * delta.x,
  2888. focalPt.Y + innerRadius * delta.y);
  2889. delta := PointD(delta.X * cosA - delta.Y * sinA,
  2890. delta.Y * cosA + delta.X * sinA);
  2891. end;
  2892. end;
  2893. //------------------------------------------------------------------------------
  2894. function Arc(const rec: TRectD;
  2895. startAngle, endAngle: double; scale: double): TPathD;
  2896. var
  2897. i, steps: Integer;
  2898. angle: double;
  2899. sinA, cosA: double;
  2900. centre, radius: TPointD;
  2901. deltaX, deltaX2, deltaY: double;
  2902. const
  2903. qtrDeg = PI/1440;
  2904. begin
  2905. Result := nil;
  2906. if (endAngle = startAngle) or IsEmptyRect(rec) then Exit;
  2907. if scale <= 0 then scale := 4.0;
  2908. {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
  2909. startAngle := -startAngle;
  2910. endAngle := -endAngle;
  2911. {$ENDIF}
  2912. NormalizeAngle(startAngle, qtrDeg);
  2913. NormalizeAngle(endAngle, qtrDeg);
  2914. with rec do
  2915. begin
  2916. centre := MidPoint;
  2917. radius := PointD(Width * 0.5, Height * 0.5);
  2918. end;
  2919. if endAngle < startAngle then
  2920. angle := endAngle - startAngle + angle360 else
  2921. angle := endAngle - startAngle;
  2922. //steps = (No. steps for a whole ellipse) * angle/(2*Pi)
  2923. steps := Round(CalcRoundingSteps((rec.width + rec.height)/2 * scale));
  2924. steps := steps div 2; /////////////////////////////////
  2925. if steps < 2 then steps := 2;
  2926. NewPointDArray(Result, Steps +1, True);
  2927. //angle of the first step ...
  2928. GetSinCos(startAngle, deltaY, deltaX);
  2929. Result[0].X := centre.X + radius.X * deltaX;
  2930. Result[0].Y := centre.Y + radius.y * deltaY;
  2931. //angle of each subsequent step ...
  2932. GetSinCos(angle / Steps, sinA, cosA);
  2933. for i := 1 to steps do
  2934. begin
  2935. deltaX2 := deltaX * cosA - deltaY * sinA;
  2936. deltaY := deltaY * cosA + deltaX * sinA;
  2937. deltaX := deltaX2;
  2938. Result[i].X := centre.X + radius.X * deltaX;
  2939. Result[i].Y := centre.Y + radius.y * deltaY;
  2940. end; //progresses clockwise from start to end
  2941. end;
  2942. //------------------------------------------------------------------------------
  2943. function Pie(const rec: TRectD;
  2944. StartAngle, EndAngle: double; scale: double): TPathD;
  2945. var
  2946. len: integer;
  2947. begin
  2948. result := Arc(rec, StartAngle, EndAngle, scale);
  2949. len := length(result);
  2950. SetLengthUninit(result, len +1);
  2951. result[len] := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
  2952. end;
  2953. //------------------------------------------------------------------------------
  2954. function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
  2955. arrowStyle: TArrowStyle): TPathD;
  2956. var
  2957. unitVec, basePt: TPointD;
  2958. sDiv40, sDiv50, sDiv60, sDiv120: double;
  2959. begin
  2960. result := nil;
  2961. sDiv40 := size * 0.40;
  2962. sDiv50 := size * 0.50;
  2963. sDiv60 := size * 0.60;
  2964. sDiv120 := sDiv60 * 2;
  2965. unitVec := GetUnitVector(ctrlPt, arrowTip);
  2966. case arrowStyle of
  2967. asNone:
  2968. Exit;
  2969. asSimple:
  2970. begin
  2971. NewPointDArray(result, 3, True);
  2972. basePt := TranslatePoint(arrowTip, -unitVec.X * size, -unitVec.Y * size);
  2973. result[0] := arrowTip;
  2974. result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50);
  2975. result[2] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
  2976. end;
  2977. asFancy:
  2978. begin
  2979. NewPointDArray(result, 4, True);
  2980. basePt := TranslatePoint(arrowTip,
  2981. -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
  2982. result[0] := TranslatePoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50);
  2983. result[1] := TranslatePoint(arrowTip, -unitVec.X *size, -unitVec.Y *size);
  2984. result[2] := TranslatePoint(basePt, unitVec.Y *sDiv50, -unitVec.X *sDiv50);
  2985. result[3] := arrowTip;
  2986. end;
  2987. asDiamond:
  2988. begin
  2989. NewPointDArray(result, 4, True);
  2990. basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60);
  2991. result[0] := arrowTip;
  2992. result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50);
  2993. result[2] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
  2994. result[3] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
  2995. end;
  2996. asCircle:
  2997. begin
  2998. basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50);
  2999. with Point(basePt) do
  3000. result := Ellipse(RectD(x - sDiv50, y - sDiv50, x + sDiv50, y + sDiv50));
  3001. end;
  3002. asTail:
  3003. begin
  3004. NewPointDArray(result, 6, True);
  3005. basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60);
  3006. result[0] := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50);
  3007. result[1] := TranslatePoint(arrowTip, -unitVec.Y * sDiv40, unitVec.X * sDiv40);
  3008. result[2] := TranslatePoint(basePt, -unitVec.Y * sDiv40, unitVec.X * sDiv40);
  3009. result[3] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
  3010. result[4] := TranslatePoint(basePt, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
  3011. result[5] := TranslatePoint(arrowTip, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
  3012. end;
  3013. end;
  3014. end;
  3015. //------------------------------------------------------------------------------
  3016. function GetDefaultArrowHeadSize(lineWidth: double): double;
  3017. begin
  3018. Result := lineWidth *3 + 7;
  3019. end;
  3020. //------------------------------------------------------------------------------
  3021. procedure AdjustPoint(var pt: TPointD; const referencePt: TPointD; delta: double);
  3022. var
  3023. vec: TPointD;
  3024. begin
  3025. //Positive delta moves pt away from referencePt, and
  3026. //negative delta moves pt toward referencePt.
  3027. vec := GetUnitVector(referencePt, pt);
  3028. pt.X := pt.X + (vec.X * delta);
  3029. pt.Y := pt.Y + (vec.Y * delta);
  3030. end;
  3031. //------------------------------------------------------------------------------
  3032. function ShortenPath(const path: TPathD;
  3033. pathEnd: TPathEnd; amount: double): TPathD;
  3034. var
  3035. len, amount2: double;
  3036. vec: TPointD;
  3037. i, highPath: integer;
  3038. begin
  3039. result := path;
  3040. highPath := high(path);
  3041. if highPath < 1 then Exit;
  3042. amount2 := amount;
  3043. if pathEnd <> peEnd then
  3044. begin
  3045. //shorten start
  3046. i := 0;
  3047. while (i < highPath) do
  3048. begin
  3049. len := Distance(result[i], result[i+1]);
  3050. if (len >= amount) then Break;
  3051. amount := amount - len;
  3052. inc(i);
  3053. end;
  3054. if i > 0 then
  3055. begin
  3056. Move(path[i], Result[0], (highPath - i +1) * SizeOf(TPointD));
  3057. dec(highPath, i);
  3058. SetLength(Result, highPath +1);
  3059. end;
  3060. if amount > 0 then
  3061. begin
  3062. vec := GetUnitVector(result[0], result[1]);
  3063. result[0].X := result[0].X + vec.X * amount;
  3064. result[0].Y := result[0].Y + vec.Y * amount;
  3065. end;
  3066. end;
  3067. if pathEnd <> peStart then
  3068. begin
  3069. //shorten end
  3070. while (highPath > 1) do
  3071. begin
  3072. len := Distance(result[highPath], result[highPath -1]);
  3073. if (len >= amount2) then Break;
  3074. amount2 := amount2 - len;
  3075. dec(highPath);
  3076. end;
  3077. SetLength(Result, highPath +1);
  3078. if amount2 > 0 then
  3079. begin
  3080. vec := GetUnitVector(result[highPath], result[highPath -1]);
  3081. result[highPath].X := result[highPath].X + vec.X * amount2;
  3082. result[highPath].Y := result[highPath].Y + vec.Y * amount2;
  3083. end;
  3084. end;
  3085. end;
  3086. //------------------------------------------------------------------------------
  3087. function GetDashedPath(const path: TPathD;
  3088. closed: Boolean; const pattern: TArrayOfDouble;
  3089. patternOffset: PDouble): TPathsD;
  3090. var
  3091. i, highI, paIdx: integer;
  3092. vecs, path2, dash: TPathD;
  3093. patCnt: integer;
  3094. patLen: double;
  3095. dashCapacity, dashCnt, ptsCapacity, ptsCnt: integer;
  3096. segLen, residualPat, patOff: double;
  3097. filling: Boolean;
  3098. pt, pt2: TPointD;
  3099. procedure NewDash;
  3100. begin
  3101. if ptsCnt = 1 then ptsCnt := 0;
  3102. if ptsCnt = 0 then Exit;
  3103. if dashCnt = dashCapacity then
  3104. begin
  3105. inc(dashCapacity, BuffSize);
  3106. setLength(result, dashCapacity);
  3107. end;
  3108. result[dashCnt] := Copy(dash, 0, ptsCnt);
  3109. inc(dashCnt);
  3110. ptsCapacity := BuffSize;
  3111. setLength(dash, ptsCapacity);
  3112. ptsCnt := 0;
  3113. end;
  3114. procedure ExtendDash(const pt: TPointD);
  3115. begin
  3116. if ptsCnt = ptsCapacity then
  3117. begin
  3118. inc(ptsCapacity, BuffSize);
  3119. setLength(dash, ptsCapacity);
  3120. end;
  3121. dash[ptsCnt] := pt;
  3122. inc(ptsCnt);
  3123. end;
  3124. begin
  3125. Result := nil;
  3126. paIdx := 0;
  3127. patCnt := length(pattern);
  3128. path2 := path;
  3129. highI := high(path2);
  3130. if (highI < 1) or (patCnt = 0) then Exit;
  3131. if closed and
  3132. ((path2[highI].X <> path2[0].X) or (path2[highI].Y <> path2[0].Y)) then
  3133. begin
  3134. inc(highI);
  3135. setLength(path2, highI +2);
  3136. path2[highI] := path2[0];
  3137. end;
  3138. vecs := GetVectors(path2);
  3139. if (vecs[0].X = 0) and (vecs[0].Y = 0) then Exit; //not a line
  3140. if not assigned(patternOffset) then
  3141. patOff := 0 else
  3142. patOff := patternOffset^;
  3143. patLen := 0;
  3144. for i := 0 to patCnt -1 do
  3145. patLen := patLen + pattern[i];
  3146. if patOff < 0 then
  3147. begin
  3148. patOff := patLen + patOff;
  3149. while patOff < 0 do
  3150. patOff := patOff + patLen;
  3151. end
  3152. else while patOff > patLen do
  3153. patOff := patOff - patLen;
  3154. //nb: each dash is made up of 2 or more pts
  3155. dashCnt := 0;
  3156. dashCapacity := 0;
  3157. ptsCnt := 0;
  3158. ptsCapacity := 0;
  3159. filling := true;
  3160. while patOff >= pattern[paIdx] do
  3161. begin
  3162. filling := not filling;
  3163. patOff := patOff - pattern[paIdx];
  3164. paIdx := (paIdx + 1) mod patCnt;
  3165. end;
  3166. residualPat := pattern[paIdx] - patOff;
  3167. pt := path2[0];
  3168. ExtendDash(pt);
  3169. i := 0;
  3170. while (i < highI) do
  3171. begin
  3172. segLen := Distance(pt, path2[i+1]);
  3173. if residualPat > segLen then
  3174. begin
  3175. if filling then ExtendDash(path2[i+1]);
  3176. residualPat := residualPat - segLen;
  3177. pt := path2[i+1];
  3178. inc(i);
  3179. end else
  3180. begin
  3181. pt2.X := pt.X + vecs[i].X * residualPat;
  3182. pt2.Y := pt.Y + vecs[i].Y * residualPat;
  3183. if filling then ExtendDash(pt2);
  3184. filling := not filling;
  3185. NewDash;
  3186. paIdx := (paIdx + 1) mod patCnt;
  3187. residualPat := pattern[paIdx];
  3188. pt := pt2;
  3189. ExtendDash(pt);
  3190. end;
  3191. end;
  3192. NewDash;
  3193. SetLength(Result, dashCnt);
  3194. if not assigned(patternOffset) then Exit;
  3195. patOff := 0;
  3196. for i := 0 to paIdx -1 do
  3197. patOff := patOff + pattern[i];
  3198. patternOffset^ := patOff + (pattern[paIdx] - residualPat);
  3199. end;
  3200. //------------------------------------------------------------------------------
  3201. function GetDashedOutLine(const path: TPathD;
  3202. closed: Boolean; const pattern: TArrayOfDouble;
  3203. patternOffset: PDouble; lineWidth: double;
  3204. joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
  3205. var
  3206. i: integer;
  3207. tmp: TPathsD;
  3208. begin
  3209. Result := nil;
  3210. for i := 0 to High(pattern) do
  3211. if pattern[i] <= 0 then pattern[i] := 1;
  3212. tmp := GetDashedPath(path, closed, pattern, patternOffset);
  3213. for i := 0 to high(tmp) do
  3214. // AppendPath(Result, GrowOpenLine(tmp[i],
  3215. // lineWidth, joinStyle, endStyle, 2));
  3216. AppendPath(Result, GrowClosedLine(tmp[i], lineWidth, joinStyle, 2));
  3217. end;
  3218. //------------------------------------------------------------------------------
  3219. function GetBoundsD(const paths: TArrayOfPathsD): TRectD;
  3220. var
  3221. i, len: integer;
  3222. rec: TRectD;
  3223. begin
  3224. len := Length(paths);
  3225. i := 0;
  3226. while (i < len) do
  3227. begin
  3228. rec := GetBoundsD(paths[i]);
  3229. if not IsEmptyRect(rec) then Break;
  3230. inc(i);
  3231. end;
  3232. if i = len then
  3233. begin
  3234. Result := NullRectD;
  3235. Exit;
  3236. end;
  3237. Result := rec;
  3238. for i := i + 1 to len -1 do
  3239. begin
  3240. rec := GetBoundsD(paths[i]);
  3241. if IsEmptyRect(rec) then Continue;
  3242. Result := UnionRect(Result, rec);
  3243. end;
  3244. end;
  3245. //------------------------------------------------------------------------------
  3246. function GetBoundsD(const paths: TPathsD): TRectD;
  3247. var
  3248. i,j: integer;
  3249. p: PPointD;
  3250. {$IFDEF CPUX64}
  3251. l,t,r,b,x,y: double;
  3252. {$ENDIF CPUX64}
  3253. begin
  3254. if paths = nil then
  3255. begin
  3256. Result := NullRectD;
  3257. Exit;
  3258. end;
  3259. {$IFDEF CPUX64}
  3260. l := MaxDouble; t := l;
  3261. r := -MaxDouble; b := r;
  3262. {$ELSE}
  3263. Result.Left := MaxDouble;
  3264. Result.Top := MaxDouble;
  3265. Result.Right := -MaxDouble;
  3266. Result.Bottom := -MaxDouble;
  3267. {$ENDIF CPUX64}
  3268. for i := 0 to high(paths) do
  3269. begin
  3270. p := PPointD(paths[i]);
  3271. if not assigned(p) then Continue;
  3272. for j := 0 to high(paths[i]) do
  3273. begin
  3274. {$IFDEF CPUX64}
  3275. // load p.X and p.Y into xmm registers
  3276. x := p.X;
  3277. y := p.Y;
  3278. if x < l then l := x;
  3279. if x > r then r := x;
  3280. if y < t then t := y;
  3281. if y > b then b := y;
  3282. {$ELSE}
  3283. // If we must use the FPU and memory then we should write directly
  3284. // to the target memory.
  3285. if p.x < Result.Left then Result.Left := p.x;
  3286. if p.x > Result.Right then Result.Right := p.x;
  3287. if p.y < Result.Top then Result.Top := p.y;
  3288. if p.y > Result.Bottom then Result.Bottom := p.y;
  3289. {$ENDIF CPUX64}
  3290. inc(p);
  3291. end;
  3292. end;
  3293. {$IFDEF CPUX64}
  3294. if r < l then
  3295. Result := NullRectD
  3296. else
  3297. begin
  3298. // Inline the RectD() call by hand
  3299. Result.Left := l;
  3300. Result.Top := t;
  3301. Result.Right := r;
  3302. Result.Bottom := b;
  3303. end;
  3304. {$ELSE}
  3305. if Result.Right < Result.Left then
  3306. Result := NullRectD;
  3307. {$ENDIF CPUX64}
  3308. end;
  3309. //------------------------------------------------------------------------------
  3310. function GetBoundsD(const path: TPathD): TRectD;
  3311. var
  3312. i,highI: integer;
  3313. p: PPointD;
  3314. {$IFDEF CPUX64}
  3315. l,t,r,b,x,y: double;
  3316. {$ENDIF CPUX64}
  3317. begin
  3318. highI := High(path);
  3319. if highI < 0 then
  3320. begin
  3321. Result := NullRectD;
  3322. Exit;
  3323. end;
  3324. {$IFDEF CPUX64}
  3325. l := path[0].X; r := l;
  3326. t := path[0].Y; b := t;
  3327. p := PPointD(path);
  3328. for i := 1 to highI do
  3329. begin
  3330. inc(p);
  3331. // load p.X and p.Y into xmm registers
  3332. x := p.X;
  3333. y := p.Y;
  3334. if x < l then l := x;
  3335. if x > r then r := x;
  3336. if y < t then t := y;
  3337. if y > b then b := y;
  3338. end;
  3339. // Inline the RectD() call by hand
  3340. Result.Left := l;
  3341. Result.Top := t;
  3342. Result.Right := r;
  3343. Result.Bottom := b;
  3344. {$ELSE}
  3345. // If we must use the FPU and memory then we should write directly
  3346. // to the target memory.
  3347. {$IFDEF RECORD_METHODS}
  3348. Result.TopLeft := path[0]; // uses "rep movsd"
  3349. Result.BottomRight := Result.TopLeft;
  3350. {$ELSE}
  3351. Result.Left := path[0].X; // uses "fld" and "fstp"
  3352. Result.Top := path[0].Y;
  3353. Result.Right := Result.Left;
  3354. Result.Bottom := Result.Right;
  3355. {$ENDIF RECORD_METHODS}
  3356. p := PPointD(path);
  3357. for i := 1 to highI do
  3358. begin
  3359. inc(p);
  3360. if p.x < Result.Left then Result.Left := p.x;
  3361. if p.x > Result.Right then Result.Right := p.x;
  3362. if p.y < Result.Top then Result.Top := p.y;
  3363. if p.y > Result.Bottom then Result.Bottom := p.y;
  3364. end;
  3365. {$ENDIF CPUX64}
  3366. end;
  3367. //------------------------------------------------------------------------------
  3368. function GetBounds(const path: TPathD): TRect;
  3369. var
  3370. recD: TRectD;
  3371. begin
  3372. recD := GetBoundsD(path);
  3373. Result := Rect(recD);
  3374. end;
  3375. //------------------------------------------------------------------------------
  3376. function GetBounds(const paths: TPathsD): TRect;
  3377. var
  3378. recD: TRectD;
  3379. begin
  3380. recD := GetBoundsD(paths);
  3381. Result := Rect(recD);
  3382. end;
  3383. //------------------------------------------------------------------------------
  3384. procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD);
  3385. var
  3386. len: integer;
  3387. begin
  3388. len := Length(p);
  3389. SetLengthUninit(Result, len +1);
  3390. Result[0] := pt;
  3391. if len > 0 then Move(p[0], Result[1], len * SizeOf(TPointD));
  3392. end;
  3393. //------------------------------------------------------------------------------
  3394. function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD;
  3395. begin
  3396. PrePendPoint(pt, p, Result);
  3397. end;
  3398. //------------------------------------------------------------------------------
  3399. function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
  3400. var
  3401. len: integer;
  3402. begin
  3403. len := Length(p);
  3404. NewPointDArray(Result, len +2, True);
  3405. Result[0] := pt1;
  3406. Result[1] := pt2;
  3407. if len > 0 then Move(p[0], Result[2], len * SizeOf(TPointD));
  3408. end;
  3409. //------------------------------------------------------------------------------
  3410. function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
  3411. var
  3412. omt: double;
  3413. begin
  3414. if t > 1 then t := 1
  3415. else if t < 0 then t := 0;
  3416. omt := 1 - t;
  3417. Result.X := a.X*omt*omt + b.X*2*omt*t + c.X*t*t;
  3418. Result.Y := a.Y*omt*omt + b.Y*2*omt*t + c.Y*t*t;
  3419. end;
  3420. //------------------------------------------------------------------------------
  3421. function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
  3422. tolerance: double = 0.0): TPathD; overload;
  3423. begin
  3424. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3425. Result := FlattenQBezier(PrePendPoint(firstPt, pts), tolerance);
  3426. end;
  3427. //------------------------------------------------------------------------------
  3428. function FlattenQBezier(const pts: TPathD; tolerance: double = 0.0): TPathD;
  3429. var
  3430. i, highI: integer;
  3431. p: TPathD;
  3432. begin
  3433. Result := nil;
  3434. highI := high(pts);
  3435. if highI < 0 then Exit;
  3436. if (highI < 2) or Odd(highI) then
  3437. raise Exception.CreateRes(@rsInvalidQBezier);
  3438. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3439. NewPointDArray(Result, 1, True);
  3440. Result[0] := pts[0];
  3441. for i := 0 to (highI div 2) -1 do
  3442. begin
  3443. if PointsEqual(pts[i*2], pts[i*2+1]) and
  3444. PointsEqual(pts[i*2+1], pts[i*2+2]) then
  3445. begin
  3446. AppendPoint(Result, pts[i*2]);
  3447. AppendPoint(Result, pts[i*2 +2]);
  3448. end else
  3449. begin
  3450. p := FlattenQBezier(pts[i*2], pts[i*2+1], pts[i*2+2], tolerance);
  3451. ConcatPaths(Result, Copy(p, 1, Length(p) -1));
  3452. end;
  3453. end;
  3454. end;
  3455. //------------------------------------------------------------------------------
  3456. function FlattenQBezier(const pt1, pt2, pt3: TPointD;
  3457. tolerance: double = 0.0): TPathD;
  3458. var
  3459. resultCnt, resultLen: integer;
  3460. procedure AddPoint(const pt: TPointD);
  3461. begin
  3462. if resultCnt = resultLen then
  3463. begin
  3464. inc(resultLen, BuffSize);
  3465. SetLengthUninit(result, resultLen);
  3466. end;
  3467. result[resultCnt] := pt;
  3468. inc(resultCnt);
  3469. end;
  3470. procedure DoCurve(const p1, p2, p3: TPointD);
  3471. var
  3472. p12, p23, p123: TPointD;
  3473. begin
  3474. if (abs(p1.x + p3.x - 2 * p2.x) +
  3475. abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
  3476. begin
  3477. AddPoint(p3);
  3478. end else
  3479. begin
  3480. P12.X := (P1.X + P2.X) * 0.5;
  3481. P12.Y := (P1.Y + P2.Y) * 0.5;
  3482. P23.X := (P2.X + P3.X) * 0.5;
  3483. P23.Y := (P2.Y + P3.Y) * 0.5;
  3484. P123.X := (P12.X + P23.X) * 0.5;
  3485. P123.Y := (P12.Y + P23.Y) * 0.5;
  3486. DoCurve(p1, p12, p123);
  3487. DoCurve(p123, p23, p3);
  3488. end;
  3489. end;
  3490. begin
  3491. resultLen := 0; resultCnt := 0;
  3492. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3493. AddPoint(pt1);
  3494. if ((pt1.X = pt2.X) and (pt1.Y = pt2.Y)) or
  3495. ((pt2.X = pt3.X) and (pt2.Y = pt3.Y)) then
  3496. begin
  3497. AddPoint(pt3)
  3498. end else
  3499. DoCurve(pt1, pt2, pt3);
  3500. SetLength(result, resultCnt);
  3501. end;
  3502. //------------------------------------------------------------------------------
  3503. function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
  3504. var
  3505. omt: double;
  3506. begin
  3507. if t > 1 then t := 1
  3508. else if t < 0 then t := 0;
  3509. omt := 1 - t;
  3510. Result.X := a.X*omt*omt*omt +b.X*3*omt*omt*t +c.X*3*omt*t*t +d.X*t*t*t;
  3511. Result.Y := a.Y*omt*omt*omt +b.Y*3*omt*omt*t +c.Y*3*omt*t*t +d.Y*t*t*t;
  3512. end;
  3513. //------------------------------------------------------------------------------
  3514. function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
  3515. tolerance: double = 0.0): TPathD; overload;
  3516. begin
  3517. Result := FlattenCBezier(PrePendPoint(firstPt, pts), tolerance);
  3518. end;
  3519. //------------------------------------------------------------------------------
  3520. function FlattenCBezier(const path: TPathD; tolerance: double = 0.0): TPathD;
  3521. var
  3522. i, len: integer;
  3523. p: TPathD;
  3524. begin
  3525. Result := nil;
  3526. len := Length(path) -1;
  3527. if len < 0 then Exit;
  3528. if (len < 3) or (len mod 3 <> 0) then
  3529. raise Exception.Create(rsInvalidCBezier);
  3530. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3531. NewPointDArray(Result, 1, True);
  3532. Result[0] := path[0];
  3533. for i := 0 to (len div 3) -1 do
  3534. begin
  3535. if PointsEqual(path[i*3], path[i*3+1]) and
  3536. PointsEqual(path[i*3+2], path[i*3+3]) then
  3537. begin
  3538. AppendPoint(Result, path[i*3]);
  3539. AppendPoint(Result, path[i*3 +3]);
  3540. end else
  3541. begin
  3542. p := FlattenCBezier(path[i*3], path[i*3+1],
  3543. path[i*3+2], path[i*3+3], tolerance);
  3544. ConcatPaths(Result, Copy(p, 1, Length(p) -1));
  3545. end;
  3546. end;
  3547. end;
  3548. //------------------------------------------------------------------------------
  3549. function FlattenCBezier(const paths: TPathsD; tolerance: double): TPathsD;
  3550. var
  3551. i, len: integer;
  3552. begin
  3553. len := Length(paths);
  3554. SetLength(Result, len);
  3555. for i := 0 to len -1 do
  3556. Result[i] := FlattenCBezier(paths[i], tolerance);
  3557. end;
  3558. //------------------------------------------------------------------------------
  3559. function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
  3560. tolerance: double = 0.0): TPathD;
  3561. var
  3562. resultCnt, resultLen: integer;
  3563. procedure AddPoint(const pt: TPointD);
  3564. begin
  3565. if resultCnt = resultLen then
  3566. begin
  3567. inc(resultLen, BuffSize);
  3568. SetLengthUninit(result, resultLen);
  3569. end;
  3570. result[resultCnt] := pt;
  3571. inc(resultCnt);
  3572. end;
  3573. procedure DoCurve(const p1, p2, p3, p4: TPointD);
  3574. var
  3575. p12, p23, p34, p123, p234, p1234: TPointD;
  3576. begin
  3577. if ((abs(p1.x +p3.x - 2*p2.x) < tolerance) and
  3578. (abs(p2.x +p4.x - 2*p3.x) < tolerance)) and
  3579. ((abs(p1.y +p3.y - 2*p2.y) < tolerance) and
  3580. (abs(p2.y +p4.y - 2*p3.y) < tolerance)) then
  3581. begin
  3582. AddPoint(p4);
  3583. end else
  3584. begin
  3585. p12.X := (p1.X + p2.X) / 2;
  3586. p12.Y := (p1.Y + p2.Y) / 2;
  3587. p23.X := (p2.X + p3.X) / 2;
  3588. p23.Y := (p2.Y + p3.Y) / 2;
  3589. p34.X := (p3.X + p4.X) / 2;
  3590. p34.Y := (p3.Y + p4.Y) / 2;
  3591. p123.X := (p12.X + p23.X) / 2;
  3592. p123.Y := (p12.Y + p23.Y) / 2;
  3593. p234.X := (p23.X + p34.X) / 2;
  3594. p234.Y := (p23.Y + p34.Y) / 2;
  3595. p1234.X := (p123.X + p234.X) / 2;
  3596. p1234.Y := (p123.Y + p234.Y) / 2;
  3597. DoCurve(p1, p12, p123, p1234);
  3598. DoCurve(p1234, p234, p34, p4);
  3599. end;
  3600. end;
  3601. begin
  3602. result := nil;
  3603. resultLen := 0; resultCnt := 0;
  3604. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3605. AddPoint(pt1);
  3606. if ValueAlmostZero(pt1.X - pt2.X) and ValueAlmostZero(pt1.Y - pt2.Y) and
  3607. ValueAlmostZero(pt3.X - pt4.X) and ValueAlmostZero(pt3.Y - pt4.Y) then
  3608. begin
  3609. AddPoint(pt4)
  3610. end else
  3611. DoCurve(pt1, pt2, pt3, pt4);
  3612. SetLength(result,resultCnt);
  3613. end;
  3614. //------------------------------------------------------------------------------
  3615. function ReflectPoint(const pt, pivot: TPointD): TPointD;
  3616. begin
  3617. Result.X := pivot.X + (pivot.X - pt.X);
  3618. Result.Y := pivot.Y + (pivot.Y - pt.Y);
  3619. end;
  3620. //------------------------------------------------------------------------------
  3621. function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
  3622. const pts: TPathD; tolerance: double = 0.0): TPathD;
  3623. var
  3624. p: TPathD;
  3625. len: integer;
  3626. begin
  3627. len := Length(pts);
  3628. NewPointDArray(p, len + 2, True);
  3629. p[0] := startPt;
  3630. p[1] := ReflectPoint(priorCtrlPt, startPt);
  3631. if len > 0 then
  3632. Move(pts[0], p[2], len * SizeOf(TPointD));
  3633. Result := FlattenCSpline(p, tolerance);
  3634. end;
  3635. //------------------------------------------------------------------------------
  3636. function FlattenCSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
  3637. var
  3638. resultCnt, resultLen: integer;
  3639. procedure AddPoint(const pt: TPointD);
  3640. begin
  3641. if resultCnt = resultLen then
  3642. begin
  3643. inc(resultLen, BuffSize);
  3644. SetLengthUninit(result, resultLen);
  3645. end;
  3646. result[resultCnt] := pt;
  3647. inc(resultCnt);
  3648. end;
  3649. procedure DoCurve(const p1, p2, p3, p4: TPointD);
  3650. var
  3651. p12, p23, p34, p123, p234, p1234: TPointD;
  3652. begin
  3653. if (abs(p1.x + p3.x - 2*p2.x) + abs(p2.x + p4.x - 2*p3.x) +
  3654. abs(p1.y + p3.y - 2*p2.y) + abs(p2.y + p4.y - 2*p3.y)) < tolerance then
  3655. begin
  3656. AddPoint(p4);
  3657. end else
  3658. begin
  3659. p12.X := (p1.X + p2.X) / 2;
  3660. p12.Y := (p1.Y + p2.Y) / 2;
  3661. p23.X := (p2.X + p3.X) / 2;
  3662. p23.Y := (p2.Y + p3.Y) / 2;
  3663. p34.X := (p3.X + p4.X) / 2;
  3664. p34.Y := (p3.Y + p4.Y) / 2;
  3665. p123.X := (p12.X + p23.X) / 2;
  3666. p123.Y := (p12.Y + p23.Y) / 2;
  3667. p234.X := (p23.X + p34.X) / 2;
  3668. p234.Y := (p23.Y + p34.Y) / 2;
  3669. p1234.X := (p123.X + p234.X) / 2;
  3670. p1234.Y := (p123.Y + p234.Y) / 2;
  3671. DoCurve(p1, p12, p123, p1234);
  3672. DoCurve(p1234, p234, p34, p4);
  3673. end;
  3674. end;
  3675. var
  3676. i, len: integer;
  3677. p: PPointD;
  3678. pt1,pt2,pt3,pt4: TPointD;
  3679. begin
  3680. result := nil;
  3681. len := Length(pts); resultLen := 0; resultCnt := 0;
  3682. if (len < 4) then Exit;
  3683. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3684. //ignore incomplete trailing control points
  3685. if Odd(len) then dec(len);
  3686. p := @pts[0];
  3687. AddPoint(p^);
  3688. pt1 := p^; inc(p);
  3689. pt2 := p^; inc(p);
  3690. for i := 0 to (len shr 1) - 2 do
  3691. begin
  3692. pt3 := p^; inc(p);
  3693. pt4 := p^; inc(p);
  3694. DoCurve(pt1, pt2, pt3, pt4);
  3695. pt1 := pt4;
  3696. pt2 := ReflectPoint(pt3, pt1);
  3697. end;
  3698. SetLength(result,resultCnt);
  3699. end;
  3700. //------------------------------------------------------------------------------
  3701. function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
  3702. const pts: TPathD; tolerance: double = 0.0): TPathD;
  3703. var
  3704. p: TPathD;
  3705. len: integer;
  3706. begin
  3707. len := Length(pts);
  3708. NewPointDArray(p, len + 2, True);
  3709. p[0] := startPt;
  3710. p[1] := ReflectPoint(priorCtrlPt, startPt);
  3711. if len > 0 then
  3712. Move(pts[0], p[2], len * SizeOf(TPointD));
  3713. Result := FlattenQSpline(p, tolerance);
  3714. end;
  3715. //------------------------------------------------------------------------------
  3716. function FlattenQSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
  3717. var
  3718. resultCnt, resultLen: integer;
  3719. procedure AddPoint(const pt: TPointD);
  3720. begin
  3721. if resultCnt = resultLen then
  3722. begin
  3723. inc(resultLen, BuffSize);
  3724. SetLengthUninit(result, resultLen);
  3725. end;
  3726. result[resultCnt] := pt;
  3727. inc(resultCnt);
  3728. end;
  3729. procedure DoCurve(const p1, p2, p3: TPointD);
  3730. var
  3731. p12, p23, p123: TPointD;
  3732. begin
  3733. if (abs(p1.x + p3.x - 2 * p2.x) +
  3734. abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
  3735. begin
  3736. AddPoint(p3);
  3737. end else
  3738. begin
  3739. P12.X := (P1.X + P2.X) * 0.5;
  3740. P12.Y := (P1.Y + P2.Y) * 0.5;
  3741. P23.X := (P2.X + P3.X) * 0.5;
  3742. P23.Y := (P2.Y + P3.Y) * 0.5;
  3743. P123.X := (P12.X + P23.X) * 0.5;
  3744. P123.Y := (P12.Y + P23.Y) * 0.5;
  3745. DoCurve(p1, p12, p123);
  3746. DoCurve(p123, p23, p3);
  3747. end;
  3748. end;
  3749. var
  3750. i, len: integer;
  3751. p: PPointD;
  3752. pt1, pt2, pt3: TPointD;
  3753. begin
  3754. result := nil;
  3755. len := Length(pts);
  3756. if (len < 3) then Exit;
  3757. resultLen := 0;
  3758. resultCnt := 0;
  3759. if tolerance <= 0.0 then tolerance := BezierTolerance;
  3760. p := @pts[0];
  3761. AddPoint(p^);
  3762. pt1 := p^; inc(p);
  3763. pt2 := p^; inc(p);
  3764. for i := 0 to len - 3 do
  3765. begin
  3766. pt3 := p^; inc(p);
  3767. DoCurve(pt1, pt2, pt3);
  3768. pt1 := pt3;
  3769. pt2 := ReflectPoint(pt2, pt1);
  3770. end;
  3771. SetLength(result,resultCnt);
  3772. end;
  3773. //------------------------------------------------------------------------------
  3774. function MakePath(const pts: array of double): TPathD;
  3775. var
  3776. i, len: Integer;
  3777. x,y: double;
  3778. begin
  3779. Result := nil;
  3780. len := length(pts) div 2;
  3781. if len = 0 then Exit;
  3782. NewPointDArray(Result, len, True);
  3783. Result[0].X := pts[0];
  3784. Result[0].Y := pts[1];
  3785. for i := 1 to len -1 do
  3786. begin
  3787. x := pts[i*2];
  3788. y := pts[i*2 +1];
  3789. Result[i].X := x;
  3790. Result[i].Y := y;
  3791. end;
  3792. end;
  3793. //------------------------------------------------------------------------------
  3794. function MakePath(const pt: TPointD): TPathD;
  3795. begin
  3796. SetLengthUninit(Result, 1);
  3797. Result[0] := pt;
  3798. end;
  3799. //------------------------------------------------------------------------------
  3800. end.