| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202 |
- unit Img32.Vector;
- (*******************************************************************************
- * Author : Angus Johnson *
- * Version : 4.7 *
- * Date : 6 January 2025 *
- * Website : http://www.angusj.com *
- * Copyright : Angus Johnson 2019-2025 *
- * *
- * Purpose : Vector drawing for TImage32 *
- * *
- * License : Use, modification & distribution is subject to *
- * Boost Software License Ver 1 *
- * http://www.boost.org/LICENSE_1_0.txt *
- *******************************************************************************)
- interface
- {$I Img32.inc}
- uses
- SysUtils, Classes, Math, Types, Img32;
- type
- TArrowStyle = (asNone, asSimple, asFancy, asDiamond, asCircle, asTail);
- // TJoinStyle:
- // jsSquare - Convex joins will be truncated using a 'squaring' edge.
- // The mid-points of these squaring edges will also be exactly the offset
- // (ie delta) distance away from their origins (ie the starting vertices).
- // jsButt - joins are similar to 'squared' joins except that squaring
- // won't occur at a fixed distance. While bevelled joins may not be as
- // pretty as squared joins, bevelling will be much faster than squaring.
- // And perhaps this is why bevelling (rather than squaring) is preferred
- // in numerous graphics display formats (including SVG & PDF documents).
- TJoinStyle = (jsAuto, jsSquare, jsButt, jsMiter, jsRound);
- TEndStyle = (esPolygon = 0, esClosed = 0, esButt, esSquare, esRound);
- TPathEnd = (peStart, peEnd, peBothEnds);
- TSplineType = (stQuadratic, stCubic);
- TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);
- TImg32FillRule = TFillRule; //useful whenever there's ambiguity with Clipper
- TSizeD = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
- cx : double;
- cy : double;
- function average: double;
- property Width: Double read cx write cx;
- property Height: Double read cy write cy;
- end;
- TRectWH = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
- public
- Left, Top, Width, Height: double;
- function IsEmpty: Boolean;
- function IsValid: Boolean;
- function Right: double;
- function Bottom: double;
- function Contains(const Pt: TPoint): Boolean; overload;
- function Contains(const Pt: TPointD): Boolean; overload;
- function MidPoint: TPointD;
- function RectD: TRectD;
- function Rect: TRect;
- end;
- function RectWH(left, top, width, height: integer): TRectWH; overload;
- function RectWH(left, top, width, height: double ): TRectWH; overload;
- function RectWH(const rec: TRectD): TRectWH; overload;
- //InflateRect: missing in Delphi 7
- procedure InflateRect(var rec: TRect; dx, dy: integer); overload;
- procedure InflateRect(var rec: TRectD; dx, dy: double); overload;
- function NormalizeRect(var rect: TRect): Boolean;
- function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD; overload;
- procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD); overload;
- function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
- function Rectangle(const rec: TRect): TPathD; overload;
- function Rectangle(const rec: TRectD): TPathD; overload;
- function Rectangle(l, t, r, b: double): TPathD; overload;
- function RoundRect(const rec: TRect; radius: integer): TPathD; overload;
- function RoundRect(const rec: TRectD; radius: double): TPathD; overload;
- function RoundRect(const rec: TRect; radius: TPoint): TPathD; overload;
- function RoundRect(const rec: TRectD; radius: TPointD): TPathD; overload;
- function Ellipse(const rec: TRect; steps: integer = 0): TPathD; overload;
- function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload;
- function Ellipse(const rec: TRectD; pendingScale: double): TPathD; overload;
- function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD; overload;
- function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD; overload;
- function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
- function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
- function Circle(const pt: TPoint; radius: double): TPathD; overload;
- function Circle(const pt: TPointD; radius: double): TPathD; overload;
- function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD; overload;
- function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
- out centre: TPointD; out radius: double): Boolean;
- function Star(const rec: TRectD; points: integer; indentFrac: double = 0.4): TPathD; overload;
- function Star(const focalPt: TPointD;
- innerRadius, outerRadius: double; points: integer): TPathD; overload;
- function Arc(const rec: TRectD;
- startAngle, endAngle: double; scale: double = 0): TPathD;
- function Pie(const rec: TRectD;
- StartAngle, EndAngle: double; scale: double = 0): TPathD;
- function FlattenQBezier(const pt1, pt2, pt3: TPointD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenQBezier(const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
- function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenCBezier(const path: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenCBezier(const paths: TPathsD;
- tolerance: double = 0.0): TPathsD; overload;
- function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
- //FlattenCSpline: Approximates the 'S' command inside the 'd' property of an
- //SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
- function FlattenCSpline(const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
- const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
- //FlattenQSpline: Approximates the 'T' command inside the 'd' property of an
- //SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
- function FlattenQSpline(const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
- const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
- //ArrowHead: The ctrlPt's only function is to control the angle of the arrow.
- function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
- arrowStyle: TArrowStyle): TPathD;
- function GetDefaultArrowHeadSize(lineWidth: double): double;
- procedure AdjustPoint(var pt: TPointD;
- const referencePt: TPointD; delta: double);
- function ShortenPath(const path: TPathD;
- pathEnd: TPathEnd; amount: double): TPathD;
- //GetDashPath: Returns a polyline (not polygons)
- function GetDashedPath(const path: TPathD;
- closed: Boolean; const pattern: TArrayOfDouble;
- patternOffset: PDouble): TPathsD;
- function GetDashedOutLine(const path: TPathD;
- closed: Boolean; const pattern: TArrayOfDouble;
- patternOffset: PDouble; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
- function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint; overload;
- function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload;
- function TranslatePath(const path: TPathD;
- dx, dy: double): TPathD; overload;
- function TranslatePath(const paths: TPathsD;
- dx, dy: double): TPathsD; overload;
- function TranslatePath(const ppp: TArrayOfPathsD;
- dx, dy: double): TArrayOfPathsD; overload;
- function Paths(const path: TPathD): TPathsD;
- {$IFDEF INLINING} inline; {$ENDIF}
- //CopyPath: note that only dynamic string arrays are copy-on-write
- function CopyPath(const path: TPathD): TPathD;
- {$IFDEF INLINING} inline; {$ENDIF}
- function CopyPaths(const paths: TPathsD): TPathsD;
- function ScalePoint(const pt: TPointD; scale: double): TPointD; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function ScalePoint(const pt: TPointD; sx, sy: double): TPointD; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function ScalePath(const path: TPathD;
- sx, sy: double): TPathD; overload;
- function ScalePath(const path: TPathD;
- scale: double): TPathD; overload;
- function ScalePath(const paths: TPathsD;
- sx, sy: double): TPathsD; overload;
- function ScalePath(const paths: TPathsD;
- scale: double): TPathsD; overload;
- function ScaleRect(const rec: TRect; scale: double): TRect; overload;
- function ScaleRect(const rec: TRectD; scale: double): TRectD; overload;
- function ScaleRect(const rec: TRect; sx, sy: double): TRect; overload;
- function ScaleRect(const rec: TRectD; sx, sy: double): TRectD; overload;
- function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
- function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
- function ReversePath(const path: TPathD): TPathD; overload;
- function ReversePath(const paths: TPathsD): TPathsD; overload;
- function OpenPathToFlatPolygon(const path: TPathD): TPathD;
- procedure AppendPoint(var path: TPathD; const extra: TPointD);
- // AppendPath - adds TPathD & TPathsD objects to the end of
- // TPathsD (or TArrayOfPathsD) objects
- procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload;
- procedure AppendPath(var paths: TPathsD; const extra: TPathsD); overload;
- procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD); overload;
- // ConcatPaths - concats multiple paths into a single path.
- // It also avoids point duplicates where path joins
- procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
- procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD); overload;
- function GetAngle(const origin, pt: TPoint): double; overload;
- function GetAngle(const origin, pt: TPointD): double; overload;
- function GetAngle(const a, b, c: TPoint): double; overload;
- function GetAngle(const a, b, c: TPointD): double; overload;
- procedure GetSinCos(angle: double; out sinA, cosA: double);
- function GetPointAtAngleAndDist(const origin: TPointD;
- angle, distance: double): TPointD;
- function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; overload;
- function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD; out ip: TPointD): Boolean; overload;
- function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
- function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
- out ip: TPointD): Boolean;
- procedure RotatePoint(var pt: TPointD;
- const focalPoint: TPointD; sinA, cosA: double); overload;
- procedure RotatePoint(var pt: TPointD;
- const focalPoint: TPointD; angleRad: double); overload;
- function RotatePath(const path: TPathD;
- const focalPoint: TPointD; angleRads: double): TPathD; overload;
- function RotatePath(const paths: TPathsD;
- const focalPoint: TPointD; angleRads: double): TPathsD; overload;
- //function MakePath(const pts: array of integer): TPathD; overload;
- function MakePath(const pts: array of double): TPathD; overload;
- function MakePath(const pt: TPointD): TPathD; overload;
- function GetBounds(const path: TPathD): TRect; overload;
- function GetBounds(const paths: TPathsD): TRect; overload;
- function GetBoundsD(const path: TPathD): TRectD; overload;
- function GetBoundsD(const paths: TPathsD): TRectD; overload;
- function GetBoundsD(const paths: TArrayOfPathsD): TRectD; overload;
- function GetRotatedRectBounds(const rec: TRect; angle: double): TRect; overload;
- function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD; overload;
- function Rect(const recD: TRectD): TRect; overload;
- function Rect(const left,top,right,bottom: integer): TRect; overload;
- function PtInRect(const rec: TRectD; const pt: TPointD): Boolean; overload;
- function Size(cx, cy: integer): TSize;
- function SizeD(cx, cy: double): TSizeD;
- function IsClockwise(const path: TPathD): Boolean;
- // IsSimpleRectanglePath returns true if the specified path has only one polygon
- // with 4 points that describe a rectangle.
- function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean; overload;
- function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean; overload;
- function Area(const path: TPathD): Double; overload;
- function RectsEqual(const rec1, rec2: TRect): Boolean;
- procedure TranslateRect(var rec: TRect; dx, dy: integer); overload;
- procedure TranslateRect(var rec: TRectD; dx, dy: double); overload;
- function MakeSquare(rec: TRect): TRect;
- function IsValid(value: integer): Boolean; overload;
- function IsValid(value: double): Boolean; overload;
- function IsValid(const pt: TPoint): Boolean; overload;
- function IsValid(const pt: TPointD): Boolean; overload;
- function IsValid(const rec: TRect): Boolean; overload;
- function Point(X,Y: Integer): TPoint; overload;
- function Point(const pt: TPointD): TPoint; overload;
- function PointsEqual(const pt1, pt2: TPointD): Boolean; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function PointsNearEqual(const pt1, pt2: TPoint;
- dist: integer): Boolean; overload;
- function PointsNearEqual(const pt1, pt2: TPointD;
- distSqrd: double): Boolean; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function StripNearDuplicates(const path: TPathD;
- minDist: double; isClosedPath: Boolean): TPathD; overload;
- function StripNearDuplicates(const paths: TPathsD;
- minLength: double; isClosedPaths: Boolean): TPathsD; overload;
- function MidPoint(const rec: TRect): TPoint; overload;
- function MidPoint(const rec: TRectD): TPointD; overload;
- function MidPoint(const pt1, pt2: TPoint): TPoint; overload;
- function MidPoint(const pt1, pt2: TPointD): TPointD; overload;
- function Average(val1, val2: integer): integer; overload;
- function Average(val1, val2: double): double; overload;
- function ReflectPoint(const pt, pivot: TPointD): TPointD;
- {$IFDEF INLINING} inline; {$ENDIF}
- function RectsOverlap(const rec1, rec2: TRect): Boolean;
- function IsSameRect(const rec1, rec2: TRect): Boolean;
- function RectsIntersect(const rec1, rec2: TRect): Boolean; overload;
- function RectsIntersect(const rec1, rec2: TRectD): Boolean; overload;
- function IntersectRect(const rec1, rec2: TRectD): TRectD; overload;
- // UnionRect: this behaves differently to types.UnionRect
- // in that if either parameter is empty the other parameter is returned
- function UnionRect(const rec1, rec2: TRect): TRect; overload;
- function UnionRect(const rec1, rec2: TRectD): TRectD; overload;
- //these 2 functions are only needed to support older versions of Delphi
- function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
- function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
- function CrossProduct(const vector1, vector2: TPointD): double; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function DotProduct(const vector1, vector2: TPointD): double; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function DotProduct(const pt1, pt2, pt3: TPointD): double; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
- {$IFDEF INLINING} inline; {$ENDIF}
- function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
- {$IFDEF INLINING} inline; {$ENDIF}
- function IsPathConvex(const path: TPathD): Boolean;
- function NormalizeVector(const vec: TPointD): TPointD;
- {$IFDEF INLINING} inline; {$ENDIF}
- //GetUnitVector: Used internally
- function GetUnitVector(const pt1, pt2: TPointD): TPointD;
- //GetUnitNormal: Used internally
- function GetUnitNormal(const pt1, pt2: TPointD): TPointD; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean; overload;
- {$IFDEF INLINING} inline; {$ENDIF}
- function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
- {$IFDEF INLINING} inline; {$ENDIF}
- //GetVectors: Used internally
- function GetVectors(const path: TPathD): TPathD;
- //GetNormals: Used internally
- function GetNormals(const path: TPathD): TPathD;
- //DistanceSqrd: Used internally
- function DistanceSqrd(const pt1, pt2: TPoint): double; overload;
- {$IFDEF INLINE} inline; {$ENDIF}
- //DistanceSqrd: Used internally
- function DistanceSqrd(const pt1, pt2: TPointD): double; overload;
- {$IFDEF INLINE} inline; {$ENDIF}
- function Distance(const pt1, pt2: TPoint): double; overload;
- {$IFDEF INLINE} inline; {$ENDIF}
- function Distance(const pt1, pt2: TPointD): double; overload;
- {$IFDEF INLINE} inline; {$ENDIF}
- function Distance(const path: TPathD; stopAt: integer = 0): double; overload;
- function GetDistances(const path: TPathD): TArrayOfDouble;
- function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
- function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
- function PointInPolygon(const pt: TPointD;
- const polygon: TPathD; fillRule: TFillRule): Boolean;
- function PointInPolygons(const pt: TPointD;
- const polygons: TPathsD; fillRule: TFillRule): Boolean;
- function PerpendicularDist(const pt, line1, line2: TPointD): double;
- function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
- function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
- function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
- //GetLineEllipseIntersects: Gets the intersection of a line and
- //an ellipse. The function succeeds when the line either touches
- //tangentially or passes through the ellipse. If the line touches
- //tangentially, the coordintates returned in pt1 and pt2 will match.
- function GetLineEllipseIntersects(const ellipseRec: TRect;
- var linePt1, linePt2: TPointD): Boolean;
- function GetPtOnEllipseFromAngle(const ellipseRect: TRectD; angle: double): TPointD;
- function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
- ellipseRotAngle, angle: double): TPointD;
- function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
- const pt: TPointD): double;
- function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
- ellipseRotAngle: double; pt: TPointD): double;
- function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
- ellipseRotation: double; const pt: TPointD): TPointD;
- // RoughOutline: outlines are **rough** because they will contain numerous
- // self-intersections and negative area regions. (This untidiness will be
- // hidden as long as the NonZero fill rule is applied when rendering, and
- // this function will be **much** faster than Img32.Clipper.InflatePaths.)
- // The 'scale' parameter doesn't actually scale the returned outline, it's
- // only a warning of future scaling and used to guide the returned precision.
- // RoughOutline is intended mostly for internal use.
- function RoughOutline(const line: TPathD; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle;
- miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
- function RoughOutline(const lines: TPathsD; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle;
- miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
- // Grow: For the same reasons stated in RoughOutline's comments above,
- // this function is also intended mostly for internal use
- function Grow(const path, normals: TPathD; delta: double;
- joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0; isOpen: Boolean = false): TPathD;
- function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
- function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
- const
- Invalid = -MaxInt;
- InvalidD = -Infinity;
- NullPoint : TPoint = (X: 0; Y: 0);
- NullPointD : TPointD = (X: 0; Y: 0);
- InvalidPoint : TPoint = (X: -MaxInt; Y: -MaxInt);
- InvalidPointD : TPointD = (X: -Infinity; Y: -Infinity);
- NullRect : TRect = (left: 0; top: 0; right: 0; Bottom: 0);
- NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0);
- InvalidRect : TRect = (left: MaxInt; top: MaxInt; right: 0; Bottom: 0);
- BezierTolerance: double = 0.25;
- DoubleTolerance: double = 1.0e-12;
- var
- //AutoWidthThreshold: When JoinStyle = jsAuto, this is the threshold at
- //which line joins will be rounded instead of squared. With wider strokes,
- //rounded joins generally look better, but as rounding is more complex it
- //also requries more processing and hence is slower to execute.
- AutoWidthThreshold: double = 5.0;
- //When lines are too narrow, they become too faint to sensibly draw
- MinStrokeWidth: double = 0.5;
- //Miter limit avoids excessive spikes when line offsetting
- DefaultMiterLimit: double = 4.0;
- resourcestring
- rsInvalidMatrix = 'Invalid matrix.'; //nb: always start with IdentityMatrix
- implementation
- uses
- Img32.Transform;
- resourcestring
- rsInvalidQBezier = 'Invalid number of control points for a QBezier';
- rsInvalidCBezier = 'Invalid number of control points for a CBezier';
- const
- BuffSize = 64;
- {$IFDEF CPUX86}
- // Use faster Trunc for x86 code in this unit.
- Trunc: function(Value: Double): Integer = __Trunc;
- {$ENDIF CPUX86}
- //------------------------------------------------------------------------------
- // TSizeD
- //------------------------------------------------------------------------------
- function TSizeD.average: double;
- begin
- Result := (cx + cy) * 0.5;
- end;
- //------------------------------------------------------------------------------
- // TRectWH record/object.
- //------------------------------------------------------------------------------
- function TRectWH.IsEmpty: Boolean;
- begin
- Result := (Width <= 0) or (Height <= 0);
- end;
- //------------------------------------------------------------------------------
- function TRectWH.IsValid: Boolean;
- begin
- Result := (Left <> InvalidD) and (Top <> InvalidD)
- and (Width >= 0) and (Height >= 0);
- end;
- //------------------------------------------------------------------------------
- function TRectWH.Right: double;
- begin
- Result := Left + Width;
- end;
- //------------------------------------------------------------------------------
- function TRectWH.Bottom: double;
- begin
- Result := Top + Height;
- end;
- //------------------------------------------------------------------------------
- function TRectWH.Contains(const Pt: TPoint): Boolean;
- begin
- Result := (pt.X >= Left) and (pt.X <= Left + Width) and
- (pt.Y >= Top) and (pt.Y <= Top + Height)
- end;
- //------------------------------------------------------------------------------
- function TRectWH.Contains(const Pt: TPointD): Boolean;
- begin
- Result := (pt.X >= Left) and (pt.X <= Left + Width) and
- (pt.Y >= Top) and (pt.Y <= Top + Height)
- end;
- //------------------------------------------------------------------------------
- function TRectWH.MidPoint: TPointD;
- begin
- Result := PointD(left + Width * 0.5, top + Height * 0.5);
- end;
- //------------------------------------------------------------------------------
- function TRectWH.RectD: TRectD;
- begin
- Result := Img32.RectD(left, top, left + Width, top + Height);
- end;
- //------------------------------------------------------------------------------
- function TRectWH.Rect: TRect;
- begin
- Result := Img32.Vector.Rect(RectD);
- end;
- //------------------------------------------------------------------------------
- function RectWH(left, top, width, height: integer): TRectWH;
- begin
- Result.Left := left;
- Result.Top := top;
- Result.Width := width;
- Result.Height := height;
- end;
- //------------------------------------------------------------------------------
- function RectWH(left, top, width, height: double): TRectWH;
- begin
- Result.Left := left;
- Result.Top := top;
- Result.Width := width;
- Result.Height := height;
- end;
- //------------------------------------------------------------------------------
- function RectWH(const rec: TRectD): TRectWH;
- begin
- Result.Left := rec.left;
- Result.Top := rec.top;
- Result.Width := rec.width;
- Result.Height := rec.height;
- end;
- //------------------------------------------------------------------------------
- function RectsEqual(const rec1, rec2: TRect): Boolean;
- begin
- result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
- (rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
- end;
- //------------------------------------------------------------------------------
- function Rect(const left, top, right, bottom: integer): TRect;
- begin
- Result.Left := left;
- Result.Top := top;
- Result.Right := right;
- Result.Bottom := bottom;
- end;
- //------------------------------------------------------------------------------
- function IsValid(value: integer): Boolean;
- begin
- Result := value <> -MaxInt;
- end;
- //------------------------------------------------------------------------------
- function IsValid(value: double): Boolean;
- begin
- Result := value <> InvalidD;
- end;
- //------------------------------------------------------------------------------
- function IsValid(const pt: TPoint): Boolean;
- begin
- result := (pt.X <> Invalid) and (pt.Y <> Invalid);
- end;
- //------------------------------------------------------------------------------
- function IsValid(const pt: TPointD): Boolean;
- begin
- result := (pt.X <> -Infinity) and (pt.Y <> -Infinity);
- end;
- //------------------------------------------------------------------------------
- function IsValid(const rec: TRect): Boolean;
- begin
- result := (rec.Left <> MaxInt) and (rec.Top <> MaxInt);
- end;
- //------------------------------------------------------------------------------
- function Point(X,Y: Integer): TPoint;
- begin
- result.X := X;
- result.Y := Y;
- end;
- //------------------------------------------------------------------------------
- function Point(const pt: TPointD): TPoint;
- begin
- result.X := Round(pt.x);
- result.Y := Round(pt.y);
- end;
- //------------------------------------------------------------------------------
- function PointsEqual(const pt1, pt2: TPointD): Boolean;
- begin
- result := (pt1.X = pt2.X) and (pt1.Y = pt2.Y);
- end;
- //------------------------------------------------------------------------------
- function PointsNearEqual(const pt1, pt2: TPoint; dist: integer): Boolean;
- begin
- Result := (Abs(pt1.X - pt2.X) <= dist) and (Abs(pt1.Y - pt2.Y) < dist);
- end;
- //------------------------------------------------------------------------------
- function PointsNearEqual(const pt1, pt2: TPointD; distSqrd: double): Boolean;
- begin
- Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distSqrd;
- end;
- //------------------------------------------------------------------------------
- function StripNearDuplicates(const path: TPathD;
- minDist: double; isClosedPath: Boolean): TPathD;
- var
- i,j, len: integer;
- begin
- len := length(path);
- NewPointDArray(Result, len, True);
- if len = 0 then Exit;
- Result[0] := path[0];
- j := 0;
- minDist := minDist * minDist;
- for i := 1 to len -1 do
- if not PointsNearEqual(Result[j], path[i], minDist) then
- begin
- inc(j);
- Result[j] := path[i];
- end;
- if isClosedPath and
- PointsNearEqual(Result[j], Result[0], minDist) then dec(j);
- SetLength(Result, j +1);
- end;
- //------------------------------------------------------------------------------
- function StripNearDuplicates(const paths: TPathsD;
- minLength: double; isClosedPaths: Boolean): TPathsD;
- var
- i, len: integer;
- begin
- len := Length(paths);
- SetLength(Result, len);
- for i := 0 to len -1 do
- Result[i] := StripNearDuplicates(paths[i], minLength, isClosedPaths);
- end;
- //------------------------------------------------------------------------------
- function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
- {$IFDEF INLINE} inline; {$ENDIF}
- begin
- Result := Abs(val) < epsilon;
- end;
- //------------------------------------------------------------------------------
- function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
- {$IFDEF INLINE} inline; {$ENDIF}
- begin
- Result := Abs(val-1) < epsilon;
- end;
- //------------------------------------------------------------------------------
- procedure GetSinCos(angle: double; out sinA, cosA: double);
- {$IFDEF INLINE} inline; {$ENDIF}
- {$IFNDEF FPC}
- var s, c: extended;
- {$ENDIF}
- begin
- {$IFDEF FPC}
- Math.SinCos(angle, sinA, cosA);
- {$ELSE}
- Math.SinCos(angle, s, c);
- sinA := s; cosA := c;
- {$ENDIF}
- end;
- //------------------------------------------------------------------------------
- function GetRotatedRectBounds(const rec: TRect; angle: double): TRect;
- var
- p: TPathD;
- mp: TPointD;
- begin
- p := Rectangle(rec);
- mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
- if angle <> 0 then
- p := RotatePath(p, mp, angle);
- Result := GetBounds(p);
- end;
- //------------------------------------------------------------------------------
- function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD;
- var
- p: TPathD;
- mp: TPointD;
- begin
- p := Rectangle(rec);
- mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
- if angle <> 0 then
- p := RotatePath(p, mp, angle);
- Result := GetBoundsD(p);
- end;
- //------------------------------------------------------------------------------
- function Rect(const recD: TRectD): TRect;
- begin
- // see https://github.com/AngusJohnson/Image32/issues/15
- Result.Left := Floor(recD.Left + DoubleTolerance);
- Result.Top := Floor(recD.Top + DoubleTolerance);
- Result.Right := Ceil(recD.Right - DoubleTolerance);
- Result.Bottom := Ceil(recD.Bottom - DoubleTolerance);
- end;
- //------------------------------------------------------------------------------
- function PtInRect(const rec: TRectD; const pt: TPointD): Boolean;
- begin
- Result := (pt.X >= rec.Left) and (pt.X < rec.Right) and
- (pt.Y >= rec.Top) and (pt.Y < rec.Bottom);
- end;
- //------------------------------------------------------------------------------
- function Size(cx, cy: integer): TSize;
- begin
- Result.cx := cx;
- Result.cy := cy;
- end;
- //------------------------------------------------------------------------------
- function SizeD(cx, cy: double): TSizeD;
- begin
- Result.cx := cx;
- Result.cy := cy;
- end;
- //------------------------------------------------------------------------------
- function IsClockwise(const path: TPathD): Boolean;
- begin
- Result := Area(path) > 0;
- end;
- //------------------------------------------------------------------------------
- function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean;
- type
- TLastMatch = (lmX, lmY);
- var
- i: Integer;
- lastMatch: TLastMatch;
- begin
- Result := False;
- // If we have a single path with 4 points, it could be a rectangle
- if Length(path) = 4 then
- begin
- // For a rectangle the X and Y coordinates of the points alternate
- // in being equal
- if path[0].X = path[3].X then
- lastMatch := lmX
- else if path[0].Y = path[3].Y then
- lastMatch := lmY
- else
- Exit;
- R.Left := Trunc(path[0].X);
- R.Top := Trunc(path[0].Y);
- R.Right := Ceil(path[0].X);
- R.Bottom := Ceil(path[0].Y);
- for i := 1 to 3 do
- begin
- case lastMatch of
- lmY: // now the X-coordinates must be equal
- begin
- if path[i].X <> path[i - 1].X then Exit;
- lastMatch := lmX;
- R.Top := Min(R.Top, Trunc(path[i].Y));
- R.Bottom := Max(R.Bottom, Ceil(path[i].Y));
- end;
- lmX: // now the Y-coordinates must be equal
- begin
- if path[i].Y <> path[i - 1].Y then Exit;
- lastMatch := lmY;
- R.Left := Min(R.Left, Trunc(path[i].X));
- R.Right := Max(R.Right, Ceil(path[i].X));
- end;
- end;
- end;
- Result := True;
- end;
- end;
- //------------------------------------------------------------------------------
- function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean;
- begin
- if (Length(paths) = 1) and (Length(paths[0]) = 4) then
- Result := IsSimpleRectanglePath(paths[0], r)
- else
- Result := False;
- end;
- //------------------------------------------------------------------------------
- function Area(const path: TPathD): Double;
- var
- i, j, highI: Integer;
- d: Double;
- begin
- Result := 0.0;
- highI := High(path);
- if (highI < 2) then Exit;
- j := highI;
- for i := 0 to highI do
- begin
- d := (path[j].X + path[i].X);
- Result := Result + d * (path[j].Y - path[i].Y);
- j := i;
- end;
- Result := -Result * 0.5;
- end;
- //------------------------------------------------------------------------------
- procedure TranslateRect(var rec: TRect; dx, dy: integer);
- begin
- rec.Left := rec.Left + dx;
- rec.Top := rec.Top + dy;
- rec.Right := rec.Right + dx;
- rec.Bottom := rec.Bottom + dy;
- end;
- //------------------------------------------------------------------------------
- procedure TranslateRect(var rec: TRectD; dx, dy: double);
- begin
- rec.Left := rec.Left + dx;
- rec.Top := rec.Top + dy;
- rec.Right := rec.Right + dx;
- rec.Bottom := rec.Bottom + dy;
- end;
- //------------------------------------------------------------------------------
- function MakeSquare(rec: TRect): TRect;
- var
- i: integer;
- begin
- Result := rec;
- i := ((rec.Right - rec.Left) + (rec.Bottom - rec.Top)) div 2;
- Result.Right := Result.Left + i;
- Result.Bottom := Result.Top + i;
- end;
- //------------------------------------------------------------------------------
- function MidPoint(const rec: TRect): TPoint;
- begin
- Result.X := (rec.Left + rec.Right) div 2;
- Result.Y := (rec.Top + rec.Bottom) div 2;
- end;
- //------------------------------------------------------------------------------
- function MidPoint(const rec: TRectD): TPointD;
- begin
- Result.X := (rec.Left + rec.Right) * 0.5;
- Result.Y := (rec.Top + rec.Bottom) * 0.5;
- end;
- //------------------------------------------------------------------------------
- function MidPoint(const pt1, pt2: TPoint): TPoint;
- begin
- Result.X := (pt1.X + pt2.X) div 2;
- Result.Y := (pt1.Y + pt2.Y) div 2;
- end;
- //------------------------------------------------------------------------------
- function MidPoint(const pt1, pt2: TPointD): TPointD;
- begin
- Result.X := (pt1.X + pt2.X) * 0.5;
- Result.Y := (pt1.Y + pt2.Y) * 0.5;
- end;
- //------------------------------------------------------------------------------
- function Average(val1, val2: integer): integer;
- begin
- Result := (val1 + val2) div 2;
- end;
- //------------------------------------------------------------------------------
- function Average(val1, val2: double): double;
- begin
- Result := (val1 + val2) * 0.5;
- end;
- //------------------------------------------------------------------------------
- function RectsOverlap(const rec1, rec2: TRect): Boolean;
- begin
- Result := (rec1.Left < rec2.Right) and (rec1.Right > rec2.Left) and
- (rec1.Top < rec2.Bottom) and (rec1.Bottom > rec2.Top);
- end;
- //------------------------------------------------------------------------------
- function IsSameRect(const rec1, rec2: TRect): Boolean;
- begin
- Result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
- (rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
- end;
- //------------------------------------------------------------------------------
- function RectsIntersect(const rec1, rec2: TRect): Boolean;
- var
- dummy: TRect;
- begin
- Result := Types.IntersectRect(dummy, rec1, rec2);
- end;
- //------------------------------------------------------------------------------
- function RectsIntersect(const rec1, rec2: TRectD): Boolean;
- begin
- Result := not IntersectRect(rec1, rec2).IsEmpty;
- end;
- //------------------------------------------------------------------------------
- function IntersectRect(const rec1, rec2: TRectD): TRectD;
- begin
- result.Left := Max(rec1.Left, rec2.Left);
- result.Top := Max(rec1.Top, rec2.Top);
- result.Right := Min(rec1.Right, rec2.Right);
- result.Bottom := Min(rec1.Bottom, rec2.Bottom);
- end;
- //------------------------------------------------------------------------------
- function UnionRect(const rec1, rec2: TRect): TRect;
- begin
- if IsEmptyRect(rec1) then
- Result := rec2
- else if IsEmptyRect(rec2) then
- Result := rec1
- else
- begin
- result.Left := Min(rec1.Left, rec2.Left);
- result.Top := Min(rec1.Top, rec2.Top);
- result.Right := Max(rec1.Right, rec2.Right);
- result.Bottom := Max(rec1.Bottom, rec2.Bottom);
- end;
- end;
- //------------------------------------------------------------------------------
- function UnionRect(const rec1, rec2: TRectD): TRectD;
- begin
- if IsEmptyRect(rec1) then
- Result := rec2
- else if IsEmptyRect(rec2) then
- Result := rec1
- else
- begin
- result.Left := Min(rec1.Left, rec2.Left);
- result.Top := Min(rec1.Top, rec2.Top);
- result.Right := Max(rec1.Right, rec2.Right);
- result.Bottom := Max(rec1.Bottom, rec2.Bottom);
- end;
- end;
- //------------------------------------------------------------------------------
- function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
- var
- i, len: integer;
- begin
- len := Length(ints);
- NewIntegerArray(Result, len, True);
- for i := 0 to len -1 do Result[i] := ints[i];
- end;
- //------------------------------------------------------------------------------
- function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
- var
- i, len: integer;
- begin
- len := Length(doubles);
- SetLength(Result, len);
- for i := 0 to len -1 do Result[i] := doubles[i];
- end;
- //------------------------------------------------------------------------------
- function CrossProduct(const vector1, vector2: TPointD): double;
- begin
- result := vector1.X * vector2.Y - vector2.X * vector1.Y;
- end;
- //------------------------------------------------------------------------------
- function CrossProduct(const pt1, pt2, pt3: TPointD): double;
- var
- x1,x2,y1,y2: double;
- begin
- x1 := pt2.X - pt1.X;
- y1 := pt2.Y - pt1.Y;
- x2 := pt3.X - pt2.X;
- y2 := pt3.Y - pt2.Y;
- result := (x1 * y2 - y1 * x2);
- end;
- //---------------------------------------------------------------------------
- function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double;
- var
- x1,x2,y1,y2: double;
- begin
- x1 := pt2.X - pt1.X;
- y1 := pt2.Y - pt1.Y;
- x2 := pt4.X - pt3.X;
- y2 := pt4.Y - pt3.Y;
- result := (x1 * y2 - y1 * x2);
- end;
- //---------------------------------------------------------------------------
- function DotProduct(const vector1, vector2: TPointD): double;
- begin
- result := vector1.X * vector2.X + vector1.Y * vector2.Y;
- end;
- //------------------------------------------------------------------------------
- function DotProduct(const pt1, pt2, pt3: TPointD): double;
- var
- x1,x2,y1,y2: double;
- begin
- x1 := pt2.X - pt1.X;
- y1 := pt2.Y - pt1.Y;
- x2 := pt2.X - pt3.X;
- y2 := pt2.Y - pt3.Y;
- result := (x1 * x2 + y1 * y2);
- end;
- //------------------------------------------------------------------------------
- function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
- begin
- result := CrossProduct(pt1, pt2, pt3) < 0;
- end;
- //------------------------------------------------------------------------------
- function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
- begin
- result := CrossProduct(pt1, pt2, pt3) > 0;
- end;
- //------------------------------------------------------------------------------
- function IsPathConvex(const path: TPathD): Boolean;
- var
- i, pathLen: integer;
- dir: boolean;
- begin
- result := false;
- pathLen := length(path);
- if pathLen < 3 then Exit;
- //get the winding direction of the first angle
- dir := TurnsRight(path[0], path[1], path[2]);
- //check that each other angle has the same winding direction
- for i := 1 to pathLen -1 do
- if TurnsRight(path[i], path[(i+1) mod pathLen],
- path[(i+2) mod pathLen]) <> dir then Exit;
- result := true;
- end;
- //------------------------------------------------------------------------------
- function GetUnitVector(const pt1, pt2: TPointD): TPointD;
- var
- dx, dy, inverseHypot: Double;
- begin
- if (pt1.x = pt2.x) and (pt1.y = pt2.y) then
- begin
- Result.X := 0;
- Result.Y := 0;
- Exit;
- end;
- dx := (pt2.X - pt1.X);
- dy := (pt2.Y - pt1.Y);
- inverseHypot := 1 / Hypot(dx, dy);
- dx := dx * inverseHypot;
- dy := dy * inverseHypot;
- Result.X := dx;
- Result.Y := dy;
- end;
- //------------------------------------------------------------------------------
- function GetUnitNormal(const pt1, pt2: TPointD): TPointD;
- begin
- if not GetUnitNormal(pt1, pt2, Result) then
- Result := NullPointD;
- end;
- //------------------------------------------------------------------------------
- function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean;
- var
- dx, dy, inverseHypot: Double;
- begin
- result := not PointsNearEqual(pt1, pt2, 0.001);
- if not result then Exit;
- dx := (pt2.X - pt1.X);
- dy := (pt2.Y - pt1.Y);
- inverseHypot := 1 / Hypot(dx, dy);
- dx := dx * inverseHypot;
- dy := dy * inverseHypot;
- norm.X := dy;
- norm.Y := -dx
- end;
- //------------------------------------------------------------------------------
- function NormalizeVector(const vec: TPointD): TPointD;
- var
- h, inverseHypot: Double;
- begin
- h := Hypot(vec.X, vec.Y);
- if ValueAlmostZero(h, 0.001) then
- begin
- Result := NullPointD;
- Exit;
- end;
- inverseHypot := 1 / h;
- Result.X := vec.X * inverseHypot;
- Result.Y := vec.Y * inverseHypot;
- end;
- //------------------------------------------------------------------------------
- function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
- begin
- Result := NormalizeVector(PointD(vec1.X + vec2.X, vec1.Y + vec2.Y));
- end;
- //------------------------------------------------------------------------------
- function Paths(const path: TPathD): TPathsD;
- begin
- SetLength(Result, 1);
- result[0] := Copy(path, 0, length(path));
- end;
- //------------------------------------------------------------------------------
- function CopyPath(const path: TPathD): TPathD;
- begin
- Result := Copy(path, 0, Length(path));
- end;
- //------------------------------------------------------------------------------
- function CopyPaths(const paths: TPathsD): TPathsD;
- var
- i, len1: integer;
- begin
- len1 := length(paths);
- setLength(result, len1);
- for i := 0 to len1 -1 do
- result[i] := Copy(paths[i], 0, length(paths[i]));
- end;
- //------------------------------------------------------------------------------
- function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint;
- begin
- result.x := pt.x + dx;
- result.y := pt.y + dy;
- end;
- //------------------------------------------------------------------------------
- function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD;
- begin
- result.x := pt.x + dx;
- result.y := pt.y + dy;
- end;
- //------------------------------------------------------------------------------
- function TranslatePath(const path: TPathD; dx, dy: double): TPathD;
- var
- i, len: integer;
- begin
- len := length(path);
- NewPointDArray(result, len, True);
- for i := 0 to len -1 do
- begin
- result[i].x := path[i].x + dx;
- result[i].y := path[i].y + dy;
- end;
- end;
- //------------------------------------------------------------------------------
- function TranslatePath(const paths: TPathsD;
- dx, dy: double): TPathsD;
- var
- i,len: integer;
- begin
- len := length(paths);
- setLength(result, len);
- for i := 0 to len -1 do
- result[i] := TranslatePath(paths[i], dx, dy);
- end;
- //------------------------------------------------------------------------------
- function TranslatePath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD;
- var
- i,len: integer;
- begin
- len := length(ppp);
- setLength(result, len);
- for i := 0 to len -1 do
- result[i] := TranslatePath(ppp[i], dx, dy);
- end;
- //------------------------------------------------------------------------------
- function ScalePoint(const pt: TPointD; scale: double): TPointD;
- begin
- Result.X := pt.X * scale;
- Result.Y := pt.Y * scale;
- end;
- //------------------------------------------------------------------------------
- function ScalePoint(const pt: TPointD; sx, sy: double): TPointD;
- begin
- Result.X := pt.X * sx;
- Result.Y := pt.Y * sy;
- end;
- //------------------------------------------------------------------------------
- function ScalePath(const path: TPathD; sx, sy: double): TPathD;
- var
- i, len: integer;
- begin
- if (sx = 0) or (sy = 0) then
- Result := nil
- else if ((sx = 1) and (sy = 1)) then
- begin
- Result := Copy(path, 0, Length(path));
- end else
- begin
- len := length(path);
- NewPointDArray(result, len, True);
- for i := 0 to len -1 do
- begin
- result[i].x := path[i].x * sx;
- result[i].y := path[i].y * sy;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function ScalePath(const path: TPathD;
- scale: double): TPathD;
- begin
- result := ScalePath(path, scale, scale);
- end;
- //------------------------------------------------------------------------------
- function ScalePath(const paths: TPathsD;
- sx, sy: double): TPathsD;
- var
- i,len: integer;
- begin
- len := length(paths);
- setLength(result, len);
- for i := 0 to len -1 do
- result[i] := ScalePath(paths[i], sx, sy);
- end;
- //------------------------------------------------------------------------------
- function ScalePath(const paths: TPathsD;
- scale: double): TPathsD;
- begin
- result := ScalePath(paths, scale, scale);
- end;
- //------------------------------------------------------------------------------
- function ScaleRect(const rec: TRect; scale: double): TRect;
- begin
- result := rec;
- Result.Left := Round(Result.Left * scale);
- Result.Top := Round(Result.Top * scale);
- Result.Right := Round(Result.Right * scale);
- Result.Bottom := Round(Result.Bottom * scale);
- end;
- //------------------------------------------------------------------------------
- function ScaleRect(const rec: TRect; sx, sy: double): TRect;
- begin
- result := rec;
- Result.Left := Round(Result.Left * sx);
- Result.Top := Round(Result.Top * sy);
- Result.Right := Round(Result.Right * sx);
- Result.Bottom := Round(Result.Bottom * sy);
- end;
- //------------------------------------------------------------------------------
- function ScaleRect(const rec: TRectD; scale: double): TRectD;
- begin
- result := rec;
- Result.Left := Result.Left * scale;
- Result.Top := Result.Top * scale;
- Result.Right := Result.Right * scale;
- Result.Bottom := Result.Bottom * scale;
- end;
- //------------------------------------------------------------------------------
- function ScaleRect(const rec: TRectD; sx, sy: double): TRectD;
- begin
- result := rec;
- Result.Left := Result.Left * sx;
- Result.Top := Result.Top * sy;
- Result.Right := Result.Right * sx;
- Result.Bottom := Result.Bottom * sy;
- end;
- //------------------------------------------------------------------------------
- function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
- var
- pathWidth, pathHeight, outHeight, outWidth: integer;
- pathBounds: TRect;
- scale: double;
- begin
- pathBounds := GetBounds(path);
- RectWidthHeight(pathBounds, pathWidth, pathHeight);
- RectWidthHeight(rec, outWidth, outHeight);
- Result := TranslatePath(path,
- rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
- if outWidth / pathWidth < outHeight / pathHeight then
- scale := outWidth / pathWidth else
- scale := outHeight / pathHeight;
- Result := ScalePath(Result, scale, scale);
- end;
- //------------------------------------------------------------------------------
- function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
- var
- pathWidth, pathHeight, outHeight, outWidth: integer;
- pathBounds: TRect;
- scale: double;
- begin
- pathBounds := GetBounds(paths);
- RectWidthHeight(pathBounds, pathWidth, pathHeight);
- RectWidthHeight(rec, outWidth, outHeight);
- Result := TranslatePath(paths,
- rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
- if outWidth / pathWidth < outHeight / pathHeight then
- scale := outWidth / pathWidth else
- scale := outHeight / pathHeight;
- Result := ScalePath(Result, scale, scale);
- end;
- //------------------------------------------------------------------------------
- function ReversePath(const path: TPathD): TPathD;
- var
- i, highI: integer;
- begin
- highI := High(path);
- NewPointDArray(result, highI +1, True);
- for i := 0 to highI do
- result[i] := path[highI -i];
- end;
- //------------------------------------------------------------------------------
- function ReversePath(const paths: TPathsD): TPathsD;
- var
- i, len: integer;
- begin
- len := Length(paths);
- SetLength(result, len);
- for i := 0 to len -1 do
- result[i] := ReversePath(paths[i]);
- end;
- //------------------------------------------------------------------------------
- function OpenPathToFlatPolygon(const path: TPathD): TPathD;
- var
- i, len, len2: integer;
- begin
- len := Length(path);
- len2 := Max(0, len - 2);
- NewPointDArray(Result, len + len2, True);
- if len = 0 then Exit;
- Move(path[0], Result[0], len * SizeOf(TPointD));
- if len2 = 0 then Exit;
- for i := 0 to len - 3 do
- result[len + i] := path[len - 2 -i];
- end;
- //------------------------------------------------------------------------------
- function GetVectors(const path: TPathD): TPathD;
- var
- i,j, len: cardinal;
- pt: TPointD;
- begin
- len := length(path);
- NewPointDArray(result, len, True);
- if len = 0 then Exit;
- pt := path[0];
- //skip duplicates
- i := len -1;
- while (i > 0) and
- (path[i].X = pt.X) and (path[i].Y = pt.Y) do dec(i);
- if (i = 0) then
- begin
- //all points are equal!
- for i := 0 to len -1 do result[i] := PointD(0,0);
- Exit;
- end;
- result[i] := GetUnitVector(path[i], pt);
- //fix up any duplicates at the end of the path
- for j := i +1 to len -1 do
- result[j] := result[j-1];
- //with at least one valid vector, we can now
- //safely get the remaining vectors
- pt := path[i];
- for i := i -1 downto 0 do
- begin
- if (path[i].X <> pt.X) or (path[i].Y <> pt.Y) then
- begin
- result[i] := GetUnitVector(path[i], pt);
- pt := path[i];
- end else
- result[i] := result[i+1]
- end;
- end;
- //------------------------------------------------------------------------------
- function GetNormals(const path: TPathD): TPathD;
- var
- i, highI: integer;
- last: TPointD;
- begin
- highI := High(path);
- NewPointDArray(result, highI+1, True);
- if highI < 0 then Exit;
- last := NullPointD;
- for i := 0 to highI -1 do
- begin
- if GetUnitNormal(path[i], path[i+1], result[i]) then
- last := result[i] else
- result[i] := last;
- end;
- if GetUnitNormal(path[highI], path[0], result[highI]) then
- last := result[highI];
- for i := 0 to highI do
- begin
- if (result[i].X <> 0) or (result[i].Y <> 0) then Break;
- result[i] := last;
- end;
- end;
- //------------------------------------------------------------------------------
- function DistanceSqrd(const pt1, pt2: TPoint): double;
- begin
- result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
- end;
- //------------------------------------------------------------------------------
- function DistanceSqrd(const pt1, pt2: TPointD): double;
- begin
- result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
- end;
- //------------------------------------------------------------------------------
- function Distance(const pt1, pt2: TPoint): double;
- begin
- Result := Sqrt(DistanceSqrd(pt1, pt2));
- end;
- //------------------------------------------------------------------------------
- function Distance(const pt1, pt2: TPointD): double;
- begin
- Result := Sqrt(DistanceSqrd(pt1, pt2));
- end;
- //------------------------------------------------------------------------------
- function Distance(const path: TPathD; stopAt: integer): double;
- var
- i, highI: integer;
- begin
- Result := 0;
- highI := High(path);
- if (stopAt > 0) and (stopAt < HighI) then highI := stopAt;
- for i := 1 to highI do
- Result := Result + Distance(path[i-1],path[i]);
- end;
- //------------------------------------------------------------------------------
- function GetDistances(const path: TPathD): TArrayOfDouble;
- var
- i, len: integer;
- begin
- len := Length(path);
- SetLength(Result, len);
- if len = 0 then Exit;
- Result[0] := 0;
- for i := 1 to len -1 do
- Result[i] := Distance(path[i-1], path[i]);
- end;
- //------------------------------------------------------------------------------
- function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
- var
- i, len: integer;
- begin
- len := Length(path);
- SetLength(Result, len);
- if len = 0 then Exit;
- Result[0] := 0;
- for i := 1 to len -1 do
- Result[i] := Result[i-1] + Distance(path[i-1], path[i]);
- end;
- //------------------------------------------------------------------------------
- function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
- var
- a,b,c,d: double;
- begin
- if PointsEqual(line1, line2) then
- begin
- Result := DistanceSqrd(pt, line1);
- end else
- begin
- a := pt.X - line1.X;
- b := pt.Y - line1.Y;
- c := line2.X - line1.X;
- d := line2.Y - line1.Y;
- if (c = 0) and (d = 0) then
- result := 0 else
- result := Sqr(a * d - c * b) / (c * c + d * d);
- end;
- end;
- //------------------------------------------------------------------------------
- function PointInPolyWindingCount(const pt: TPointD;
- const path: TPathD; out PointOnEdgeDir: integer): integer;
- var
- i, len: integer;
- prevPt: TPointD;
- isAbove: Boolean;
- crossProd: double;
- begin
- //nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
- Result := 0;
- PointOnEdgeDir := 0;
- i := 0;
- len := Length(path);
- if len = 0 then Exit;
- prevPt := path[len-1];
- while (i < len) and (path[i].Y = prevPt.Y) do inc(i);
- if i = len then Exit;
- isAbove := (prevPt.Y < pt.Y);
- while (i < len) do
- begin
- if isAbove then
- begin
- while (i < len) and (path[i].Y < pt.Y) do inc(i);
- if i = len then break
- else if i > 0 then prevPt := path[i -1];
- crossProd := CrossProduct(prevPt, path[i], pt);
- if crossProd = 0 then
- begin
- PointOnEdgeDir := -1;
- //nb: could safely exit here with frNonZero or frEvenOdd fill rules
- end
- else if crossProd < 0 then dec(Result);
- end else
- begin
- while (i < len) and (path[i].Y > pt.Y) do inc(i);
- if i = len then break
- else if i > 0 then prevPt := path[i -1];
- crossProd := CrossProduct(prevPt, path[i], pt);
- if crossProd = 0 then
- begin
- PointOnEdgeDir := 1;
- //nb: could safely exit here with frNonZero or frEvenOdd fill rules
- end
- else if crossProd > 0 then inc(Result);
- end;
- inc(i);
- isAbove := not isAbove;
- end;
- end;
- //------------------------------------------------------------------------------
- function PointInPolygon(const pt: TPointD;
- const polygon: TPathD; fillRule: TFillRule): Boolean;
- var
- wc: integer;
- PointOnEdgeDir: integer;
- begin
- wc := PointInPolyWindingCount(pt, polygon, PointOnEdgeDir);
- case fillRule of
- frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
- frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
- frPositive: result := (PointOnEdgeDir + wc > 0);
- else {frNegative} result := (PointOnEdgeDir + wc < 0);
- end;
- end;
- //------------------------------------------------------------------------------
- function PointInPolysWindingCount(const pt: TPointD;
- const paths: TPathsD; out PointOnEdgeDir: integer): integer;
- var
- i,j, len: integer;
- p: TPathD;
- prevPt: TPointD;
- isAbove: Boolean;
- crossProd: double;
- begin
- //nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
- Result := 0;
- PointOnEdgeDir := 0;
- for i := 0 to High(paths) do
- begin
- j := 0;
- p := paths[i];
- len := Length(p);
- if len < 3 then Continue;
- prevPt := p[len-1];
- while (j < len) and (p[j].Y = prevPt.Y) do inc(j);
- if j = len then continue;
- isAbove := (prevPt.Y < pt.Y);
- while (j < len) do
- begin
- if isAbove then
- begin
- while (j < len) and (p[j].Y < pt.Y) do inc(j);
- if j = len then break
- else if j > 0 then prevPt := p[j -1];
- crossProd := CrossProduct(prevPt, p[j], pt);
- if crossProd = 0 then PointOnEdgeDir := -1
- else if crossProd < 0 then dec(Result);
- end else
- begin
- while (j < len) and (p[j].Y > pt.Y) do inc(j);
- if j = len then break
- else if j > 0 then prevPt := p[j -1];
- crossProd := CrossProduct(prevPt, p[j], pt);
- if crossProd = 0 then PointOnEdgeDir := 1
- else if crossProd > 0 then inc(Result);
- end;
- inc(j);
- isAbove := not isAbove;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function PointInPolygons(const pt: TPointD;
- const polygons: TPathsD; fillRule: TFillRule): Boolean;
- var
- wc: integer;
- PointOnEdgeDir: integer;
- begin
- wc := PointInPolysWindingCount(pt, polygons, PointOnEdgeDir);
- case fillRule of
- frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
- frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
- frPositive: result := (PointOnEdgeDir + wc > 0);
- else {frNegative} result := (PointOnEdgeDir + wc < 0);
- end;
- end;
- //------------------------------------------------------------------------------
- function PerpendicularDist(const pt, line1, line2: TPointD): double;
- var
- a,b,c,d: double;
- begin
- //given: cross product of 2 vectors = area of parallelogram
- //and given: area of parallelogram = length base * height
- //height (ie perpendic. dist.) = cross product of 2 vectors / length base
- a := pt.X - line1.X;
- b := pt.Y - line1.Y;
- c := line2.X - line1.X;
- d := line2.Y - line1.Y;
- result := abs(a * d - c * b) / Sqrt(c * c + d * d);
- end;
- //------------------------------------------------------------------------------
- function ClosestPoint(const pt, linePt1, linePt2: TPointD;
- constrainToSegment: Boolean): TPointD;
- var
- q: double;
- begin
- if (linePt1.X = linePt2.X) and (linePt1.Y = linePt2.Y) then
- begin
- Result := linePt1;
- end else
- begin
- q := ((pt.X-linePt1.X)*(linePt2.X-linePt1.X) +
- (pt.Y-linePt1.Y)*(linePt2.Y-linePt1.Y)) /
- (sqr(linePt2.X-linePt1.X) + sqr(linePt2.Y-linePt1.Y));
- if constrainToSegment then
- begin
- if q < 0 then q := 0 else if q > 1 then q := 1;
- end;
- Result.X := (1-q)*linePt1.X + q*linePt2.X;
- Result.Y := (1-q)*linePt1.Y + q*linePt2.Y;
- end;
- end;
- //------------------------------------------------------------------------------
- function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
- begin
- result := ClosestPoint(pt, linePt1, linePt2, false);
- end;
- //------------------------------------------------------------------------------
- function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
- begin
- result := ClosestPoint(pt, segPt1, segPt2, true);
- end;
- //------------------------------------------------------------------------------
- function GetPtOnEllipseFromAngle(const ellipseRect: TRectD;
- angle: double): TPointD;
- var
- sn, co: double;
- begin
- NormalizeAngle(angle);
- GetSinCos(angle, sn, co);
- Result.X := ellipseRect.MidPoint.X + ellipseRect.Width/2 * co;
- Result.Y := ellipseRect.MidPoint.Y + ellipseRect.Height/2 * sn;
- end;
- //------------------------------------------------------------------------------
- function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
- const pt: TPointD): double;
- begin
- with ellipseRect do
- Result := ArcTan2(Width/Height * (pt.Y - MidPoint.Y), (pt.X - MidPoint.X));
- end;
- //------------------------------------------------------------------------------
- function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
- ellipseRotAngle: double; pt: TPointD): double;
- begin
- Result := 0;
- if ellipseRect.IsEmpty then Exit;
- RotatePoint(pt, ellipseRect.MidPoint, -ellipseRotAngle);
- Result := GetEllipticalAngleFromPoint(ellipseRect, pt);
- end;
- //------------------------------------------------------------------------------
- function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
- ellipseRotAngle, angle: double): TPointD;
- begin
- Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
- if ellipseRotAngle <> 0 then
- img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotAngle);
- end;
- //------------------------------------------------------------------------------
- function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
- ellipseRotation: double; const pt: TPointD): TPointD;
- var
- pt2: TPointD;
- angle: double;
- begin
- pt2 := pt;
- Img32.Vector.RotatePoint(pt2, ellipseRect.MidPoint, -ellipseRotation);
- angle := GetEllipticalAngleFromPoint(ellipseRect, pt2);
- Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
- Img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotation);
- end;
- //------------------------------------------------------------------------------
- function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
- var
- rec: TRectD;
- w,h: integer;
- x,y, y2, a,b, dx,dy: double;
- begin
- RectWidthHeight(ellipseRec, w, h);
- a := w * 0.5;
- b := h * 0.5;
- dx := ellipseRec.Left + a;
- dy := ellipseRec.Top + b;
- rec := RectD(ellipseRec);
- TranslateRect(rec, -dx, -dy);
- x := pt.X -dx; y := pt.Y -dy;
- //first make sure pt is inside rect
- Result := (abs(x) <= a) and (abs(y) <= b);
- if not result then Exit;
- //given (x*x)/(a*a) + (y*y)/(b*b) = 1
- //then y*y = b*b(1 - (x*x)/(a*a))
- //nb: contents of Sqrt below will always be positive
- //since the substituted x must be within ellipseRec bounds
- y2 := Sqrt((b*b*(1 - (x*x)/(a*a))));
- Result := (y >= -y2) and (y <= y2);
- end;
- //------------------------------------------------------------------------------
- function GetLineEllipseIntersects(const ellipseRec: TRect;
- var linePt1, linePt2: TPointD): Boolean;
- var
- dx, dy, m,a,b,c,q: double;
- qa,qb,qc,qs: double;
- rec: TRectD;
- pt1, pt2: TPointD;
- begin
- rec := RectD(ellipseRec);
- a := rec.Width *0.5;
- b := rec.Height *0.5;
- //offset ellipseRect so it's centered over the coordinate origin
- dx := ellipseRec.Left + a; dy := ellipseRec.Top + b;
- TranslateRect(rec, -dx, -dy);
- pt1 := TranslatePoint(linePt1, -dx, -dy);
- pt2 := TranslatePoint(linePt2, -dx, -dy);
- //equation of ellipse = (x*x)/(a*a) + (y*y)/(b*b) = 1
- //equation of line = y = mx + c;
- if (pt1.X = pt2.X) then //vertical line (ie infinite slope)
- begin
- //given x = K, then y*y = b*b(1 - (x*x)/(a*a))
- q := (b*b)*(1 - Sqr(pt1.X)/(a*a));
- result := q >= 0;
- if not result then Exit;
- q := Sqrt(q);
- pt1.Y := q;
- pt2.Y := -q;
- end else
- begin
- //using simultaneous equations and substitution
- //given y = mx + c
- m := (pt1.Y - pt2.Y)/(pt1.X - pt2.X);
- c := pt1.Y - m * pt1.X;
- //given (x*x)/(a*a) + (y*y)/(b*b) = 1
- //(x*x)/(a*a)*(b*b) + (y*y) = (b*b)
- //(b*b)/(a*a) *(x*x) + Sqr(m*x +c) = (b*b)
- //(b*b)/(a*a) *(x*x) + (m*m)*(x*x) + 2*m*x*c +c*c = b*b
- //((b*b)/(a*a) +(m*m)) *(x*x) + 2*m*c*(x) + (c*c) - (b*b) = 0
- //solving quadratic equation
- qa := ((b*b)/(a*a) +(m*m));
- qb := 2*m*c;
- qc := (c*c) - (b*b);
- qs := (qb*qb) - 4*qa*qc;
- Result := qs >= 0;
- if not result then Exit;
- qs := Sqrt(qs);
- pt1.X := (-qb +qs)/(2 * qa);
- pt1.Y := m * pt1.X + c;
- pt2.X := (-qb -qs)/(2 * qa);
- pt2.Y := m * pt2.X + c;
- end;
- //finally reverse initial offset
- linePt1 := TranslatePoint(pt1, dx, dy);
- linePt2 := TranslatePoint(pt2, dx, dy);
- end;
- //------------------------------------------------------------------------------
- function Sign(const value: Double): integer; {$IFDEF INLINE} inline; {$ENDIF}
- begin
- if value < 0 then Result := -1
- else if value > 0 then Result := 1
- else Result := 0;
- end;
- //------------------------------------------------------------------------------
- function ApplyNormal(const pt, norm: TPointD; delta: double): TPointD;
- {$IFDEF INLINE} inline; {$ENDIF}
- begin
- result := PointD(pt.X + norm.X * delta, pt.Y + norm.Y * delta);
- end;
- //------------------------------------------------------------------------------
- procedure AppendPoint(var path: TPathD; const extra: TPointD);
- var
- len: integer;
- begin
- len := length(path);
- SetLengthUninit(path, len +1);
- path[len] := extra;
- end;
- //------------------------------------------------------------------------------
- procedure AppendPath(var paths: TPathsD; const extra: TPathD);
- var
- len1, len2: integer;
- begin
- len2 := length(extra);
- if len2 = 0 then Exit;
- len1 := length(paths);
- setLength(paths, len1 + 1);
- paths[len1] := Copy(extra, 0, len2);
- end;
- //------------------------------------------------------------------------------
- procedure AppendPath(var paths: TPathsD; const extra: TPathsD);
- var
- i, len1, len2: integer;
- begin
- len2 := length(extra);
- if len2 = 0 then Exit;
- len1 := length(paths);
- setLength(paths, len1 + len2);
- for i := 0 to len2 -1 do
- paths[len1+i] := Copy(extra[i], 0, length(extra[i]));
- end;
- //------------------------------------------------------------------------------
- procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD);
- var
- len: integer;
- begin
- len := length(ppp);
- setLength(ppp, len + 1);
- if Assigned(extra) then
- AppendPath(ppp[len], extra) else
- ppp[len] := nil;
- end;
- //------------------------------------------------------------------------------
- procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
- var
- len, pathLen: integer;
- begin
- // calculate the length of the final array
- len := Length(dstPath);
- pathLen := Length(path);
- if pathLen = 0 then Exit;
- // Avoid point duplicates where paths join
- if (len > 0) and PointsEqual(dstPath[len -1], path[0]) then dec(len);
- // fill the array
- SetLengthUninit(dstPath, len + pathLen);
- Move(path[0], dstPath[len], pathLen * SizeOf(TPointD));
- end;
- //------------------------------------------------------------------------------
- procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD);
- var
- i, len, pathLen, offset: integer;
- begin
- // calculate the length of the final array
- len := 0;
- for i := 0 to high(paths) do
- begin
- pathLen := Length(paths[i]);
- if pathLen > 0 then
- begin
- // Skip the start-point if it matches the previous path's end-point
- if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then
- dec(pathLen);
- inc(len, pathLen);
- end;
- end;
- SetLengthUninit(dstPath, len);
- // fill the array
- len := 0;
- for i := 0 to high(paths) do
- begin
- pathLen := Length(paths[i]);
- if pathLen > 0 then
- begin
- offset := 0;
- // Skip the start-point if it matches the previous path's end-point
- if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then
- begin
- dec(pathLen);
- offset := 1;
- end;
- // Skip if we have a path with only one point and that point also matches
- // the previous path's end-point.
- if pathLen > 0 then
- begin
- Move(paths[i][offset], dstPath[len], pathLen * SizeOf(TPointD));
- inc(len, pathLen);
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- procedure RotatePoint(var pt: TPointD;
- const focalPoint: TPointD; sinA, cosA: double);
- var
- tmpX, tmpY: double;
- begin
- tmpX := pt.X-focalPoint.X;
- tmpY := pt.Y-focalPoint.Y;
- pt.X := tmpX * cosA - tmpY * sinA + focalPoint.X;
- pt.Y := tmpX * sinA + tmpY * cosA + focalPoint.Y;
- end;
- //------------------------------------------------------------------------------
- procedure RotatePoint(var pt: TPointD;
- const focalPoint: TPointD; angleRad: double);
- var
- sinA, cosA: double;
- begin
- if angleRad = 0 then Exit;
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- angleRad := -angleRad;
- {$ENDIF}
- GetSinCos(angleRad, sinA, cosA);
- RotatePoint(pt, focalPoint, sinA, cosA);
- end;
- //------------------------------------------------------------------------------
- function RotatePathInternal(const path: TPathD;
- const focalPoint: TPointD; sinA, cosA: double): TPathD;
- var
- i: integer;
- x,y: double;
- begin
- NewPointDArray(Result, length(path), True);
- for i := 0 to high(path) do
- begin
- x := path[i].X - focalPoint.X;
- y := path[i].Y - focalPoint.Y;
- Result[i].X := x * cosA - y * sinA + focalPoint.X;
- Result[i].Y := x * sinA + y * cosA + focalPoint.Y;
- end;
- end;
- //------------------------------------------------------------------------------
- function RotatePath(const path: TPathD;
- const focalPoint: TPointD; angleRads: double): TPathD;
- var
- sinA, cosA: double;
- begin
- if angleRads = 0 then
- begin
- Result := path;
- Exit;
- end;
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- angleRads := -angleRads;
- {$ENDIF}
- GetSinCos(angleRads, sinA, cosA);
- Result := RotatePathInternal(path, focalPoint, sinA, cosA);
- end;
- //------------------------------------------------------------------------------
- function RotatePath(const paths: TPathsD;
- const focalPoint: TPointD; angleRads: double): TPathsD;
- var
- i: integer;
- sinA, cosA: double;
- fp: TPointD;
- begin
- Result := paths;
- if not IsValid(angleRads) then Exit;
- NormalizeAngle(angleRads);
- if angleRads = 0 then Exit;
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- angleRads := -angleRads;
- {$ENDIF}
- GetSinCos(angleRads, sinA, cosA);
- SetLength(Result, length(paths));
- if IsValid(focalPoint) then
- fp := focalPoint else
- fp := GetBoundsD(paths).MidPoint;
- for i := 0 to high(paths) do
- Result[i] := RotatePathInternal(paths[i], fp, sinA, cosA);
- end;
- //------------------------------------------------------------------------------
- function GetAngle(const origin, pt: TPoint): double;
- var
- x,y: double;
- begin
- x := pt.X - origin.X;
- y := pt.Y - origin.Y;
- if x = 0 then
- begin
- if y > 0 then result := angle90
- else result := -angle90;
- end
- else if y = 0 then
- begin
- if x > 0 then result := 0
- else result := angle180;
- end else
- result := arctan2(y, x); //range between -Pi and Pi
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- Result := -Result;
- {$ENDIF}
- end;
- //------------------------------------------------------------------------------
- function GetAngle(const origin, pt: TPointD): double;
- var
- x,y: double;
- begin
- x := pt.X - origin.X;
- y := pt.Y - origin.Y;
- if x = 0 then
- begin
- if y > 0 then result := angle90
- else result := -angle90;
- end
- else if y = 0 then
- begin
- if x > 0 then result := 0
- else result := angle180;
- end else
- result := arctan2(y, x); //range between -Pi and Pi
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- Result := -Result;
- {$ENDIF}
- end;
- //------------------------------------------------------------------------------
- function GetAngle(const a, b, c: TPoint): double;
- var
- ab, bc: TPointD;
- dp, cp: double;
- begin
- //https://stackoverflow.com/a/3487062/359538
- ab := PointD(b.x - a.x, b.y - a.y);
- bc := PointD(b.x - c.x, b.y - c.y);
- dp := (ab.x * bc.x + ab.y * bc.y);
- cp := (ab.x * bc.y - ab.y * bc.x);
- Result := arctan2(cp, dp); //range between -Pi and Pi
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- Result := -Result;
- {$ENDIF}
- end;
- //------------------------------------------------------------------------------
- function GetAngle(const a, b, c: TPointD): double;
- var
- ab, bc: TPointD;
- dp, cp: double;
- begin
- //https://stackoverflow.com/a/3487062/359538
- ab := PointD(b.x - a.x, b.y - a.y);
- bc := PointD(b.x - c.x, b.y - c.y);
- dp := (ab.x * bc.x + ab.y * bc.y);
- cp := (ab.x * bc.y - ab.y * bc.x);
- Result := arctan2(cp, dp); //range between -Pi and Pi
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- Result := -Result;
- {$ENDIF}
- end;
- //------------------------------------------------------------------------------
- function GetPointAtAngleAndDist(const origin: TPointD;
- angle, distance: double): TPointD;
- begin
- Result := origin;
- Result.X := Result.X + distance;
- RotatePoint(Result, origin, angle);
- end;
- //------------------------------------------------------------------------------
- function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
- var
- m1,b1,m2,b2: double;
- begin
- result := InvalidPointD;
- //see http://paulbourke.net/geometry/pointlineplane/
- if (ln1B.X = ln1A.X) then
- begin
- if (ln2B.X = ln2A.X) then exit; //parallel lines
- m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
- b2 := ln2A.Y - m2 * ln2A.X;
- Result.X := ln1A.X;
- Result.Y := m2*ln1A.X + b2;
- end
- else if (ln2B.X = ln2A.X) then
- begin
- m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
- b1 := ln1A.Y - m1 * ln1A.X;
- Result.X := ln2A.X;
- Result.Y := m1*ln2A.X + b1;
- end else
- begin
- m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
- b1 := ln1A.Y - m1 * ln1A.X;
- m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
- b2 := ln2A.Y - m2 * ln2A.X;
- if m1 = m2 then exit; //parallel lines
- Result.X := (b2 - b1)/(m1 - m2);
- Result.Y := m1 * Result.X + b1;
- end;
- end;
- //------------------------------------------------------------------------------
- function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD;
- out ip: TPointD): Boolean;
- begin
- ip := IntersectPoint(ln1a, ln1b, ln2a, ln2b);
- Result := IsValid(ip);
- end;
- //------------------------------------------------------------------------------
- function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
- var
- pqd,r,s : TPointD; //scalar vectors;
- rs, t : double;
- begin
- //https://stackoverflow.com/a/565282/359538
- Result := InvalidPointD;
- r := PointD(ln1b.X - ln1a.X, ln1b.Y - ln1a.Y);
- s := PointD(ln2b.X - ln2a.X, ln2b.Y - ln2a.Y);
- rs := CrossProduct(r,s);
- if Abs(rs) < 1 then Exit;
- pqd.X := ln2a.X - ln1a.X;
- pqd.y := ln2a.Y - ln1a.Y;
- t := CrossProduct(pqd, s) / rs;
- if (t < -0.025) or (t > 1.025) then Exit;
- Result.X := ln1a.X + t * r.X;
- Result.Y := ln1a.Y + t * r.Y;
- // pqd.X := -pqd.X; pqd.Y := -pqd.Y;
- // u := CrossProduct(pqd, r) / rs;
- // if (u < -0.05) or (u > 1.05) then Exit;
- end;
- //------------------------------------------------------------------------------
- function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
- out ip: TPointD): Boolean;
- begin
- ip := SegmentIntersectPt(ln1a, ln1b, ln2a, ln2b);
- Result := IsValid(ip);
- end;
- //------------------------------------------------------------------------------
- function CalcRoundingSteps(radius: double): double;
- begin
- //the results of this function have been derived empirically
- //and may need further adjustment
- if radius < 0.55 then result := 4
- else result := Pi * Sqrt(radius *2);
- end;
- //------------------------------------------------------------------------------
- function Grow(const path, normals: TPathD; delta: double;
- joinStyle: TJoinStyle; miterLim: double; scale: double; isOpen: Boolean): TPathD;
- var
- resCnt, resCap : integer;
- norms : TPathD;
- stepsPerRadian : double;
- stepSin, stepCos : double;
- asin, acos : double;
- procedure AddPoint(const pt: TPointD);
- begin
- if resCnt >= resCap then
- begin
- inc(resCap, 64);
- SetLengthUninit(result, resCap);
- end;
- result[resCnt] := pt;
- inc(resCnt);
- end;
- procedure DoMiter(j, k: Integer; cosA: Double);
- var
- q: Double;
- begin
- q := delta / (cosA +1);
- AddPoint(PointD(
- path[j].X + (norms[k].X + norms[j].X) *q,
- path[j].Y + (norms[k].Y + norms[j].Y) *q));
- end;
- procedure DoBevel(j, k: Integer);
- var
- absDelta: double;
- begin
- if k = j then
- begin
- absDelta := Abs(delta);
- AddPoint(PointD(
- path[j].x - absDelta * norms[j].x,
- path[j].y - absDelta * norms[j].y));
- AddPoint(PointD(
- path[j].x + absDelta * norms[j].x,
- path[j].y + absDelta * norms[j].y));
- end else
- begin
- AddPoint(PointD(
- path[j].x + delta * norms[k].x,
- path[j].y + delta * norms[k].y));
- AddPoint(PointD(
- path[j].x + delta * norms[j].x,
- path[j].y + delta * norms[j].y));
- end;
- end;
- procedure DoSquare(j, k: Integer);
- var
- vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
- absDelta: double;
- begin
- if k = j then
- begin
- vec.X := norms[j].Y; //squaring a line end
- vec.Y := -norms[j].X;
- end else
- begin
- // using the reciprocal of unit normals (as unit vectors)
- // get the average unit vector ...
- vec := GetAvgUnitVector(
- PointD(-norms[k].Y, norms[k].X),
- PointD(norms[j].Y, -norms[j].X));
- end;
- absDelta := Abs(delta);
- ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
- ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
- ptS := ReflectPoint(ptR, ptQ);
- // get 2 vertices along one edge offset
- ptT := PointD(
- path[k].X + norms[k].X * delta,
- path[k].Y + norms[k].Y * delta);
- if (j = k) then
- begin
- ptU.X := ptT.X + vec.X * delta;
- ptU.Y := ptT.Y + vec.Y * delta;
- ip := IntersectPoint(ptR, ptS, ptT, ptU);
- AddPoint(ReflectPoint(ip, ptQ));
- AddPoint(ip);
- end else
- begin
- ptU := PointD(
- path[j].X + norms[k].X * delta,
- path[j].Y + norms[k].Y * delta);
- ip := IntersectPoint(ptR, ptS, ptT, ptU);
- AddPoint(ip);
- AddPoint(ReflectPoint(ip, ptQ));
- end;
- end;
- procedure DoRound(j, k: Integer);
- var
- i, steps: Integer;
- pt: TPointD;
- dx, dy, oldDx: double;
- angle: double;
- begin
- // nb: angles may be negative but this will always be a convex join
- pt := path[j];
- if j = k then
- begin
- dx := -norms[k].X * delta;
- dy := -norms[k].Y * delta;
- end else
- begin
- dx := norms[k].X * delta;
- dy := norms[k].Y * delta;
- end;
- AddPoint(PointD(pt.X + dx, pt.Y + dy));
- angle := ArcTan2(asin, acos);
- steps := Ceil(stepsPerRadian * abs(angle));
- for i := 2 to steps do
- begin
- oldDx := dx;
- dx := oldDx * stepCos - stepSin * dy;
- dy := oldDx * stepSin + stepCos * dy;
- AddPoint(PointD(pt.X + dx, pt.Y + dy));
- end;
- AddPoint(PointD(
- pt.X + norms[j].X * delta,
- pt.Y + norms[j].Y * delta));
- end;
- var
- j, k : cardinal;
- len : cardinal;
- steps : double;
- highI : cardinal;
- iLo,iHi : cardinal;
- absDelta : double;
- begin
- Result := nil;
- if not Assigned(path) then exit;
- len := Length(path);
- if not isOpen then
- while (len > 2) and
- PointsNearEqual(path[len -1], path[0], 0.001) do
- dec(len);
- if len < 2 then Exit;
- if scale = 0 then scale := 1.0;
- absDelta := Abs(delta);
- if absDelta * scale < 1 then
- joinStyle := jsButt
- else if joinStyle = jsAuto then
- begin
- if delta < AutoWidthThreshold / 2 then
- joinStyle := jsSquare else
- joinStyle := jsRound;
- end;
- if absDelta < MinStrokeWidth/2 then
- begin
- if delta < 0 then
- delta := -MinStrokeWidth/2 else
- delta := MinStrokeWidth/2;
- end;
- if assigned(normals) then
- norms := normals else
- norms := GetNormals(path);
- highI := len -1;
- stepsPerRadian := 0;
- if joinStyle = jsRound then
- begin
- steps := CalcRoundingSteps(delta * scale);
- stepSin := sin(TwoPi/steps);
- stepCos := cos(TwoPi/steps);
- if (delta < 0) then stepSin := -stepSin;
- stepsPerRadian := steps / TwoPi;
- end;
- if miterLim <= 0 then miterLim := DefaultMiterLimit
- else if miterLim < 2 then miterLim := 2;
- miterLim := 2 /(sqr(miterLim));
- resCnt := 0;
- resCap := 0;
- if isOpen then
- begin
- iLo := 1; iHi := highI -1;
- k := 0;
- AddPoint(PointD(
- path[0].X + norms[0].X * delta,
- path[0].Y + norms[0].Y * delta));
- end else
- begin
- iLo := 0; iHi := highI;
- k := highI;
- end;
- for j := iLo to iHi do
- begin
- if PointsNearEqual(path[j], path[k], 0.01) then
- begin
- k := j; // todo - check if needed
- Continue;
- end;
- asin := CrossProduct(norms[k], norms[j]);
- if (asin > 1.0) then asin := 1.0
- else if (asin < -1.0) then asin := -1.0;
- acos := DotProduct(norms[k], norms[j]);
- if (acos > -0.999) and (asin * delta < 0) then
- begin
- // is concave
- AddPoint(PointD(
- path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
- AddPoint(path[j]);
- AddPoint(PointD(
- path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
- end
- else if (acos > 0.999) and (joinStyle <> jsRound) then
- begin
- // almost straight - less than 2.5 degree, so miter
- DoMiter(j, k, acos);
- end
- else if (joinStyle = jsMiter) then
- begin
- if (1 + acos > miterLim) then
- DoMiter(j, k, acos) else
- DoSquare(j, k);
- end
- else if (joinStyle = jsRound) then
- DoRound(j, k)
- else if (joinStyle = jsSquare) then
- DoSquare(j, k)
- else
- DoBevel(j, k);
- k := j;
- end;
- if isOpen then
- AddPoint(PointD(
- path[highI].X + norms[highI].X * delta, //todo - check this !!!
- path[highI].Y + norms[highI].Y * delta));
- SetLength(Result, resCnt);
- end;
- //------------------------------------------------------------------------------
- function GrowOpenLine(const line: TPathD; delta: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle;
- miterLim: double = 0; scale: double = 1.0): TPathD;
- var
- len : integer;
- resCnt, resCap : integer;
- asin, acos : double;
- stepSin, stepCos : double;
- stepsPerRadian : double;
- path, norms : TPathD;
- procedure AddPoint(const pt: TPointD);
- begin
- if resCnt >= resCap then
- begin
- inc(resCap, 64);
- SetLengthUninit(result, resCap);
- end;
- result[resCnt] := pt;
- inc(resCnt);
- end;
- procedure DoMiter(j, k: Integer; cosA: Double);
- var
- q: Double;
- begin
- q := delta / (cosA +1);
- AddPoint(PointD(
- path[j].X + (norms[k].X + norms[j].X) *q,
- path[j].Y + (norms[k].Y + norms[j].Y) *q));
- end;
- procedure DoBevel(j, k: Integer);
- var
- absDelta: double;
- begin
- if k = j then
- begin
- absDelta := Abs(delta);
- AddPoint(PointD(
- path[j].x - absDelta * norms[j].x,
- path[j].y - absDelta * norms[j].y));
- AddPoint(PointD(
- path[j].x + absDelta * norms[j].x,
- path[j].y + absDelta * norms[j].y));
- end else
- begin
- AddPoint(PointD(
- path[j].x + delta * norms[k].x,
- path[j].y + delta * norms[k].y));
- AddPoint(PointD(
- path[j].x + delta * norms[j].x,
- path[j].y + delta * norms[j].y));
- end;
- end;
- procedure DoSquare(j, k: Integer);
- var
- vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
- absDelta: double;
- begin
- if k = j then
- begin
- vec.X := norms[j].Y; //squaring a line end
- vec.Y := -norms[j].X;
- end else
- begin
- // using the reciprocal of unit normals (as unit vectors)
- // get the average unit vector ...
- vec := GetAvgUnitVector(
- PointD(-norms[k].Y, norms[k].X),
- PointD(norms[j].Y, -norms[j].X));
- end;
- absDelta := Abs(delta);
- ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
- ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
- ptS := ReflectPoint(ptR, ptQ);
- // get 2 vertices along one edge offset
- ptT := PointD(
- path[k].X + norms[k].X * delta,
- path[k].Y + norms[k].Y * delta);
- if (j = k) then
- begin
- ptU.X := ptT.X + vec.X * delta;
- ptU.Y := ptT.Y + vec.Y * delta;
- ip := IntersectPoint(ptR, ptS, ptT, ptU);
- AddPoint(ReflectPoint(ip, ptQ));
- AddPoint(ip);
- end else
- begin
- ptU := PointD(
- path[j].X + norms[k].X * delta,
- path[j].Y + norms[k].Y * delta);
- ip := IntersectPoint(ptR, ptS, ptT, ptU);
- AddPoint(ip);
- AddPoint(ReflectPoint(ip, ptQ));
- end;
- end;
- procedure DoRound(j, k: Integer);
- var
- i, steps: Integer;
- pt: TPointD;
- dx, dy, oldDx: double;
- angle: double;
- begin
- // nb: angles may be negative but this will always be a convex join
- pt := path[j];
- if j = k then
- begin
- dx := -norms[k].X * delta;
- dy := -norms[k].Y * delta;
- angle := PI;
- end else
- begin
- dx := norms[k].X * delta;
- dy := norms[k].Y * delta;
- angle := ArcTan2(asin, acos);
- end;
- AddPoint(PointD(pt.X + dx, pt.Y + dy));
- steps := Ceil(stepsPerRadian * abs(angle));
- for i := 2 to steps do
- begin
- oldDx := dx;
- dx := oldDx * stepCos - stepSin * dy;
- dy := oldDx * stepSin + stepCos * dy;
- AddPoint(PointD(pt.X + dx, pt.Y + dy));
- end;
- AddPoint(PointD(
- pt.X + norms[j].X * delta,
- pt.Y + norms[j].Y * delta));
- end;
- procedure DoPoint(j: Cardinal; var k: Cardinal);
- begin
- asin := CrossProduct(norms[k], norms[j]);
- if (asin > 1.0) then asin := 1.0
- else if (asin < -1.0) then asin := -1.0;
- acos := DotProduct(norms[k], norms[j]);
- if (acos > -0.999) and (asin * delta < 0) then
- begin
- // is concave
- AddPoint(PointD(
- path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
- AddPoint(path[j]);
- AddPoint(PointD(
- path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
- end
- else if (acos > 0.999) and (joinStyle <> jsRound) then
- // almost straight - less than 2.5 degree, so miter
- DoMiter(j, k, acos)
- else if (joinStyle = jsMiter) then
- begin
- if (1 + acos > miterLim) then
- DoMiter(j, k, acos) else
- DoSquare(j, k);
- end
- else if (joinStyle = jsRound) then
- DoRound(j, k)
- else if (joinStyle = jsSquare) then
- DoSquare(j, k)
- else
- DoBevel(j, k);
- k := j;
- end;
- var
- highJ : cardinal;
- j, k : cardinal;
- steps : double;
- begin
- Result := nil;
- path := StripNearDuplicates(line, 0.1, false);
- len := length(path);
- if (len = 0) or (delta <= 0) then Exit;
- // don't specify a minimum delta as this path may be scaled later
- // if delta < MinStrokeWidth then
- // delta := MinStrokeWidth;
- delta := delta * 0.5;
- if len = 1 then
- begin
- with path[0] do
- result := Ellipse(RectD(x-delta, y-delta, x+delta, y+delta));
- Exit;
- end;
- //Assert(endStyle <> esClosed);
- //with very narrow lines, don't get fancy with joins and line ends
- if (delta <= 1) then
- begin
- if (joinStyle = jsRound) and (delta * scale <= 1) then
- joinStyle := jsButt;
- if (endStyle = esRound) and (delta * scale <= 1) then
- endStyle := esSquare;
- end
- else if joinStyle = jsAuto then
- begin
- if (endStyle = esRound) and (delta * scale >= AutoWidthThreshold) then
- joinStyle := jsRound else
- joinStyle := jsSquare;
- end;
- stepsPerRadian := 0;
- if (joinStyle = jsRound) or (endStyle = esRound) then
- begin
- steps := CalcRoundingSteps(delta * scale);
- stepSin := sin(TwoPi/steps);
- stepCos := cos(TwoPi/steps);
- if (delta < 0) then stepSin := -stepSin;
- stepsPerRadian := steps / TwoPi;
- end;
- if miterLim <= 0 then miterLim := DefaultMiterLimit
- else if miterLim < 2 then miterLim := 2;
- miterLim := 2 /(sqr(miterLim));
- norms := GetNormals(path);
- resCnt := 0; resCap := 0;
- case endStyle of
- esButt: DoBevel(0,0);
- esRound: DoRound(0,0);
- else DoSquare(0, 0);
- end;
- // offset the left side going **forward**
- k := 0;
- highJ := len -1;
- for j := 1 to highJ -1 do DoPoint(j,k);
- // reverse the normals ...
- for j := highJ downto 1 do
- begin
- norms[j].X := -norms[j-1].X;
- norms[j].Y := -norms[j-1].Y;
- end;
- norms[0] := norms[len -1];
- case endStyle of
- esButt: DoBevel(highJ,highJ);
- esRound: DoRound(highJ,highJ);
- else DoSquare(highJ,highJ);
- end;
- // offset the left side going **backward**
- k := highJ;
- for j := highJ -1 downto 1 do
- DoPoint(j, k);
- SetLength(Result, resCnt);
- end;
- //------------------------------------------------------------------------------
- function GrowClosedLine(const line: TPathD; width: double;
- joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0): TPathsD;
- var
- norms: TPathD;
- rec: TRectD;
- skipHole: Boolean;
- begin
- rec := GetBoundsD(line);
- skipHole := (rec.Width <= width) or (rec.Height <= width);
- if skipHole then
- begin
- SetLength(Result, 1);
- norms := GetNormals(line);
- Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
- end else
- begin
- SetLength(Result, 2);
- norms := GetNormals(line);
- Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
- Result[1] := ReversePath(
- Grow(line, norms, -width/2, joinStyle, miterLim, scale, false));
- end;
- end;
- //------------------------------------------------------------------------------
- function RoughOutline(const line: TPathD; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle;
- miterLim: double = 0; scale: double = 1.0): TPathsD;
- var
- lines: TPathsD;
- begin
- SetLength(lines,1);
- lines[0] := line;
- Result := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLim, scale);
- end;
- //------------------------------------------------------------------------------
- function RoughOutline(const lines: TPathsD; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle;
- miterLim: double = 0; scale: double = 1.0): TPathsD;
- var
- i: integer;
- lwDiv2: double;
- p: TPathD;
- begin
- result := nil;
- if not assigned(lines) then exit;
- if joinStyle = jsAuto then
- begin
- if endStyle in [esPolygon, esRound] then
- joinStyle := jsRound else
- joinStyle := jsSquare;
- end;
- if scale = 0 then scale := 1;
- if endStyle = esPolygon then
- begin
- for i := 0 to high(lines) do
- begin
- if Length(lines[i]) = 1 then
- begin
- lwDiv2 := lineWidth/2;
- with lines[i][0] do
- AppendPath(Result,
- Ellipse(RectD(x-lwDiv2, y-lwDiv2, x+lwDiv2, y+lwDiv2)));
- end else
- begin
- p := StripNearDuplicates(lines[i], 0.1, true);
- if Length(p) = 2 then AppendPoint(p, p[0]);
- AppendPath(Result,
- GrowClosedLine(p, lineWidth, joinStyle, miterLim, scale));
- end;
- end;
- end
- else
- begin
- SetLength(Result, Length(lines));
- for i := 0 to high(lines) do
- Result[i] := GrowOpenLine(lines[i], lineWidth,
- joinStyle, endStyle, miterLim, scale);
- end;
- end;
- //------------------------------------------------------------------------------
- function Rectangle(const rec: TRect): TPathD;
- begin
- NewPointDArray(Result, 4, True);
- with rec do
- begin
- result[0] := PointD(left, top);
- result[1] := PointD(right, top);
- result[2] := PointD(right, bottom);
- result[3] := PointD(left, bottom);
- end;
- end;
- //------------------------------------------------------------------------------
- function Rectangle(const rec: TRectD): TPathD;
- begin
- NewPointDArray(Result, 4, True);
- with rec do
- begin
- result[0] := PointD(left, top);
- result[1] := PointD(right, top);
- result[2] := PointD(right, bottom);
- result[3] := PointD(left, bottom);
- end;
- end;
- //------------------------------------------------------------------------------
- function Rectangle(l, t, r, b: double): TPathD;
- begin
- NewPointDArray(Result, 4, True);
- result[0] := PointD(l, t);
- result[1] := PointD(r, t);
- result[2] := PointD(r, b);
- result[3] := PointD(l, b);
- end;
- //------------------------------------------------------------------------------
- procedure InflateRect(var rec: TRect; dx, dy: integer);
- begin
- rec.Left := rec.Left - dx;
- rec.Top := rec.Top - dy;
- rec.Right := rec.Right + dx;
- rec.Bottom := rec.Bottom + dy;
- end;
- //------------------------------------------------------------------------------
- procedure InflateRect(var rec: TRectD; dx, dy: double);
- begin
- rec.Left := rec.Left - dx;
- rec.Top := rec.Top - dy;
- rec.Right := rec.Right + dx;
- rec.Bottom := rec.Bottom + dy;
- end;
- //------------------------------------------------------------------------------
- function NormalizeRect(var rect: TRect): Boolean;
- var
- i: integer;
- begin
- Result := False;
- with rect do
- begin
- if Left > Right then
- begin
- i := Left;
- Left := Right;
- Right := i;
- Result := True;
- end;
- if Top > Bottom then
- begin
- i := Top;
- Top := Bottom;
- Bottom := i;
- Result := True;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function RoundRect(const rec: TRect; radius: integer): TPathD;
- begin
- Result := RoundRect(RectD(rec), PointD(radius, radius));
- end;
- //------------------------------------------------------------------------------
- function RoundRect(const rec: TRect; radius: TPoint): TPathD;
- begin
- Result := RoundRect(RectD(rec), PointD(radius));
- end;
- //------------------------------------------------------------------------------
- function RoundRect(const rec: TRectD; radius: double): TPathD;
- begin
- Result := RoundRect(rec, PointD(radius, radius));
- end;
- //------------------------------------------------------------------------------
- function RoundRect(const rec: TRectD; radius: TPointD): TPathD;
- var
- i,j : integer;
- corners : TPathD;
- bezPts : TPathD;
- magic : TPointD;
- const
- magicC: double = 0.55228475; // =4/3 * (sqrt(2)-1)
- begin
- Result := nil;
- if rec.IsEmpty then Exit;
- radius.X := Min(radius.X, rec.Width/2);
- radius.Y := Min(radius.Y, rec.Height/2);
- if (radius.X < 1) and (radius.Y < 1) then
- begin
- Result := Rectangle(rec);
- Exit;
- end;
- magic.X := radius.X * magicC;
- magic.Y := radius.Y * magicC;
- NewPointDArray(Corners, 4, True);
- with rec do
- begin
- corners[0] := PointD(Right, Top);
- corners[1] := BottomRight;
- corners[2] := PointD(Left, Bottom);
- corners[3] := TopLeft;
- end;
- NewPointDArray(Result, 1, True);
- Result[0].X := corners[3].X + radius.X;
- Result[0].Y := corners[3].Y;
- NewPointDArray(bezPts, 4, True);
- for i := 0 to High(corners) do
- begin
- for j := 0 to 3 do bezPts[j] := corners[i];
- case i of
- 3:
- begin
- bezPts[0].Y := bezPts[0].Y + radius.Y;
- bezPts[1].Y := bezPts[0].Y - magic.Y;
- bezPts[3].X := bezPts[3].X + radius.X;
- bezPts[2].X := bezPts[3].X - magic.X;
- end;
- 0:
- begin
- bezPts[0].X := bezPts[0].X - radius.X;
- bezPts[1].X := bezPts[0].X + magic.X;
- bezPts[3].Y := bezPts[3].Y + radius.Y;
- bezPts[2].Y := bezPts[3].Y - magic.Y;
- end;
- 1:
- begin
- bezPts[0].Y := bezPts[0].Y - radius.Y;
- bezPts[1].Y := bezPts[0].Y + magic.Y;
- bezPts[3].X := bezPts[3].X - radius.X;
- bezPts[2].X := bezPts[3].X + magic.X;
- end;
- 2:
- begin
- bezPts[0].X := bezPts[0].X + radius.X;
- bezPts[1].X := bezPts[0].X - magic.X;
- bezPts[3].Y := bezPts[3].Y - radius.Y;
- bezPts[2].Y := bezPts[3].Y + magic.Y;
- end;
- end;
- ConcatPaths(Result, FlattenCBezier(bezPts));
- end;
- end;
- //------------------------------------------------------------------------------
- function Circle(const pt: TPoint; radius: double): TPathD;
- var
- rec: TRectD;
- begin
- rec.Left := pt.X - radius;
- rec.Right := pt.X + radius;
- rec.Top := pt.Y - radius;
- rec.Bottom := pt.Y + radius;
- Result := Ellipse(rec);
- end;
- //------------------------------------------------------------------------------
- function Circle(const pt: TPointD; radius: double): TPathD;
- var
- rec: TRectD;
- begin
- rec.Left := pt.X - radius;
- rec.Right := pt.X + radius;
- rec.Top := pt.Y - radius;
- rec.Bottom := pt.Y + radius;
- Result := Ellipse(rec);
- end;
- //------------------------------------------------------------------------------
- function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD;
- var
- rec: TRectD;
- begin
- rec.Left := pt.X - radius;
- rec.Right := pt.X + radius;
- rec.Top := pt.Y - radius;
- rec.Bottom := pt.Y + radius;
- Result := Ellipse(rec, pendingScale);
- end;
- //------------------------------------------------------------------------------
- function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
- out centre: TPointD; out radius: double): Boolean;
- var
- mat11, mat12, mat13, mat14: TMatrixD;
- m11,m12,m13,m14: double;
- begin
- mat11 := Matrix(p1.X, p1.Y, 1, p2.X, p2.Y, 1, p3.X, p3.Y, 1);
- m11 := MatrixDeterminant(mat11);
- Result := m11 <> 0;
- if not Result then Exit;
- mat12 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.Y, 1,
- Sqr(p2.X)+Sqr(p2.Y), p2.Y, 1, Sqr(p3.X)+Sqr(p3.Y), p3.Y, 1);
- mat12 := Matrix(2, 1, 1, 20, 4, 1, 34, 3, 1);
- m12 := MatrixDeterminant(mat12);
- mat13 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, 1,
- Sqr(p2.X)+Sqr(p2.Y), p2.X, 1, Sqr(p3.X)+Sqr(p3.Y), p3.X, 1);
- m13 := MatrixDeterminant(mat13);
- mat14 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, p1.Y,
- Sqr(p2.X)+Sqr(p2.Y), p2.X, p2.Y, Sqr(p3.X)+Sqr(p3.Y), p3.X, p3.Y);
- m14 := MatrixDeterminant(mat14);
- centre.X := 0.5 * m12/m11;
- centre.Y := -0.5 * m13/m11;
- radius := Sqrt(Sqr(centre.X) + Sqr(centre.Y) + m14/m11);
- end;
- //------------------------------------------------------------------------------
- function Ellipse(const rec: TRectD; pendingScale: double): TPathD;
- var
- steps: integer;
- begin
- if pendingScale <= 0 then pendingScale := 1;
- steps := Round(CalcRoundingSteps((rec.width + rec.Height) * pendingScale));
- Result := Ellipse(rec, steps);
- end;
- //------------------------------------------------------------------------------
- function Ellipse(const rec: TRect; steps: integer): TPathD;
- begin
- Result := Ellipse(RectD(rec), steps);
- end;
- //------------------------------------------------------------------------------
- function Ellipse(const rec: TRectD; steps: integer): TPathD;
- var
- i: Integer;
- sinA, cosA: double;
- centre, radius, delta: TPointD;
- begin
- result := nil;
- if rec.IsEmpty then Exit;
- with rec do
- begin
- centre := rec.MidPoint;
- radius := PointD(Width * 0.5, Height * 0.5);
- end;
- if steps < 4 then
- steps := Round(CalcRoundingSteps(rec.width + rec.height));
- GetSinCos(2 * Pi / Steps, sinA, cosA);
- delta.x := cosA; delta.y := sinA;
- NewPointDArray(Result, Steps, True);
- Result[0] := PointD(centre.X + radius.X, centre.Y);
- for i := 1 to steps -1 do
- begin
- Result[i] := PointD(centre.X + radius.X * delta.x,
- centre.Y + radius.y * delta.y);
- delta := PointD(delta.X * cosA - delta.Y * sinA,
- delta.Y * cosA + delta.X * sinA);
- end; //rotates clockwise
- end;
- //------------------------------------------------------------------------------
- function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD;
- begin
- Result := Ellipse(rec, steps);
- if angle = 0 then Exit;
- Result := RotatePath(Result, rec.MidPoint, angle);
- end;
- //------------------------------------------------------------------------------
- function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD;
- begin
- Result := Ellipse(rec, pendingScale);
- if angle = 0 then Exit;
- Result := RotatePath(Result, rec.MidPoint, angle);
- end;
- //------------------------------------------------------------------------------
- function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
- begin
- Result := arctan2(ellRec.Height/ellRec.Width * sin(angle), cos(angle));
- end;
- //------------------------------------------------------------------------------
- function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
- begin
- Result := ArcTan2(sin(angle) *ellRec.Width, cos(angle) * ellRec.Height);
- end;
- //------------------------------------------------------------------------------
- function Star(const rec: TRectD; points: integer; indentFrac: double): TPathD;
- var
- i: integer;
- innerOff: double;
- p, p2: TPathD;
- rec2: TRectD;
- begin
- Result := nil;
- if points < 5 then points := 5
- else if points > 15 then points := 15;
- if indentFrac < 0.2 then indentFrac := 0.2
- else if indentFrac > 0.8 then indentFrac := 0.8;
- innerOff := Min(rec.Width, rec.Height) * indentFrac * 0.5;
- if not Odd(points) then inc(points);
- p := Ellipse(rec, points);
- if not Assigned(p) then Exit;
- rec2 := rec;
- Img32.Vector.InflateRect(rec2, -innerOff, -innerOff);
- if rec2.IsEmpty then
- p2 := Ellipse(rec, points*2) else
- p2 := Ellipse(rec2, points*2);
- NewPointDArray(Result, points*2, True);
- for i := 0 to points -1 do
- begin
- Result[i*2] := p[i];
- Result[i*2+1] := p2[i*2+1];
- end;
- end;
- //------------------------------------------------------------------------------
- function Star(const focalPt: TPointD;
- innerRadius, outerRadius: double; points: integer): TPathD;
- var
- i: Integer;
- sinA, cosA: double;
- delta: TPointD;
- begin
- result := nil;
- if (innerRadius <= 0) or (outerRadius <= 0) then Exit;
- if points <= 5 then points := 10
- else points := points * 2;
- GetSinCos(2 * Pi / points, sinA, cosA);
- delta.x := cosA; delta.y := sinA;
- NewPointDArray(Result, points, True);
- Result[0] := PointD(focalPt.X + innerRadius, focalPt.Y);
- for i := 1 to points -1 do
- begin
- if Odd(i) then
- Result[i] := PointD(focalPt.X + outerRadius * delta.x,
- focalPt.Y + outerRadius * delta.y)
- else
- Result[i] := PointD(focalPt.X + innerRadius * delta.x,
- focalPt.Y + innerRadius * delta.y);
- delta := PointD(delta.X * cosA - delta.Y * sinA,
- delta.Y * cosA + delta.X * sinA);
- end;
- end;
- //------------------------------------------------------------------------------
- function Arc(const rec: TRectD;
- startAngle, endAngle: double; scale: double): TPathD;
- var
- i, steps: Integer;
- angle: double;
- sinA, cosA: double;
- centre, radius: TPointD;
- deltaX, deltaX2, deltaY: double;
- const
- qtrDeg = PI/1440;
- begin
- Result := nil;
- if (endAngle = startAngle) or IsEmptyRect(rec) then Exit;
- if scale <= 0 then scale := 4.0;
- {$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
- startAngle := -startAngle;
- endAngle := -endAngle;
- {$ENDIF}
- NormalizeAngle(startAngle, qtrDeg);
- NormalizeAngle(endAngle, qtrDeg);
- with rec do
- begin
- centre := MidPoint;
- radius := PointD(Width * 0.5, Height * 0.5);
- end;
- if endAngle < startAngle then
- angle := endAngle - startAngle + angle360 else
- angle := endAngle - startAngle;
- //steps = (No. steps for a whole ellipse) * angle/(2*Pi)
- steps := Round(CalcRoundingSteps((rec.width + rec.height)/2 * scale));
- steps := steps div 2; /////////////////////////////////
- if steps < 2 then steps := 2;
- NewPointDArray(Result, Steps +1, True);
- //angle of the first step ...
- GetSinCos(startAngle, deltaY, deltaX);
- Result[0].X := centre.X + radius.X * deltaX;
- Result[0].Y := centre.Y + radius.y * deltaY;
- //angle of each subsequent step ...
- GetSinCos(angle / Steps, sinA, cosA);
- for i := 1 to steps do
- begin
- deltaX2 := deltaX * cosA - deltaY * sinA;
- deltaY := deltaY * cosA + deltaX * sinA;
- deltaX := deltaX2;
- Result[i].X := centre.X + radius.X * deltaX;
- Result[i].Y := centre.Y + radius.y * deltaY;
- end; //progresses clockwise from start to end
- end;
- //------------------------------------------------------------------------------
- function Pie(const rec: TRectD;
- StartAngle, EndAngle: double; scale: double): TPathD;
- var
- len: integer;
- begin
- result := Arc(rec, StartAngle, EndAngle, scale);
- len := length(result);
- SetLengthUninit(result, len +1);
- result[len] := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
- end;
- //------------------------------------------------------------------------------
- function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
- arrowStyle: TArrowStyle): TPathD;
- var
- unitVec, basePt: TPointD;
- sDiv40, sDiv50, sDiv60, sDiv120: double;
- begin
- result := nil;
- sDiv40 := size * 0.40;
- sDiv50 := size * 0.50;
- sDiv60 := size * 0.60;
- sDiv120 := sDiv60 * 2;
- unitVec := GetUnitVector(ctrlPt, arrowTip);
- case arrowStyle of
- asNone:
- Exit;
- asSimple:
- begin
- NewPointDArray(result, 3, True);
- basePt := TranslatePoint(arrowTip, -unitVec.X * size, -unitVec.Y * size);
- result[0] := arrowTip;
- result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50);
- result[2] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
- end;
- asFancy:
- begin
- NewPointDArray(result, 4, True);
- basePt := TranslatePoint(arrowTip,
- -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
- result[0] := TranslatePoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50);
- result[1] := TranslatePoint(arrowTip, -unitVec.X *size, -unitVec.Y *size);
- result[2] := TranslatePoint(basePt, unitVec.Y *sDiv50, -unitVec.X *sDiv50);
- result[3] := arrowTip;
- end;
- asDiamond:
- begin
- NewPointDArray(result, 4, True);
- basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60);
- result[0] := arrowTip;
- result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50);
- result[2] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
- result[3] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
- end;
- asCircle:
- begin
- basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50);
- with Point(basePt) do
- result := Ellipse(RectD(x - sDiv50, y - sDiv50, x + sDiv50, y + sDiv50));
- end;
- asTail:
- begin
- NewPointDArray(result, 6, True);
- basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60);
- result[0] := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50);
- result[1] := TranslatePoint(arrowTip, -unitVec.Y * sDiv40, unitVec.X * sDiv40);
- result[2] := TranslatePoint(basePt, -unitVec.Y * sDiv40, unitVec.X * sDiv40);
- result[3] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
- result[4] := TranslatePoint(basePt, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
- result[5] := TranslatePoint(arrowTip, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function GetDefaultArrowHeadSize(lineWidth: double): double;
- begin
- Result := lineWidth *3 + 7;
- end;
- //------------------------------------------------------------------------------
- procedure AdjustPoint(var pt: TPointD; const referencePt: TPointD; delta: double);
- var
- vec: TPointD;
- begin
- //Positive delta moves pt away from referencePt, and
- //negative delta moves pt toward referencePt.
- vec := GetUnitVector(referencePt, pt);
- pt.X := pt.X + (vec.X * delta);
- pt.Y := pt.Y + (vec.Y * delta);
- end;
- //------------------------------------------------------------------------------
- function ShortenPath(const path: TPathD;
- pathEnd: TPathEnd; amount: double): TPathD;
- var
- len, amount2: double;
- vec: TPointD;
- i, highPath: integer;
- begin
- result := path;
- highPath := high(path);
- if highPath < 1 then Exit;
- amount2 := amount;
- if pathEnd <> peEnd then
- begin
- //shorten start
- i := 0;
- while (i < highPath) do
- begin
- len := Distance(result[i], result[i+1]);
- if (len >= amount) then Break;
- amount := amount - len;
- inc(i);
- end;
- if i > 0 then
- begin
- Move(path[i], Result[0], (highPath - i +1) * SizeOf(TPointD));
- dec(highPath, i);
- SetLength(Result, highPath +1);
- end;
- if amount > 0 then
- begin
- vec := GetUnitVector(result[0], result[1]);
- result[0].X := result[0].X + vec.X * amount;
- result[0].Y := result[0].Y + vec.Y * amount;
- end;
- end;
- if pathEnd <> peStart then
- begin
- //shorten end
- while (highPath > 1) do
- begin
- len := Distance(result[highPath], result[highPath -1]);
- if (len >= amount2) then Break;
- amount2 := amount2 - len;
- dec(highPath);
- end;
- SetLength(Result, highPath +1);
- if amount2 > 0 then
- begin
- vec := GetUnitVector(result[highPath], result[highPath -1]);
- result[highPath].X := result[highPath].X + vec.X * amount2;
- result[highPath].Y := result[highPath].Y + vec.Y * amount2;
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function GetDashedPath(const path: TPathD;
- closed: Boolean; const pattern: TArrayOfDouble;
- patternOffset: PDouble): TPathsD;
- var
- i, highI, paIdx: integer;
- vecs, path2, dash: TPathD;
- patCnt: integer;
- patLen: double;
- dashCapacity, dashCnt, ptsCapacity, ptsCnt: integer;
- segLen, residualPat, patOff: double;
- filling: Boolean;
- pt, pt2: TPointD;
- procedure NewDash;
- begin
- if ptsCnt = 1 then ptsCnt := 0;
- if ptsCnt = 0 then Exit;
- if dashCnt = dashCapacity then
- begin
- inc(dashCapacity, BuffSize);
- setLength(result, dashCapacity);
- end;
- result[dashCnt] := Copy(dash, 0, ptsCnt);
- inc(dashCnt);
- ptsCapacity := BuffSize;
- setLength(dash, ptsCapacity);
- ptsCnt := 0;
- end;
- procedure ExtendDash(const pt: TPointD);
- begin
- if ptsCnt = ptsCapacity then
- begin
- inc(ptsCapacity, BuffSize);
- setLength(dash, ptsCapacity);
- end;
- dash[ptsCnt] := pt;
- inc(ptsCnt);
- end;
- begin
- Result := nil;
- paIdx := 0;
- patCnt := length(pattern);
- path2 := path;
- highI := high(path2);
- if (highI < 1) or (patCnt = 0) then Exit;
- if closed and
- ((path2[highI].X <> path2[0].X) or (path2[highI].Y <> path2[0].Y)) then
- begin
- inc(highI);
- setLength(path2, highI +2);
- path2[highI] := path2[0];
- end;
- vecs := GetVectors(path2);
- if (vecs[0].X = 0) and (vecs[0].Y = 0) then Exit; //not a line
- if not assigned(patternOffset) then
- patOff := 0 else
- patOff := patternOffset^;
- patLen := 0;
- for i := 0 to patCnt -1 do
- patLen := patLen + pattern[i];
- if patOff < 0 then
- begin
- patOff := patLen + patOff;
- while patOff < 0 do
- patOff := patOff + patLen;
- end
- else while patOff > patLen do
- patOff := patOff - patLen;
- //nb: each dash is made up of 2 or more pts
- dashCnt := 0;
- dashCapacity := 0;
- ptsCnt := 0;
- ptsCapacity := 0;
- filling := true;
- while patOff >= pattern[paIdx] do
- begin
- filling := not filling;
- patOff := patOff - pattern[paIdx];
- paIdx := (paIdx + 1) mod patCnt;
- end;
- residualPat := pattern[paIdx] - patOff;
- pt := path2[0];
- ExtendDash(pt);
- i := 0;
- while (i < highI) do
- begin
- segLen := Distance(pt, path2[i+1]);
- if residualPat > segLen then
- begin
- if filling then ExtendDash(path2[i+1]);
- residualPat := residualPat - segLen;
- pt := path2[i+1];
- inc(i);
- end else
- begin
- pt2.X := pt.X + vecs[i].X * residualPat;
- pt2.Y := pt.Y + vecs[i].Y * residualPat;
- if filling then ExtendDash(pt2);
- filling := not filling;
- NewDash;
- paIdx := (paIdx + 1) mod patCnt;
- residualPat := pattern[paIdx];
- pt := pt2;
- ExtendDash(pt);
- end;
- end;
- NewDash;
- SetLength(Result, dashCnt);
- if not assigned(patternOffset) then Exit;
- patOff := 0;
- for i := 0 to paIdx -1 do
- patOff := patOff + pattern[i];
- patternOffset^ := patOff + (pattern[paIdx] - residualPat);
- end;
- //------------------------------------------------------------------------------
- function GetDashedOutLine(const path: TPathD;
- closed: Boolean; const pattern: TArrayOfDouble;
- patternOffset: PDouble; lineWidth: double;
- joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
- var
- i: integer;
- tmp: TPathsD;
- begin
- Result := nil;
- for i := 0 to High(pattern) do
- if pattern[i] <= 0 then pattern[i] := 1;
- tmp := GetDashedPath(path, closed, pattern, patternOffset);
- for i := 0 to high(tmp) do
- // AppendPath(Result, GrowOpenLine(tmp[i],
- // lineWidth, joinStyle, endStyle, 2));
- AppendPath(Result, GrowClosedLine(tmp[i], lineWidth, joinStyle, 2));
- end;
- //------------------------------------------------------------------------------
- function GetBoundsD(const paths: TArrayOfPathsD): TRectD;
- var
- i, len: integer;
- rec: TRectD;
- begin
- len := Length(paths);
- i := 0;
- while (i < len) do
- begin
- rec := GetBoundsD(paths[i]);
- if not IsEmptyRect(rec) then Break;
- inc(i);
- end;
- if i = len then
- begin
- Result := NullRectD;
- Exit;
- end;
- Result := rec;
- for i := i + 1 to len -1 do
- begin
- rec := GetBoundsD(paths[i]);
- if IsEmptyRect(rec) then Continue;
- Result := UnionRect(Result, rec);
- end;
- end;
- //------------------------------------------------------------------------------
- function GetBoundsD(const paths: TPathsD): TRectD;
- var
- i,j: integer;
- p: PPointD;
- {$IFDEF CPUX64}
- l,t,r,b,x,y: double;
- {$ENDIF CPUX64}
- begin
- if paths = nil then
- begin
- Result := NullRectD;
- Exit;
- end;
- {$IFDEF CPUX64}
- l := MaxDouble; t := l;
- r := -MaxDouble; b := r;
- {$ELSE}
- Result.Left := MaxDouble;
- Result.Top := MaxDouble;
- Result.Right := -MaxDouble;
- Result.Bottom := -MaxDouble;
- {$ENDIF CPUX64}
- for i := 0 to high(paths) do
- begin
- p := PPointD(paths[i]);
- if not assigned(p) then Continue;
- for j := 0 to high(paths[i]) do
- begin
- {$IFDEF CPUX64}
- // load p.X and p.Y into xmm registers
- x := p.X;
- y := p.Y;
- if x < l then l := x;
- if x > r then r := x;
- if y < t then t := y;
- if y > b then b := y;
- {$ELSE}
- // If we must use the FPU and memory then we should write directly
- // to the target memory.
- if p.x < Result.Left then Result.Left := p.x;
- if p.x > Result.Right then Result.Right := p.x;
- if p.y < Result.Top then Result.Top := p.y;
- if p.y > Result.Bottom then Result.Bottom := p.y;
- {$ENDIF CPUX64}
- inc(p);
- end;
- end;
- {$IFDEF CPUX64}
- if r < l then
- Result := NullRectD
- else
- begin
- // Inline the RectD() call by hand
- Result.Left := l;
- Result.Top := t;
- Result.Right := r;
- Result.Bottom := b;
- end;
- {$ELSE}
- if Result.Right < Result.Left then
- Result := NullRectD;
- {$ENDIF CPUX64}
- end;
- //------------------------------------------------------------------------------
- function GetBoundsD(const path: TPathD): TRectD;
- var
- i,highI: integer;
- p: PPointD;
- {$IFDEF CPUX64}
- l,t,r,b,x,y: double;
- {$ENDIF CPUX64}
- begin
- highI := High(path);
- if highI < 0 then
- begin
- Result := NullRectD;
- Exit;
- end;
- {$IFDEF CPUX64}
- l := path[0].X; r := l;
- t := path[0].Y; b := t;
- p := PPointD(path);
- for i := 1 to highI do
- begin
- inc(p);
- // load p.X and p.Y into xmm registers
- x := p.X;
- y := p.Y;
- if x < l then l := x;
- if x > r then r := x;
- if y < t then t := y;
- if y > b then b := y;
- end;
- // Inline the RectD() call by hand
- Result.Left := l;
- Result.Top := t;
- Result.Right := r;
- Result.Bottom := b;
- {$ELSE}
- // If we must use the FPU and memory then we should write directly
- // to the target memory.
- {$IFDEF RECORD_METHODS}
- Result.TopLeft := path[0]; // uses "rep movsd"
- Result.BottomRight := Result.TopLeft;
- {$ELSE}
- Result.Left := path[0].X; // uses "fld" and "fstp"
- Result.Top := path[0].Y;
- Result.Right := Result.Left;
- Result.Bottom := Result.Right;
- {$ENDIF RECORD_METHODS}
- p := PPointD(path);
- for i := 1 to highI do
- begin
- inc(p);
- if p.x < Result.Left then Result.Left := p.x;
- if p.x > Result.Right then Result.Right := p.x;
- if p.y < Result.Top then Result.Top := p.y;
- if p.y > Result.Bottom then Result.Bottom := p.y;
- end;
- {$ENDIF CPUX64}
- end;
- //------------------------------------------------------------------------------
- function GetBounds(const path: TPathD): TRect;
- var
- recD: TRectD;
- begin
- recD := GetBoundsD(path);
- Result := Rect(recD);
- end;
- //------------------------------------------------------------------------------
- function GetBounds(const paths: TPathsD): TRect;
- var
- recD: TRectD;
- begin
- recD := GetBoundsD(paths);
- Result := Rect(recD);
- end;
- //------------------------------------------------------------------------------
- procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD);
- var
- len: integer;
- begin
- len := Length(p);
- SetLengthUninit(Result, len +1);
- Result[0] := pt;
- if len > 0 then Move(p[0], Result[1], len * SizeOf(TPointD));
- end;
- //------------------------------------------------------------------------------
- function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD;
- begin
- PrePendPoint(pt, p, Result);
- end;
- //------------------------------------------------------------------------------
- function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
- var
- len: integer;
- begin
- len := Length(p);
- NewPointDArray(Result, len +2, True);
- Result[0] := pt1;
- Result[1] := pt2;
- if len > 0 then Move(p[0], Result[2], len * SizeOf(TPointD));
- end;
- //------------------------------------------------------------------------------
- function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
- var
- omt: double;
- begin
- if t > 1 then t := 1
- else if t < 0 then t := 0;
- omt := 1 - t;
- Result.X := a.X*omt*omt + b.X*2*omt*t + c.X*t*t;
- Result.Y := a.Y*omt*omt + b.Y*2*omt*t + c.Y*t*t;
- end;
- //------------------------------------------------------------------------------
- function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- begin
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- Result := FlattenQBezier(PrePendPoint(firstPt, pts), tolerance);
- end;
- //------------------------------------------------------------------------------
- function FlattenQBezier(const pts: TPathD; tolerance: double = 0.0): TPathD;
- var
- i, highI: integer;
- p: TPathD;
- begin
- Result := nil;
- highI := high(pts);
- if highI < 0 then Exit;
- if (highI < 2) or Odd(highI) then
- raise Exception.CreateRes(@rsInvalidQBezier);
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- NewPointDArray(Result, 1, True);
- Result[0] := pts[0];
- for i := 0 to (highI div 2) -1 do
- begin
- if PointsEqual(pts[i*2], pts[i*2+1]) and
- PointsEqual(pts[i*2+1], pts[i*2+2]) then
- begin
- AppendPoint(Result, pts[i*2]);
- AppendPoint(Result, pts[i*2 +2]);
- end else
- begin
- p := FlattenQBezier(pts[i*2], pts[i*2+1], pts[i*2+2], tolerance);
- ConcatPaths(Result, Copy(p, 1, Length(p) -1));
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function FlattenQBezier(const pt1, pt2, pt3: TPointD;
- tolerance: double = 0.0): TPathD;
- var
- resultCnt, resultLen: integer;
- procedure AddPoint(const pt: TPointD);
- begin
- if resultCnt = resultLen then
- begin
- inc(resultLen, BuffSize);
- SetLengthUninit(result, resultLen);
- end;
- result[resultCnt] := pt;
- inc(resultCnt);
- end;
- procedure DoCurve(const p1, p2, p3: TPointD);
- var
- p12, p23, p123: TPointD;
- begin
- if (abs(p1.x + p3.x - 2 * p2.x) +
- abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
- begin
- AddPoint(p3);
- end else
- begin
- P12.X := (P1.X + P2.X) * 0.5;
- P12.Y := (P1.Y + P2.Y) * 0.5;
- P23.X := (P2.X + P3.X) * 0.5;
- P23.Y := (P2.Y + P3.Y) * 0.5;
- P123.X := (P12.X + P23.X) * 0.5;
- P123.Y := (P12.Y + P23.Y) * 0.5;
- DoCurve(p1, p12, p123);
- DoCurve(p123, p23, p3);
- end;
- end;
- begin
- resultLen := 0; resultCnt := 0;
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- AddPoint(pt1);
- if ((pt1.X = pt2.X) and (pt1.Y = pt2.Y)) or
- ((pt2.X = pt3.X) and (pt2.Y = pt3.Y)) then
- begin
- AddPoint(pt3)
- end else
- DoCurve(pt1, pt2, pt3);
- SetLength(result, resultCnt);
- end;
- //------------------------------------------------------------------------------
- function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
- var
- omt: double;
- begin
- if t > 1 then t := 1
- else if t < 0 then t := 0;
- omt := 1 - t;
- Result.X := a.X*omt*omt*omt +b.X*3*omt*omt*t +c.X*3*omt*t*t +d.X*t*t*t;
- Result.Y := a.Y*omt*omt*omt +b.Y*3*omt*omt*t +c.Y*3*omt*t*t +d.Y*t*t*t;
- end;
- //------------------------------------------------------------------------------
- function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
- tolerance: double = 0.0): TPathD; overload;
- begin
- Result := FlattenCBezier(PrePendPoint(firstPt, pts), tolerance);
- end;
- //------------------------------------------------------------------------------
- function FlattenCBezier(const path: TPathD; tolerance: double = 0.0): TPathD;
- var
- i, len: integer;
- p: TPathD;
- begin
- Result := nil;
- len := Length(path) -1;
- if len < 0 then Exit;
- if (len < 3) or (len mod 3 <> 0) then
- raise Exception.Create(rsInvalidCBezier);
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- NewPointDArray(Result, 1, True);
- Result[0] := path[0];
- for i := 0 to (len div 3) -1 do
- begin
- if PointsEqual(path[i*3], path[i*3+1]) and
- PointsEqual(path[i*3+2], path[i*3+3]) then
- begin
- AppendPoint(Result, path[i*3]);
- AppendPoint(Result, path[i*3 +3]);
- end else
- begin
- p := FlattenCBezier(path[i*3], path[i*3+1],
- path[i*3+2], path[i*3+3], tolerance);
- ConcatPaths(Result, Copy(p, 1, Length(p) -1));
- end;
- end;
- end;
- //------------------------------------------------------------------------------
- function FlattenCBezier(const paths: TPathsD; tolerance: double): TPathsD;
- var
- i, len: integer;
- begin
- len := Length(paths);
- SetLength(Result, len);
- for i := 0 to len -1 do
- Result[i] := FlattenCBezier(paths[i], tolerance);
- end;
- //------------------------------------------------------------------------------
- function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
- tolerance: double = 0.0): TPathD;
- var
- resultCnt, resultLen: integer;
- procedure AddPoint(const pt: TPointD);
- begin
- if resultCnt = resultLen then
- begin
- inc(resultLen, BuffSize);
- SetLengthUninit(result, resultLen);
- end;
- result[resultCnt] := pt;
- inc(resultCnt);
- end;
- procedure DoCurve(const p1, p2, p3, p4: TPointD);
- var
- p12, p23, p34, p123, p234, p1234: TPointD;
- begin
- if ((abs(p1.x +p3.x - 2*p2.x) < tolerance) and
- (abs(p2.x +p4.x - 2*p3.x) < tolerance)) and
- ((abs(p1.y +p3.y - 2*p2.y) < tolerance) and
- (abs(p2.y +p4.y - 2*p3.y) < tolerance)) then
- begin
- AddPoint(p4);
- end else
- begin
- p12.X := (p1.X + p2.X) / 2;
- p12.Y := (p1.Y + p2.Y) / 2;
- p23.X := (p2.X + p3.X) / 2;
- p23.Y := (p2.Y + p3.Y) / 2;
- p34.X := (p3.X + p4.X) / 2;
- p34.Y := (p3.Y + p4.Y) / 2;
- p123.X := (p12.X + p23.X) / 2;
- p123.Y := (p12.Y + p23.Y) / 2;
- p234.X := (p23.X + p34.X) / 2;
- p234.Y := (p23.Y + p34.Y) / 2;
- p1234.X := (p123.X + p234.X) / 2;
- p1234.Y := (p123.Y + p234.Y) / 2;
- DoCurve(p1, p12, p123, p1234);
- DoCurve(p1234, p234, p34, p4);
- end;
- end;
- begin
- result := nil;
- resultLen := 0; resultCnt := 0;
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- AddPoint(pt1);
- if ValueAlmostZero(pt1.X - pt2.X) and ValueAlmostZero(pt1.Y - pt2.Y) and
- ValueAlmostZero(pt3.X - pt4.X) and ValueAlmostZero(pt3.Y - pt4.Y) then
- begin
- AddPoint(pt4)
- end else
- DoCurve(pt1, pt2, pt3, pt4);
- SetLength(result,resultCnt);
- end;
- //------------------------------------------------------------------------------
- function ReflectPoint(const pt, pivot: TPointD): TPointD;
- begin
- Result.X := pivot.X + (pivot.X - pt.X);
- Result.Y := pivot.Y + (pivot.Y - pt.Y);
- end;
- //------------------------------------------------------------------------------
- function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
- const pts: TPathD; tolerance: double = 0.0): TPathD;
- var
- p: TPathD;
- len: integer;
- begin
- len := Length(pts);
- NewPointDArray(p, len + 2, True);
- p[0] := startPt;
- p[1] := ReflectPoint(priorCtrlPt, startPt);
- if len > 0 then
- Move(pts[0], p[2], len * SizeOf(TPointD));
- Result := FlattenCSpline(p, tolerance);
- end;
- //------------------------------------------------------------------------------
- function FlattenCSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
- var
- resultCnt, resultLen: integer;
- procedure AddPoint(const pt: TPointD);
- begin
- if resultCnt = resultLen then
- begin
- inc(resultLen, BuffSize);
- SetLengthUninit(result, resultLen);
- end;
- result[resultCnt] := pt;
- inc(resultCnt);
- end;
- procedure DoCurve(const p1, p2, p3, p4: TPointD);
- var
- p12, p23, p34, p123, p234, p1234: TPointD;
- begin
- if (abs(p1.x + p3.x - 2*p2.x) + abs(p2.x + p4.x - 2*p3.x) +
- abs(p1.y + p3.y - 2*p2.y) + abs(p2.y + p4.y - 2*p3.y)) < tolerance then
- begin
- AddPoint(p4);
- end else
- begin
- p12.X := (p1.X + p2.X) / 2;
- p12.Y := (p1.Y + p2.Y) / 2;
- p23.X := (p2.X + p3.X) / 2;
- p23.Y := (p2.Y + p3.Y) / 2;
- p34.X := (p3.X + p4.X) / 2;
- p34.Y := (p3.Y + p4.Y) / 2;
- p123.X := (p12.X + p23.X) / 2;
- p123.Y := (p12.Y + p23.Y) / 2;
- p234.X := (p23.X + p34.X) / 2;
- p234.Y := (p23.Y + p34.Y) / 2;
- p1234.X := (p123.X + p234.X) / 2;
- p1234.Y := (p123.Y + p234.Y) / 2;
- DoCurve(p1, p12, p123, p1234);
- DoCurve(p1234, p234, p34, p4);
- end;
- end;
- var
- i, len: integer;
- p: PPointD;
- pt1,pt2,pt3,pt4: TPointD;
- begin
- result := nil;
- len := Length(pts); resultLen := 0; resultCnt := 0;
- if (len < 4) then Exit;
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- //ignore incomplete trailing control points
- if Odd(len) then dec(len);
- p := @pts[0];
- AddPoint(p^);
- pt1 := p^; inc(p);
- pt2 := p^; inc(p);
- for i := 0 to (len shr 1) - 2 do
- begin
- pt3 := p^; inc(p);
- pt4 := p^; inc(p);
- DoCurve(pt1, pt2, pt3, pt4);
- pt1 := pt4;
- pt2 := ReflectPoint(pt3, pt1);
- end;
- SetLength(result,resultCnt);
- end;
- //------------------------------------------------------------------------------
- function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
- const pts: TPathD; tolerance: double = 0.0): TPathD;
- var
- p: TPathD;
- len: integer;
- begin
- len := Length(pts);
- NewPointDArray(p, len + 2, True);
- p[0] := startPt;
- p[1] := ReflectPoint(priorCtrlPt, startPt);
- if len > 0 then
- Move(pts[0], p[2], len * SizeOf(TPointD));
- Result := FlattenQSpline(p, tolerance);
- end;
- //------------------------------------------------------------------------------
- function FlattenQSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
- var
- resultCnt, resultLen: integer;
- procedure AddPoint(const pt: TPointD);
- begin
- if resultCnt = resultLen then
- begin
- inc(resultLen, BuffSize);
- SetLengthUninit(result, resultLen);
- end;
- result[resultCnt] := pt;
- inc(resultCnt);
- end;
- procedure DoCurve(const p1, p2, p3: TPointD);
- var
- p12, p23, p123: TPointD;
- begin
- if (abs(p1.x + p3.x - 2 * p2.x) +
- abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
- begin
- AddPoint(p3);
- end else
- begin
- P12.X := (P1.X + P2.X) * 0.5;
- P12.Y := (P1.Y + P2.Y) * 0.5;
- P23.X := (P2.X + P3.X) * 0.5;
- P23.Y := (P2.Y + P3.Y) * 0.5;
- P123.X := (P12.X + P23.X) * 0.5;
- P123.Y := (P12.Y + P23.Y) * 0.5;
- DoCurve(p1, p12, p123);
- DoCurve(p123, p23, p3);
- end;
- end;
- var
- i, len: integer;
- p: PPointD;
- pt1, pt2, pt3: TPointD;
- begin
- result := nil;
- len := Length(pts);
- if (len < 3) then Exit;
- resultLen := 0;
- resultCnt := 0;
- if tolerance <= 0.0 then tolerance := BezierTolerance;
- p := @pts[0];
- AddPoint(p^);
- pt1 := p^; inc(p);
- pt2 := p^; inc(p);
- for i := 0 to len - 3 do
- begin
- pt3 := p^; inc(p);
- DoCurve(pt1, pt2, pt3);
- pt1 := pt3;
- pt2 := ReflectPoint(pt2, pt1);
- end;
- SetLength(result,resultCnt);
- end;
- //------------------------------------------------------------------------------
- function MakePath(const pts: array of double): TPathD;
- var
- i, len: Integer;
- x,y: double;
- begin
- Result := nil;
- len := length(pts) div 2;
- if len = 0 then Exit;
- NewPointDArray(Result, len, True);
- Result[0].X := pts[0];
- Result[0].Y := pts[1];
- for i := 1 to len -1 do
- begin
- x := pts[i*2];
- y := pts[i*2 +1];
- Result[i].X := x;
- Result[i].Y := y;
- end;
- end;
- //------------------------------------------------------------------------------
- function MakePath(const pt: TPointD): TPathD;
- begin
- SetLengthUninit(Result, 1);
- Result[0] := pt;
- end;
- //------------------------------------------------------------------------------
- end.
|