2
0

Clipper.Core.pas 72 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421
  1. unit Clipper.Core;
  2. (*******************************************************************************
  3. * Author : Angus Johnson *
  4. * Date : 22 November 2024 *
  5. * Website : http://www.angusj.com *
  6. * Copyright : Angus Johnson 2010-2024 *
  7. * Purpose : Core Clipper Library module *
  8. * Contains structures and functions used throughout the library *
  9. * License : http://www.boost.org/LICENSE_1_0.txt *
  10. *******************************************************************************)
  11. {$I Clipper.inc}
  12. interface
  13. uses
  14. SysUtils, Classes, Math;
  15. type
  16. {$IFDEF USINGZ}
  17. ZType = Int64; // or alternatively, ZType = double
  18. {$ENDIF}
  19. PPoint64 = ^TPoint64;
  20. TPoint64 = record
  21. X, Y: Int64;
  22. {$IFDEF USINGZ}
  23. Z: ZType;
  24. {$ENDIF}
  25. end;
  26. PPointD = ^TPointD;
  27. TPointD = record
  28. X, Y: double;
  29. {$IFDEF USINGZ}
  30. Z: ZType;
  31. {$ENDIF}
  32. end;
  33. // Path: a simple data structure representing a series of vertices, whether
  34. // open (poly-line) or closed (polygon). Paths may be simple or complex (self
  35. // intersecting). For simple polygons, consisting of a single non-intersecting
  36. // path, path orientation is unimportant. However, for complex polygons and
  37. // for overlapping polygons, various 'filling rules' define which regions will
  38. // be inside (filled) and which will be outside (unfilled).
  39. TPath64 = array of TPoint64;
  40. TPaths64 = array of TPath64;
  41. TArrayOfPaths = array of TPaths64;
  42. TPathD = array of TPointD;
  43. TPathsD = array of TPathD;
  44. TArrayOfPathsD = array of TPathsD;
  45. // The most commonly used filling rules for polygons are EvenOdd and NonZero.
  46. // https://en.wikipedia.org/wiki/Even-odd_rule
  47. // https://en.wikipedia.org/wiki/Nonzero-rule
  48. TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);
  49. TArrayOfBoolean = array of Boolean;
  50. TArrayOfInteger = array of Integer;
  51. TArrayOfDouble = array of double;
  52. TRect64 = {$IFDEF RECORD_METHODS}record{$ELSE}object{$ENDIF}
  53. private
  54. function GetWidth: Int64; {$IFDEF INLINING} inline; {$ENDIF}
  55. function GetHeight: Int64; {$IFDEF INLINING} inline; {$ENDIF}
  56. function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  57. function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  58. function GetMidPoint: TPoint64; {$IFDEF INLINING} inline; {$ENDIF}
  59. public
  60. Left : Int64;
  61. Top : Int64;
  62. Right : Int64;
  63. Bottom : Int64;
  64. function Contains(const pt: TPoint64; inclusive: Boolean = false): Boolean; overload;
  65. function Contains(const rec: TRect64): Boolean; overload;
  66. function Intersect(const rec: TRect64): TRect64;
  67. function Intersects(const rec: TRect64): Boolean;
  68. function AsPath: TPath64;
  69. property Width: Int64 read GetWidth;
  70. property Height: Int64 read GetHeight;
  71. property IsEmpty: Boolean read GetIsEmpty;
  72. property IsValid: Boolean read GetIsValid;
  73. property MidPoint: TPoint64 read GetMidPoint;
  74. end;
  75. TRectD = {$ifdef RECORD_METHODS}record{$else}object{$endif}
  76. private
  77. function GetWidth: double; {$IFDEF INLINING} inline; {$ENDIF}
  78. function GetHeight: double; {$IFDEF INLINING} inline; {$ENDIF}
  79. function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  80. function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF}
  81. function GetMidPoint: TPointD; {$IFDEF INLINING} inline; {$ENDIF}
  82. public
  83. Left : double;
  84. Top : double;
  85. Right : double;
  86. Bottom : double;
  87. function Contains(const pt: TPointD): Boolean; overload;
  88. function Contains(const rec: TRectD): Boolean; overload;
  89. function Intersects(const rec: TRectD): Boolean;
  90. function AsPath: TPathD;
  91. property Width: double read GetWidth;
  92. property Height: double read GetHeight;
  93. property IsEmpty: Boolean read GetIsEmpty;
  94. property IsValid: Boolean read GetIsValid;
  95. property MidPoint: TPointD read GetMidPoint;
  96. end;
  97. {$IFDEF FPC}
  98. TPointerList = array of Pointer;
  99. TListSortCompareFunc = function (Item1, Item2: Pointer): Integer;
  100. {$ELSE}
  101. {$IF COMPILERVERSION < 23} //PRIOR DELPHI XE2
  102. TPointerList = array of Pointer;
  103. TListSortCompareFunc = function (Item1, Item2: Pointer): Integer;
  104. {$IFEND}
  105. {$ENDIF}
  106. TListEx = class
  107. private
  108. fCount : integer;
  109. fCapacity : integer;
  110. fList : TPointerList;
  111. fSorted : Boolean;
  112. protected
  113. function UnsafeGet(idx: integer): Pointer; // no range checking
  114. procedure UnsafeSet(idx: integer; val: Pointer);
  115. procedure UnsafeDelete(index: integer); virtual;
  116. public
  117. constructor Create(capacity: integer = 0); virtual;
  118. destructor Destroy; override;
  119. procedure Clear; virtual;
  120. function Add(item: Pointer): integer;
  121. procedure DeleteLast;
  122. procedure Swap(idx1, idx2: integer);
  123. procedure Sort(Compare: TListSortCompareFunc);
  124. procedure Resize(count: integer);
  125. property Count: integer read fCount;
  126. property Sorted: Boolean read fSorted;
  127. property Item[idx: integer]: Pointer read UnsafeGet; default;
  128. end;
  129. TClipType = (ctNoClip, ctIntersection, ctUnion, ctDifference, ctXor);
  130. TPointInPolygonResult = (pipOn, pipInside, pipOutside);
  131. EClipper2LibException = class(Exception);
  132. function Area(const path: TPath64): Double; overload;
  133. function Area(const paths: TPaths64): Double; overload;
  134. {$IFDEF INLINING} inline; {$ENDIF}
  135. function Area(const path: TPathD): Double; overload;
  136. function Area(const paths: TPathsD): Double; overload;
  137. {$IFDEF INLINING} inline; {$ENDIF}
  138. function IsPositive(const path: TPath64): Boolean; overload;
  139. {$IFDEF INLINING} inline; {$ENDIF}
  140. function IsPositive(const path: TPathD): Boolean; overload;
  141. {$IFDEF INLINING} inline; {$ENDIF}
  142. function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
  143. function CrossProduct(const pt1, pt2, pt3: TPoint64): double; overload;
  144. {$IFDEF INLINING} inline; {$ENDIF}
  145. function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload;
  146. {$IFDEF INLINING} inline; {$ENDIF}
  147. function CrossProduct(const vec1, vec2: TPointD): double; overload;
  148. {$IFDEF INLINING} inline; {$ENDIF}
  149. function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double; overload;
  150. {$IFDEF INLINING} inline; {$ENDIF}
  151. function DotProduct(const pt1, pt2, pt3: TPoint64): double;
  152. {$IFDEF INLINING} inline; {$ENDIF}
  153. function DistanceSqr(const pt1, pt2: TPoint64): double; overload;
  154. {$IFDEF INLINING} inline; {$ENDIF}
  155. function DistanceSqr(const pt1, pt2: TPointD): double; overload;
  156. {$IFDEF INLINING} inline; {$ENDIF}
  157. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; overload;
  158. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; overload;
  159. function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64;
  160. inclusive: Boolean = false): boolean; {$IFDEF INLINING} inline; {$ENDIF}
  161. function PointsEqual(const pt1, pt2: TPoint64): Boolean; overload;
  162. {$IFDEF INLINING} inline; {$ENDIF}
  163. function PointsNearEqual(const pt1, pt2: TPointD): Boolean; overload;
  164. {$IFDEF INLINING} inline; {$ENDIF}
  165. function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean; overload;
  166. {$IFDEF INLINING} inline; {$ENDIF}
  167. {$IFDEF USINGZ}
  168. function Point64(const X, Y: Int64; Z: ZType = 0): TPoint64; overload;
  169. {$IFDEF INLINING} inline; {$ENDIF}
  170. function Point64(const X, Y: Double; Z: ZType = 0): TPoint64; overload;
  171. {$IFDEF INLINING} inline; {$ENDIF}
  172. function PointD(const X, Y: Double; Z: ZType = 0): TPointD; overload;
  173. {$IFDEF INLINING} inline; {$ENDIF}
  174. {$ELSE}
  175. function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  176. function Point64(const X, Y: Double): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  177. function PointD(const X, Y: Double): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  178. {$ENDIF}
  179. function Negate(const pt: TPoint64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  180. function Negate(const pt: TPointD): TPointD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  181. function NegatePath(const path: TPathD): TPathD; overload; {$IFDEF INLINING} inline; {$ENDIF}
  182. function Point64(const pt: TPointD): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
  183. function PointD(const pt: TPoint64): TPointD; overload;
  184. {$IFDEF INLINING} inline; {$ENDIF}
  185. function Rect64(const left, top, right, bottom: Int64): TRect64; overload;
  186. {$IFDEF INLINING} inline; {$ENDIF}
  187. function Rect64(const recD: TRectD): TRect64; overload;
  188. {$IFDEF INLINING} inline; {$ENDIF}
  189. function RectD(const left, top, right, bottom: double): TRectD; overload;
  190. {$IFDEF INLINING} inline; {$ENDIF}
  191. function RectD(const rec64: TRect64): TRectD; overload;
  192. {$IFDEF INLINING} inline; {$ENDIF}
  193. function GetBounds(const paths: TArrayOfPaths): TRect64; overload;
  194. function GetBounds(const paths: TPaths64): TRect64; overload;
  195. function GetBounds(const paths: TPathsD): TRectD; overload;
  196. function GetBounds(const path: TPath64): TRect64; overload;
  197. function GetBounds(const path: TPathD): TRectD; overload;
  198. function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64; overload;
  199. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload;
  200. procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double);
  201. procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double);
  202. procedure InflateRect(var rec: TRect64; dx, dy: Int64); overload;
  203. {$IFDEF INLINING} inline; {$ENDIF}
  204. procedure InflateRect(var rec: TRectD; dx, dy: double); overload;
  205. {$IFDEF INLINING} inline; {$ENDIF}
  206. function UnionRect(const rec, rec2: TRect64): TRect64; overload;
  207. {$IFDEF INLINING} inline; {$ENDIF}
  208. function UnionRect(const rec, rec2: TRectD): TRectD; overload;
  209. {$IFDEF INLINING} inline; {$ENDIF}
  210. function RotateRect(const rec: TRect64; angleRad: double): TRect64; overload;
  211. function RotateRect(const rec: TRectD; angleRad: double): TRectD; overload;
  212. procedure OffsetRect(var rec: TRect64; dx, dy: Int64); overload;
  213. {$IFDEF INLINING} inline; {$ENDIF}
  214. procedure OffsetRect(var rec: TRectD; dx, dy: double); overload;
  215. {$IFDEF INLINING} inline; {$ENDIF}
  216. function ScaleRect(const rec: TRect64; scale: double): TRect64; overload;
  217. {$IFDEF INLINING} inline; {$ENDIF}
  218. function ScaleRect(const rec: TRectD; scale: double): TRectD; overload;
  219. {$IFDEF INLINING} inline; {$ENDIF}
  220. function ScalePoint(const pt: TPoint64; scale: double): TPointD; overload;
  221. {$IFDEF INLINING} inline; {$ENDIF}
  222. function ScalePoint(const pt: TPointD; scale: double): TPointD; overload;
  223. {$IFDEF INLINING} inline; {$ENDIF}
  224. function ScalePath(const path: TPath64; sx, sy: double): TPath64; overload;
  225. function ScalePath(const path: TPathD; sx, sy: double): TPath64; overload;
  226. function ScalePath(const path: TPath64; scale: double): TPath64; overload;
  227. function ScalePath(const path: TPathD; scale: double): TPath64; overload;
  228. function ScalePathD(const path: TPath64; sx, sy: double): TPathD; overload;
  229. function ScalePathD(const path: TPathD; sx, sy: double): TPathD; overload;
  230. function ScalePathD(const path: TPath64; scale: double): TPathD; overload;
  231. function ScalePathD(const path: TPathD; scale: double): TPathD; overload;
  232. function ScalePaths(const paths: TPaths64; sx, sy: double): TPaths64; overload;
  233. function ScalePaths(const paths: TPathsD; sx, sy: double): TPaths64; overload;
  234. function ScalePaths(const paths: TPaths64; scale: double): TPaths64; overload;
  235. function ScalePaths(const paths: TPathsD; scale: double): TPaths64; overload;
  236. function ScalePathsD(const paths: TPaths64; sx, sy: double): TPathsD; overload;
  237. function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD; overload;
  238. function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload;
  239. function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload;
  240. function Path64(const pathD: TPathD): TPath64;
  241. function PathD(const path: TPath64): TPathD;
  242. function Paths64(const path: TPath64): TPaths64; overload;
  243. function Paths64(const pathsD: TPathsD): TPaths64; overload;
  244. function PathsD(const paths: TPaths64): TPathsD; overload;
  245. function PathsD(const path: TPathD): TPathsD; overload;
  246. function StripDuplicates(const path: TPath64; isClosedPath: Boolean = false): TPath64;
  247. function StripNearDuplicates(const path: TPathD;
  248. minLenSqrd: double; isClosedPath: Boolean): TPathD;
  249. function ValueBetween(val, end1, end2: Int64): Boolean;
  250. {$IFDEF INLINING} inline; {$ENDIF}
  251. function ValueEqualOrBetween(val, end1, end2: Int64): Boolean;
  252. {$IFDEF INLINING} inline; {$ENDIF}
  253. function ReversePath(const path: TPath64): TPath64; overload;
  254. {$IFDEF INLINING} inline; {$ENDIF}
  255. function ReversePath(const path: TPathD): TPathD; overload;
  256. function ReversePaths(const paths: TPaths64): TPaths64; overload;
  257. {$IFDEF INLINING} inline; {$ENDIF}
  258. function ReversePaths(const paths: TPathsD): TPathsD; overload;
  259. {$IFDEF INLINING} inline; {$ENDIF}
  260. function ShiftPath(const path: TPath64; shift: integer): TPath64; overload;
  261. {$IFDEF INLINING} inline; {$ENDIF}
  262. function ShiftPath(const path: TPathD; shift: integer): TPathD; overload;
  263. {$IFDEF INLINING} inline; {$ENDIF}
  264. procedure AppendPoint(var path: TPath64; const pt: TPoint64); overload;
  265. {$IFDEF INLINING} inline; {$ENDIF}
  266. procedure AppendPoint(var path: TPathD; const pt: TPointD); overload;
  267. {$IFDEF INLINING} inline; {$ENDIF}
  268. function AppendPoints(const path, extra: TPath64): TPath64;
  269. {$IFDEF INLINING} inline; {$ENDIF}
  270. procedure AppendPath(var paths: TPaths64; const extra: TPath64); overload;
  271. procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload;
  272. procedure AppendPaths(var paths: TPaths64; const extra: TPaths64); overload;
  273. procedure AppendPaths(var paths: TPathsD; const extra: TPathsD); overload;
  274. function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
  275. function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64;
  276. out ip: TPoint64): Boolean;
  277. function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult;
  278. function GetClosestPointOnSegment(const pt, seg1, seg2: TPoint64): TPoint64;
  279. {$IFDEF INLINING} inline; {$ENDIF}
  280. function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64; overload;
  281. function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64; overload;
  282. function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload;
  283. function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload;
  284. procedure GetSinCos(angle: double; out sinA, cosA: double);
  285. function Ellipse(const rec: TRect64; steps: integer = 0): TPath64; overload;
  286. function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload;
  287. procedure QuickSort(SortList: TPointerList;
  288. L, R: Integer; const SCompare: TListSortCompareFunc);
  289. procedure CheckPrecisionRange(var precision: integer);
  290. function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean; overload;
  291. function Iif(eval: Boolean; trueVal, falseVal: integer): integer; overload;
  292. function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64; overload;
  293. function Iif(eval: Boolean; trueVal, falseVal: double): double; overload;
  294. const
  295. MaxInt64 = 9223372036854775807;
  296. MinInt64 = -MaxInt64;
  297. MaxCoord = MaxInt64 div 4;
  298. MinCoord = - MaxCoord;
  299. invalid64 = MaxInt64;
  300. invalidD = infinity;
  301. NullPointD : TPointD = (X: 0; Y: 0);
  302. NullRect64 : TRect64 = (left: 0; top: 0; right: 0; Bottom: 0);
  303. InvalidPt64 : TPoint64 = (X: invalid64; Y: invalid64);
  304. InvalidPtD : TPointD = (X: invalidD; Y: invalidD);
  305. NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0);
  306. InvalidRect64 : TRect64 =
  307. (left: invalid64; top: invalid64; right: invalid64; bottom: invalid64);
  308. InvalidRectD : TRectD =
  309. (left: invalidD; top: invalidD; right: invalidD; bottom: invalidD);
  310. Tolerance : Double = 1.0E-12;
  311. //https://github.com/AngusJohnson/Clipper2/discussions/564
  312. MaxDecimalPrecision = 8;
  313. implementation
  314. resourcestring
  315. rsClipper_PrecisonErr = 'The decimal rounding value is invalid';
  316. //------------------------------------------------------------------------------
  317. // TRect64 methods ...
  318. //------------------------------------------------------------------------------
  319. function TRect64.GetWidth: Int64;
  320. begin
  321. result := right - left;
  322. end;
  323. //------------------------------------------------------------------------------
  324. function TRect64.GetHeight: Int64;
  325. begin
  326. result := bottom - top;
  327. end;
  328. //------------------------------------------------------------------------------
  329. function TRect64.GetIsEmpty: Boolean;
  330. begin
  331. result := (bottom <= top) or (right <= left);
  332. end;
  333. //------------------------------------------------------------------------------
  334. function TRect64.GetIsValid: Boolean;
  335. begin
  336. result := left <> invalid64;
  337. end;
  338. //------------------------------------------------------------------------------
  339. function TRect64.GetMidPoint: TPoint64;
  340. begin
  341. result := Point64((Left + Right) div 2, (Top + Bottom) div 2);
  342. end;
  343. //------------------------------------------------------------------------------
  344. function TRect64.Contains(const pt: TPoint64; inclusive: Boolean = false): Boolean;
  345. begin
  346. if inclusive then
  347. result := (pt.X >= Left) and (pt.X <= Right) and
  348. (pt.Y >= Top) and (pt.Y <= Bottom)
  349. else
  350. result := (pt.X > Left) and (pt.X < Right) and
  351. (pt.Y > Top) and (pt.Y < Bottom);
  352. end;
  353. //------------------------------------------------------------------------------
  354. function TRect64.Contains(const rec: TRect64): Boolean;
  355. begin
  356. result := (rec.Left >= Left) and (rec.Right <= Right) and
  357. (rec.Top >= Top) and (rec.Bottom <= Bottom);
  358. end;
  359. //------------------------------------------------------------------------------
  360. function TRect64.Intersects(const rec: TRect64): Boolean;
  361. begin
  362. Result := (Max(Left, rec.Left) <= Min(Right, rec.Right)) and
  363. (Max(Top, rec.Top) <= Min(Bottom, rec.Bottom));
  364. end;
  365. //------------------------------------------------------------------------------
  366. function TRect64.Intersect(const rec: TRect64): TRect64;
  367. begin
  368. Result.Left := Max(Left, rec.Left);
  369. Result.Top := Max(Top, rec.Top);
  370. Result.Right := Min(Right, rec.Right);
  371. Result.Bottom := Min(Bottom, rec.Bottom);
  372. if IsEmpty then Result := NullRect64;
  373. end;
  374. //------------------------------------------------------------------------------
  375. function TRect64.AsPath: TPath64;
  376. begin
  377. SetLength(Result, 4);
  378. Result[0] := Point64(Left, Top);
  379. Result[1] := Point64(Right, Top);
  380. Result[2] := Point64(Right, Bottom);
  381. Result[3] := Point64(Left, Bottom);
  382. end;
  383. //------------------------------------------------------------------------------
  384. // TRectD methods ...
  385. //------------------------------------------------------------------------------
  386. function TRectD.GetWidth: double;
  387. begin
  388. result := right - left;
  389. end;
  390. //------------------------------------------------------------------------------
  391. function TRectD.GetHeight: double;
  392. begin
  393. result := bottom - top;
  394. end;
  395. //------------------------------------------------------------------------------
  396. function TRectD.GetIsEmpty: Boolean;
  397. begin
  398. result := (bottom <= top) or (right <= left);
  399. end;
  400. //------------------------------------------------------------------------------
  401. function TRectD.GetIsValid: Boolean;
  402. begin
  403. result := left <> invalidD;
  404. end;
  405. //------------------------------------------------------------------------------
  406. function TRectD.GetMidPoint: TPointD;
  407. begin
  408. result := PointD((Left + Right) *0.5, (Top + Bottom) *0.5);
  409. end;
  410. //------------------------------------------------------------------------------
  411. function TRectD.Contains(const pt: TPointD): Boolean;
  412. begin
  413. result := (pt.X > Left) and (pt.X < Right) and
  414. (pt.Y > Top) and (pt.Y < Bottom);
  415. end;
  416. //------------------------------------------------------------------------------
  417. function TRectD.Contains(const rec: TRectD): Boolean;
  418. begin
  419. result := (rec.Left >= Left) and (rec.Right <= Right) and
  420. (rec.Top >= Top) and (rec.Bottom <= Bottom);
  421. end;
  422. //------------------------------------------------------------------------------
  423. function TRectD.Intersects(const rec: TRectD): Boolean;
  424. begin
  425. Result := (Max(Left, rec.Left) <= Min(Right, rec.Right)) and
  426. (Max(Top, rec.Top) <= Min(Bottom, rec.Bottom));
  427. end;
  428. //------------------------------------------------------------------------------
  429. function TRectD.AsPath: TPathD;
  430. begin
  431. SetLength(Result, 4);
  432. Result[0] := PointD(Left, Top);
  433. Result[1] := PointD(Right, Top);
  434. Result[2] := PointD(Right, Bottom);
  435. Result[3] := PointD(Left, Bottom);
  436. end;
  437. //------------------------------------------------------------------------------
  438. // TListEx class
  439. //------------------------------------------------------------------------------
  440. constructor TListEx.Create(capacity: integer);
  441. begin
  442. if capacity > 0 then
  443. begin
  444. fCapacity := 16;
  445. while capacity > fCapacity do fCapacity := fCapacity * 2;
  446. SetLength(fList, fCapacity);
  447. end;
  448. end;
  449. //------------------------------------------------------------------------------
  450. destructor TListEx.Destroy;
  451. begin
  452. Clear;
  453. inherited;
  454. end;
  455. //------------------------------------------------------------------------------
  456. procedure TListEx.Clear;
  457. begin
  458. fList := nil;
  459. fCount := 0;
  460. fCapacity := 0;
  461. fSorted := false;
  462. end;
  463. //------------------------------------------------------------------------------
  464. function TListEx.Add(item: Pointer): integer;
  465. begin
  466. if fCount = fCapacity then
  467. begin
  468. if fCapacity = 0 then
  469. fCapacity := 16 else
  470. fCapacity := fCapacity *2;
  471. SetLength(fList, fCapacity);
  472. end;
  473. fList[fCount] := item;
  474. Result := fCount;
  475. inc(fCount);
  476. fSorted := false;
  477. end;
  478. //------------------------------------------------------------------------------
  479. procedure TListEx.DeleteLast;
  480. begin
  481. dec(fCount);
  482. end;
  483. //------------------------------------------------------------------------------
  484. procedure QuickSort(SortList: TPointerList; L, R: Integer;
  485. const SCompare: TListSortCompareFunc);
  486. var
  487. I, J: Integer;
  488. P, T: Pointer;
  489. begin
  490. if L >= R then Exit;
  491. repeat
  492. if (R - L) = 1 then
  493. begin
  494. if SCompare(SortList[L], SortList[R]) > 0 then
  495. begin
  496. T := SortList[L];
  497. SortList[L] := SortList[R];
  498. SortList[R] := T;
  499. end;
  500. break;
  501. end;
  502. I := L;
  503. J := R;
  504. P := SortList[(L + R) shr 1];
  505. repeat
  506. while SCompare(SortList[I], P) < 0 do Inc(I);
  507. while SCompare(SortList[J], P) > 0 do Dec(J);
  508. if I <= J then
  509. begin
  510. if I <> J then
  511. begin
  512. T := SortList[I];
  513. SortList[I] := SortList[J];
  514. SortList[J] := T;
  515. end;
  516. Inc(I);
  517. Dec(J);
  518. end;
  519. until I > J;
  520. if (J - L) > (R - I) then
  521. begin
  522. if I < R then QuickSort(SortList, I, R, SCompare);
  523. R := J;
  524. end
  525. else
  526. begin
  527. if L < J then QuickSort(SortList, L, J, SCompare);
  528. L := I;
  529. end;
  530. until L >= R;
  531. end;
  532. //------------------------------------------------------------------------------
  533. procedure TListEx.Sort(Compare: TListSortCompareFunc);
  534. begin
  535. if fCount < 2 then Exit;
  536. QuickSort(FList, 0, fCount - 1, Compare);
  537. fSorted := true;
  538. end;
  539. //------------------------------------------------------------------------------
  540. procedure TListEx.Resize(count: integer);
  541. begin
  542. if (fCapacity = 0) then fCapacity := 16;
  543. while count > fCapacity do fCapacity := fCapacity * 2;
  544. SetLength(fList, fCapacity);
  545. fCount := count;
  546. end;
  547. //------------------------------------------------------------------------------
  548. function TListEx.UnsafeGet(idx: integer): Pointer;
  549. begin
  550. Result := fList[idx];
  551. end;
  552. //------------------------------------------------------------------------------
  553. procedure TListEx.UnsafeSet(idx: integer; val: Pointer);
  554. begin
  555. fList[idx] := val;
  556. end;
  557. //------------------------------------------------------------------------------
  558. procedure TListEx.UnsafeDelete(index: integer);
  559. begin
  560. dec(fCount);
  561. if index < fCount then
  562. Move(fList[index +1], fList[index], (fCount - index) * SizeOf(Pointer));
  563. end;
  564. //------------------------------------------------------------------------------
  565. procedure TListEx.Swap(idx1, idx2: integer);
  566. var
  567. p: Pointer;
  568. begin
  569. p := fList[idx1];
  570. fList[idx1] := fList[idx2];
  571. fList[idx2] := p;
  572. fSorted := false;
  573. end;
  574. //------------------------------------------------------------------------------
  575. // Miscellaneous Functions ...
  576. //------------------------------------------------------------------------------
  577. function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean;
  578. {$IFDEF INLINING} inline; {$ENDIF}
  579. begin
  580. if eval then Result := trueVal else Result := falseVal;
  581. end;
  582. //------------------------------------------------------------------------------
  583. function Iif(eval: Boolean; trueVal, falseVal: integer): integer;
  584. {$IFDEF INLINING} inline; {$ENDIF}
  585. begin
  586. if eval then Result := trueVal else Result := falseVal;
  587. end;
  588. //------------------------------------------------------------------------------
  589. function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64;
  590. {$IFDEF INLINING} inline; {$ENDIF}
  591. begin
  592. if eval then Result := trueVal else Result := falseVal;
  593. end;
  594. //------------------------------------------------------------------------------
  595. function Iif(eval: Boolean; trueVal, falseVal: double): double;
  596. {$IFDEF INLINING} inline; {$ENDIF}
  597. begin
  598. if eval then Result := trueVal else Result := falseVal;
  599. end;
  600. //------------------------------------------------------------------------------
  601. procedure CheckPrecisionRange(var precision: integer);
  602. begin
  603. if (precision < -MaxDecimalPrecision) or (precision > MaxDecimalPrecision) then
  604. Raise EClipper2LibException(rsClipper_PrecisonErr);
  605. end;
  606. //------------------------------------------------------------------------------
  607. procedure RaiseError(const msg: string); {$IFDEF INLINING} inline; {$ENDIF}
  608. begin
  609. raise EClipper2LibException.Create(msg);
  610. end;
  611. //------------------------------------------------------------------------------
  612. function PointsEqual(const pt1, pt2: TPoint64): Boolean;
  613. begin
  614. Result := (pt1.X = pt2.X) and (pt1.Y = pt2.Y);
  615. end;
  616. //------------------------------------------------------------------------------
  617. function PointsNearEqual(const pt1, pt2: TPointD): Boolean;
  618. begin
  619. Result := (Abs(pt1.X - pt2.X) < Tolerance) and
  620. (Abs(pt1.Y - pt2.Y) < Tolerance);
  621. end;
  622. //------------------------------------------------------------------------------
  623. function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean;
  624. begin
  625. Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distanceSqrd;
  626. end;
  627. //------------------------------------------------------------------------------
  628. function StripDuplicates(const path: TPath64; isClosedPath: Boolean): TPath64;
  629. var
  630. i,j, len: integer;
  631. begin
  632. len := length(path);
  633. SetLength(Result, len);
  634. if len = 0 then Exit;
  635. Result[0] := path[0];
  636. j := 0;
  637. for i := 1 to len -1 do
  638. if not PointsEqual(Result[j], path[i]) then
  639. begin
  640. inc(j);
  641. Result[j] := path[i];
  642. end;
  643. if isClosedPath and PointsEqual(Result[0], path[j]) then dec(j);
  644. SetLength(Result, j +1);
  645. end;
  646. //------------------------------------------------------------------------------
  647. function StripNearDuplicates(const path: TPathD;
  648. minLenSqrd: double; isClosedPath: Boolean): TPathD;
  649. var
  650. i,j, len: integer;
  651. begin
  652. len := length(path);
  653. SetLength(Result, len);
  654. if len = 0 then Exit;
  655. Result[0] := path[0];
  656. j := 0;
  657. for i := 1 to len -1 do
  658. if not PointsNearEqual(Result[j], path[i], minLenSqrd) then
  659. begin
  660. inc(j);
  661. Result[j] := path[i];
  662. end;
  663. if isClosedPath and
  664. PointsNearEqual(Result[j], Result[0], minLenSqrd) then dec(j);
  665. SetLength(Result, j +1);
  666. end;
  667. //------------------------------------------------------------------------------
  668. function ValueBetween(val, end1, end2: Int64): Boolean;
  669. begin
  670. // nb: accommodates axis aligned between where end1 == end2
  671. Result := ((val <> end1) = (val <> end2)) and
  672. ((val > end1) = (val < end2));
  673. end;
  674. //------------------------------------------------------------------------------
  675. function ValueEqualOrBetween(val, end1, end2: Int64): Boolean;
  676. begin
  677. Result := (val = end1) or (val = end2) or
  678. ((val > end1) = (val < end2));
  679. end;
  680. //------------------------------------------------------------------------------
  681. function ScaleRect(const rec: TRect64; scale: double): TRect64;
  682. begin
  683. Result.Left := Round(rec.Left * scale);
  684. Result.Top := Round(rec.Top * scale);
  685. Result.Right := Round(rec.Right * scale);
  686. Result.Bottom := Round(rec.Bottom * scale);
  687. end;
  688. //------------------------------------------------------------------------------
  689. function ScaleRect(const rec: TRectD; scale: double): TRectD;
  690. begin
  691. Result.Left := rec.Left * scale;
  692. Result.Top := rec.Top * scale;
  693. Result.Right := rec.Right * scale;
  694. Result.Bottom := rec.Bottom * scale;
  695. end;
  696. //------------------------------------------------------------------------------
  697. function ScalePoint(const pt: TPoint64; scale: double): TPointD;
  698. begin
  699. Result.X := pt.X * scale;
  700. Result.Y := pt.Y * scale;
  701. {$IFDEF USINGZ}
  702. Result.Z := pt.Z;
  703. {$ENDIF}
  704. end;
  705. //------------------------------------------------------------------------------
  706. function ScalePoint(const pt: TPointD; scale: double): TPointD;
  707. begin
  708. Result.X := pt.X * scale;
  709. Result.Y := pt.Y * scale;
  710. {$IFDEF USINGZ}
  711. Result.Z := pt.Z;
  712. {$ENDIF}
  713. end;
  714. //------------------------------------------------------------------------------
  715. function ScalePath(const path: TPath64; sx, sy: double): TPath64;
  716. var
  717. i,len: integer;
  718. begin
  719. if sx = 0 then sx := 1;
  720. if sy = 0 then sy := 1;
  721. len := length(path);
  722. setlength(result, len);
  723. for i := 0 to len -1 do
  724. begin
  725. result[i].X := Round(path[i].X * sx);
  726. result[i].Y := Round(path[i].Y * sy);
  727. {$IFDEF USINGZ}
  728. result[i].Z := path[i].Z;
  729. {$ENDIF}
  730. end;
  731. end;
  732. //------------------------------------------------------------------------------
  733. function ScalePath(const path: TPathD; sx, sy: double): TPath64;
  734. var
  735. i,j, len: integer;
  736. begin
  737. if sx = 0 then sx := 1;
  738. if sy = 0 then sy := 1;
  739. len := length(path);
  740. setlength(result, len);
  741. if len = 0 then Exit;
  742. j := 1;
  743. result[0].X := Round(path[0].X * sx);
  744. result[0].Y := Round(path[0].Y * sy);
  745. {$IFDEF USINGZ}
  746. result[0].Z := path[0].Z;
  747. {$ENDIF}
  748. for i := 1 to len -1 do
  749. begin
  750. result[j].X := Round(path[i].X * sx);
  751. result[j].Y := Round(path[i].Y * sy);
  752. {$IFDEF USINGZ}
  753. result[j].Z := path[i].Z;
  754. {$ENDIF}
  755. if (result[j].X <> result[j-1].X) or
  756. (result[j].Y <> result[j-1].Y) then inc(j);
  757. end;
  758. setlength(result, j);
  759. end;
  760. //------------------------------------------------------------------------------
  761. function ScalePath(const path: TPath64; scale: double): TPath64;
  762. var
  763. i,j, len: integer;
  764. begin
  765. len := length(path);
  766. setlength(result, len);
  767. if len = 0 then Exit;
  768. j := 1;
  769. result[0].X := Round(path[0].X * scale);
  770. result[0].Y := Round(path[0].Y * scale);
  771. {$IFDEF USINGZ}
  772. result[0].Z := path[0].Z;
  773. {$ENDIF}
  774. for i := 1 to len -1 do
  775. begin
  776. result[j].X := Round(path[i].X * scale);
  777. result[j].Y := Round(path[i].Y * scale);
  778. {$IFDEF USINGZ}
  779. result[j].Z := path[i].Z;
  780. {$ENDIF}
  781. if (result[j].X <> result[j-1].X) or
  782. (result[j].Y <> result[j-1].Y) then inc(j);
  783. end;
  784. setlength(result, j);
  785. end;
  786. //------------------------------------------------------------------------------
  787. function ScalePath(const path: TPathD; scale: double): TPath64;
  788. var
  789. i,len: integer;
  790. begin
  791. len := length(path);
  792. setlength(result, len);
  793. for i := 0 to len -1 do
  794. begin
  795. result[i].X := Round(path[i].X * scale);
  796. result[i].Y := Round(path[i].Y * scale);
  797. {$IFDEF USINGZ}
  798. result[i].Z := path[i].Z;
  799. {$ENDIF}
  800. end;
  801. end;
  802. //------------------------------------------------------------------------------
  803. function ScalePaths(const paths: TPaths64; sx, sy: double): TPaths64;
  804. var
  805. i,len: integer;
  806. begin
  807. if sx = 0 then sx := 1;
  808. if sy = 0 then sy := 1;
  809. len := length(paths);
  810. setlength(result, len);
  811. for i := 0 to len -1 do
  812. result[i] := ScalePath(paths[i], sx, sy);
  813. end;
  814. //------------------------------------------------------------------------------
  815. function ScalePaths(const paths: TPathsD; sx, sy: double): TPaths64;
  816. var
  817. i,len: integer;
  818. begin
  819. if sx = 0 then sx := 1;
  820. if sy = 0 then sy := 1;
  821. len := length(paths);
  822. setlength(result, len);
  823. for i := 0 to len -1 do
  824. result[i] := ScalePath(paths[i], sx, sy);
  825. end;
  826. //------------------------------------------------------------------------------
  827. function ScalePathD(const path: TPath64; sx, sy: double): TPathD;
  828. var
  829. i: integer;
  830. begin
  831. setlength(result, length(path));
  832. for i := 0 to high(path) do
  833. begin
  834. result[i].X := path[i].X * sx;
  835. result[i].Y := path[i].Y * sy;
  836. {$IFDEF USINGZ}
  837. result[i].Z := path[i].Z;
  838. {$ENDIF}
  839. end;
  840. end;
  841. //------------------------------------------------------------------------------
  842. function ScalePathD(const path: TPathD; sx, sy: double): TPathD;
  843. var
  844. i: integer;
  845. begin
  846. setlength(result, length(path));
  847. for i := 0 to high(path) do
  848. begin
  849. result[i].X := path[i].X * sx;
  850. result[i].Y := path[i].Y * sy;
  851. {$IFDEF USINGZ}
  852. result[i].Z := path[i].Z;
  853. {$ENDIF}
  854. end;
  855. end;
  856. //------------------------------------------------------------------------------
  857. function ScalePathD(const path: TPath64; scale: double): TPathD;
  858. var
  859. i: integer;
  860. begin
  861. setlength(result, length(path));
  862. for i := 0 to high(path) do
  863. begin
  864. result[i].X := path[i].X * scale;
  865. result[i].Y := path[i].Y * scale;
  866. {$IFDEF USINGZ}
  867. result[i].Z := path[i].Z;
  868. {$ENDIF}
  869. end;
  870. end;
  871. //------------------------------------------------------------------------------
  872. function ScalePathD(const path: TPathD; scale: double): TPathD;
  873. var
  874. i: integer;
  875. begin
  876. setlength(result, length(path));
  877. for i := 0 to high(path) do
  878. begin
  879. result[i].X := path[i].X * scale;
  880. result[i].Y := path[i].Y * scale;
  881. {$IFDEF USINGZ}
  882. result[i].Z := path[i].Z;
  883. {$ENDIF}
  884. end;
  885. end;
  886. //------------------------------------------------------------------------------
  887. function ScalePathsD(const paths: TPaths64; sx, sy: double): TPathsD;
  888. var
  889. i,j: integer;
  890. begin
  891. if sx = 0 then sx := 1;
  892. if sy = 0 then sy := 1;
  893. setlength(result, length(paths));
  894. for i := 0 to high(paths) do
  895. begin
  896. setlength(result[i], length(paths[i]));
  897. for j := 0 to high(paths[i]) do
  898. begin
  899. result[i][j].X := (paths[i][j].X * sx);
  900. result[i][j].Y := (paths[i][j].Y * sy);
  901. {$IFDEF USINGZ}
  902. result[i][j].Z := paths[i][j].Z;
  903. {$ENDIF}
  904. end;
  905. end;
  906. end;
  907. //------------------------------------------------------------------------------
  908. function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD;
  909. var
  910. i,j: integer;
  911. begin
  912. if sx = 0 then sx := 1;
  913. if sy = 0 then sy := 1;
  914. setlength(result, length(paths));
  915. for i := 0 to high(paths) do
  916. begin
  917. setlength(result[i], length(paths[i]));
  918. for j := 0 to high(paths[i]) do
  919. begin
  920. result[i][j].X := paths[i][j].X * sx;
  921. result[i][j].Y := paths[i][j].Y * sy;
  922. {$IFDEF USINGZ}
  923. result[i][j].Z := paths[i][j].Z;
  924. {$ENDIF}
  925. end;
  926. end;
  927. end;
  928. //------------------------------------------------------------------------------
  929. function ScalePaths(const paths: TPaths64; scale: double): TPaths64;
  930. var
  931. i,j: integer;
  932. begin
  933. setlength(result, length(paths));
  934. for i := 0 to high(paths) do
  935. begin
  936. setlength(result[i], length(paths[i]));
  937. for j := 0 to high(paths[i]) do
  938. begin
  939. result[i][j].X := Round(paths[i][j].X * scale);
  940. result[i][j].Y := Round(paths[i][j].Y * scale);
  941. {$IFDEF USINGZ}
  942. result[i][j].Z := paths[i][j].Z;
  943. {$ENDIF}
  944. end;
  945. end;
  946. end;
  947. //------------------------------------------------------------------------------
  948. function ScalePaths(const paths: TPathsD; scale: double): TPaths64;
  949. var
  950. i,j: integer;
  951. begin
  952. setlength(result, length(paths));
  953. for i := 0 to high(paths) do
  954. begin
  955. setlength(result[i], length(paths[i]));
  956. for j := 0 to high(paths[i]) do
  957. begin
  958. result[i][j].X := Round(paths[i][j].X * scale);
  959. result[i][j].Y := Round(paths[i][j].Y * scale);
  960. {$IFDEF USINGZ}
  961. result[i][j].Z := paths[i][j].Z;
  962. {$ENDIF}
  963. end;
  964. end;
  965. end;
  966. //------------------------------------------------------------------------------
  967. function ScalePathsD(const paths: TPaths64; scale: double): TPathsD; overload;
  968. var
  969. i,j: integer;
  970. begin
  971. setlength(result, length(paths));
  972. for i := 0 to high(paths) do
  973. begin
  974. setlength(result[i], length(paths[i]));
  975. for j := 0 to high(paths[i]) do
  976. begin
  977. result[i][j].X := paths[i][j].X * scale;
  978. result[i][j].Y := paths[i][j].Y * scale;
  979. {$IFDEF USINGZ}
  980. result[i][j].Z := paths[i][j].Z;
  981. {$ENDIF}
  982. end;
  983. end;
  984. end;
  985. //------------------------------------------------------------------------------
  986. function ScalePathsD(const paths: TPathsD; scale: double): TPathsD; overload;
  987. var
  988. i,j: integer;
  989. begin
  990. setlength(result, length(paths));
  991. for i := 0 to high(paths) do
  992. begin
  993. setlength(result[i], length(paths[i]));
  994. for j := 0 to high(paths[i]) do
  995. begin
  996. result[i][j].X := paths[i][j].X * scale;
  997. result[i][j].Y := paths[i][j].Y * scale;
  998. {$IFDEF USINGZ}
  999. result[i][j].Z := paths[i][j].Z;
  1000. {$ENDIF}
  1001. end;
  1002. end;
  1003. end;
  1004. //------------------------------------------------------------------------------
  1005. function Path64(const pathD: TPathD): TPath64;
  1006. var
  1007. i, len: integer;
  1008. begin
  1009. len := Length(pathD);
  1010. setLength(Result, len);
  1011. for i := 0 to len -1 do
  1012. begin
  1013. Result[i].X := Round(pathD[i].X);
  1014. Result[i].Y := Round(pathD[i].Y);
  1015. {$IFDEF USINGZ}
  1016. Result[i].Z := pathD[i].Z;
  1017. {$ENDIF}
  1018. end;
  1019. end;
  1020. //------------------------------------------------------------------------------
  1021. function PathD(const path: TPath64): TPathD;
  1022. var
  1023. i, len: integer;
  1024. begin
  1025. len := Length(path);
  1026. setLength(Result, len);
  1027. for i := 0 to len -1 do
  1028. begin
  1029. Result[i].X := path[i].X;
  1030. Result[i].Y := path[i].Y;
  1031. {$IFDEF USINGZ}
  1032. Result[i].Z := path[i].Z;
  1033. {$ENDIF}
  1034. end;
  1035. end;
  1036. //------------------------------------------------------------------------------
  1037. function Paths64(const path: TPath64): TPaths64;
  1038. begin
  1039. setLength(Result, 1);
  1040. Result[0] := path;
  1041. end;
  1042. //------------------------------------------------------------------------------
  1043. function Paths64(const pathsD: TPathsD): TPaths64;
  1044. var
  1045. i, len: integer;
  1046. begin
  1047. len := Length(pathsD);
  1048. setLength(Result, len);
  1049. for i := 0 to len -1 do
  1050. Result[i] := Path64(pathsD[i]);
  1051. end;
  1052. //------------------------------------------------------------------------------
  1053. function PathsD(const paths: TPaths64): TPathsD;
  1054. var
  1055. i, len: integer;
  1056. begin
  1057. len := Length(paths);
  1058. setLength(Result, len);
  1059. for i := 0 to len -1 do
  1060. Result[i] := PathD(paths[i]);
  1061. end;
  1062. //------------------------------------------------------------------------------
  1063. function PathsD(const path: TPathD): TPathsD;
  1064. begin
  1065. setLength(Result, 1);
  1066. Result[0] := path;
  1067. end;
  1068. //------------------------------------------------------------------------------
  1069. function ReversePath(const path: TPath64): TPath64;
  1070. var
  1071. i, highI: Integer;
  1072. begin
  1073. highI := high(path);
  1074. SetLength(Result, highI +1);
  1075. for i := 0 to highI do
  1076. Result[i] := path[highI - i];
  1077. end;
  1078. //------------------------------------------------------------------------------
  1079. function ReversePath(const path: TPathD): TPathD;
  1080. var
  1081. i, highI: Integer;
  1082. begin
  1083. highI := high(path);
  1084. SetLength(Result, highI +1);
  1085. for i := 0 to highI do
  1086. Result[i] := path[highI - i];
  1087. end;
  1088. //------------------------------------------------------------------------------
  1089. function ReversePaths(const paths: TPaths64): TPaths64;
  1090. var
  1091. i, j, highJ: Integer;
  1092. begin
  1093. i := length(paths);
  1094. SetLength(Result, i);
  1095. for i := 0 to i -1 do
  1096. begin
  1097. highJ := high(paths[i]);
  1098. SetLength(Result[i], highJ+1);
  1099. for j := 0 to highJ do
  1100. Result[i][j] := paths[i][highJ - j];
  1101. end;
  1102. end;
  1103. //------------------------------------------------------------------------------
  1104. function ReversePaths(const paths: TPathsD): TPathsD;
  1105. var
  1106. i, j, highJ: Integer;
  1107. begin
  1108. i := length(paths);
  1109. SetLength(Result, i);
  1110. for i := 0 to i -1 do
  1111. begin
  1112. highJ := high(paths[i]);
  1113. SetLength(Result[i], highJ+1);
  1114. for j := 0 to highJ do
  1115. Result[i][j] := paths[i][highJ - j];
  1116. end;
  1117. end;
  1118. //------------------------------------------------------------------------------
  1119. function ShiftPath(const path: TPath64; shift: integer): TPath64;
  1120. var
  1121. diff, len: Integer;
  1122. begin
  1123. Result := nil;
  1124. len := Length(path);
  1125. if len = 0 then Exit;
  1126. Result := Copy(path, 0, len);
  1127. shift := shift mod len;
  1128. if shift = 0 then Exit;
  1129. if shift < 0 then shift := len + shift;
  1130. diff := len - shift;
  1131. Move(path[shift], Result[0], diff *SizeOf(TPoint64));
  1132. Move(path[0], Result[diff], shift *SizeOf(TPoint64));
  1133. end;
  1134. //------------------------------------------------------------------------------
  1135. function ShiftPath(const path: TPathD; shift: integer): TPathD;
  1136. var
  1137. diff, len: Integer;
  1138. begin
  1139. Result := nil;
  1140. len := Length(path);
  1141. if len = 0 then Exit;
  1142. Result := Copy(path, 0, len);
  1143. shift := shift mod len;
  1144. if shift = 0 then Exit;
  1145. if shift < 0 then shift := len + shift;
  1146. diff := len - shift;
  1147. Move(path[shift], Result[0], diff *SizeOf(TPointD));
  1148. Move(path[0], Result[diff], shift *SizeOf(TPointD));
  1149. end;
  1150. //------------------------------------------------------------------------------
  1151. procedure AppendPoint(var path: TPath64; const pt: TPoint64);
  1152. var
  1153. len: Integer;
  1154. begin
  1155. len := length(path);
  1156. SetLength(path, len +1);
  1157. path[len] := pt;
  1158. end;
  1159. //------------------------------------------------------------------------------
  1160. function AppendPoints(const path, extra: TPath64): TPath64;
  1161. var
  1162. len1, len2: Integer;
  1163. begin
  1164. len1 := length(path);
  1165. len2 := length(extra);
  1166. SetLength(Result, len1 + len2);
  1167. if len1 > 0 then
  1168. Move(path[0], Result[0], len1 * sizeOf(TPoint64));
  1169. if len2 > 0 then
  1170. Move(extra[0], Result[len1], len2 * sizeOf(TPoint64));
  1171. end;
  1172. //------------------------------------------------------------------------------
  1173. procedure AppendPoint(var path: TPathD; const pt: TPointD);
  1174. var
  1175. len: Integer;
  1176. begin
  1177. len := length(path);
  1178. SetLength(path, len +1);
  1179. path[len] := pt;
  1180. end;
  1181. //------------------------------------------------------------------------------
  1182. procedure AppendPath(var paths: TPaths64; const extra: TPath64);
  1183. var
  1184. len: Integer;
  1185. begin
  1186. if not Assigned(extra) then Exit;
  1187. len := length(paths);
  1188. SetLength(paths, len +1);
  1189. paths[len] := extra;
  1190. end;
  1191. //------------------------------------------------------------------------------
  1192. procedure AppendPath(var paths: TPathsD; const extra: TPathD);
  1193. var
  1194. len: Integer;
  1195. begin
  1196. if not Assigned(extra) then Exit;
  1197. len := length(paths);
  1198. SetLength(paths, len +1);
  1199. paths[len] := extra;
  1200. end;
  1201. //------------------------------------------------------------------------------
  1202. procedure AppendPaths(var paths: TPaths64; const extra: TPaths64);
  1203. var
  1204. i, len1, len2: Integer;
  1205. begin
  1206. len1 := length(paths);
  1207. len2 := length(extra);
  1208. SetLength(paths, len1 + len2);
  1209. for i := 0 to len2 -1 do
  1210. paths[len1 + i] := extra[i];
  1211. end;
  1212. //------------------------------------------------------------------------------
  1213. procedure AppendPaths(var paths: TPathsD; const extra: TPathsD);
  1214. var
  1215. i, len1, len2: Integer;
  1216. begin
  1217. len1 := length(paths);
  1218. len2 := length(extra);
  1219. SetLength(paths, len1 + len2);
  1220. for i := 0 to len2 -1 do
  1221. paths[len1 + i] := extra[i];
  1222. end;
  1223. //------------------------------------------------------------------------------
  1224. function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
  1225. var
  1226. i,j,k, len, cnt: integer;
  1227. begin
  1228. cnt := 0;
  1229. len := length(ap);
  1230. for i := 0 to len -1 do
  1231. inc(cnt, length(ap[i]));
  1232. k := 0;
  1233. setlength(result, cnt);
  1234. for i := 0 to len -1 do
  1235. for j := 0 to length(ap[i]) -1 do
  1236. begin
  1237. result[k] := ap[i][j];
  1238. inc(k);
  1239. end;
  1240. end;
  1241. //------------------------------------------------------------------------------
  1242. {$IFDEF USINGZ}
  1243. function Point64(const X, Y: Int64; Z: ZType): TPoint64;
  1244. begin
  1245. Result.X := X;
  1246. Result.Y := Y;
  1247. Result.Z := Z;
  1248. end;
  1249. //------------------------------------------------------------------------------
  1250. function Point64(const X, Y: Double; Z: ZType): TPoint64;
  1251. begin
  1252. Result.X := Round(X);
  1253. Result.Y := Round(Y);
  1254. Result.Z := Z;
  1255. end;
  1256. //------------------------------------------------------------------------------
  1257. function PointD(const X, Y: Double; Z: ZType): TPointD;
  1258. begin
  1259. Result.X := X;
  1260. Result.Y := Y;
  1261. Result.Z := Z;
  1262. end;
  1263. //------------------------------------------------------------------------------
  1264. function Point64(const pt: TPointD): TPoint64;
  1265. begin
  1266. Result.X := Round(pt.X);
  1267. Result.Y := Round(pt.Y);
  1268. Result.Z := pt.Z;
  1269. end;
  1270. //------------------------------------------------------------------------------
  1271. function PointD(const pt: TPoint64): TPointD;
  1272. begin
  1273. Result.X := pt.X;
  1274. Result.Y := pt.Y;
  1275. Result.Z := pt.Z;
  1276. end;
  1277. //------------------------------------------------------------------------------
  1278. {$ELSE}
  1279. function Point64(const X, Y: Int64): TPoint64;
  1280. begin
  1281. Result.X := X;
  1282. Result.Y := Y;
  1283. end;
  1284. //------------------------------------------------------------------------------
  1285. function Point64(const X, Y: Double): TPoint64;
  1286. begin
  1287. Result.X := Round(X);
  1288. Result.Y := Round(Y);
  1289. end;
  1290. //------------------------------------------------------------------------------
  1291. function PointD(const X, Y: Double): TPointD;
  1292. begin
  1293. Result.X := X;
  1294. Result.Y := Y;
  1295. end;
  1296. //------------------------------------------------------------------------------
  1297. function Point64(const pt: TPointD): TPoint64;
  1298. begin
  1299. Result.X := Round(pt.X);
  1300. Result.Y := Round(pt.Y);
  1301. end;
  1302. //------------------------------------------------------------------------------
  1303. function PointD(const pt: TPoint64): TPointD;
  1304. begin
  1305. Result.X := pt.X;
  1306. Result.Y := pt.Y;
  1307. end;
  1308. //------------------------------------------------------------------------------
  1309. {$ENDIF}
  1310. function Negate(const pt: TPoint64): TPoint64;
  1311. begin
  1312. Result.X := -pt.X;
  1313. Result.Y := -pt.Y;
  1314. end;
  1315. //------------------------------------------------------------------------------
  1316. function Negate(const pt: TPointD): TPointD;
  1317. begin
  1318. Result.X := -pt.X;
  1319. Result.Y := -pt.Y;
  1320. end;
  1321. //------------------------------------------------------------------------------
  1322. function NegatePath(const path: TPathD): TPathD;
  1323. var
  1324. i: Integer;
  1325. begin
  1326. Result := path;
  1327. for i := 0 to High(Result) do
  1328. with Result[i] do
  1329. begin
  1330. X := -X;
  1331. Y := -Y;
  1332. end;
  1333. end;
  1334. //------------------------------------------------------------------------------
  1335. function Rect64(const left, top, right, bottom: Int64): TRect64;
  1336. begin
  1337. Result.Left := left;
  1338. Result.Top := top;
  1339. Result.Right := right;
  1340. Result.Bottom := bottom;
  1341. end;
  1342. //------------------------------------------------------------------------------
  1343. function Rect64(const recD: TRectD): TRect64;
  1344. begin
  1345. Result.Left := Floor(recD.left);
  1346. Result.Top := Floor(recD.top);
  1347. Result.Right := Ceil(recD.right);
  1348. Result.Bottom := Ceil(recD.bottom);
  1349. end;
  1350. //------------------------------------------------------------------------------
  1351. function RectD(const left, top, right, bottom: double): TRectD;
  1352. begin
  1353. Result.Left := left;
  1354. Result.Top := top;
  1355. Result.Right := right;
  1356. Result.Bottom := bottom;
  1357. end;
  1358. //------------------------------------------------------------------------------
  1359. function RectD(const rec64: TRect64): TRectD; overload;
  1360. begin
  1361. Result.Left := rec64.left;
  1362. Result.Top := rec64.top;
  1363. Result.Right := rec64.right;
  1364. Result.Bottom := rec64.bottom;
  1365. end;
  1366. //------------------------------------------------------------------------------
  1367. function GetBounds(const paths: TArrayOfPaths): TRect64; overload;
  1368. var
  1369. i,j,k: Integer;
  1370. p: PPoint64;
  1371. begin
  1372. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1373. for i := 0 to High(paths) do
  1374. for j := 0 to High(paths[i]) do
  1375. if Assigned(paths[i][j]) then
  1376. begin
  1377. p := @paths[i][j][0];
  1378. for k := 0 to High(paths[i][j]) do
  1379. begin
  1380. if p.X < Result.Left then Result.Left := p.X;
  1381. if p.X > Result.Right then Result.Right := p.X;
  1382. if p.Y < Result.Top then Result.Top := p.Y;
  1383. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1384. inc(p);
  1385. end;
  1386. end;
  1387. if Result.Left > Result.Right then Result := NullRect64;
  1388. end;
  1389. //------------------------------------------------------------------------------
  1390. function GetBounds(const paths: TPaths64): TRect64;
  1391. var
  1392. i,j: Integer;
  1393. p: PPoint64;
  1394. begin
  1395. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1396. for i := 0 to High(paths) do
  1397. if Assigned(paths[i]) then
  1398. begin
  1399. p := @paths[i][0];
  1400. for j := 0 to High(paths[i]) do
  1401. begin
  1402. if p.X < Result.Left then Result.Left := p.X;
  1403. if p.X > Result.Right then Result.Right := p.X;
  1404. if p.Y < Result.Top then Result.Top := p.Y;
  1405. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1406. inc(p);
  1407. end;
  1408. end;
  1409. if Result.Left = MaxInt64 then Result := NullRect64;
  1410. end;
  1411. //------------------------------------------------------------------------------
  1412. function GetBounds(const paths: TPathsD): TRectD;
  1413. var
  1414. i,j: Integer;
  1415. p: PPointD;
  1416. begin
  1417. Result := RectD(MaxDouble, MaxDouble, -MaxDouble, -MaxDouble);
  1418. for i := 0 to High(paths) do
  1419. if Assigned(paths[i]) then
  1420. begin
  1421. p := @paths[i][0];
  1422. for j := 0 to High(paths[i]) do
  1423. begin
  1424. if p.X < Result.Left then Result.Left := p.X;
  1425. if p.X > Result.Right then Result.Right := p.X;
  1426. if p.Y < Result.Top then Result.Top := p.Y;
  1427. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1428. inc(p);
  1429. end;
  1430. end;
  1431. if Result.Left = MaxDouble then Result := NullRectD;
  1432. end;
  1433. //------------------------------------------------------------------------------
  1434. function GetBounds(const path: TPath64): TRect64;
  1435. var
  1436. i, len: Integer;
  1437. p: PPoint64;
  1438. begin
  1439. len := Length(path);
  1440. if len = 0 then
  1441. begin
  1442. Result := NullRect64;
  1443. Exit;
  1444. end;
  1445. Result := Rect64(MaxInt64, MaxInt64, -MaxInt64, -MaxInt64);
  1446. p := @path[0];
  1447. for i := 0 to High(path) do
  1448. begin
  1449. if p.X < Result.Left then Result.Left := p.X;
  1450. if p.X > Result.Right then Result.Right := p.X;
  1451. if p.Y < Result.Top then Result.Top := p.Y;
  1452. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1453. inc(p);
  1454. end;
  1455. end;
  1456. //------------------------------------------------------------------------------
  1457. function GetBounds(const path: TPathD): TRectD;
  1458. var
  1459. i, len: Integer;
  1460. p: PPointD;
  1461. begin
  1462. len := Length(path);
  1463. if len = 0 then
  1464. begin
  1465. Result := NullRectD;
  1466. Exit;
  1467. end;
  1468. Result := RectD(infinity, infinity, -infinity, -infinity);
  1469. p := @path[0];
  1470. for i := 0 to High(path) do
  1471. begin
  1472. if p.X < Result.Left then Result.Left := p.X;
  1473. if p.X > Result.Right then Result.Right := p.X;
  1474. if p.Y < Result.Top then Result.Top := p.Y;
  1475. if p.Y > Result.Bottom then Result.Bottom := p.Y;
  1476. inc(p);
  1477. end;
  1478. end;
  1479. //------------------------------------------------------------------------------
  1480. function TranslatePoint(const pt: TPoint64; dx, dy: Int64): TPoint64;
  1481. begin
  1482. Result.X := pt.X + dx;
  1483. Result.Y := pt.Y + dy;
  1484. end;
  1485. //------------------------------------------------------------------------------
  1486. function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD;
  1487. begin
  1488. Result.X := pt.X + dx;
  1489. Result.Y := pt.Y + dy;
  1490. end;
  1491. //------------------------------------------------------------------------------
  1492. procedure InflateRect(var rec: TRect64; dx, dy: Int64);
  1493. begin
  1494. dec(rec.Left, dx);
  1495. inc(rec.Right, dx);
  1496. dec(rec.Top, dy);
  1497. inc(rec.Bottom, dy);
  1498. end;
  1499. //------------------------------------------------------------------------------
  1500. procedure InflateRect(var rec: TRectD; dx, dy: double);
  1501. begin
  1502. rec.Left := rec.Left - dx;
  1503. rec.Right := rec.Right + dx;
  1504. rec.Top := rec.Top - dy;
  1505. rec.Bottom := rec.Bottom + dy;
  1506. end;
  1507. //------------------------------------------------------------------------------
  1508. procedure RotatePt(var pt: TPointD; const center: TPointD; sinA, cosA: double);
  1509. var
  1510. tmpX, tmpY: double;
  1511. begin
  1512. tmpX := pt.X-center.X;
  1513. tmpY := pt.Y-center.Y;
  1514. pt.X := tmpX * cosA - tmpY * sinA + center.X;
  1515. pt.Y := tmpX * sinA + tmpY * cosA + center.Y;
  1516. end;
  1517. //------------------------------------------------------------------------------
  1518. procedure RotatePath(var path: TPathD; const center: TPointD; sinA, cosA: double);
  1519. var
  1520. i: integer;
  1521. begin
  1522. for i := 0 to High(path) do
  1523. RotatePt(path[i], center, sinA, cosA);
  1524. end;
  1525. //------------------------------------------------------------------------------
  1526. function RotateRect(const rec: TRectD; angleRad: double): TRectD;
  1527. var
  1528. i: integer;
  1529. sinA, cosA: double;
  1530. cp: TPointD;
  1531. pts: TPathD;
  1532. begin
  1533. setLength(pts, 4);
  1534. sinA := Sin(-angleRad);
  1535. cosA := cos(-angleRad);
  1536. cp.X := (rec.Right + rec.Left) / 2;
  1537. cp.Y := (rec.Bottom + rec.Top) / 2;
  1538. pts[0] := PointD(rec.Left, rec.Top);
  1539. pts[1] := PointD(rec.Right, rec.Top);
  1540. pts[2] := PointD(rec.Left, rec.Bottom);
  1541. pts[3] := PointD(rec.Right, rec.Bottom);
  1542. for i := 0 to 3 do RotatePt(pts[i], cp, sinA, cosA);
  1543. result.Left := pts[0].X;
  1544. result.Right := result.Left;
  1545. result.Top := pts[0].Y;
  1546. result.Bottom := result.Top;
  1547. for i := 1 to 3 do
  1548. begin
  1549. if pts[i].X < result.Left then result.Left := pts[i].X;
  1550. if pts[i].Y < result.Top then result.Top := pts[i].Y;
  1551. if pts[i].X > result.Right then result.Right := pts[i].X;
  1552. if pts[i].Y > result.Bottom then result.Bottom := pts[i].Y;
  1553. end;
  1554. end;
  1555. //------------------------------------------------------------------------------
  1556. function RotateRect(const rec: TRect64; angleRad: double): TRect64;
  1557. var
  1558. recD: TRectD;
  1559. begin
  1560. recD := RectD(rec.Left, rec.Top, rec.Right, rec.Bottom);
  1561. recD := RotateRect(recD, angleRad);
  1562. result.Left := Floor(recD.Left);
  1563. result.Top := Floor(recD.Top);
  1564. result.Right := Ceil(recD.Right);
  1565. result.Bottom := Ceil(recD.Bottom);
  1566. end;
  1567. //------------------------------------------------------------------------------
  1568. procedure OffsetRect(var rec: TRect64; dx, dy: Int64);
  1569. begin
  1570. inc(rec.Left, dx); inc(rec.Top, dy);
  1571. inc(rec.Right, dx); inc(rec.Bottom, dy);
  1572. end;
  1573. //------------------------------------------------------------------------------
  1574. procedure OffsetRect(var rec: TRectD; dx, dy: double);
  1575. begin
  1576. rec.Left := rec.Left + dx;
  1577. rec.Right := rec.Right + dx;
  1578. rec.Top := rec.Top + dy;
  1579. rec.Bottom := rec.Bottom + dy;
  1580. end;
  1581. //------------------------------------------------------------------------------
  1582. function UnionRect(const rec, rec2: TRect64): TRect64;
  1583. begin
  1584. // nb: don't use rec.IsEmpty as this will
  1585. // reject open axis-aligned flat paths
  1586. if (rec.Width <= 0) and (rec.Height <= 0) then result := rec2
  1587. else if (rec2.Width <= 0) and (rec2.Height <= 0) then result := rec
  1588. else
  1589. begin
  1590. result.Left := min(rec.Left, rec2.Left);
  1591. result.Right := max(rec.Right, rec2.Right);
  1592. result.Top := min(rec.Top, rec2.Top);
  1593. result.Bottom := max(rec.Bottom, rec2.Bottom);
  1594. end;
  1595. end;
  1596. //------------------------------------------------------------------------------
  1597. function UnionRect(const rec, rec2: TRectD): TRectD;
  1598. begin
  1599. // nb: don't use rec.IsEmpty as this will
  1600. // reject open axis-aligned flat paths
  1601. if (rec.Width <= 0) and (rec.Height <= 0) then result := rec2
  1602. else if (rec2.Width <= 0) and (rec2.Height <= 0) then result := rec
  1603. else
  1604. begin
  1605. result.Left := min(rec.Left, rec2.Left);
  1606. result.Right := max(rec.Right, rec2.Right);
  1607. result.Top := min(rec.Top, rec2.Top);
  1608. result.Bottom := max(rec.Bottom, rec2.Bottom);
  1609. end;
  1610. end;
  1611. //------------------------------------------------------------------------------
  1612. function Area(const path: TPath64): Double;
  1613. var
  1614. i, highI: Integer;
  1615. d: double;
  1616. p1,p2: PPoint64;
  1617. begin
  1618. // shoelace formula
  1619. Result := 0.0;
  1620. highI := High(path);
  1621. if highI < 2 then Exit;
  1622. p1 := @path[highI];
  1623. p2 := @path[0];
  1624. for i := 0 to highI do
  1625. begin
  1626. d := (p1.Y + p2.Y); // needed for Delphi7
  1627. Result := Result + d * (p1.X - p2.X);
  1628. p1 := p2; inc(p2);
  1629. end;
  1630. Result := Result * 0.5;
  1631. end;
  1632. //------------------------------------------------------------------------------
  1633. function Area(const paths: TPaths64): Double;
  1634. var
  1635. i: integer;
  1636. begin
  1637. Result := 0;
  1638. for i := 0 to High(paths) do
  1639. Result := Result + Area(paths[i]);
  1640. end;
  1641. //------------------------------------------------------------------------------
  1642. function Area(const path: TPathD): Double;
  1643. var
  1644. i, highI: Integer;
  1645. p1,p2: PPointD;
  1646. begin
  1647. // https://en.wikipedia.org/wiki/Shoelace_formula
  1648. Result := 0.0;
  1649. highI := High(path);
  1650. if highI < 2 then Exit;
  1651. p1 := @path[highI];
  1652. p2 := @path[0];
  1653. for i := 0 to highI do
  1654. begin
  1655. Result := Result + (p1.Y + p2.Y) * (p1.X - p2.X);
  1656. p1 := p2; inc(p2);
  1657. end;
  1658. Result := Result * 0.5;
  1659. end;
  1660. //------------------------------------------------------------------------------
  1661. function Area(const paths: TPathsD): Double;
  1662. var
  1663. i: integer;
  1664. begin
  1665. Result := 0;
  1666. for i := 0 to High(paths) do
  1667. Result := Result + Area(paths[i]);
  1668. end;
  1669. //------------------------------------------------------------------------------
  1670. function IsPositive(const path: TPath64): Boolean;
  1671. begin
  1672. Result := (Area(path) >= 0);
  1673. end;
  1674. //------------------------------------------------------------------------------
  1675. function IsPositive(const path: TPathD): Boolean;
  1676. begin
  1677. Result := (Area(path) >= 0);
  1678. end;
  1679. //------------------------------------------------------------------------------
  1680. function TriSign(val: Int64): integer; // returns 0, 1 or -1
  1681. {$IFDEF INLINING} inline; {$ENDIF}
  1682. begin
  1683. if (val < 0) then Result := -1
  1684. else if (val > 1) then Result := 1
  1685. else Result := 0;
  1686. end;
  1687. //------------------------------------------------------------------------------
  1688. type
  1689. TMultiplyUInt64Result = record
  1690. lo64: UInt64;
  1691. hi64 : UInt64;
  1692. end;
  1693. function MultiplyUInt64(a, b: UInt64): TMultiplyUInt64Result; // #834, #835
  1694. {$IFDEF INLINING} inline; {$ENDIF}
  1695. var
  1696. x1, x2, x3: UInt64;
  1697. begin
  1698. x1 := (a and $FFFFFFFF) * (b and $FFFFFFFF);
  1699. x2 := (a shr 32) * (b and $FFFFFFFF) + (x1 shr 32);
  1700. x3 := (a and $FFFFFFFF) * (b shr 32) + (x2 and $FFFFFFFF);
  1701. Result.lo64 := ((x3 and $FFFFFFFF) shl 32) or (x1 and $FFFFFFFF);
  1702. Result.hi64 := hi(a shr 32) * (b shr 32) + (x2 shr 32) + (x3 shr 32);
  1703. end;
  1704. //------------------------------------------------------------------------------
  1705. function ProductsAreEqual(a, b, c, d: Int64): Boolean;
  1706. var
  1707. absA,absB,absC,absD: UInt64;
  1708. absAB, absCD : TMultiplyUInt64Result;
  1709. signAB, signCD : integer;
  1710. begin
  1711. // nb: unsigned values will be needed for CalcOverflowCarry()
  1712. absA := UInt64(Abs(a));
  1713. absB := UInt64(Abs(b));
  1714. absC := UInt64(Abs(c));
  1715. absD := UInt64(Abs(d));
  1716. absAB := MultiplyUInt64(absA, absB);
  1717. absCD := MultiplyUInt64(absC, absD);
  1718. // nb: it's important to differentiate 0 values here from other values
  1719. signAB := TriSign(a) * TriSign(b);
  1720. signCD := TriSign(c) * TriSign(d);
  1721. Result := (absAB.lo64 = absCD.lo64) and
  1722. (absAB.hi64 = absCD.hi64) and (signAB = signCD);
  1723. end;
  1724. //------------------------------------------------------------------------------
  1725. function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
  1726. var
  1727. a,b,c,d: Int64;
  1728. begin
  1729. a := sharedPt.X - pt1.X;
  1730. b := pt2.Y - sharedPt.Y;
  1731. c := sharedPt.Y - pt1.Y;
  1732. d := pt2.X - sharedPt.X;
  1733. // When checking for collinearity with very large coordinate values
  1734. // then ProductsAreEqual is more accurate than using CrossProduct.
  1735. Result := ProductsAreEqual(a, b, c, d);
  1736. end;
  1737. //------------------------------------------------------------------------------
  1738. function CrossProduct(const pt1, pt2, pt3: TPoint64): double;
  1739. begin
  1740. result := CrossProduct(
  1741. pt2.X - pt1.X, pt2.Y - pt1.Y,
  1742. pt3.X - pt2.X, pt3.Y - pt2.Y);
  1743. end;
  1744. //------------------------------------------------------------------------------
  1745. function CrossProduct(const pt1, pt2, pt3: TPointD): double;
  1746. begin
  1747. result := CrossProduct(
  1748. pt2.X - pt1.X, pt2.Y - pt1.Y,
  1749. pt3.X - pt2.X, pt3.Y - pt2.Y);
  1750. end;
  1751. //------------------------------------------------------------------------------
  1752. function CrossProduct(const vec1, vec2: TPointD): double;
  1753. begin
  1754. result := (vec1.X * vec2.Y - vec1.Y * vec2.X);
  1755. end;
  1756. //------------------------------------------------------------------------------
  1757. function CrossProduct(vec1x, vec1y, vec2x, vec2y: double): double;
  1758. begin
  1759. result := (vec1x * vec2y - vec1y * vec2x);
  1760. end;
  1761. //------------------------------------------------------------------------------
  1762. function DotProduct(const pt1, pt2, pt3: TPoint64): double;
  1763. var
  1764. x1,x2,y1,y2: double; // avoids potential int overflow
  1765. begin
  1766. x1 := pt2.X - pt1.X;
  1767. y1 := pt2.Y - pt1.Y;
  1768. x2 := pt3.X - pt2.X;
  1769. y2 := pt3.Y - pt2.Y;
  1770. result := (x1 * x2 + y1 * y2);
  1771. end;
  1772. //------------------------------------------------------------------------------
  1773. function SqrInt64(val: Int64): double; {$IFDEF INLINING} inline; {$ENDIF}
  1774. begin
  1775. Result := val; // force conversion
  1776. Result := Result * Result;
  1777. end;
  1778. //------------------------------------------------------------------------------
  1779. function DistanceSqr(const pt1, pt2: TPoint64): double;
  1780. begin
  1781. Result := SqrInt64(pt1.X - pt2.X) + SqrInt64(pt1.Y - pt2.Y);
  1782. end;
  1783. //------------------------------------------------------------------------------
  1784. function DistanceSqr(const pt1, pt2: TPointD): double;
  1785. begin
  1786. Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
  1787. end;
  1788. //------------------------------------------------------------------------------
  1789. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double;
  1790. var
  1791. a,b,c: double;
  1792. begin
  1793. // perpendicular distance of point (x0,y0) = (a*x0 + b*y0 + C)/Sqrt(a*a + b*b)
  1794. // where ax + by +c = 0 is the equation of the line
  1795. // see https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line
  1796. a := (linePt1.Y - linePt2.Y);
  1797. b := (linePt2.X - linePt1.X);
  1798. c := a * linePt1.X + b * linePt1.Y;
  1799. c := a * pt.x + b * pt.y - c;
  1800. if (a = 0) and (b = 0) then
  1801. Result := 0 else
  1802. Result := (c * c) / (a * a + b * b);
  1803. end;
  1804. //---------------------------------------------------------------------------
  1805. function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double;
  1806. var
  1807. a,b,c: double;
  1808. begin
  1809. a := (linePt1.Y - linePt2.Y);
  1810. b := (linePt2.X - linePt1.X);
  1811. c := a * linePt1.X + b * linePt1.Y;
  1812. c := a * pt.x + b * pt.y - c;
  1813. if (a = 0) and (b = 0) then
  1814. Result := 0 else
  1815. Result := (c * c) / (a * a + b * b);
  1816. end;
  1817. //---------------------------------------------------------------------------
  1818. function CleanPath(const path: TPath64): TPath64;
  1819. var
  1820. i,j, len: integer;
  1821. prev: TPoint64;
  1822. begin
  1823. Result := nil;
  1824. len := Length(path);
  1825. while (len > 2) and
  1826. (IsCollinear(path[len-2], path[len-1], path[0])) do dec(len);
  1827. SetLength(Result, len);
  1828. if (len < 2) then Exit;
  1829. prev := path[len -1];
  1830. j := 0;
  1831. for i := 0 to len -2 do
  1832. begin
  1833. if IsCollinear(prev, path[i], path[i+1]) then Continue;
  1834. Result[j] := path[i];
  1835. inc(j);
  1836. prev := path[i];
  1837. end;
  1838. Result[j] := path[len -1];
  1839. SetLength(Result, j+1);
  1840. end;
  1841. //------------------------------------------------------------------------------
  1842. function GetSign(const val: double): integer; {$IFDEF INLINING} inline; {$ENDIF}
  1843. begin
  1844. if val = 0 then Result := 0
  1845. else if val < 0 then Result := -1
  1846. else Result := 1;
  1847. end;
  1848. //------------------------------------------------------------------------------
  1849. function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64;
  1850. inclusive: Boolean): boolean;
  1851. var
  1852. res1, res2, res3, res4: double;
  1853. begin
  1854. if inclusive then
  1855. begin
  1856. //result can include segments that only touch
  1857. Result := false;
  1858. res1 := CrossProduct(s1a, s2a, s2b);
  1859. res2 := CrossProduct(s1b, s2a, s2b);
  1860. if (res1 * res2 > 0) then Exit;
  1861. res3 := CrossProduct(s2a, s1a, s1b);
  1862. res4 := CrossProduct(s2b, s1a, s1b);
  1863. if (res3 * res4 > 0) then Exit;
  1864. Result := (res1 <> 0) or (res2 <> 0) or
  1865. (res3 <> 0) or (res4 <> 0); // ensures not collinear
  1866. end else
  1867. begin
  1868. result := (GetSign(CrossProduct(s1a, s2a, s2b)) *
  1869. GetSign(CrossProduct(s1b, s2a, s2b)) < 0) and
  1870. (GetSign(CrossProduct(s2a, s1a, s1b)) *
  1871. GetSign(CrossProduct(s2b, s1a, s1b)) < 0);
  1872. end;
  1873. end;
  1874. //------------------------------------------------------------------------------
  1875. function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64;
  1876. out ip: TPoint64): Boolean;
  1877. var
  1878. dx1,dy1, dx2,dy2, t, cp: double;
  1879. begin
  1880. // https://en.wikipedia.org/wiki/Line%E2%80%93line_intersection
  1881. dy1 := (ln1b.y - ln1a.y);
  1882. dx1 := (ln1b.x - ln1a.x);
  1883. dy2 := (ln2b.y - ln2a.y);
  1884. dx2 := (ln2b.x - ln2a.x);
  1885. cp := dy1 * dx2 - dy2 * dx1;
  1886. Result := (cp <> 0.0);
  1887. if not Result then Exit;
  1888. t := ((ln1a.x-ln2a.x) * dy2 - (ln1a.y-ln2a.y) * dx2) / cp;
  1889. if t <= 0.0 then ip := ln1a
  1890. else if t >= 1.0 then ip := ln1b;
  1891. ip.X := Trunc(ln1a.X + t * dx1);
  1892. ip.Y := Trunc(ln1a.Y + t * dy1);
  1893. {$IFDEF USINGZ}
  1894. ip.Z := 0;
  1895. {$ENDIF}
  1896. end;
  1897. //------------------------------------------------------------------------------
  1898. {$R-}
  1899. function PointInPolygon(const pt: TPoint64;
  1900. const polygon: TPath64): TPointInPolygonResult;
  1901. var
  1902. len, val: Integer;
  1903. isAbove, startingAbove: Boolean;
  1904. d: Double; // avoids integer overflow
  1905. curr, prev, cbegin, cend, first: PPoint64;
  1906. begin
  1907. result := pipOutside;
  1908. len := Length(polygon);
  1909. if len < 3 then Exit;
  1910. cbegin := @polygon[0];
  1911. cend := @polygon[len]; // stop is just past the last point (nb {$R-})
  1912. first := cbegin;
  1913. while (first <> cend) and (first.Y = pt.Y) do inc(first);
  1914. if (first = cend) then Exit; // not a proper polygon
  1915. isAbove := first.Y < pt.Y;
  1916. startingAbove := isAbove;
  1917. Result := pipOn;
  1918. curr := first;
  1919. inc(curr);
  1920. val := 0;
  1921. while true do
  1922. begin
  1923. if (curr = cend) then
  1924. begin
  1925. if (cend = first) or (first = cbegin) then break;
  1926. cend := first;
  1927. curr := cbegin;
  1928. end;
  1929. if isAbove then
  1930. begin
  1931. while (curr <> cend) and (curr.Y < pt.Y) do inc(curr);
  1932. if (curr = cend) then Continue;
  1933. end else
  1934. begin
  1935. while (curr <> cend) and (curr.Y > pt.Y) do inc(curr);
  1936. if (curr = cend) then Continue;
  1937. end;
  1938. if curr = cbegin then
  1939. prev := @polygon[len] else // NOT cend!
  1940. prev := curr;
  1941. dec(prev);
  1942. if (curr.Y = pt.Y) then
  1943. begin
  1944. if (curr.X = pt.X) or ((curr.Y = prev.Y) and
  1945. ((pt.X < prev.X) <> (pt.X < curr.X))) then Exit;
  1946. inc(curr);
  1947. if (curr = first) then Break;
  1948. Continue;
  1949. end;
  1950. if (pt.X < curr.X) and (pt.X < prev.X) then
  1951. // we're only interested in edges crossing on the left
  1952. else if((pt.X > prev.X) and (pt.X > curr.X)) then
  1953. val := 1 - val // toggle val
  1954. else
  1955. begin
  1956. d := CrossProduct(prev^, curr^, pt);
  1957. if d = 0 then Exit; // ie point on path
  1958. if (d < 0) = isAbove then val := 1 - val;
  1959. end;
  1960. isAbove := not isAbove;
  1961. inc(curr);
  1962. end;
  1963. if (isAbove <> startingAbove) then
  1964. begin
  1965. cend := @polygon[len];
  1966. if (curr = cend) then curr := cbegin;
  1967. if curr = cbegin then
  1968. prev := cend else
  1969. prev := curr;
  1970. dec(prev);
  1971. d := CrossProduct(prev^, curr^, pt);
  1972. if d = 0 then Exit; // ie point on path
  1973. if (d < 0) = isAbove then val := 1 - val;
  1974. end;
  1975. if val = 0 then
  1976. result := pipOutside else
  1977. result := pipInside;
  1978. end;
  1979. //------------------------------------------------------------------------------
  1980. {$R+}
  1981. procedure GetSinCos(angle: double; out sinA, cosA: double);
  1982. {$IFDEF INLINE} inline; {$ENDIF}
  1983. {$IFNDEF FPC}
  1984. var s, c: extended;
  1985. {$ENDIF}
  1986. begin
  1987. {$IFDEF FPC}
  1988. Math.SinCos(angle, sinA, cosA);
  1989. {$ELSE}
  1990. Math.SinCos(angle, s, c);
  1991. sinA := s; cosA := c;
  1992. {$ENDIF}
  1993. end;
  1994. //------------------------------------------------------------------------------
  1995. function Ellipse(const rec: TRect64; steps: integer): TPath64;
  1996. begin
  1997. Result := Path64(Ellipse(RectD(rec), steps));
  1998. end;
  1999. //------------------------------------------------------------------------------
  2000. function Ellipse(const rec: TRectD; steps: integer): TPathD;
  2001. var
  2002. i: Integer;
  2003. sinA, cosA: double;
  2004. centre, radius, delta: TPointD;
  2005. begin
  2006. result := nil;
  2007. if rec.IsEmpty then Exit;
  2008. with rec do
  2009. begin
  2010. centre := rec.MidPoint;
  2011. radius := PointD(Width * 0.5, Height * 0.5);
  2012. end;
  2013. if (steps < 3) then
  2014. steps := Ceil(PI * sqrt(rec.width + rec.height));
  2015. GetSinCos(2 * Pi / Steps, sinA, cosA);
  2016. delta.x := cosA; delta.y := sinA;
  2017. SetLength(Result, Steps);
  2018. Result[0] := PointD(centre.X + radius.X, centre.Y);
  2019. for i := 1 to steps -1 do
  2020. begin
  2021. Result[i] := PointD(centre.X + radius.X * delta.x,
  2022. centre.Y + radius.y * delta.y);
  2023. delta := PointD(delta.X * cosA - delta.Y * sinA,
  2024. delta.Y * cosA + delta.X * sinA);
  2025. end; // rotates clockwise
  2026. end;
  2027. //------------------------------------------------------------------------------
  2028. function GetClosestPointOnSegment(const pt, seg1, seg2: TPoint64): TPoint64;
  2029. var
  2030. dx, dy, q: double;
  2031. begin
  2032. if (seg1.X = seg2.X) and (seg1.Y = seg2.Y) then
  2033. begin
  2034. Result := seg1;
  2035. Exit;
  2036. end;
  2037. dx := (seg2.X - seg1.X);
  2038. dy := (seg2.Y - seg1.Y);
  2039. q := ((pt.X - seg1.X) * dx + (pt.Y - seg1.Y) * dy) / (Sqr(dx) + Sqr(dy));
  2040. if (q < 0) then q := 0
  2041. else if (q > 1) then q := 1;
  2042. Result := Point64(
  2043. seg1.X + Round(q * dx),
  2044. seg1.Y + Round(q * dy));
  2045. end;
  2046. //------------------------------------------------------------------------------
  2047. procedure RDP(const path: TPath64; startIdx, endIdx: integer;
  2048. epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload;
  2049. var
  2050. i, idx: integer;
  2051. d, maxD: double;
  2052. begin
  2053. idx := 0;
  2054. maxD := 0;
  2055. while (endIdx > startIdx) and
  2056. PointsEqual(path[startIdx], path[endIdx]) do
  2057. begin
  2058. boolArray[endIdx] := false;
  2059. dec(endIdx);
  2060. end;
  2061. for i := startIdx +1 to endIdx -1 do
  2062. begin
  2063. // PerpendicDistFromLineSqrd - avoids expensive Sqrt()
  2064. d := PerpendicDistFromLineSqrd(path[i], path[startIdx], path[endIdx]);
  2065. if d <= maxD then Continue;
  2066. maxD := d;
  2067. idx := i;
  2068. end;
  2069. if maxD < epsilonSqrd then Exit;
  2070. boolArray[idx] := true;
  2071. if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, boolArray);
  2072. if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, boolArray);
  2073. end;
  2074. //------------------------------------------------------------------------------
  2075. procedure RDP(const path: TPathD; startIdx, endIdx: integer;
  2076. epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload;
  2077. var
  2078. i, idx: integer;
  2079. d, maxD: double;
  2080. begin
  2081. idx := 0;
  2082. maxD := 0;
  2083. while (endIdx > startIdx) and
  2084. PointsNearEqual(path[startIdx], path[endIdx]) do
  2085. begin
  2086. boolArray[endIdx] := false;
  2087. dec(endIdx);
  2088. end;
  2089. for i := startIdx +1 to endIdx -1 do
  2090. begin
  2091. // PerpendicDistFromLineSqrd - avoids expensive Sqrt()
  2092. d := PerpendicDistFromLineSqrd(path[i], path[startIdx], path[endIdx]);
  2093. if d <= maxD then Continue;
  2094. maxD := d;
  2095. idx := i;
  2096. end;
  2097. if maxD < epsilonSqrd then Exit;
  2098. boolArray[idx] := true;
  2099. if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, boolArray);
  2100. if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, boolArray);
  2101. end;
  2102. //------------------------------------------------------------------------------
  2103. function RamerDouglasPeucker(const path: TPath64; epsilon: double): TPath64;
  2104. var
  2105. i,j, len: integer;
  2106. boolArray: TArrayOfBoolean;
  2107. begin
  2108. len := length(path);
  2109. if len < 5 then
  2110. begin
  2111. result := Copy(path, 0, len);
  2112. Exit;
  2113. end;
  2114. SetLength(boolArray, len); // already zero initialized
  2115. boolArray[0] := true;
  2116. boolArray[len -1] := true;
  2117. RDP(path, 0, len -1, Sqr(epsilon), boolArray);
  2118. j := 0;
  2119. SetLength(Result, len);
  2120. for i := 0 to len -1 do
  2121. if boolArray[i] then
  2122. begin
  2123. Result[j] := path[i];
  2124. inc(j);
  2125. end;
  2126. SetLength(Result, j);
  2127. end;
  2128. //------------------------------------------------------------------------------
  2129. function RamerDouglasPeucker(const paths: TPaths64; epsilon: double): TPaths64;
  2130. var
  2131. i, len: integer;
  2132. begin
  2133. len := Length(paths);
  2134. SetLength(Result, len);
  2135. for i := 0 to len -1 do
  2136. Result[i] := RamerDouglasPeucker(paths[i], epsilon);
  2137. end;
  2138. //------------------------------------------------------------------------------
  2139. function RamerDouglasPeucker(const path: TPathD; epsilon: double): TPathD; overload;
  2140. var
  2141. i,j, len: integer;
  2142. boolArray: TArrayOfBoolean;
  2143. begin
  2144. len := length(path);
  2145. if len < 5 then
  2146. begin
  2147. result := Copy(path, 0, len);
  2148. Exit;
  2149. end;
  2150. SetLength(boolArray, len); // already zero initialized
  2151. boolArray[0] := true;
  2152. boolArray[len -1] := true;
  2153. RDP(path, 0, len -1, Sqr(epsilon), boolArray);
  2154. j := 0;
  2155. SetLength(Result, len);
  2156. for i := 0 to len -1 do
  2157. if boolArray[i] then
  2158. begin
  2159. Result[j] := path[i];
  2160. inc(j);
  2161. end;
  2162. SetLength(Result, j);
  2163. end;
  2164. //------------------------------------------------------------------------------
  2165. function RamerDouglasPeucker(const paths: TPathsD; epsilon: double): TPathsD; overload;
  2166. var
  2167. i, len: integer;
  2168. begin
  2169. len := Length(paths);
  2170. SetLength(Result, len);
  2171. for i := 0 to len -1 do
  2172. Result[i] := RamerDouglasPeucker(paths[i], epsilon);
  2173. end;
  2174. //------------------------------------------------------------------------------
  2175. end.