GR32_VectorUtils.pas 98 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409
  1. unit GR32_VectorUtils;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions `
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is Vectorial Polygon Rasterizer for Graphics32
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Mattias Andersson <[email protected]>
  26. *
  27. * Portions created by the Initial Developer are Copyright (C) 2008-2012
  28. * the Initial Developer. All Rights Reserved.
  29. *
  30. * Contributor(s):
  31. *
  32. * ***** END LICENSE BLOCK ***** *)
  33. interface
  34. {$I GR32.inc}
  35. {$BOOLEVAL OFF}
  36. uses
  37. GR32, GR32_Transforms, GR32_Polygons, Types, Math;
  38. const
  39. DEFAULT_MITER_LIMIT = 4.0;
  40. DEFAULT_MITER_LIMIT_FIXED = $40000;
  41. TWOPI = 2 * Pi;
  42. function InSignedRange(const X, X1, X2: TFloat): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  43. function InSignedRange(const X, X1, X2: TFixed): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  44. function OverlapExclusive(const X1, X2, Y1, Y2: TFloat): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  45. function OverlapExclusive(const Pt1, Pt2: TFloatPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  46. function OverlapExclusive(const X1, X2, Y1, Y2: TFixed): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  47. function OverlapExclusive(const Pt1, Pt2: TFixedPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  48. function OverlapInclusive(const X1, X2, Y1, Y2: TFloat): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  49. function OverlapInclusive(const Pt1, Pt2: TFloatPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  50. function OverlapInclusive(const X1, X2, Y1, Y2: TFixed): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  51. function OverlapInclusive(const Pt1, Pt2: TFixedPoint): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  52. function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean; overload;
  53. function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
  54. function FindNearestPointIndex(Point: TFloatPoint; Points: TArrayOfFloatPoint): Integer; overload;
  55. function FindNearestPointIndex(Point: TFixedPoint; Points: TArrayOfFixedPoint): Integer; overload;
  56. function VertexReduction(Points: TArrayOfFloatPoint; Epsilon: TFloat = 1): TArrayOfFloatPoint; overload;
  57. function VertexReduction(Points: TArrayOfFixedPoint; Epsilon: TFixed = FixedOne): TArrayOfFixedPoint; overload;
  58. function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
  59. function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
  60. function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean; overload;
  61. function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean; overload;
  62. function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean; overload;
  63. function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean; overload;
  64. function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean; overload;
  65. function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean; overload;
  66. procedure Extract(Src: TArrayOfFloat; Indexes: TArrayOfInteger; out Dst: TArrayOfFloat); overload;
  67. procedure Extract(Src: TArrayOfFixed; Indexes: TArrayOfInteger; out Dst: TArrayOfFixed); overload;
  68. procedure FastMergeSort(const Values: TArrayOfFloat; out Indexes: TArrayOfInteger); overload;
  69. procedure FastMergeSort(const Values: TArrayOfFixed; out Indexes: TArrayOfInteger); overload;
  70. type
  71. TTriangleVertexIndices = array [0 .. 2] of Integer;
  72. TArrayOfTriangleVertexIndices = array of TTriangleVertexIndices;
  73. function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
  74. function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
  75. function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
  76. function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint;
  77. const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter;
  78. Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
  79. function Grow(const Points: TArrayOfFloatPoint;
  80. const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter;
  81. Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
  82. function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint;
  83. const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
  84. Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
  85. function Grow(const Points: TArrayOfFixedPoint;
  86. const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
  87. Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
  88. function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
  89. function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
  90. function BuildPolyline(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat;
  91. JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
  92. MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
  93. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint;
  94. Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter;
  95. EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfArrayOfFloatPoint; overload;
  96. function BuildPolyline(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed;
  97. JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
  98. MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
  99. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint;
  100. Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter;
  101. EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfArrayOfFixedPoint; overload;
  102. function BuildDashedLine(const Points: TArrayOfFloatPoint;
  103. const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
  104. Closed: Boolean = False): TArrayOfArrayOfFloatPoint; overload;
  105. function BuildDashedLine(const Points: TArrayOfFixedPoint;
  106. const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
  107. Closed: Boolean = False): TArrayOfArrayOfFixedPoint; overload;
  108. function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint; overload;
  109. function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint; overload;
  110. function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint; overload;
  111. function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload;
  112. function CalculateCircleSteps(Radius: TFloat): Cardinal; {$IFDEF USEINLINING} inline; {$ENDIF}
  113. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
  114. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint; overload;
  115. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFixedPoint; overload;
  116. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint; overload;
  117. function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint; overload;
  118. function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
  119. function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
  120. function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
  121. function Circle(const P: TFloatPoint; const Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
  122. function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  123. function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  124. function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  125. function Circle(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  126. function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  127. function Circle(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  128. function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  129. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
  130. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  131. function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  132. function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  133. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  134. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  135. function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint; overload;
  136. function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  137. function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  138. function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  139. function Ellipse(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  140. function Ellipse(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  141. function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  142. function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  143. function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat;
  144. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  145. function Star(const X, Y, InnerRadius, OuterRadius: TFloat;
  146. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  147. function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5;
  148. Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  149. function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5;
  150. Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
  151. function Rectangle(const R: TFloatRect): TArrayOfFloatPoint; {$IFDEF USEINLINING} inline; {$ENDIF}
  152. function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint; {$IFDEF USEINLINING} inline; {$ENDIF}
  153. function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect; overload;
  154. function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect; overload;
  155. function PolypolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect; overload;
  156. function PolypolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect; overload;
  157. function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint; overload;
  158. function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint; overload;
  159. function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint; overload;
  160. function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint; overload;
  161. procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
  162. procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
  163. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
  164. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
  165. function TranslatePolygon(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfFloatPoint; overload;
  166. function TranslatePolygon(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed): TArrayOfFixedPoint; overload;
  167. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfArrayOfFloatPoint; overload;
  168. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint; overload;
  169. procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
  170. procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed); overload;
  171. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
  172. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed); overload;
  173. function TransformPolygon(const Points: TArrayOfFloatPoint; Transformation: TTransformation): TArrayOfFloatPoint; overload;
  174. function TransformPolygon(const Points: TArrayOfFixedPoint; Transformation: TTransformation): TArrayOfFixedPoint; overload;
  175. function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint; Transformation: TTransformation): TArrayOfArrayOfFloatPoint; overload;
  176. function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint; overload;
  177. function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint; overload;
  178. function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint; overload;
  179. function PolyPolygon(const Points: TArrayOfFloatPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  180. function PolyPolygon(const Points: TArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  181. function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint; overload;
  182. function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint; overload;
  183. function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint; overload;
  184. function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint; overload;
  185. function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  186. function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  187. function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  188. function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  189. implementation
  190. uses
  191. SysUtils, GR32_Math, GR32_Geometry, GR32_LowLevel;
  192. type
  193. TTransformationAccess = class(TTransformation);
  194. // Returns True if Min(X1, X2) <= X < Max(X1, X2)
  195. function InSignedRange(const X, X1, X2: TFloat): Boolean;
  196. begin
  197. Result := (X < X1) xor (X < X2);
  198. end;
  199. // Returns True if Min(X1, X2) <= X < Max(X1, X2)
  200. function InSignedRange(const X, X1, X2: TFixed): Boolean;
  201. begin
  202. Result := (X < X1) xor (X < X2);
  203. end;
  204. // Returns True if the intervals (X1, X2) and (Y1, Y2) overlap
  205. function OverlapExclusive(const X1, X2, Y1, Y2: TFloat): Boolean;
  206. begin
  207. Result := Abs((X1 + X2) - (Y1 + Y2)) < Abs(X1 - X2) + Abs(Y1 - Y2);
  208. end;
  209. // Returns True if the intervals (X1, X2) and (Y1, Y2) overlap
  210. function OverlapExclusive(const Pt1, Pt2: TFloatPoint): Boolean;
  211. begin
  212. Result := Abs((Pt1.X + Pt2.X) - (Pt1.Y + Pt2.Y)) < Abs(Pt1.X - Pt2.X) +
  213. Abs(Pt1.Y - Pt2.Y);
  214. end;
  215. // Returns True if the intervals (X1, X2) and (Y1, Y2) overlap
  216. function OverlapExclusive(const X1, X2, Y1, Y2: TFixed): Boolean;
  217. begin
  218. Result := Abs((X1 + X2) - (Y1 + Y2)) < Abs(X1 - X2) + Abs(Y1 - Y2);
  219. end;
  220. // Returns True if the intervals (X1, X2) and (Y1, Y2) overlap
  221. function OverlapExclusive(const Pt1, Pt2: TFixedPoint): Boolean;
  222. begin
  223. Result := Abs((Pt1.X + Pt2.X) - (Pt1.Y + Pt2.Y)) < Abs(Pt1.X - Pt2.X) +
  224. Abs(Pt1.Y - Pt2.Y);
  225. end;
  226. // Returns True if the intervals [X1, X2] and [Y1, Y2] overlap
  227. function OverlapInclusive(const X1, X2, Y1, Y2: TFloat): Boolean;
  228. begin
  229. Result := Abs((X1 + X2) - (Y1 + Y2)) <= Abs(X1 - X2) + Abs(Y1 - Y2);
  230. end;
  231. // Returns True if the intervals [X1, X2] and [Y1, Y2] overlap
  232. function OverlapInclusive(const Pt1, Pt2: TFloatPoint): Boolean;
  233. begin
  234. Result := Abs((Pt1.X + Pt2.X) - (Pt1.Y + Pt2.Y)) <= Abs(Pt1.X - Pt2.X) +
  235. Abs(Pt1.Y - Pt2.Y);
  236. end;
  237. // Returns True if the intervals [X1, X2] and [Y1, Y2] overlap
  238. function OverlapInclusive(const X1, X2, Y1, Y2: TFixed): Boolean;
  239. begin
  240. Result := Abs((X1 + X2) - (Y1 + Y2)) <= Abs(X1 - X2) + Abs(Y1 - Y2);
  241. end;
  242. // Returns True if the intervals [X1, X2] and [Y1, Y2] overlap
  243. function OverlapInclusive(const Pt1, Pt2: TFixedPoint): Boolean;
  244. begin
  245. Result := Abs((Pt1.X + Pt2.X) - (Pt1.Y + Pt2.Y)) <= Abs(Pt1.X - Pt2.X) +
  246. Abs(Pt1.Y - Pt2.Y);
  247. end;
  248. // Returns True if the line segments (A1, A2) and (B1, B2) intersects
  249. // P is the point of intersection
  250. function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean;
  251. var
  252. Adx, Ady, Bdx, Bdy, ABy, ABx: TFloat;
  253. t, ta, tb: TFloat;
  254. begin
  255. Result := False;
  256. Adx := A2.X - A1.X;
  257. Ady := A2.Y - A1.Y;
  258. Bdx := B2.X - B1.X;
  259. Bdy := B2.Y - B1.Y;
  260. t := (Bdy * Adx) - (Bdx * Ady);
  261. if t = 0 then Exit; // lines are parallell
  262. ABx := A1.X - B1.X;
  263. ABy := A1.Y - B1.Y;
  264. ta := Bdx * ABy - Bdy * ABx;
  265. tb := Adx * ABy - Ady * ABx;
  266. if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
  267. begin
  268. Result := True;
  269. ta := ta / t;
  270. P.X := A1.X + ta * Adx;
  271. P.Y := A1.Y + ta * Ady;
  272. end;
  273. end;
  274. function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
  275. var
  276. Adx, Ady, Bdx, Bdy, ABy, ABx: TFixed;
  277. t, ta, tb: TFixed;
  278. begin
  279. Result := False;
  280. Adx := A2.X - A1.X;
  281. Ady := A2.Y - A1.Y;
  282. Bdx := B2.X - B1.X;
  283. Bdy := B2.Y - B1.Y;
  284. t := (Bdy * Adx) - (Bdx * Ady);
  285. if t = 0 then Exit; // lines are parallell
  286. ABx := A1.X - B1.X;
  287. ABy := A1.Y - B1.Y;
  288. ta := Bdx * ABy - Bdy * ABx;
  289. tb := Adx * ABy - Ady * ABx;
  290. if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
  291. begin
  292. Result := True;
  293. ta := FixedDiv(ta, t);
  294. P.X := A1.X + ta * Adx;
  295. P.Y := A1.Y + ta * Ady;
  296. end;
  297. end;
  298. function FindNearestPointIndex(Point: TFloatPoint; Points: TArrayOfFloatPoint): Integer;
  299. var
  300. Index: Integer;
  301. Distance: TFloat;
  302. NearestDistance: TFloat;
  303. begin
  304. Result := 0;
  305. NearestDistance := SqrDistance(Point, Points[0]);
  306. for Index := 1 to High(Points) do
  307. begin
  308. Distance := SqrDistance(Point, Points[Index]);
  309. if Distance < NearestDistance then
  310. begin
  311. NearestDistance := Distance;
  312. Result := Index;
  313. end;
  314. end;
  315. end;
  316. function FindNearestPointIndex(Point: TFixedPoint; Points: TArrayOfFixedPoint): Integer;
  317. var
  318. Index: Integer;
  319. Distance: TFixed;
  320. NearestDistance: TFixed;
  321. begin
  322. Result := 0;
  323. NearestDistance := SqrDistance(Point, Points[0]);
  324. for Index := 1 to High(Points) do
  325. begin
  326. Distance := SqrDistance(Point, Points[Index]);
  327. if Distance < NearestDistance then
  328. begin
  329. NearestDistance := Distance;
  330. Result := Index;
  331. end;
  332. end;
  333. end;
  334. function RamerDouglasPeucker(Points: TArrayOfFloatPoint; FirstIndex,
  335. LastIndex: Integer; Epsilon: TFloat = 1): TArrayOfFloatPoint; overload;
  336. var
  337. Index, DeltaMaxIndex: Integer;
  338. Delta, DeltaMax: TFloat;
  339. Parts: array [0 .. 1] of TArrayOfFloatPoint;
  340. begin
  341. if LastIndex - FirstIndex > 1 then
  342. begin
  343. // find the point with the maximum distance
  344. DeltaMax := 0;
  345. DeltaMaxIndex := 0;
  346. for Index := FirstIndex + 1 to LastIndex - 1 do
  347. begin
  348. with Points[LastIndex] do
  349. Delta := Abs((Points[Index].x - x) * (Points[FirstIndex].y - y) -
  350. (Points[Index].y - y) * (Points[FirstIndex].x - x));
  351. if Delta > DeltaMax then
  352. begin
  353. DeltaMaxIndex := Index;
  354. DeltaMax := Delta;
  355. end;
  356. end;
  357. // if max distance is greater than epsilon, recursively simplify
  358. if DeltaMax >= Epsilon * GR32_Math.Hypot(Points[FirstIndex].x - Points[LastIndex].x,
  359. Points[FirstIndex].y - Points[LastIndex].y) then
  360. begin
  361. // Recursive call
  362. Parts[0] := RamerDouglasPeucker(Points, FirstIndex, DeltaMaxIndex, Epsilon);
  363. Parts[1] := RamerDouglasPeucker(Points, DeltaMaxIndex, LastIndex, Epsilon);
  364. // Build the result list
  365. SetLength(Result, Length(Parts[0]) + Length(Parts[1]) - 1);
  366. Move(Parts[0, 0], Result[0], (Length(Parts[0]) - 1) * SizeOf(TFloatPoint));
  367. Move(Parts[1, 0], Result[Length(Parts[0]) - 1], Length(Parts[1]) *
  368. SizeOf(TFloatPoint));
  369. Exit;
  370. end;
  371. end;
  372. SetLength(Result, 2);
  373. Result[0] := Points[FirstIndex];
  374. Result[1] := Points[LastIndex];
  375. end;
  376. function RamerDouglasPeucker(Points: TArrayOfFixedPoint; FirstIndex,
  377. LastIndex: Integer; Epsilon: TFixed = 1): TArrayOfFixedPoint; overload;
  378. var
  379. Index, DeltaMaxIndex: Integer;
  380. Delta, DeltaMax: TFixed;
  381. Parts: array [0 .. 1] of TArrayOfFixedPoint;
  382. //Finds the perpendicular distance from a point to a straight line.
  383. //The coordinates of the point are specified as $ptX and $ptY.
  384. //The line passes through points l1 and l2, specified respectively with their
  385. //coordinates $l1x and $l1y, and $l2x and $l2y
  386. function PerpendicularDistance(ptX, ptY, l1x, l1y, l2x, l2y: TFixed): TFixed;
  387. var
  388. Slope, PassThroughY: TFixed;
  389. begin
  390. if (l2x = l1x) then
  391. begin
  392. //vertical lines - treat this case specially to avoid divide by zero
  393. Result := Abs(ptX - l2x);
  394. end
  395. else
  396. begin
  397. Slope := FixedDiv(l2y-l1y, l2x-l1x);
  398. PassThroughY := FixedMul(0 - l1x, Slope) + l1y;
  399. Result := FixedDiv(Abs(FixedMul(Slope, ptX) - ptY + PassThroughY),
  400. FixedSqrtHP(FixedSqr(Slope) + 1));
  401. end;
  402. end;
  403. begin
  404. if LastIndex - FirstIndex > 1 then
  405. begin
  406. // find the point with the maximum distance
  407. DeltaMax := 0;
  408. DeltaMaxIndex := 0;
  409. for Index := FirstIndex + 1 to LastIndex - 1 do
  410. begin
  411. Delta := PerpendicularDistance(
  412. Points[Index].x, Points[Index].y,
  413. Points[FirstIndex].x, Points[FirstIndex].y,
  414. Points[LastIndex].x, Points[LastIndex].y);
  415. if Delta > DeltaMax then
  416. begin
  417. DeltaMaxIndex := Index;
  418. DeltaMax := Delta;
  419. end;
  420. end;
  421. // if max distance is greater than epsilon, recursively simplify
  422. if DeltaMax > Epsilon then
  423. begin
  424. // Recursive call
  425. Parts[0] := RamerDouglasPeucker(Points, FirstIndex, DeltaMaxIndex, Epsilon);
  426. Parts[1] := RamerDouglasPeucker(Points, DeltaMaxIndex, LastIndex, Epsilon);
  427. // Build the result list
  428. SetLength(Result, Length(Parts[0]) + Length(Parts[1]) - 1);
  429. Move(Parts[0, 0], Result[0], (Length(Parts[0]) - 1) * SizeOf(TFixedPoint));
  430. Move(Parts[1, 0], Result[Length(Parts[0]) - 1], Length(Parts[1]) * SizeOf(TFixedPoint));
  431. Exit;
  432. end;
  433. end;
  434. SetLength(Result, 2);
  435. Result[0] := Points[FirstIndex];
  436. Result[1] := Points[LastIndex];
  437. end;
  438. function VertexReduction(Points: TArrayOfFloatPoint; Epsilon: TFloat = 1): TArrayOfFloatPoint;
  439. var
  440. Index: Integer;
  441. SqrEpsilon: TFloat;
  442. begin
  443. SqrEpsilon := Sqr(Epsilon);
  444. SetLength(Result, 1);
  445. Result[0] := Points[0];
  446. Index := 1;
  447. while Index < Length(Points) do
  448. begin
  449. if SqrDistance(Result[Length(Result) - 1], Points[Index]) > SqrEpsilon then
  450. begin
  451. SetLength(Result, Length(Result) + 1);
  452. Result[Length(Result) - 1] := Points[Index];
  453. end;
  454. Inc(Index);
  455. end;
  456. if Length(Result) > 2 then
  457. Result := RamerDouglasPeucker(Result, 0, Length(Result) - 1, Epsilon);
  458. end;
  459. function VertexReduction(Points: TArrayOfFixedPoint; Epsilon: TFixed): TArrayOfFixedPoint;
  460. var
  461. Index: Integer;
  462. SqrEpsilon: TFixed;
  463. begin
  464. SqrEpsilon := FixedSqr(Epsilon);
  465. SetLength(Result, 1);
  466. Result[0] := Points[0];
  467. Index := 1;
  468. while Index < Length(Points) do
  469. begin
  470. if SqrDistance(Result[Length(Result) - 1], Points[Index]) > SqrEpsilon then
  471. begin
  472. SetLength(Result, Length(Result) + 1);
  473. Result[Length(Result) - 1] := Points[Index];
  474. end;
  475. Inc(Index);
  476. end;
  477. Result := RamerDouglasPeucker(Points, 0, Length(Points) - 1, Epsilon);
  478. end;
  479. function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  480. var
  481. L: Integer;
  482. P1, P2: TFloatPoint;
  483. begin
  484. L := Length(Points);
  485. Result := Points;
  486. if L <= 1 then
  487. Exit;
  488. P1 := Result[0];
  489. P2 := Result[L - 1];
  490. if (P1.X = P2.X) and (P1.Y = P2.Y) then
  491. Exit;
  492. SetLength(Result, L + 1);
  493. Move(Result[0], Points[0], L * SizeOf(TFloatPoint));
  494. Result[L] := P1;
  495. end;
  496. function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  497. var
  498. L: Integer;
  499. P1, P2: TFixedPoint;
  500. begin
  501. L := Length(Points);
  502. Result := Points;
  503. if L <= 1 then
  504. Exit;
  505. P1 := Result[0];
  506. P2 := Result[L - 1];
  507. if (P1.X = P2.X) and (P1.Y = P2.Y) then
  508. Exit;
  509. SetLength(Result, L + 1);
  510. Move(Result[0], Points[0], L * SizeOf(TFixedPoint));
  511. Result[L] := P1;
  512. end;
  513. function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean;
  514. var
  515. C1, C2: Integer;
  516. V: Integer;
  517. begin
  518. { Get edge codes }
  519. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  520. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  521. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  522. begin
  523. if (C1 and 12) <> 0 then
  524. begin
  525. if C1 < 8 then V := MinY else V := MaxY;
  526. Inc(X1, MulDiv(V - Y1, X2 - X1, Y2 - Y1));
  527. Y1 := V;
  528. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  529. end;
  530. if (C2 and 12) <> 0 then
  531. begin
  532. if C2 < 8 then V := MinY else V := MaxY;
  533. Inc(X2, MulDiv(V - Y2, X2 - X1, Y2 - Y1));
  534. Y2 := V;
  535. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  536. end;
  537. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  538. begin
  539. if C1 <> 0 then
  540. begin
  541. if C1 = 1 then V := MinX else V := MaxX;
  542. Inc(Y1, MulDiv(V - X1, Y2 - Y1, X2 - X1));
  543. X1 := V;
  544. C1 := 0;
  545. end;
  546. if C2 <> 0 then
  547. begin
  548. if C2 = 1 then V := MinX else V := MaxX;
  549. Inc(Y2, MulDiv(V - X2, Y2 - Y1, X2 - X1));
  550. X2 := V;
  551. C2 := 0;
  552. end;
  553. end;
  554. end;
  555. Result := (C1 or C2) = 0;
  556. end;
  557. function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean;
  558. var
  559. C1, C2: Integer;
  560. V: TFloat;
  561. begin
  562. { Get edge codes }
  563. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  564. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  565. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  566. begin
  567. if (C1 and 12) <> 0 then
  568. begin
  569. if C1 < 8 then V := MinY else V := MaxY;
  570. X1 := X1 + (V - Y1) * (X2 - X1) / (Y2 - Y1);
  571. Y1 := V;
  572. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  573. end;
  574. if (C2 and 12) <> 0 then
  575. begin
  576. if C2 < 8 then V := MinY else V := MaxY;
  577. X2 := X2 + (V - Y2) * (X2 - X1) / (Y2 - Y1);
  578. Y2 := V;
  579. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  580. end;
  581. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  582. begin
  583. if C1 <> 0 then
  584. begin
  585. if C1 = 1 then V := MinX else V := MaxX;
  586. Y1 := Y1 + (V - X1) * (Y2 - Y1) / (X2 - X1);
  587. X1 := V;
  588. C1 := 0;
  589. end;
  590. if C2 <> 0 then
  591. begin
  592. if C2 = 1 then V := MinX else V := MaxX;
  593. Y2 := Y2 + (V - X2) * (Y2 - Y1) / (X2 - X1);
  594. X2 := V;
  595. C2 := 0;
  596. end;
  597. end;
  598. end;
  599. Result := (C1 or C2) = 0;
  600. end;
  601. function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean;
  602. var
  603. C1, C2: Integer;
  604. V: TFixed;
  605. begin
  606. { Get edge codes }
  607. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
  608. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
  609. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  610. begin
  611. if (C1 and 12) <> 0 then
  612. begin
  613. if C1 < 8 then V := MinY else V := MaxY;
  614. X1 := X1 + FixedDiv(FixedMul(V - Y1, X2 - X1), Y2 - Y1);
  615. Y1 := V;
  616. C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
  617. end;
  618. if (C2 and 12) <> 0 then
  619. begin
  620. if C2 < 8 then V := MinY else V := MaxY;
  621. X2 := X2 + FixedDiv(FixedMul(V - Y2, X2 - X1), Y2 - Y1);
  622. Y2 := V;
  623. C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
  624. end;
  625. if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
  626. begin
  627. if C1 <> 0 then
  628. begin
  629. if C1 = 1 then V := MinX else V := MaxX;
  630. Y1 := Y1 + FixedDiv(FixedMul(V - X1, Y2 - Y1), X2 - X1);
  631. X1 := V;
  632. C1 := 0;
  633. end;
  634. if C2 <> 0 then
  635. begin
  636. if C2 = 1 then V := MinX else V := MaxX;
  637. Y2 := Y2 + FixedDiv(FixedMul(V - X2, Y2 - Y1), X2 - X1);
  638. X2 := V;
  639. C2 := 0;
  640. end;
  641. end;
  642. end;
  643. Result := (C1 or C2) = 0;
  644. end;
  645. function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean;
  646. begin
  647. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  648. ClipRect.Right, ClipRect.Bottom);
  649. end;
  650. function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean;
  651. begin
  652. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  653. ClipRect.Right, ClipRect.Bottom);
  654. end;
  655. function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean;
  656. begin
  657. Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
  658. ClipRect.Right, ClipRect.Bottom);
  659. end;
  660. procedure Extract(Src: TArrayOfFloat; Indexes: TArrayOfInteger; out Dst: TArrayOfFloat);
  661. var
  662. I: Integer;
  663. begin
  664. SetLength(Dst, Length(Indexes));
  665. for I := 0 to High(Indexes) do
  666. Dst[I] := Src[Indexes[I]];
  667. end;
  668. procedure Extract(Src: TArrayOfFixed; Indexes: TArrayOfInteger; out Dst: TArrayOfFixed);
  669. var
  670. I: Integer;
  671. begin
  672. SetLength(Dst, Length(Indexes));
  673. for I := 0 to High(Indexes) do
  674. Dst[I] := Src[Indexes[I]];
  675. end;
  676. // A modified implementation of merge sort
  677. // - returns the indexes of the sorted elements
  678. // - use Extract(Indexes, Output) to return the sorted values
  679. // - complexity when input is already sorted: O(n)
  680. // - worst case complexity: O(n log n)
  681. procedure FastMergeSort(const Values: TArrayOfFloat; out Indexes: TArrayOfInteger);
  682. var
  683. Temp: TArrayOfInteger;
  684. procedure Merge(I1, I2, J1, J2: Integer);
  685. var
  686. I, J, K: Integer;
  687. begin
  688. if Values[Indexes[I2]] < Values[Indexes[J1]] then Exit;
  689. I := I1;
  690. J := J1;
  691. K := 0;
  692. repeat
  693. if Values[Indexes[I]] < Values[Indexes[J]] then
  694. begin
  695. Temp[K] := Indexes[I];
  696. Inc(I);
  697. end
  698. else
  699. begin
  700. Temp[K] := Indexes[J];
  701. Inc(J);
  702. end;
  703. Inc(K);
  704. until (I > I2) or (J > J2);
  705. while I <= I2 do
  706. begin
  707. Temp[K] := Indexes[I];
  708. Inc(I); Inc(K);
  709. end;
  710. while J <= J2 do
  711. begin
  712. Temp[K] := Indexes[J];
  713. Inc(J); Inc(K);
  714. end;
  715. for I := 0 to K - 1 do
  716. begin
  717. Indexes[I + I1] := Temp[I];
  718. end;
  719. end;
  720. procedure Recurse(I1, I2: Integer);
  721. var
  722. I, IX: Integer;
  723. begin
  724. if I1 = I2 then
  725. Indexes[I1] := I1
  726. else if Indexes[I1] = Indexes[I2] then
  727. begin
  728. if Values[I1] <= Values[I2] then
  729. begin
  730. for I := I1 to I2 do Indexes[I] := I;
  731. end
  732. else
  733. begin
  734. IX := I1 + I2;
  735. for I := I1 to I2 do Indexes[I] := IX - I;
  736. end;
  737. end
  738. else
  739. begin
  740. IX := (I1 + I2) div 2;
  741. Recurse(I1, IX);
  742. Recurse(IX + 1, I2);
  743. Merge(I1, IX, IX + 1, I2);
  744. end;
  745. end;
  746. var
  747. I, Index, S: Integer;
  748. begin
  749. SetLength(Temp, Length(Values));
  750. SetLength(Indexes, Length(Values));
  751. Index := 0;
  752. S := Math.Sign(Values[1] - Values[0]);
  753. if S = 0 then S := 1;
  754. Indexes[0] := 0;
  755. for I := 1 to High(Values) do
  756. begin
  757. if Math.Sign(Values[I] - Values[I - 1]) = -S then
  758. begin
  759. S := -S;
  760. Inc(Index);
  761. end;
  762. Indexes[I] := Index;
  763. end;
  764. Recurse(0, High(Values));
  765. end;
  766. // A modified implementation of merge sort
  767. // - returns the indexes of the sorted elements
  768. // - use Extract(Indexes, Output) to return the sorted values
  769. // - complexity when input is already sorted: O(n)
  770. // - worst case complexity: O(n log n)
  771. procedure FastMergeSort(const Values: TArrayOfFixed; out Indexes: TArrayOfInteger);
  772. var
  773. Temp: TArrayOfInteger;
  774. procedure Merge(I1, I2, J1, J2: Integer);
  775. var
  776. I, J, K: Integer;
  777. begin
  778. if Values[Indexes[I2]] < Values[Indexes[J1]] then Exit;
  779. I := I1;
  780. J := J1;
  781. K := 0;
  782. repeat
  783. if Values[Indexes[I]] < Values[Indexes[J]] then
  784. begin
  785. Temp[K] := Indexes[I];
  786. Inc(I);
  787. end
  788. else
  789. begin
  790. Temp[K] := Indexes[J];
  791. Inc(J);
  792. end;
  793. Inc(K);
  794. until (I > I2) or (J > J2);
  795. while I <= I2 do
  796. begin
  797. Temp[K] := Indexes[I];
  798. Inc(I); Inc(K);
  799. end;
  800. while J <= J2 do
  801. begin
  802. Temp[K] := Indexes[J];
  803. Inc(J); Inc(K);
  804. end;
  805. for I := 0 to K - 1 do
  806. begin
  807. Indexes[I + I1] := Temp[I];
  808. end;
  809. end;
  810. procedure Recurse(I1, I2: Integer);
  811. var
  812. I, IX: Integer;
  813. begin
  814. if I1 = I2 then
  815. Indexes[I1] := I1
  816. else if Indexes[I1] = Indexes[I2] then
  817. begin
  818. if Values[I1] <= Values[I2] then
  819. begin
  820. for I := I1 to I2 do Indexes[I] := I;
  821. end
  822. else
  823. begin
  824. IX := I1 + I2;
  825. for I := I1 to I2 do Indexes[I] := IX - I;
  826. end;
  827. end
  828. else
  829. begin
  830. IX := (I1 + I2) div 2;
  831. Recurse(I1, IX);
  832. Recurse(IX + 1, I2);
  833. Merge(I1, IX, IX + 1, I2);
  834. end;
  835. end;
  836. var
  837. I, Index, S: Integer;
  838. begin
  839. SetLength(Temp, Length(Values));
  840. SetLength(Indexes, Length(Values));
  841. Index := 0;
  842. S := Math.Sign(Values[1] - Values[0]);
  843. if S = 0 then S := 1;
  844. Indexes[0] := 0;
  845. for I := 1 to High(Values) do
  846. begin
  847. if Math.Sign(Values[I] - Values[I - 1]) = -S then
  848. begin
  849. S := -S;
  850. Inc(Index);
  851. end;
  852. Indexes[I] := Index;
  853. end;
  854. Recurse(0, High(Values));
  855. end;
  856. procedure FastMergeSortX(const Values: TArrayOfFloatPoint;
  857. out Indexes: TArrayOfInteger; out Bounds: TFloatRect);
  858. var
  859. Temp: TArrayOfInteger;
  860. procedure Merge(I1, I2, J1, J2: Integer);
  861. var
  862. I, J, K: Integer;
  863. begin
  864. if Values[Indexes[I2]].X < Values[Indexes[J1]].X then Exit;
  865. I := I1;
  866. J := J1;
  867. K := 0;
  868. repeat
  869. if Values[Indexes[I]].X < Values[Indexes[J]].X then
  870. begin
  871. Temp[K] := Indexes[I];
  872. Inc(I);
  873. end
  874. else
  875. begin
  876. Temp[K] := Indexes[J];
  877. Inc(J);
  878. end;
  879. Inc(K);
  880. until (I > I2) or (J > J2);
  881. while I <= I2 do
  882. begin
  883. Temp[K] := Indexes[I];
  884. Inc(I); Inc(K);
  885. end;
  886. while J <= J2 do
  887. begin
  888. Temp[K] := Indexes[J];
  889. Inc(J); Inc(K);
  890. end;
  891. for I := 0 to K - 1 do
  892. begin
  893. Indexes[I + I1] := Temp[I];
  894. end;
  895. end;
  896. procedure Recurse(I1, I2: Integer);
  897. var
  898. I, IX: Integer;
  899. begin
  900. if I1 = I2 then
  901. Indexes[I1] := I1
  902. else if Indexes[I1] = Indexes[I2] then
  903. begin
  904. if Values[I1].X <= Values[I2].X then
  905. begin
  906. for I := I1 to I2 do Indexes[I] := I;
  907. end
  908. else
  909. begin
  910. IX := I1 + I2;
  911. for I := I1 to I2 do Indexes[I] := IX - I;
  912. end;
  913. end
  914. else
  915. begin
  916. IX := (I1 + I2) div 2;
  917. Recurse(I1, IX);
  918. Recurse(IX + 1, I2);
  919. Merge(I1, IX, IX + 1, I2);
  920. end;
  921. end;
  922. var
  923. I, Index, S: Integer;
  924. begin
  925. SetLength(Temp, Length(Values));
  926. SetLength(Indexes, Length(Values));
  927. Index := 0;
  928. S := Math.Sign(Values[1].X - Values[0].X);
  929. if S = 0 then S := 1;
  930. Indexes[0] := 0;
  931. Bounds.Left := Values[0].X;
  932. Bounds.Top := Values[0].Y;
  933. Bounds.Right := Bounds.Left;
  934. Bounds.Bottom := Bounds.Top;
  935. for I := 1 to High(Values) do
  936. begin
  937. if Math.Sign(Values[I].X - Values[I - 1].X) = -S then
  938. begin
  939. S := -S;
  940. Inc(Index);
  941. end;
  942. if Values[I].X < Bounds.Left then
  943. Bounds.Left := Values[I].X;
  944. if Values[I].Y < Bounds.Top then
  945. Bounds.Top := Values[I].Y;
  946. if Values[I].X > Bounds.Right then
  947. Bounds.Right := Values[I].X;
  948. if Values[I].Y > Bounds.Bottom then
  949. Bounds.Bottom := Values[I].Y;
  950. Indexes[I] := Index;
  951. end;
  952. Recurse(0, High(Values));
  953. end;
  954. function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
  955. var
  956. Complete: array of Byte;
  957. Edges: array of array [0 .. 1] of Integer;
  958. ByteIndex, Bit: Byte;
  959. MaxVerticesCount, EdgeCount, MaxEdgeCount, MaxTriangleCount: Integer;
  960. // For super triangle
  961. ScaledDeltaMax: TFloat;
  962. Mid: TFloatPoint;
  963. Bounds: TFloatRect;
  964. // General Variables
  965. SortedVertexIndices: TArrayOfInteger;
  966. TriangleCount, VertexCount, I, J, K: Integer;
  967. CenterX, CenterY, RadSqr: TFloat;
  968. Inside: Boolean;
  969. const
  970. CSuperTriangleCount = 3; // -> super triangle
  971. CTolerance = 0.000001;
  972. function InCircle(Pt, Pt1, Pt2, Pt3: TFloatPoint): Boolean;
  973. // Return TRUE if the point Pt(x, y) lies inside the circumcircle made up by
  974. // points Pt1(x, y) Pt2(x, y) Pt3(x, y)
  975. // The circumcircle centre is returned in (CenterX, CenterY) and the radius r
  976. // NOTE: A point on the edge is inside the circumcircle
  977. var
  978. M1, M2, MX1, MY1, MX2, MY2: Double;
  979. DeltaX, DeltaY, DeltaRadSqr, AbsY1Y2, AbsY2Y3: Double;
  980. begin
  981. AbsY1Y2 := Abs(Pt1.Y - Pt2.Y);
  982. AbsY2Y3 := Abs(Pt2.Y - Pt3.Y);
  983. // Check for coincident points
  984. if (AbsY1Y2 < CTolerance) and (AbsY2Y3 < CTolerance) then
  985. begin
  986. Result := False;
  987. Exit;
  988. end;
  989. if AbsY1Y2 < CTolerance then
  990. begin
  991. M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
  992. MX2 := (Pt2.X + Pt3.X) * 0.5;
  993. MY2 := (Pt2.Y + Pt3.Y) * 0.5;
  994. CenterX := (Pt2.X + Pt1.X) * 0.5;
  995. CenterY := M2 * (CenterX - MX2) + MY2;
  996. end
  997. else if AbsY2Y3 < CTolerance then
  998. begin
  999. M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
  1000. MX1 := (Pt1.X + Pt2.X) * 0.5;
  1001. MY1 := (Pt1.Y + Pt2.Y) * 0.5;
  1002. CenterX := (Pt3.X + Pt2.X) * 0.5;
  1003. CenterY := M1 * (CenterX - MX1) + MY1;
  1004. end
  1005. else
  1006. begin
  1007. M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
  1008. M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
  1009. MX1 := (Pt1.X + Pt2.X) * 0.5;
  1010. MX2 := (Pt2.X + Pt3.X) * 0.5;
  1011. MY1 := (Pt1.Y + Pt2.Y) * 0.5;
  1012. MY2 := (Pt2.Y + Pt3.Y) * 0.5;
  1013. CenterX := (M1 * MX1 - M2 * Mx2 + My2 - MY1) / (M1 - M2);
  1014. if (AbsY1Y2 > AbsY2Y3) then
  1015. CenterY := M1 * (CenterX - MX1) + MY1
  1016. else
  1017. CenterY := M2 * (CenterX - MX2) + MY2;
  1018. end;
  1019. DeltaX := Pt2.X - CenterX;
  1020. DeltaY := Pt2.Y - CenterY;
  1021. RadSqr := DeltaX * DeltaX + DeltaY * DeltaY;
  1022. DeltaX := Pt.X - CenterX;
  1023. DeltaY := Pt.Y - CenterY;
  1024. DeltaRadSqr := Sqr(DeltaX) + Sqr(DeltaY);
  1025. Result := (DeltaRadSqr - RadSqr) <= CTolerance;
  1026. end;
  1027. begin
  1028. VertexCount := Length(Points);
  1029. MaxVerticesCount := VertexCount + CSuperTriangleCount;
  1030. // Sort points by x value and find maximum and minimum vertex bounds.
  1031. FastMergeSortX(Points, SortedVertexIndices, Bounds);
  1032. // set dynamic array sizes
  1033. SetLength(Points, MaxVerticesCount);
  1034. MaxTriangleCount := 2 * (MaxVerticesCount - 1);
  1035. SetLength(Result, MaxTriangleCount);
  1036. MaxEdgeCount := 3 * (MaxVerticesCount - 1);
  1037. SetLength(Edges, MaxEdgeCount);
  1038. SetLength(Complete, (MaxTriangleCount + 7) shr 3);
  1039. // This is to allow calculation of the bounding triangle
  1040. with Bounds do
  1041. begin
  1042. ScaledDeltaMax := 30 * Max(Right - Left, Bottom - Top);
  1043. Mid := FloatPoint((Left + Right) * 0.5, (Top + Bottom) * 0.5);
  1044. end;
  1045. // Set up the super triangle
  1046. // This is a triangle which encompasses all the sample points. The super
  1047. // triangle coordinates are added to the end of the vertex list. The super
  1048. // triangle is the first triangle in the triangle list.
  1049. Points[VertexCount] := FloatPoint(Mid.X - ScaledDeltaMax, Mid.Y - ScaledDeltaMax);
  1050. Points[VertexCount + 1] := FloatPoint(Mid.X + ScaledDeltaMax, Mid.Y);
  1051. Points[VertexCount + 2] := FloatPoint(Mid.X, Mid.Y + ScaledDeltaMax);
  1052. Result[0, 0] := VertexCount;
  1053. Result[0, 1] := VertexCount + 1;
  1054. Result[0, 2] := VertexCount + 2;
  1055. Complete[0] := 0;
  1056. TriangleCount := 1;
  1057. // Include each point one at a time into the existing mesh
  1058. for I := 0 to VertexCount - 1 do
  1059. begin
  1060. EdgeCount := 0;
  1061. // Set up the edge buffer.
  1062. // If the point [x, y] lies inside the circumcircle then the hree edges of
  1063. // that triangle are added to the edge buffer.
  1064. J := 0;
  1065. repeat
  1066. if Complete[J shr 3] and (1 shl (J and $7)) = 0 then
  1067. begin
  1068. Inside := InCircle(Points[SortedVertexIndices[I]],
  1069. Points[Result[J, 0]], Points[Result[J, 1]], Points[Result[J, 2]]);
  1070. ByteIndex := J shr 3;
  1071. Bit := 1 shl (J and $7);
  1072. if (CenterX < Points[SortedVertexIndices[I]].X) and
  1073. ((Sqr(Points[SortedVertexIndices[I]].X - CenterX)) > RadSqr) then
  1074. Complete[ByteIndex] := Complete[ByteIndex] or Bit
  1075. else
  1076. if Inside then
  1077. begin
  1078. Edges[EdgeCount + 0, 0] := Result[J, 0];
  1079. Edges[EdgeCount + 0, 1] := Result[J, 1];
  1080. Edges[EdgeCount + 1, 0] := Result[J, 1];
  1081. Edges[EdgeCount + 1, 1] := Result[J, 2];
  1082. Edges[EdgeCount + 2, 0] := Result[J, 2];
  1083. Edges[EdgeCount + 2, 1] := Result[J, 0];
  1084. EdgeCount := EdgeCount + 3;
  1085. Assert(EdgeCount <= MaxEdgeCount);
  1086. TriangleCount := TriangleCount - 1;
  1087. Result[J] := Result[TriangleCount];
  1088. Complete[ByteIndex] := (Complete[ByteIndex] and (not Bit))
  1089. or (Complete[TriangleCount shr 3] and Bit);
  1090. Continue;
  1091. end;
  1092. end;
  1093. J := J + 1;
  1094. until J >= TriangleCount;
  1095. // Tag multiple edges
  1096. // Note: if all triangles are specified anticlockwise then all
  1097. // interior edges are opposite pointing in direction.
  1098. for J := 0 to EdgeCount - 2 do
  1099. begin
  1100. if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
  1101. begin
  1102. for K := J + 1 to EdgeCount - 1 do
  1103. begin
  1104. if (Edges[K, 0] <> -1) or (Edges[K, 1] <> -1) then
  1105. begin
  1106. if (Edges[J, 0] = Edges[K, 1]) and
  1107. (Edges[J, 1] = Edges[K, 0]) then
  1108. begin
  1109. Edges[J, 0] := -1;
  1110. Edges[J, 1] := -1;
  1111. Edges[K, 1] := -1;
  1112. Edges[K, 0] := -1;
  1113. end;
  1114. end;
  1115. end;
  1116. end;
  1117. end;
  1118. // Form new triangles for the current point.
  1119. // Skipping over any tagged edges. All edges are arranged in clockwise
  1120. // order.
  1121. for J := 0 to EdgeCount - 1 do
  1122. begin
  1123. if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
  1124. begin
  1125. Result[TriangleCount, 0] := Edges[J, 0];
  1126. Result[TriangleCount, 1] := Edges[J, 1];
  1127. Result[TriangleCount, 2] := SortedVertexIndices[I];
  1128. ByteIndex := TriangleCount shr 3;
  1129. Bit := 1 shl (TriangleCount and $7);
  1130. Complete[ByteIndex] := Complete[ByteIndex] and not Bit;
  1131. Inc(TriangleCount);
  1132. Assert(TriangleCount <= MaxTriangleCount);
  1133. end;
  1134. end;
  1135. end;
  1136. // Remove triangles with supertriangle vertices
  1137. // These are triangles which have a vertex number greater than VertexCount
  1138. I := 0;
  1139. repeat
  1140. if (Result[I, 0] >= VertexCount) or
  1141. (Result[I, 1] >= VertexCount) or
  1142. (Result[I, 2] >= VertexCount) then
  1143. begin
  1144. TriangleCount := TriangleCount - 1;
  1145. Result[I, 0] := Result[TriangleCount, 0];
  1146. Result[I, 1] := Result[TriangleCount, 1];
  1147. Result[I, 2] := Result[TriangleCount, 2];
  1148. I := I - 1;
  1149. end;
  1150. I := I + 1;
  1151. until I >= TriangleCount;
  1152. SetLength(Points, Length(Points) - 3);
  1153. SetLength(Result, TriangleCount);
  1154. end;
  1155. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat;
  1156. Steps: Integer): TArrayOfFloatPoint;
  1157. var
  1158. I: Integer;
  1159. C, D: TFloatPoint;
  1160. begin
  1161. SetLength(Result, Steps);
  1162. SinCos(StartAngle, Radius, C.Y, C.X);
  1163. Result[0] := OffsetPoint(P, C);
  1164. GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
  1165. for I := 1 to Steps - 1 do
  1166. begin
  1167. C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
  1168. Result[I] := OffsetPoint(P, C);
  1169. end;
  1170. end;
  1171. function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint;
  1172. const
  1173. MINSTEPS = 6;
  1174. SQUAREDMINSTEPS = Sqr(MINSTEPS);
  1175. var
  1176. Temp: TFloat;
  1177. Steps: Integer;
  1178. begin
  1179. // The code below was previously:
  1180. //
  1181. // Steps := Max(MINSTEPS, System.Round(Sqrt(Abs(Radius)) *
  1182. // Abs(EndAngle - StartAngle)));
  1183. //
  1184. // However, for small radii, the square root calculation is performed with
  1185. // the result that the output is set to 6 anyway. In this case (only a few
  1186. // drawing operations), the performance spend for this calculation is dominant
  1187. // for large radii (when a lot of CPU intensive drawing takes place), the
  1188. // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
  1189. // significant
  1190. Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
  1191. if Temp < SQUAREDMINSTEPS then
  1192. Steps := 6
  1193. else
  1194. Steps := Round(Sqrt(Temp));
  1195. Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
  1196. end;
  1197. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat;
  1198. Steps: Integer): TArrayOfFixedPoint;
  1199. var
  1200. I: Integer;
  1201. C, D: TFloatPoint;
  1202. begin
  1203. SetLength(Result, Steps);
  1204. SinCos(StartAngle, Radius, C.Y, C.X);
  1205. Result[0] := OffsetPoint(P, C);
  1206. GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
  1207. for I := 1 to Steps - 1 do
  1208. begin
  1209. C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
  1210. Result[I] := OffsetPoint(P, FixedPoint(C));
  1211. end;
  1212. end;
  1213. function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint;
  1214. const
  1215. MINSTEPS = 6;
  1216. SQUAREDMINSTEPS = Sqr(MINSTEPS);
  1217. var
  1218. Temp: TFloat;
  1219. Steps: Integer;
  1220. begin
  1221. // The code below was previously:
  1222. //
  1223. // Steps := Clamp(System.Round(Sqrt(Abs(Radius)) *
  1224. // Abs(EndAngle - StartAngle)), MINSTEPS, $100000);
  1225. //
  1226. // However, for small radii, the square root calculation is performed with
  1227. // the result that the output is set to 6 anyway. In this case (only a few
  1228. // drawing operations), the performance spend for this calculation is dominant
  1229. // for large radii (when a lot of CPU intensive drawing takes place), the
  1230. // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
  1231. // significant
  1232. Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
  1233. if Temp < SQUAREDMINSTEPS then
  1234. Steps := MINSTEPS
  1235. else
  1236. Steps := Clamp(Round(Sqrt(Temp)), $100000);
  1237. Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
  1238. end;
  1239. function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint;
  1240. begin
  1241. SetLength(Result, 2);
  1242. Result[0] := P1;
  1243. Result[1] := P2;
  1244. end;
  1245. function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
  1246. begin
  1247. SetLength(Result, 2);
  1248. Result[0] := FloatPoint(X1, Y1);
  1249. Result[1] := FloatPoint(X2, Y2);
  1250. end;
  1251. function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
  1252. begin
  1253. SetLength(Result, 2);
  1254. Result[0] := FloatPoint(X, Y1);
  1255. Result[1] := FloatPoint(X, Y2);
  1256. end;
  1257. function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
  1258. begin
  1259. SetLength(Result, 2);
  1260. Result[0] := FloatPoint(X1, Y);
  1261. Result[1] := FloatPoint(X2, Y);
  1262. end;
  1263. function CalculateCircleSteps(Radius: TFloat): Cardinal;
  1264. var
  1265. AbsRadius: TFloat;
  1266. begin
  1267. AbsRadius := Abs(Radius);
  1268. Result := Trunc(Pi / (ArcCos(AbsRadius / (AbsRadius + 0.125))));
  1269. end;
  1270. function Circle(const P: TFloatPoint; const Radius: TFloat;
  1271. Steps: Integer): TArrayOfFloatPoint;
  1272. var
  1273. I: Integer;
  1274. M: TFloat;
  1275. C, D: TFloatPoint;
  1276. begin
  1277. if Steps <= 0 then
  1278. Steps := CalculateCircleSteps(Radius);
  1279. SetLength(Result, Steps);
  1280. M := 2 * System.Pi / Steps;
  1281. // first item
  1282. Result[0].X := Radius + P.X;
  1283. Result[0].Y := P.Y;
  1284. // calculate complex offset
  1285. GR32_Math.SinCos(M, C.Y, C.X);
  1286. D.X := Radius * C.X;
  1287. D.Y := Radius * C.Y;
  1288. // second item
  1289. Result[1].X := D.X + P.X;
  1290. Result[1].Y := D.Y + P.Y;
  1291. // other items
  1292. for I := 2 to Steps - 1 do
  1293. begin
  1294. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1295. Result[I].X := D.X + P.X;
  1296. Result[I].Y := D.Y + P.Y;
  1297. end;
  1298. end;
  1299. function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint;
  1300. begin
  1301. Result := Circle(P, Radius, CalculateCircleSteps(Radius));
  1302. end;
  1303. function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1304. begin
  1305. Result := Circle(FloatPoint(X, Y), Radius, Steps);
  1306. end;
  1307. function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint;
  1308. begin
  1309. Result := Circle(FloatPoint(X, Y), Radius, CalculateCircleSteps(Radius));
  1310. end;
  1311. function Circle(const R: TRect): TArrayOfFloatPoint;
  1312. begin
  1313. Result := Circle(
  1314. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1315. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1316. end;
  1317. function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
  1318. begin
  1319. Result := Circle(
  1320. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1321. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1322. end;
  1323. function Circle(const R: TFloatRect): TArrayOfFloatPoint;
  1324. begin
  1325. Result := Circle(
  1326. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1327. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1328. end;
  1329. function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
  1330. begin
  1331. Result := Circle(
  1332. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1333. Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1334. end;
  1335. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1336. const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1337. var
  1338. I: Integer;
  1339. C, D: TFloatPoint;
  1340. begin
  1341. SetLength(Result, Steps + 2);
  1342. Result[0] := P;
  1343. // calculate initial position
  1344. GR32_Math.SinCos(Offset, Radius, D.Y, D.X);
  1345. Result[1].X := D.X + P.X;
  1346. Result[1].Y := D.Y + P.Y;
  1347. // calculate complex offset
  1348. GR32_Math.SinCos(Angle / Steps, C.Y, C.X);
  1349. // other items
  1350. for I := 2 to Steps + 1 do
  1351. begin
  1352. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1353. Result[I].X := D.X + P.X;
  1354. Result[I].Y := D.Y + P.Y;
  1355. end;
  1356. end;
  1357. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1358. const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint;
  1359. begin
  1360. Result := Pie(P, Radius, Angle, Offset, CalculateCircleSteps(Radius));
  1361. end;
  1362. function Pie(const P: TFloatPoint; const Radius: TFloat;
  1363. const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1364. begin
  1365. Result := Pie(P, Radius, Angle, 0, Steps);
  1366. end;
  1367. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
  1368. const Offset: TFloat = 0): TArrayOfFloatPoint;
  1369. begin
  1370. Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, CalculateCircleSteps(Radius));
  1371. end;
  1372. function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat;
  1373. Steps: Integer): TArrayOfFloatPoint;
  1374. begin
  1375. Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, Steps);
  1376. end;
  1377. function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
  1378. Steps: Integer): TArrayOfFloatPoint;
  1379. begin
  1380. Result := Pie(FloatPoint(X, Y), Radius, Angle, 0, Steps);
  1381. end;
  1382. function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint;
  1383. var
  1384. I: Integer;
  1385. M: TFloat;
  1386. C, D: TFloatPoint;
  1387. begin
  1388. SetLength(Result, Steps);
  1389. M := 2 * System.Pi / Steps;
  1390. // first item
  1391. Result[0].X := R.X + P.X;
  1392. Result[0].Y := P.Y;
  1393. // calculate complex offset
  1394. GR32_Math.SinCos(M, C.Y, C.X);
  1395. D := C;
  1396. // second item
  1397. Result[1].X := R.X * D.X + P.X;
  1398. Result[1].Y := R.Y * D.Y + P.Y;
  1399. // other items
  1400. for I := 2 to Steps - 1 do
  1401. begin
  1402. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1403. Result[I].X := R.X * D.X + P.X;
  1404. Result[I].Y := R.Y * D.Y + P.Y;
  1405. end;
  1406. end;
  1407. function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint;
  1408. begin
  1409. Result := Ellipse(P, R, CalculateCircleSteps(Min(R.X, R.Y)));
  1410. end;
  1411. function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint;
  1412. begin
  1413. Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry), Steps);
  1414. end;
  1415. function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint;
  1416. begin
  1417. Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry),
  1418. CalculateCircleSteps(Min(Rx, Ry)));
  1419. end;
  1420. function Ellipse(const R: TRect): TArrayOfFloatPoint;
  1421. begin
  1422. Result := Ellipse(
  1423. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1424. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1425. end;
  1426. function Ellipse(const R: TFloatRect): TArrayOfFloatPoint;
  1427. begin
  1428. Result := Ellipse(
  1429. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1430. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
  1431. end;
  1432. function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
  1433. begin
  1434. Result := Ellipse(
  1435. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1436. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1437. end;
  1438. function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
  1439. begin
  1440. Result := Ellipse(
  1441. FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
  1442. FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
  1443. end;
  1444. function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5;
  1445. Rotation: TFloat = 0): TArrayOfFloatPoint;
  1446. var
  1447. Alpha, Ratio: TFloat;
  1448. begin
  1449. Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
  1450. Ratio := Sin(Alpha * 0.5) / Sin( Alpha * 0.5 + Pi / Vertices);
  1451. Result := Star(X, Y, Ratio * Radius, Radius, Vertices, Rotation);
  1452. end;
  1453. function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5;
  1454. Rotation: TFloat = 0): TArrayOfFloatPoint;
  1455. var
  1456. Alpha, Ratio: TFloat;
  1457. begin
  1458. Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
  1459. Ratio := Sin(Alpha * 0.5) / Sin(Alpha * 0.5 + Pi / Vertices);
  1460. Result := Star(P, Ratio * Radius, Radius, Vertices, Rotation);
  1461. end;
  1462. function Star(const X, Y, InnerRadius, OuterRadius: TFloat;
  1463. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
  1464. begin
  1465. Result := Star(FloatPoint(X, Y), InnerRadius, OuterRadius, Vertices, Rotation);
  1466. end;
  1467. function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat;
  1468. Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
  1469. var
  1470. I: Integer;
  1471. M: TFloat;
  1472. C, D: TFloatPoint;
  1473. begin
  1474. SetLength(Result, 2 * Vertices);
  1475. M := System.Pi / Vertices;
  1476. // calculate complex offset
  1477. GR32_Math.SinCos(M, C.Y, C.X);
  1478. // first item
  1479. if Rotation = 0 then
  1480. begin
  1481. Result[0].X := OuterRadius + P.X;
  1482. Result[0].Y := P.Y;
  1483. D := C;
  1484. end
  1485. else
  1486. begin
  1487. GR32_Math.SinCos(Rotation, D.Y, D.X);
  1488. Result[0].X := OuterRadius * D.X + P.X;
  1489. Result[0].Y := OuterRadius * D.Y + P.Y;
  1490. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1491. end;
  1492. // second item
  1493. Result[1].X := InnerRadius * D.X + P.X;
  1494. Result[1].Y := InnerRadius * D.Y + P.Y;
  1495. // other items
  1496. for I := 2 to (2 * Vertices) - 1 do
  1497. begin
  1498. D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
  1499. if I mod 2 = 0 then
  1500. begin
  1501. Result[I].X := OuterRadius * D.X + P.X;
  1502. Result[I].Y := OuterRadius * D.Y + P.Y;
  1503. end
  1504. else
  1505. begin
  1506. Result[I].X := InnerRadius * D.X + P.X;
  1507. Result[I].Y := InnerRadius * D.Y + P.Y;
  1508. end;
  1509. end;
  1510. end;
  1511. function Rectangle(const R: TFloatRect): TArrayOfFloatPoint;
  1512. begin
  1513. SetLength(Result, 4);
  1514. Result[0] := R.TopLeft;
  1515. Result[1] := FloatPoint(R.Right, R.Top);
  1516. Result[2] := R.BottomRight;
  1517. Result[3] := FloatPoint(R.Left, R.Bottom);
  1518. end;
  1519. function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint;
  1520. var
  1521. R2: TFloatRect;
  1522. begin
  1523. R2 := R;
  1524. GR32.InflateRect(R2, -Radius, -Radius);
  1525. Result := Grow(Rectangle(R2), Radius, jsRound, True);
  1526. end;
  1527. function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  1528. const
  1529. EPSILON = 1E-4;
  1530. var
  1531. I, Count, NextI: Integer;
  1532. dx, dy, f: Double;
  1533. begin
  1534. Count := Length(Points);
  1535. SetLength(Result, Count);
  1536. I := 0;
  1537. NextI := 1;
  1538. while I < Count do
  1539. begin
  1540. if NextI >= Count then NextI := 0;
  1541. dx := Points[NextI].X - Points[I].X;
  1542. dy := Points[NextI].Y - Points[I].Y;
  1543. f := GR32_Math.Hypot(dx, dy);
  1544. if (f > EPSILON) then
  1545. begin
  1546. f := 1 / f;
  1547. dx := dx * f;
  1548. dy := dy * f;
  1549. end;
  1550. Result[I].X := dy;
  1551. Result[I].Y := -dx;
  1552. Inc(I);
  1553. Inc(NextI);
  1554. end;
  1555. end;
  1556. function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  1557. var
  1558. I, Count, NextI: Integer;
  1559. dx, dy, f: TFixed;
  1560. begin
  1561. Count := Length(Points);
  1562. SetLength(Result, Count);
  1563. I := 0;
  1564. NextI := 1;
  1565. while I < Count do
  1566. begin
  1567. if NextI >= Count then NextI := 0;
  1568. dx := Points[NextI].X - Points[I].X;
  1569. dy := Points[NextI].Y - Points[I].Y;
  1570. f := GR32_Math.Hypot(dx, dy);
  1571. if (f <> 0) then
  1572. begin
  1573. dx := FixedDiv(dx, f);
  1574. dy := FixedDiv(dy, f);
  1575. end;
  1576. Result[I].X := dy;
  1577. Result[I].Y := -dx;
  1578. Inc(I);
  1579. Inc(NextI);
  1580. end;
  1581. end;
  1582. function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint;
  1583. const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFloat): TArrayOfFloatPoint; overload;
  1584. const
  1585. BUFFSIZEINCREMENT = 128;
  1586. MINDISTPIXEL = 1.414; // just a little bit smaller than sqrt(2),
  1587. // -> set to about 2.5 for a similar output with the previous version
  1588. var
  1589. ResSize, BuffSize: Integer;
  1590. PX, PY: TFloat;
  1591. AngleInv, RMin: TFloat;
  1592. A, B, Dm: TFloatPoint;
  1593. procedure AddPoint(const LongDeltaX, LongDeltaY: TFloat);
  1594. begin
  1595. if ResSize = BuffSize then
  1596. begin
  1597. Inc(BuffSize, BUFFSIZEINCREMENT);
  1598. SetLength(Result, BuffSize);
  1599. end;
  1600. Result[ResSize] := FloatPoint(PX + LongDeltaX, PY + LongDeltaY);
  1601. Inc(ResSize);
  1602. end;
  1603. procedure AddMitered(const X1, Y1, X2, Y2: TFloat);
  1604. var
  1605. R, CX, CY: TFloat;
  1606. begin
  1607. CX := X1 + X2;
  1608. CY := Y1 + Y2;
  1609. R := X1 * CX + Y1 * CY; //(1 - cos(?) (range: 0 <= R <= 2)
  1610. if R < RMin then
  1611. begin
  1612. AddPoint(Delta * X1, Delta * Y1);
  1613. AddPoint(Delta * X2, Delta * Y2);
  1614. end
  1615. else
  1616. begin
  1617. R := Delta / R;
  1618. AddPoint(CX * R, CY * R)
  1619. end;
  1620. end;
  1621. procedure AddBevelled(const X1, Y1, X2, Y2: TFloat);
  1622. var
  1623. R: TFloat;
  1624. begin
  1625. R := X1 * Y2 - X2 * Y1; //cross product
  1626. if R * Delta <= 0 then //ie angle is concave
  1627. begin
  1628. AddMitered(X1, Y1, X2, Y2);
  1629. end
  1630. else
  1631. begin
  1632. AddPoint(Delta * X1, Delta * Y1);
  1633. AddPoint(Delta * X2, Delta * Y2);
  1634. end;
  1635. end;
  1636. procedure AddRoundedJoin(const X1, Y1, X2, Y2: TFloat);
  1637. var
  1638. R, tmp, da: TFloat;
  1639. ArcLen: Integer;
  1640. I: Integer;
  1641. C: TFloatPoint;
  1642. begin
  1643. R := X1 * Y2 - X2 * Y1;
  1644. if R * Delta <= 0 then
  1645. AddMitered(X1, Y1, X2, Y2)
  1646. else
  1647. begin
  1648. if R < 0 then
  1649. Dm.Y := -Abs(Dm.Y)
  1650. else
  1651. Dm.Y := Abs(Dm.Y);
  1652. tmp := 1 - 0.5 * (Sqr(X2 - X1) + Sqr(Y2 - Y1));
  1653. da := 0.5 * Pi - tmp * (1 + Sqr(tmp) * 0.1667); // should be ArcCos(tmp);
  1654. ArcLen := Round(Abs(da * AngleInv)); // should be trunc instead of round
  1655. C.X := X1 * Delta;
  1656. C.Y := Y1 * Delta;
  1657. AddPoint(C.X, C.Y);
  1658. for I := 1 to ArcLen - 1 do
  1659. begin
  1660. C := FloatPoint(C.X * Dm.X - C.Y * Dm.Y, C.Y * Dm.X + C.X * Dm.Y);
  1661. AddPoint(C.X, C.Y);
  1662. end;
  1663. C.X := X2 * Delta;
  1664. C.Y := Y2 * Delta;
  1665. AddPoint(C.X, C.Y);
  1666. end;
  1667. end;
  1668. procedure AddJoin(const X, Y, X1, Y1, X2, Y2: TFloat);
  1669. begin
  1670. PX := X;
  1671. PY := Y;
  1672. case JoinStyle of
  1673. jsMiter: AddMitered(A.X, A.Y, B.X, B.Y);
  1674. jsBevel: AddBevelled(A.X, A.Y, B.X, B.Y);
  1675. jsRound: AddRoundedJoin(A.X, A.Y, B.X, B.Y);
  1676. end;
  1677. end;
  1678. var
  1679. I, L, H: Integer;
  1680. begin
  1681. Result := nil;
  1682. if Length(Points) <= 1 then Exit;
  1683. //MiterLimit = Sqrt(2/(1 - cos(?))
  1684. //Sqr(MiterLimit) = 2/(1 - cos(?)
  1685. //1 - cos(? = 2/Sqr(MiterLimit) = RMin;
  1686. RMin := 2 / Sqr(MiterLimit);
  1687. H := High(Points) - Ord(not Closed);
  1688. while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
  1689. {** all normals zeroed => Exit }
  1690. if H < 0 then Exit;
  1691. L := 0;
  1692. while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
  1693. if Closed then
  1694. A := Normals[H]
  1695. else
  1696. A := Normals[L];
  1697. ResSize := 0;
  1698. BuffSize := BUFFSIZEINCREMENT;
  1699. SetLength(Result, BuffSize);
  1700. // prepare
  1701. if JoinStyle = jsRound then
  1702. begin
  1703. Dm.X := 1 - 0.5 * Min(3, Sqr(MINDISTPIXEL / Abs(Delta)));
  1704. Dm.Y := Sqrt(1 - Sqr(Dm.X));
  1705. AngleInv := 1 / ArcCos(Dm.X);
  1706. end;
  1707. for I := L to H do
  1708. begin
  1709. B := Normals[I];
  1710. if (B.X = 0) and (B.Y = 0) then Continue;
  1711. with Points[I] do AddJoin(X, Y, A.X, A.Y, B.X, B.Y);
  1712. A := B;
  1713. end;
  1714. if not Closed then
  1715. with Points[High(Points)] do AddJoin(X, Y, A.X, A.Y, A.X, A.Y);
  1716. SetLength(Result, ResSize);
  1717. end;
  1718. function Grow(const Points: TArrayOfFloatPoint;
  1719. const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean;
  1720. MiterLimit: TFloat): TArrayOfFloatPoint; overload;
  1721. var
  1722. Normals: TArrayOfFloatPoint;
  1723. begin
  1724. Normals := BuildNormals(Points);
  1725. Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
  1726. end;
  1727. function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint;
  1728. const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
  1729. Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
  1730. const
  1731. BUFFSIZEINCREMENT = 128;
  1732. var
  1733. I, L, H: Integer;
  1734. ResSize, BuffSize: Integer;
  1735. PX, PY, D, RMin: TFixed;
  1736. A, B: TFixedPoint;
  1737. procedure AddPoint(const LongDeltaX, LongDeltaY: TFixed);
  1738. begin
  1739. if ResSize = BuffSize then
  1740. begin
  1741. Inc(BuffSize, BUFFSIZEINCREMENT);
  1742. SetLength(Result, BuffSize);
  1743. end;
  1744. with Result[ResSize] do
  1745. begin
  1746. X := PX + LongDeltaX;
  1747. Y := PY + LongDeltaY;
  1748. end;
  1749. Inc(ResSize);
  1750. end;
  1751. procedure AddMitered(const X1, Y1, X2, Y2: TFixed);
  1752. var
  1753. R, CX, CY: TFixed;
  1754. begin
  1755. CX := X1 + X2;
  1756. CY := Y1 + Y2;
  1757. R := FixedMul(X1, CX) + FixedMul(Y1, CY); //(1 - cos(?) (range: 0 <= R <= 2)
  1758. if R < RMin then
  1759. begin
  1760. AddPoint(FixedMul(D, X1), FixedMul(D, Y1));
  1761. AddPoint(FixedMul(D, X2), FixedMul(D, Y2));
  1762. end
  1763. else
  1764. begin
  1765. R := FixedDiv(D, R);
  1766. AddPoint(FixedMul(CX, R), FixedMul(CY, R));
  1767. end;
  1768. end;
  1769. procedure AddBevelled(const X1, Y1, X2, Y2: TFixed);
  1770. var
  1771. R: TFixed;
  1772. begin
  1773. R := X1 * Y2 - X2 * Y1; //cross product
  1774. if R * D <= 0 then //ie angle is concave
  1775. begin
  1776. AddMitered(X1, Y1, X2, Y2);
  1777. end
  1778. else
  1779. begin
  1780. AddPoint(FixedMul(D, X1), FixedMul(D, Y1));
  1781. AddPoint(FixedMul(D, X2), FixedMul(D, Y2));
  1782. end;
  1783. end;
  1784. procedure AddRoundedJoin(const X1, Y1, X2, Y2: TFixed);
  1785. var
  1786. R: TFixed;
  1787. a1, a2, da: TFloat;
  1788. Arc: TArrayOfFixedPoint;
  1789. ArcLen: Integer;
  1790. begin
  1791. R := FixedMul(X1, Y2) - FixedMul(X2, Y1);
  1792. if R * D <= 0 then
  1793. AddMitered(X1, Y1, X2, Y2)
  1794. else
  1795. begin
  1796. a1 := ArcTan2(Y1, X1) * FixedToFloat;
  1797. a2 := ArcTan2(Y2, X2) * FixedToFloat;
  1798. da := a2 - a1;
  1799. if da > Pi then
  1800. a2 := a2 - TWOPI
  1801. else if da < -Pi then
  1802. a2 := a2 + TWOPI;
  1803. Arc := BuildArc(FixedPoint(PX, PY), a1, a2, D);
  1804. ArcLen := Length(Arc);
  1805. if ResSize + ArcLen >= BuffSize then
  1806. begin
  1807. Inc(BuffSize, ArcLen);
  1808. SetLength(Result, BuffSize);
  1809. end;
  1810. Move(Arc[0], Result[ResSize], Length(Arc) * SizeOf(TFixedPoint));
  1811. Inc(ResSize, ArcLen);
  1812. end;
  1813. end;
  1814. procedure AddJoin(const X, Y, X1, Y1, X2, Y2: TFixed);
  1815. begin
  1816. PX := X;
  1817. PY := Y;
  1818. case JoinStyle of
  1819. jsMiter: AddMitered(A.X, A.Y, B.X, B.Y);
  1820. jsBevel: AddBevelled(A.X, A.Y, B.X, B.Y);
  1821. jsRound: AddRoundedJoin(A.X, A.Y, B.X, B.Y);
  1822. end;
  1823. end;
  1824. begin
  1825. raise Exception.Create('Not yet fully implemented');
  1826. Result := nil;
  1827. if Length(Points) <= 1 then Exit;
  1828. D := Delta;
  1829. //MiterLimit = Sqrt(2/(1 - cos(?))
  1830. //Sqr(MiterLimit) = 2/(1 - cos(?)
  1831. //1 - cos(? = 2/Sqr(MiterLimit) = RMin;
  1832. RMin := FixedDiv($20000, FixedSqr(MiterLimit));
  1833. H := High(Points) - Ord(not Closed);
  1834. while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
  1835. {** all normals zeroed => Exit }
  1836. if H < 0 then Exit;
  1837. L := 0;
  1838. while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
  1839. if Closed then
  1840. A := Normals[H]
  1841. else
  1842. A := Normals[L];
  1843. ResSize := 0;
  1844. BuffSize := BUFFSIZEINCREMENT;
  1845. SetLength(Result, BuffSize);
  1846. for I := L to H do
  1847. begin
  1848. B := Normals[I];
  1849. if (B.X = 0) and (B.Y = 0) then Continue;
  1850. with Points[I] do AddJoin(X, Y, A.X, A.Y, B.X, B.Y);
  1851. A := B;
  1852. end;
  1853. if not Closed then
  1854. with Points[High(Points)] do AddJoin(X, Y, A.X, A.Y, A.X, A.Y);
  1855. SetLength(Result, ResSize);
  1856. end;
  1857. function Grow(const Points: TArrayOfFixedPoint;
  1858. const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
  1859. Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
  1860. var
  1861. Normals: TArrayOfFixedPoint;
  1862. begin
  1863. Normals := BuildNormals(Points);
  1864. Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
  1865. end;
  1866. function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
  1867. var
  1868. I, L: Integer;
  1869. begin
  1870. L := Length(Points);
  1871. SetLength(Result, L);
  1872. Dec(L);
  1873. for I := 0 to L do
  1874. Result[I] := Points[L - I];
  1875. end;
  1876. function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
  1877. var
  1878. I, L: Integer;
  1879. begin
  1880. L := Length(Points);
  1881. SetLength(Result, L);
  1882. Dec(L);
  1883. for I := 0 to L do
  1884. Result[I] := Points[L - I];
  1885. end;
  1886. function BuildLineEnd(const P, N: TFloatPoint; const W: TFloat;
  1887. EndStyle: TEndStyle): TArrayOfFloatPoint; overload;
  1888. var
  1889. a1, a2: TFloat;
  1890. begin
  1891. case EndStyle of
  1892. esButt:
  1893. begin
  1894. Result := nil;
  1895. end;
  1896. esSquare:
  1897. begin
  1898. SetLength(Result, 2);
  1899. Result[0].X := P.X + (N.X - N.Y) * W;
  1900. Result[0].Y := P.Y + (N.Y + N.X) * W;
  1901. Result[1].X := P.X - (N.X + N.Y) * W;
  1902. Result[1].Y := P.Y - (N.Y - N.X) * W;
  1903. end;
  1904. esRound:
  1905. begin
  1906. a1 := ArcTan2(N.Y, N.X);
  1907. a2 := ArcTan2(-N.Y, -N.X);
  1908. if a2 < a1 then a2 := a2 + TWOPI;
  1909. Result := BuildArc(P, a1, a2, W);
  1910. end;
  1911. end;
  1912. end;
  1913. function BuildLineEnd(const P, N: TFixedPoint; const W: TFixed;
  1914. EndStyle: TEndStyle): TArrayOfFixedPoint; overload;
  1915. var
  1916. a1, a2: TFloat;
  1917. begin
  1918. case EndStyle of
  1919. esButt:
  1920. begin
  1921. Result := nil;
  1922. end;
  1923. esSquare:
  1924. begin
  1925. SetLength(Result, 2);
  1926. Result[0].X := P.X + (N.X - N.Y) * W;
  1927. Result[0].Y := P.Y + (N.Y + N.X) * W;
  1928. Result[1].X := P.X - (N.X + N.Y) * W;
  1929. Result[1].Y := P.Y - (N.Y - N.X) * W;
  1930. end;
  1931. esRound:
  1932. begin
  1933. a1 := ArcTan2(N.Y, N.X);
  1934. a2 := ArcTan2(-N.Y, -N.X);
  1935. if a2 < a1 then a2 := a2 + TWOPI;
  1936. Result := BuildArc(P, a1, a2, W);
  1937. end;
  1938. end;
  1939. end;
  1940. function BuildPolyline(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat;
  1941. JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfFloatPoint;
  1942. var
  1943. L, H: Integer;
  1944. Normals: TArrayOfFloatPoint;
  1945. P1, P2, E1, E2: TArrayOfFloatPoint;
  1946. V: TFloat;
  1947. P: PFloatPoint;
  1948. begin
  1949. V := StrokeWidth * 0.5;
  1950. Normals := BuildNormals(Points);
  1951. H := High(Points) - 1;
  1952. while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
  1953. if H < 0 then Exit;
  1954. L := 0;
  1955. while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
  1956. P1 := Grow(Points, Normals, V, JoinStyle, False, MiterLimit);
  1957. P2 := ReversePolygon(Grow(Points, Normals, -V, JoinStyle, False, MiterLimit));
  1958. E1 := BuildLineEnd(Points[0], Normals[L], -V, EndStyle);
  1959. E2 := BuildLineEnd(Points[High(Points)], Normals[H], V, EndStyle);
  1960. SetLength(Result, Length(P1) + Length(P2) + Length(E1) + Length(E2));
  1961. P := @Result[0];
  1962. Move(E1[0], P^, Length(E1) * SizeOf(TFloatPoint)); Inc(P, Length(E1));
  1963. Move(P1[0], P^, Length(P1) * SizeOf(TFloatPoint)); Inc(P, Length(P1));
  1964. Move(E2[0], P^, Length(E2) * SizeOf(TFloatPoint)); Inc(P, Length(E2));
  1965. Move(P2[0], P^, Length(P2) * SizeOf(TFloatPoint));
  1966. end;
  1967. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint;
  1968. Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle;
  1969. EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfArrayOfFloatPoint;
  1970. var
  1971. I: Integer;
  1972. P1, P2: TArrayOfFloatPoint;
  1973. Dst: TArrayOfArrayOfFloatPoint;
  1974. Normals: TArrayOfFloatPoint;
  1975. begin
  1976. if Closed then
  1977. begin
  1978. SetLength(Dst, Length(Points) * 2);
  1979. for I := 0 to High(Points) do
  1980. begin
  1981. Normals := BuildNormals(Points[I]);
  1982. P1 := Grow(Points[I], Normals, StrokeWidth * 0.5, JoinStyle, True, MiterLimit);
  1983. P2 := Grow(Points[I], Normals, -StrokeWidth * 0.5, JoinStyle, True, MiterLimit);
  1984. Dst[I * 2] := P1;
  1985. Dst[I * 2 + 1] := ReversePolygon(P2);
  1986. end;
  1987. end
  1988. else
  1989. begin
  1990. SetLength(Dst, Length(Points));
  1991. for I := 0 to High(Points) do
  1992. Dst[I] := BuildPolyline(Points[I], StrokeWidth, JoinStyle, EndStyle);
  1993. end;
  1994. Result := Dst;
  1995. end;
  1996. function BuildPolyline(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed;
  1997. JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfFixedPoint;
  1998. var
  1999. L, H: Integer;
  2000. Normals: TArrayOfFixedPoint;
  2001. P1, P2, E1, E2: TArrayOfFixedPoint;
  2002. V: TFixed;
  2003. P: PFixedPoint;
  2004. begin
  2005. V := StrokeWidth shr 1;
  2006. Normals := BuildNormals(Points);
  2007. H := High(Points) - 1;
  2008. while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
  2009. if H < 0 then Exit;
  2010. L := 0;
  2011. while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
  2012. P1 := Grow(Points, Normals, V, JoinStyle, False, MiterLimit);
  2013. P2 := ReversePolygon(Grow(Points, Normals, -V, JoinStyle, False, MiterLimit));
  2014. E1 := BuildLineEnd(Points[0], Normals[L], -V, EndStyle);
  2015. E2 := BuildLineEnd(Points[High(Points)], Normals[H], V, EndStyle);
  2016. SetLength(Result, Length(P1) + Length(P2) + Length(E1) + Length(E2));
  2017. P := @Result[0];
  2018. Move(E1[0], P^, Length(E1) * SizeOf(TFixedPoint)); Inc(P, Length(E1));
  2019. Move(P1[0], P^, Length(P1) * SizeOf(TFixedPoint)); Inc(P, Length(P1));
  2020. Move(E2[0], P^, Length(E2) * SizeOf(TFixedPoint)); Inc(P, Length(E2));
  2021. Move(P2[0], P^, Length(P2) * SizeOf(TFixedPoint));
  2022. end;
  2023. function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint;
  2024. Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle;
  2025. EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfArrayOfFixedPoint;
  2026. var
  2027. I: Integer;
  2028. P1, P2: TArrayOfFixedPoint;
  2029. Dst: TArrayOfArrayOfFixedPoint;
  2030. Normals: TArrayOfFixedPoint;
  2031. begin
  2032. if Closed then
  2033. begin
  2034. SetLength(Dst, Length(Points) * 2);
  2035. for I := 0 to High(Points) do
  2036. begin
  2037. Normals := BuildNormals(Points[I]);
  2038. P1 := Grow(Points[I], Normals, StrokeWidth shr 1, JoinStyle, True, MiterLimit);
  2039. P2 := Grow(Points[I], Normals, -StrokeWidth shr 1, JoinStyle, True, MiterLimit);
  2040. Dst[I * 2] := P1;
  2041. Dst[I * 2 + 1] := ReversePolygon(P2);
  2042. end;
  2043. end
  2044. else
  2045. begin
  2046. SetLength(Dst, Length(Points));
  2047. for I := 0 to High(Points) do
  2048. Dst[I] := BuildPolyline(Points[I], StrokeWidth, JoinStyle, EndStyle);
  2049. end;
  2050. Result := Dst;
  2051. end;
  2052. function BuildDashedLine(const Points: TArrayOfFloatPoint;
  2053. const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
  2054. Closed: Boolean = False): TArrayOfArrayOfFloatPoint;
  2055. const
  2056. EPSILON = 1E-4;
  2057. var
  2058. I, J, DashIndex, len1, len2: Integer;
  2059. Offset, Dist, v: TFloat;
  2060. Delta: TFloatPoint;
  2061. procedure AddPoint(X, Y: TFloat);
  2062. var
  2063. K: Integer;
  2064. begin
  2065. K := Length(Result[J]);
  2066. SetLength(Result[J], K + 1);
  2067. Result[J][K].X := X;
  2068. Result[J][K].Y := Y;
  2069. end;
  2070. procedure AddDash(I: Integer);
  2071. begin
  2072. if i = 0 then
  2073. begin
  2074. Delta.X := Points[0].X - Points[High(Points)].X;
  2075. Delta.Y := Points[0].Y - Points[High(Points)].Y;
  2076. end else
  2077. begin
  2078. Delta.X := Points[I].X - Points[I - 1].X;
  2079. Delta.Y := Points[I].Y - Points[I - 1].Y;
  2080. end;
  2081. Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
  2082. Offset := Offset + Dist;
  2083. if (Dist > EPSILON) then
  2084. begin
  2085. Dist := 1 / Dist;
  2086. Delta.X := Delta.X * Dist;
  2087. Delta.Y := Delta.Y * Dist;
  2088. end;
  2089. while Offset > DashOffset do
  2090. begin
  2091. v := Offset - DashOffset;
  2092. AddPoint(Points[I].X - v * Delta.X, Points[I].Y - v * Delta.Y);
  2093. DashIndex := (DashIndex + 1) mod Length(DashArray);
  2094. DashOffset := DashOffset + DashArray[DashIndex];
  2095. if Odd(DashIndex) then
  2096. begin
  2097. Inc(J);
  2098. SetLength(Result, J + 1);
  2099. end;
  2100. end;
  2101. if not Odd(DashIndex) then
  2102. AddPoint(Points[I].X, Points[I].Y);
  2103. end;
  2104. begin
  2105. if Length(Points) <= 0 then Exit;
  2106. DashIndex := -1;
  2107. Offset := 0;
  2108. V := 0;
  2109. for I := 0 to High(DashArray) do
  2110. V := V + DashArray[I];
  2111. DashOffset := Wrap(DashOffset, V);
  2112. DashOffset := DashOffset - V;
  2113. while DashOffset < 0 do
  2114. begin
  2115. Inc(DashIndex);
  2116. DashOffset := DashOffset + DashArray[DashIndex];
  2117. end;
  2118. J := 0;
  2119. // note to self: second dimension might not be zero by default!
  2120. SetLength(Result, 1, 0);
  2121. if not Odd(DashIndex) then
  2122. AddPoint(Points[0].X, Points[0].Y);
  2123. for I := 1 to High(Points) do
  2124. AddDash(I);
  2125. if Closed then
  2126. begin
  2127. AddDash(0);
  2128. len1 := Length(Result[0]);
  2129. len2 := Length(Result[J]);
  2130. if (len1 > 0) and (len2 > 0) then
  2131. begin
  2132. SetLength(Result[0], len1 + len2 -1);
  2133. Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFloatPoint) * len1);
  2134. Move(Result[J][0], Result[0][0], SizeOf(TFloatPoint) * len2);
  2135. SetLength(Result, J);
  2136. Dec(J);
  2137. end;
  2138. end;
  2139. //if Length(Result[J]) = 0 then SetLength(Result, J);
  2140. // Changed by Zhaoyipeng
  2141. // 2017-10-13
  2142. if (J >=0) and (Length(Result[J]) = 0) then SetLength(Result, J);
  2143. end;
  2144. function BuildDashedLine(const Points: TArrayOfFixedPoint;
  2145. const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
  2146. Closed: Boolean = False): TArrayOfArrayOfFixedPoint;
  2147. var
  2148. I, J, DashIndex, Len1, Len2: Integer;
  2149. Offset, Dist, v: TFixed;
  2150. Delta: TFixedPoint;
  2151. procedure AddPoint(X, Y: TFixed);
  2152. var
  2153. K: Integer;
  2154. begin
  2155. K := Length(Result[J]);
  2156. SetLength(Result[J], K + 1);
  2157. Result[J][K].X := X;
  2158. Result[J][K].Y := Y;
  2159. end;
  2160. procedure AddDash(I: Integer);
  2161. begin
  2162. if i = 0 then
  2163. begin
  2164. Delta.X := Points[0].X - Points[High(Points)].X;
  2165. Delta.Y := Points[0].Y - Points[High(Points)].Y;
  2166. end else
  2167. begin
  2168. Delta.X := Points[I].X - Points[I - 1].X;
  2169. Delta.Y := Points[I].Y - Points[I - 1].Y;
  2170. end;
  2171. Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
  2172. Offset := Offset + Dist;
  2173. if (Dist > 0) then
  2174. begin
  2175. Delta.X := FixedDiv(Delta.X, Dist);
  2176. Delta.Y := FixedDiv(Delta.Y, Dist);
  2177. end;
  2178. while Offset > DashOffset do
  2179. begin
  2180. v := Offset - DashOffset;
  2181. AddPoint(Points[I].X - FixedMul(v, Delta.X), Points[I].Y - FixedMul(v,
  2182. Delta.Y));
  2183. DashIndex := (DashIndex + 1) mod Length(DashArray);
  2184. DashOffset := DashOffset + DashArray[DashIndex];
  2185. if Odd(DashIndex) then
  2186. begin
  2187. Inc(J);
  2188. SetLength(Result, J + 1);
  2189. end;
  2190. end;
  2191. if not Odd(DashIndex) then
  2192. AddPoint(Points[I].X, Points[I].Y);
  2193. end;
  2194. begin
  2195. if Length(Points) <= 0 then Exit;
  2196. DashIndex := -1;
  2197. Offset := 0;
  2198. V := 0;
  2199. for I := 0 to High(DashArray) do
  2200. V := V + DashArray[I];
  2201. DashOffset := Wrap(DashOffset, V);
  2202. DashOffset := DashOffset - V;
  2203. while DashOffset < 0 do
  2204. begin
  2205. Inc(DashIndex);
  2206. DashOffset := DashOffset + DashArray[DashIndex];
  2207. end;
  2208. J := 0;
  2209. // note to self: second dimension might not be zero by default!
  2210. SetLength(Result, 1, 0);
  2211. if not Odd(DashIndex) then
  2212. AddPoint(Points[0].X, Points[0].Y);
  2213. for I := 1 to High(Points) do
  2214. AddDash(I);
  2215. if Closed then
  2216. begin
  2217. AddDash(0);
  2218. Len1 := Length(Result[0]);
  2219. Len2 := Length(Result[J]);
  2220. if (Len1 > 0) and (Len2 > 0) then
  2221. begin
  2222. SetLength(Result[0], len1 + len2 -1);
  2223. Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFixedPoint) * Len1);
  2224. Move(Result[J][0], Result[0][0], SizeOf(TFixedPoint) * Len2);
  2225. SetLength(Result, J);
  2226. Dec(J);
  2227. end;
  2228. end;
  2229. if Length(Result[J]) = 0 then SetLength(Result, J);
  2230. end;
  2231. function InterpolateX(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
  2232. var
  2233. W: Double;
  2234. begin
  2235. W := (X - P1.X) / (P2.X - P1.X);
  2236. Result.X := X;
  2237. Result.Y := P1.Y + W * (P2.Y - P1.Y);
  2238. end;
  2239. function InterpolateY(Y: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
  2240. var
  2241. W: Double;
  2242. begin
  2243. W := (Y - P1.Y) / (P2.Y - P1.Y);
  2244. Result.Y := Y;
  2245. Result.X := P1.X + W * (P2.X - P1.X);
  2246. end;
  2247. function GetCode(const P: TFloatPoint; const R: TFloatRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  2248. begin
  2249. Result := Ord(P.X >= R.Left) or
  2250. (Ord(P.X <= R.Right) shl 1) or
  2251. (Ord(P.Y >= R.Top) shl 2) or
  2252. (Ord(P.Y <= R.Bottom) shl 3);
  2253. end;
  2254. function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint;
  2255. type
  2256. TInterpolateProc = function(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint;
  2257. const
  2258. SAFEOVERSIZE = 5;
  2259. POPCOUNT: array [0..15] of Integer =
  2260. (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
  2261. var
  2262. I, J, K, L, N: Integer;
  2263. X, Y, Z, Code, Count: Integer;
  2264. Codes: PByteArray;
  2265. NextIndex: PIntegerArray;
  2266. Temp: PFloatPointArray;
  2267. label
  2268. ExitProc;
  2269. procedure AddPoint(Index: Integer; const P: TFloatPoint);
  2270. begin
  2271. Temp[K] := P;
  2272. Codes[K] := GetCode(P, ClipRect);
  2273. Inc(K);
  2274. Inc(Count);
  2275. end;
  2276. function ClipEdges(Mask: Integer; V: TFloat; Interpolate: TInterpolateProc): Boolean;
  2277. var
  2278. I, NextI, StopIndex: Integer;
  2279. begin
  2280. I := 0;
  2281. while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
  2282. Result := I = K;
  2283. if Result then { all points outside }
  2284. begin
  2285. ClipPolygon := nil;
  2286. Result := True;
  2287. Exit;
  2288. end;
  2289. StopIndex := I;
  2290. repeat
  2291. NextI := NextIndex[I];
  2292. if Codes[NextI] and Mask = 0 then { inside -> outside }
  2293. begin
  2294. NextIndex[I] := K;
  2295. NextIndex[K] := K + 1;
  2296. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  2297. while Codes[NextI] and Mask = 0 do
  2298. begin
  2299. Dec(Count);
  2300. Codes[NextI] := 0;
  2301. I := NextI;
  2302. NextI := NextIndex[I];
  2303. end;
  2304. { outside -> inside }
  2305. NextIndex[I] := K;
  2306. NextIndex[K] := NextI;
  2307. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  2308. end;
  2309. I := NextI;
  2310. until I = StopIndex;
  2311. end;
  2312. begin
  2313. N := Length(Points);
  2314. {$IFDEF USESTACKALLOC}
  2315. Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
  2316. {$ELSE}
  2317. GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
  2318. {$ENDIF}
  2319. X := 15;
  2320. Y := 0;
  2321. for I := 0 to N - 1 do
  2322. begin
  2323. Code := GetCode(Points[I], ClipRect);
  2324. Codes[I] := Code;
  2325. X := X and Code;
  2326. Y := Y or Code;
  2327. end;
  2328. if X = 15 then { all points inside }
  2329. begin
  2330. Result := Points;
  2331. end
  2332. else if Y <> 15 then { all points outside }
  2333. begin
  2334. Result := nil;
  2335. end
  2336. else
  2337. begin
  2338. Count := N;
  2339. Z := Codes[N - 1];
  2340. for I := 0 to N - 1 do
  2341. begin
  2342. Code := Codes[I];
  2343. Inc(Count, POPCOUNT[Z xor Code]);
  2344. Z := Code;
  2345. end;
  2346. {$IFDEF USESTACKALLOC}
  2347. Temp := StackAlloc(Count * SizeOf(TFloatPoint));
  2348. NextIndex := StackAlloc(Count * SizeOf(TFloatPoint));
  2349. {$ELSE}
  2350. GetMem(Temp, Count * SizeOf(TFloatPoint));
  2351. GetMem(NextIndex, Count * SizeOf(TFloatPoint));
  2352. {$ENDIF}
  2353. Move(Points[0], Temp[0], N * SizeOf(TFloatPoint));
  2354. for I := 0 to N - 2 do NextIndex[I] := I + 1;
  2355. NextIndex[N - 1] := 0;
  2356. Count := N;
  2357. K := N;
  2358. if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
  2359. if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
  2360. if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
  2361. if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
  2362. SetLength(Result, Count);
  2363. { start with first point inside the clipping rectangle }
  2364. I := 0;
  2365. while Codes[I] = 0 do
  2366. I := NextIndex[I];
  2367. J := I;
  2368. L := 0;
  2369. repeat
  2370. Result[L] := Temp[I];
  2371. Inc(L);
  2372. I := NextIndex[I];
  2373. until I = J;
  2374. ExitProc:
  2375. {$IFDEF USESTACKALLOC}
  2376. StackFree(NextIndex);
  2377. StackFree(Temp);
  2378. {$ELSE}
  2379. FreeMem(NextIndex);
  2380. FreeMem(Temp);
  2381. {$ENDIF}
  2382. end;
  2383. {$IFDEF USESTACKALLOC}
  2384. StackFree(Codes);
  2385. {$ELSE}
  2386. FreeMem(Codes);
  2387. {$ENDIF}
  2388. end;
  2389. function InterpolateX(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
  2390. var
  2391. W: TFixed;
  2392. begin
  2393. W := FixedDiv(X - P1.X, P2.X - P1.X);
  2394. Result.X := X;
  2395. Result.Y := P1.Y + FixedMul(W, P2.Y - P1.Y);
  2396. end;
  2397. function InterpolateY(Y: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
  2398. var
  2399. W: TFixed;
  2400. begin
  2401. W := FixedDiv(Y - P1.Y, P2.Y - P1.Y);
  2402. Result.Y := Y;
  2403. Result.X := P1.X + FixedMul(W, P2.X - P1.X);
  2404. end;
  2405. function GetCode(const P: TFixedPoint; const R: TFixedRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
  2406. begin
  2407. Result := Ord(P.X >= R.Left) or
  2408. (Ord(P.X <= R.Right) shl 1) or
  2409. (Ord(P.Y >= R.Top) shl 2) or
  2410. (Ord(P.Y <= R.Bottom) shl 3);
  2411. end;
  2412. function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint;
  2413. type
  2414. TInterpolateProc = function(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint;
  2415. const
  2416. SAFEOVERSIZE = 5;
  2417. POPCOUNT: array [0..15] of Integer =
  2418. (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
  2419. var
  2420. I, J, K, L, N: Integer;
  2421. X, Y, Z, Code, Count: Integer;
  2422. Codes: PByteArray;
  2423. NextIndex: PIntegerArray;
  2424. Temp: PFixedPointArray;
  2425. label
  2426. ExitProc;
  2427. procedure AddPoint(Index: Integer; const P: TFixedPoint);
  2428. begin
  2429. Temp[K] := P;
  2430. Codes[K] := GetCode(P, ClipRect);
  2431. Inc(K);
  2432. Inc(Count);
  2433. end;
  2434. function ClipEdges(Mask: Integer; V: TFixed; Interpolate: TInterpolateProc): Boolean;
  2435. var
  2436. I, NextI, StopIndex: Integer;
  2437. begin
  2438. I := 0;
  2439. while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
  2440. Result := I = K;
  2441. if Result then { all points outside }
  2442. begin
  2443. ClipPolygon := nil;
  2444. Result := True;
  2445. Exit;
  2446. end;
  2447. StopIndex := I;
  2448. repeat
  2449. NextI := NextIndex[I];
  2450. if Codes[NextI] and Mask = 0 then { inside -> outside }
  2451. begin
  2452. NextIndex[I] := K;
  2453. NextIndex[K] := K + 1;
  2454. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  2455. while Codes[NextI] and Mask = 0 do
  2456. begin
  2457. Dec(Count);
  2458. Codes[NextI] := 0;
  2459. I := NextI;
  2460. NextI := NextIndex[I];
  2461. end;
  2462. { outside -> inside }
  2463. NextIndex[I] := K;
  2464. NextIndex[K] := NextI;
  2465. AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
  2466. end;
  2467. I := NextI;
  2468. until I = StopIndex;
  2469. end;
  2470. begin
  2471. N := Length(Points);
  2472. {$IFDEF USESTACKALLOC}
  2473. Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
  2474. {$ELSE}
  2475. GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
  2476. {$ENDIF}
  2477. X := 15;
  2478. Y := 0;
  2479. for I := 0 to N - 1 do
  2480. begin
  2481. Code := GetCode(Points[I], ClipRect);
  2482. Codes[I] := Code;
  2483. X := X and Code;
  2484. Y := Y or Code;
  2485. end;
  2486. if X = 15 then { all points inside }
  2487. begin
  2488. Result := Points;
  2489. end
  2490. else if Y <> 15 then { all points outside }
  2491. begin
  2492. Result := nil;
  2493. end
  2494. else
  2495. begin
  2496. Count := N;
  2497. Z := Codes[N - 1];
  2498. for I := 0 to N - 1 do
  2499. begin
  2500. Code := Codes[I];
  2501. Inc(Count, POPCOUNT[Z xor Code]);
  2502. Z := Code;
  2503. end;
  2504. {$IFDEF USESTACKALLOC}
  2505. Temp := StackAlloc(Count * SizeOf(TFixedPoint));
  2506. NextIndex := StackAlloc(Count * SizeOf(TFixedPoint));
  2507. {$ELSE}
  2508. GetMem(Temp, Count * SizeOf(TFixedPoint));
  2509. GetMem(NextIndex, Count * SizeOf(TFixedPoint));
  2510. {$ENDIF}
  2511. Move(Points[0], Temp[0], N * SizeOf(TFixedPoint));
  2512. for I := 0 to N - 2 do NextIndex[I] := I + 1;
  2513. NextIndex[N - 1] := 0;
  2514. Count := N;
  2515. K := N;
  2516. if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
  2517. if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
  2518. if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
  2519. if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
  2520. SetLength(Result, Count);
  2521. { start with first point inside the clipping rectangle }
  2522. I := 0;
  2523. while Codes[I] = 0 do
  2524. I := NextIndex[I];
  2525. J := I;
  2526. L := 0;
  2527. repeat
  2528. Result[L] := Temp[I];
  2529. Inc(L);
  2530. I := NextIndex[I];
  2531. until I = J;
  2532. ExitProc:
  2533. {$IFDEF USESTACKALLOC}
  2534. StackFree(NextIndex);
  2535. StackFree(Temp);
  2536. {$ELSE}
  2537. FreeMem(NextIndex);
  2538. FreeMem(Temp);
  2539. {$ENDIF}
  2540. end;
  2541. {$IFDEF USESTACKALLOC}
  2542. StackFree(Codes);
  2543. {$ELSE}
  2544. FreeMem(Codes);
  2545. {$ENDIF}
  2546. end;
  2547. function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint;
  2548. var
  2549. L1, L2: Integer;
  2550. begin
  2551. L1 := Length(P1);
  2552. L2 := Length(P2);
  2553. SetLength(Result, L1 + L2);
  2554. Move(P1[0], Result[0], L1 * SizeOf(TFloatPoint));
  2555. Move(P2[0], Result[L1], L2 * SizeOf(TFloatPoint));
  2556. end;
  2557. function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload;
  2558. var
  2559. L1, L2: Integer;
  2560. begin
  2561. L1 := Length(P1);
  2562. L2 := Length(P2);
  2563. SetLength(Result, L1 + L2);
  2564. Move(P1[0], Result[0], L1 * SizeOf(TFixedPoint));
  2565. Move(P2[0], Result[L1], L2 * SizeOf(TFixedPoint));
  2566. end;
  2567. function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect;
  2568. var
  2569. I: Integer;
  2570. begin
  2571. Assert(Length(Points) > 0);
  2572. Result.Left := Points[0].X;
  2573. Result.Top := Points[0].Y;
  2574. Result.Right := Points[0].X;
  2575. Result.Bottom := Points[0].Y;
  2576. for I := 1 to High(Points) do
  2577. begin
  2578. Result.Left := Min(Result.Left, Points[I].X);
  2579. Result.Right := Max(Result.Right, Points[I].X);
  2580. Result.Top := Min(Result.Top, Points[I].Y);
  2581. Result.Bottom := Max(Result.Bottom, Points[I].Y);
  2582. end;
  2583. end;
  2584. function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect;
  2585. var
  2586. I: Integer;
  2587. begin
  2588. Assert(Length(Points) > 0);
  2589. Result.Left := Points[0].X;
  2590. Result.Top := Points[0].Y;
  2591. Result.Right := Points[0].X;
  2592. Result.Bottom := Points[0].Y;
  2593. for I := 1 to High(Points) do
  2594. begin
  2595. Result.Left := Min(Result.Left, Points[I].X);
  2596. Result.Right := Max(Result.Right, Points[I].X);
  2597. Result.Top := Min(Result.Top, Points[I].Y);
  2598. Result.Bottom := Max(Result.Bottom, Points[I].Y);
  2599. end;
  2600. end;
  2601. function PolypolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect;
  2602. var
  2603. I: Integer;
  2604. R: TFloatRect;
  2605. begin
  2606. Assert(Length(Points) > 0);
  2607. Result := PolygonBounds(Points[0]);
  2608. for I := 1 to High(Points) do
  2609. begin
  2610. R := PolygonBounds(Points[I]);
  2611. Result.Left := Min(Result.Left, R.Left);
  2612. Result.Right := Max(Result.Right, R.Right);
  2613. Result.Top := Min(Result.Top, R.Top);
  2614. Result.Bottom := Max(Result.Bottom, R.Bottom);
  2615. end;
  2616. end;
  2617. function PolypolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect;
  2618. var
  2619. I: Integer;
  2620. R: TFixedRect;
  2621. begin
  2622. Assert(Length(Points) > 0);
  2623. Result := PolygonBounds(Points[0]);
  2624. for I := 1 to High(Points) do
  2625. begin
  2626. R := PolygonBounds(Points[I]);
  2627. Result.Left := Min(Result.Left, R.Left);
  2628. Result.Right := Max(Result.Right, R.Right);
  2629. Result.Top := Min(Result.Top, R.Top);
  2630. Result.Bottom := Max(Result.Bottom, R.Bottom);
  2631. end;
  2632. end;
  2633. // Scales to a polygon (TArrayOfFloatPoint)
  2634. function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint;
  2635. var
  2636. I, L: Integer;
  2637. begin
  2638. L := Length(Points);
  2639. SetLength(Result, L);
  2640. for I := 0 to L - 1 do
  2641. begin
  2642. Result[I].X := Points[I].X * ScaleX;
  2643. Result[I].Y := Points[I].Y * ScaleY;
  2644. end;
  2645. end;
  2646. // Scales to a polygon (TArrayOfFixedPoint)
  2647. function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint;
  2648. var
  2649. I, L: Integer;
  2650. begin
  2651. L := Length(Points);
  2652. SetLength(Result, L);
  2653. for I := 0 to L - 1 do
  2654. begin
  2655. Result[I].X := FixedMul(Points[I].X, ScaleX);
  2656. Result[I].Y := FixedMul(Points[I].Y, ScaleY);
  2657. end;
  2658. end;
  2659. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2660. function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
  2661. ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint;
  2662. var
  2663. I, L: Integer;
  2664. begin
  2665. L := Length(Points);
  2666. SetLength(Result, L);
  2667. for I := 0 to L - 1 do
  2668. Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
  2669. end;
  2670. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2671. function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2672. ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint;
  2673. var
  2674. I, L: Integer;
  2675. begin
  2676. L := Length(Points);
  2677. SetLength(Result, L);
  2678. for I := 0 to L - 1 do
  2679. Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
  2680. end;
  2681. // Scales a polygon (TArrayOfFloatPoint)
  2682. procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat);
  2683. var
  2684. I: Integer;
  2685. begin
  2686. for I := 0 to Length(Points) - 1 do
  2687. begin
  2688. Points[I].X := Points[I].X * ScaleX;
  2689. Points[I].Y := Points[I].Y * ScaleY;
  2690. end;
  2691. end;
  2692. // Scales a polygon (TArrayOfFixedPoint)
  2693. procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed);
  2694. var
  2695. I: Integer;
  2696. begin
  2697. for I := 0 to Length(Points) - 1 do
  2698. begin
  2699. Points[I].X := FixedMul(Points[I].X, ScaleX);
  2700. Points[I].Y := FixedMul(Points[I].Y, ScaleY);
  2701. end;
  2702. end;
  2703. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2704. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint;
  2705. ScaleX, ScaleY: TFloat);
  2706. var
  2707. I: Integer;
  2708. begin
  2709. for I := 0 to Length(Points) - 1 do
  2710. ScalePolygonInplace(Points[I], ScaleX, ScaleY);
  2711. end;
  2712. // Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2713. procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
  2714. ScaleX, ScaleY: TFixed);
  2715. var
  2716. I: Integer;
  2717. begin
  2718. for I := 0 to Length(Points) - 1 do
  2719. ScalePolygonInplace(Points[I], ScaleX, ScaleY);
  2720. end;
  2721. // Translates a polygon (TArrayOfFloatPoint)
  2722. function TranslatePolygon(const Points: TArrayOfFloatPoint;
  2723. OffsetX, OffsetY: TFloat): TArrayOfFloatPoint;
  2724. var
  2725. I, Len: Integer;
  2726. begin
  2727. Len := Length(Points);
  2728. SetLength(Result, Len);
  2729. for I := 0 to Len - 1 do
  2730. begin
  2731. Result[I].X := Points[I].X + OffsetX;
  2732. Result[I].Y := Points[I].Y + OffsetY;
  2733. end;
  2734. end;
  2735. // Translates a polygon (TArrayOfFixedPoint)
  2736. function TranslatePolygon(const Points: TArrayOfFixedPoint;
  2737. OffsetX, OffsetY: TFixed): TArrayOfFixedPoint;
  2738. var
  2739. I, Len: Integer;
  2740. begin
  2741. Len := Length(Points);
  2742. SetLength(Result, Len);
  2743. for I := 0 to Len - 1 do
  2744. begin
  2745. Result[I].X := Points[I].X + OffsetX;
  2746. Result[I].Y := Points[I].Y + OffsetY;
  2747. end;
  2748. end;
  2749. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2750. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
  2751. OffsetY: TFloat): TArrayOfArrayOfFloatPoint;
  2752. var
  2753. I, L: Integer;
  2754. begin
  2755. L := Length(Points);
  2756. SetLength(Result, L);
  2757. for I := 0 to L - 1 do
  2758. Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
  2759. end;
  2760. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2761. function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2762. OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint;
  2763. var
  2764. I, L: Integer;
  2765. begin
  2766. L := Length(Points);
  2767. SetLength(Result, L);
  2768. for I := 0 to L - 1 do
  2769. Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
  2770. end;
  2771. procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint;
  2772. OffsetX, OffsetY: TFloat);
  2773. var
  2774. I: Integer;
  2775. begin
  2776. for I := 0 to Length(Points) - 1 do
  2777. begin
  2778. Points[I].X := Points[I].X + OffsetX;
  2779. Points[I].Y := Points[I].Y + OffsetY;
  2780. end;
  2781. end;
  2782. procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint;
  2783. OffsetX, OffsetY: TFixed);
  2784. var
  2785. I: Integer;
  2786. begin
  2787. for I := 0 to Length(Points) - 1 do
  2788. begin
  2789. Points[I].X := Points[I].X + OffsetX;
  2790. Points[I].Y := Points[I].Y + OffsetY;
  2791. end;
  2792. end;
  2793. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
  2794. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
  2795. OffsetY: TFloat);
  2796. var
  2797. I: Integer;
  2798. begin
  2799. for I := 0 to Length(Points) - 1 do
  2800. TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
  2801. end;
  2802. // Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
  2803. procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
  2804. OffsetX, OffsetY: TFixed);
  2805. var
  2806. I: Integer;
  2807. begin
  2808. for I := 0 to Length(Points) - 1 do
  2809. TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
  2810. end;
  2811. // Applies transformation to a polygon (TArrayOfFloatPoint)
  2812. function TransformPolygon(const Points: TArrayOfFloatPoint;
  2813. Transformation: TTransformation): TArrayOfFloatPoint;
  2814. var
  2815. I: Integer;
  2816. begin
  2817. SetLength(Result, Length(Points));
  2818. for I := 0 to High(Result) do
  2819. TTransformationAccess(Transformation).TransformFloat(Points[I].X,
  2820. Points[I].Y, Result[I].X, Result[I].Y);
  2821. end;
  2822. // Applies transformation to a polygon (TArrayOfFixedPoint)
  2823. function TransformPolygon(const Points: TArrayOfFixedPoint;
  2824. Transformation: TTransformation): TArrayOfFixedPoint;
  2825. var
  2826. I: Integer;
  2827. begin
  2828. SetLength(Result, Length(Points));
  2829. for I := 0 to High(Result) do
  2830. TTransformationAccess(Transformation).TransformFixed(Points[I].X,
  2831. Points[I].Y, Result[I].X, Result[I].Y);
  2832. end;
  2833. // Applies transformation to all sub polygons in a complex polygon
  2834. function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
  2835. Transformation: TTransformation): TArrayOfArrayOfFloatPoint;
  2836. var
  2837. I: Integer;
  2838. begin
  2839. SetLength(Result, Length(Points));
  2840. TTransformationAccess(Transformation).PrepareTransform;
  2841. for I := 0 to High(Result) do
  2842. Result[I] := TransformPolygon(Points[I], Transformation);
  2843. end;
  2844. // Applies transformation to all sub polygons in a complex polygon
  2845. function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
  2846. Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
  2847. var
  2848. I: Integer;
  2849. begin
  2850. SetLength(Result, Length(Points));
  2851. TTransformationAccess(Transformation).PrepareTransform;
  2852. for I := 0 to High(Result) do
  2853. Result[I] := TransformPolygon(Points[I], Transformation);
  2854. end;
  2855. function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint;
  2856. var
  2857. Index, Count: Integer;
  2858. begin
  2859. Count := Length(Data) div 2;
  2860. SetLength(Result, Count);
  2861. if Count = 0 then Exit;
  2862. for Index := 0 to Count - 1 do
  2863. begin
  2864. Result[Index].X := Data[Index * 2];
  2865. Result[Index].Y := Data[Index * 2 + 1];
  2866. end;
  2867. end;
  2868. function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint;
  2869. var
  2870. Index, Count: Integer;
  2871. begin
  2872. Count := Length(Data) div 2;
  2873. SetLength(Result, Count);
  2874. if Count = 0 then Exit;
  2875. for Index := 0 to Count - 1 do
  2876. begin
  2877. Result[Index].X := Data[Index * 2];
  2878. Result[Index].Y := Data[Index * 2 + 1];
  2879. end;
  2880. end;
  2881. // Copy data from Polygon to simple PolyPolygon (using 1 sub polygon only)
  2882. function PolyPolygon(const Points: TArrayOfFloatPoint)
  2883. : TArrayOfArrayOfFloatPoint;
  2884. begin
  2885. SetLength(Result, 1);
  2886. Result[0] := Points;
  2887. end;
  2888. function PolyPolygon(const Points: TArrayOfFixedPoint)
  2889. : TArrayOfArrayOfFixedPoint;
  2890. begin
  2891. SetLength(Result, 1);
  2892. Result[0] := Points;
  2893. end;
  2894. function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint;
  2895. var
  2896. Index: Integer;
  2897. begin
  2898. if Length(Points) > 0 then
  2899. begin
  2900. SetLength(Result, Length(Points));
  2901. for Index := 0 to Length(Points) - 1 do
  2902. begin
  2903. Result[Index].X := Points[Index].X;
  2904. Result[Index].Y := Points[Index].Y;
  2905. end;
  2906. end;
  2907. end;
  2908. function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint;
  2909. var
  2910. Index, PointIndex: Integer;
  2911. begin
  2912. if Length(Points) > 0 then
  2913. begin
  2914. SetLength(Result, Length(Points));
  2915. for Index := 0 to Length(Points) - 1 do
  2916. begin
  2917. SetLength(Result[Index], Length(Points[Index]));
  2918. for PointIndex := 0 to Length(Points[Index]) - 1 do
  2919. begin
  2920. Result[Index, PointIndex].X := Points[Index, PointIndex].X;
  2921. Result[Index, PointIndex].Y := Points[Index, PointIndex].Y;
  2922. end;
  2923. end;
  2924. end;
  2925. end;
  2926. function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint;
  2927. var
  2928. Index: Integer;
  2929. begin
  2930. if Length(Points) > 0 then
  2931. begin
  2932. SetLength(Result, Length(Points));
  2933. for Index := 0 to Length(Points) - 1 do
  2934. begin
  2935. Result[Index].X := Fixed(Points[Index].X);
  2936. Result[Index].Y := Fixed(Points[Index].Y);
  2937. end;
  2938. end;
  2939. end;
  2940. function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint;
  2941. var
  2942. Index, PointIndex: Integer;
  2943. begin
  2944. if Length(Points) > 0 then
  2945. begin
  2946. SetLength(Result, Length(Points));
  2947. for Index := 0 to Length(Points) - 1 do
  2948. begin
  2949. SetLength(Result[Index], Length(Points[Index]));
  2950. for PointIndex := 0 to Length(Points[Index]) - 1 do
  2951. begin
  2952. Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
  2953. Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
  2954. end;
  2955. end;
  2956. end;
  2957. end;
  2958. // Converts an array of points in TFixed format to an array of points in TFloat format
  2959. function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint)
  2960. : TArrayOfFloatPoint;
  2961. var
  2962. Index: Integer;
  2963. begin
  2964. if Length(Points) > 0 then
  2965. begin
  2966. SetLength(Result, Length(Points));
  2967. for Index := 0 to Length(Points) - 1 do
  2968. begin
  2969. Result[Index].X := Points[Index].X * FixedToFloat;
  2970. Result[Index].Y := Points[Index].Y * FixedToFloat;
  2971. end;
  2972. end;
  2973. end;
  2974. // Converts an array of array of points in TFixed format to an array of array of points in TFloat format
  2975. function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint)
  2976. : TArrayOfArrayOfFloatPoint;
  2977. var
  2978. Index, PointIndex: Integer;
  2979. begin
  2980. if Length(Points) > 0 then
  2981. begin
  2982. SetLength(Result, Length(Points));
  2983. for Index := 0 to Length(Points) - 1 do
  2984. begin
  2985. SetLength(Result[Index], Length(Points[Index]));
  2986. for PointIndex := 0 to Length(Points[Index]) - 1 do
  2987. begin
  2988. Result[Index, PointIndex].X := Points[Index, PointIndex].X * FixedToFloat;
  2989. Result[Index, PointIndex].Y := Points[Index, PointIndex].Y * FixedToFloat;
  2990. end;
  2991. end;
  2992. end;
  2993. end;
  2994. // Converts an array of points in TFixed format to an array of points in TFloat format
  2995. function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint)
  2996. : TArrayOfFixedPoint;
  2997. var
  2998. Index: Integer;
  2999. begin
  3000. if Length(Points) > 0 then
  3001. begin
  3002. SetLength(Result, Length(Points));
  3003. for Index := 0 to Length(Points) - 1 do
  3004. begin
  3005. Result[Index].X := Fixed(Points[Index].X);
  3006. Result[Index].Y := Fixed(Points[Index].Y);
  3007. end;
  3008. end;
  3009. end;
  3010. // Converts an array of array of points in TFixed format to an array of array of points in TFloat format
  3011. function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint)
  3012. : TArrayOfArrayOfFixedPoint;
  3013. var
  3014. Index, PointIndex: Integer;
  3015. begin
  3016. if Length(Points) > 0 then
  3017. begin
  3018. SetLength(Result, Length(Points));
  3019. for Index := 0 to Length(Points) - 1 do
  3020. begin
  3021. SetLength(Result[Index], Length(Points[Index]));
  3022. for PointIndex := 0 to Length(Points[Index]) - 1 do
  3023. begin
  3024. Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
  3025. Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
  3026. end;
  3027. end;
  3028. end;
  3029. end;
  3030. end.