1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Authors: Alexander Klenin
8
9 }
10 unit TAGeometry;
11
12 {$H+}
13
14 interface
15
16 uses
17 TAChartUtils, Types;
18
19 type
20 TPolygon = object
21 public
22 FPoints: TPointArray;
23 FCount: Integer;
24 public
25 constructor Init;
26 procedure Add(const APoint: TPoint);
27 procedure AddNoDup(const APoint: TPoint); inline;
LastPointnull28 function LastPoint: TPoint; inline;
Purgenull29 function Purge: TPointArray; inline;
30 end;
31
32 TEllipse = object
33 public
34 FC: TDoublePoint;
35 FR: TDoublePoint;
36 constructor InitBoundingBox(AX1, AY1, AX2, AY2: Integer);
37 public
GetPointnull38 function GetPoint(AParametricAngle: Double): TDoublePoint;
39 procedure SliceToPolygon(
40 AAngleStart, AAngleLength: Double; AStep: Integer; var APoly: TPolygon);
TesselateRadialPienull41 function TesselateRadialPie(
42 AAngleStart, AAngleLength: Double; AStep: Integer): TPointArray;
43 end;
44
CopyPointsnull45 function CopyPoints(
46 APoints: array of TPoint; AStartIndex, ANumPts: Integer): TPointArray;
DotProductnull47 function DotProduct(A, B: TDoublePoint): Double;
DoublePointnull48 function DoublePoint(AX, AY: Double): TDoublePoint; inline; overload;
DoublePointnull49 function DoublePoint(const AP: TPoint): TDoublePoint; inline; overload;
DoubleRectnull50 function DoubleRect(AX1, AY1, AX2, AY2: Double): TDoubleRect; inline;
51 procedure ExpandRect(var ARect: TDoubleRect; const APoint: TDoublePoint); inline;
52 procedure ExpandRect(var ARect: TRect; const APoint: TPoint); inline;
53 procedure ExpandRect(
54 var ARect: TRect; const ACenter: TPoint; ARadius: Integer;
55 AAngle1, AAngle2: Double); inline;
IsPointOnLinenull56 function IsPointOnLine(const AP, A1, A2: TPoint): Boolean; inline;
IsPointInPolygonnull57 function IsPointInPolygon(
58 const AP: TPoint; const APolygon: array of TPoint): Boolean;
IsPointInRectnull59 function IsPointInRect(const AP, A1, A2: TPoint): Boolean; inline; overload;
IsPointInRectnull60 function IsPointInRect(const AP: TPoint; const AR: TRect): Boolean; inline; overload;
IsRectInRectnull61 function IsRectInRect(const AInner, AOuter: TRect): Boolean; inline;
IsLineIntersectsLinenull62 function IsLineIntersectsLine(const AA, AB, AC, AD: TPoint): Boolean;
IsPolygonIntersectsPolygonnull63 function IsPolygonIntersectsPolygon(const AP1, AP2: array of TPoint): Boolean;
LineIntersectsRectnull64 function LineIntersectsRect(
65 var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
66 procedure NormalizeRect(var ARect: TRect); overload;
67 procedure NormalizeRect(var ARect: TDoubleRect); overload;
MakeSquarenull68 function MakeSquare(const ARect: TRect): TRect;
MakeCalloutnull69 function MakeCallout(
70 const AShape: TPointArray; const ACenter, ATarget: TPoint;
71 AAngle: Double): TPointArray;
MaxPointnull72 function MaxPoint(const A, B: TPoint): TPoint; inline;
MeasureRotatedRectnull73 function MeasureRotatedRect(const ASize: TPoint; AAngle: Double): TSize;
NextNumberSeqnull74 function NextNumberSeq(
75 const APoints: array of TDoublePoint; var AStart, AEnd: Integer): Boolean;
PointDistnull76 function PointDist(const A, B: TPoint): Integer; inline;
PointDistXnull77 function PointDistX(const A, B: TPoint): Integer; inline;
PointDistYnull78 function PointDistY(const A, B: TPoint): Integer; inline;
PointLineDistnull79 function PointLineDist(const P, A, B: TPoint): Integer;
ProjToLinenull80 function ProjToLine(const P, A, B: TDoublePoint): TDoublePoint; overload;
ProjToLinenull81 function ProjToLine(const P, A, B: TPoint): TPoint; overload;
ProjToRectnull82 function ProjToRect(
83 const APt: TDoublePoint; const ARect: TDoubleRect): TDoublePoint;
RectIntersectsRectnull84 function RectIntersectsRect(
85 var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean;
RotatePointnull86 function RotatePoint(const APoint: TDoublePoint; AAngle: Double): TDoublePoint; overload;
RotatePointnull87 function RotatePoint(const APoint: TPoint; AAngle: Double): TPoint; overload;
RotatePointXnull88 function RotatePointX(AX, AAngle: Double): TPoint;
RoundPointnull89 function RoundPoint(APoint: TDoublePoint): TPoint;
TesselateRectnull90 function TesselateRect(const ARect: TRect): TPointArray;
TesselateEllipsenull91 function TesselateEllipse(const ABounds: TRect; AStep: Integer): TPointArray;
TesselateRoundRectnull92 function TesselateRoundRect(const ARect: TRect; ARadius, AStep: Integer): TPointArray;
93
94 operator +(const A: TPoint; B: TSize): TPoint; overload; inline;
95 operator +(const A, B: TPoint): TPoint; overload; inline;
96 operator +(const A, B: TDoublePoint): TDoublePoint; overload; inline;
97 operator -(const A: TPoint): TPoint; overload; inline;
98 operator -(const A, B: TPoint): TPoint; overload; inline;
99 operator -(const A, B: TDoublePoint): TDoublePoint; overload; inline;
100 operator div(const A: TPoint; ADivisor: Integer): TPoint; inline;
101 operator *(const A: TPoint; AMultiplier: Integer): TPoint; inline;
102 operator *(const A, B: TPoint): TPoint; inline;
103 operator *(const A, B: TDoublePoint): TDoublePoint; overload; inline;
104 operator * (const A: TDoublePoint; B: Double): TDoublePoint; overload; inline;
105 operator /(const A, B: TDoublePoint): TDoublePoint; overload; inline;
106 operator = (const A, B: TDoublePoint): Boolean; overload; inline;
107 operator = (const A, B: TDoubleRect): Boolean; overload; inline;
108 operator <= (const A, B: TDoublePoint): Boolean; overload; inline;
109 operator :=(const APoint: TPoint): TSize; inline;
110 operator :=(const ASize: TSize): TPoint; inline;
111
112 implementation
113
114 uses
115 GraphMath, Math, TAMath;
116
117 function PointLineSide(AP, A1, A2: TPoint): TValueSign; forward;
118
CopyPointsnull119 function CopyPoints(
120 APoints: array of TPoint; AStartIndex, ANumPts: Integer): TPointArray;
121 var
122 i: Integer;
123 begin
124 Assert(ANumPts >= 0);
125 SetLength(Result, ANumPts);
126 for i := 0 to ANumPts - 1 do
127 Result[i] := APoints[i + AStartIndex];
128 end;
129
DotProductnull130 function DotProduct(A, B: TDoublePoint): Double;
131 begin
132 Result := A.X * B.X + A.Y * B.Y;
133 end;
134
DoublePointnull135 function DoublePoint(AX, AY: Double): TDoublePoint; inline;
136 begin
137 Result.X := AX;
138 Result.Y := AY;
139 end;
140
DoublePointnull141 function DoublePoint(const AP: TPoint): TDoublePoint;
142 begin
143 Result.X := AP.X;
144 Result.Y := AP.Y;
145 end;
146
DoubleRectnull147 function DoubleRect(AX1, AY1, AX2, AY2: Double): TDoubleRect; inline;
148 begin
149 Result.a.X := AX1;
150 Result.a.Y := AY1;
151 Result.b.X := AX2;
152 Result.b.Y := AY2;
153 end;
154
155 procedure ExpandRect(var ARect: TDoubleRect; const APoint: TDoublePoint);
156 begin
157 UpdateMinMax(APoint.X, ARect.a.X, ARect.b.X);
158 UpdateMinMax(APoint.Y, ARect.a.Y, ARect.b.Y);
159 end;
160
161 procedure ExpandRect(var ARect: TRect; const APoint: TPoint);
162 begin
163 UpdateMinMax(APoint.X, ARect.Left, ARect.Right);
164 UpdateMinMax(APoint.Y, ARect.Top, ARect.Bottom);
165 end;
166
167 procedure ExpandRect(
168 var ARect: TRect; const ACenter: TPoint; ARadius: Integer;
169 AAngle1, AAngle2: Double);
170 var
171 i, j: Integer;
172 begin
173 EnsureOrder(AAngle1, AAngle2);
174 ExpandRect(ARect, RotatePointX(ARadius, AAngle1) + ACenter);
175 ExpandRect(ARect, RotatePointX(ARadius, AAngle2) + ACenter);
176 j := Floor(AAngle1 / Pi * 2);
177 for i := j to j + 4 do
178 if InRange(Pi / 2 * i, AAngle1, AAngle2) then
179 ExpandRect(ARect, RotatePointX(ARadius, Pi / 2 * i) + ACenter);
180 end;
181
IsPointOnLinenull182 function IsPointOnLine(const AP, A1, A2: TPoint): Boolean;
183 begin
184 Result := IsPointInRect(AP, A1, A2) and (PointLineSide(AP, A1, A2) = 0);
185 end;
186
IsPointInPolygonnull187 function IsPointInPolygon(
188 const AP: TPoint; const APolygon: array of TPoint): Boolean;
189 var
190 i, count: Integer;
191 p1, p2: TPoint;
192 s1, s2: TValueSign;
193 begin
194 if Length(APolygon) = 0 then exit(false);
195 p1 := APolygon[High(APolygon)];
196 for i := 0 to High(APolygon) do begin
197 p2 := APolygon[i];
198 if IsPointOnLine(AP, p1, p2) then exit(true);
199 p1 := p2;
200 end;
201 count := 0;
202 p1 := APolygon[High(APolygon)];
203 for i := 0 to High(APolygon) do begin
204 p2 := APolygon[i];
205 s1 := Sign(p1.Y - AP.Y);
206 s2 := Sign(p2.Y - AP.Y);
207 case s1 * s2 of
208 -1: count += Ord(PointLineSide(AP, p1, p2) = Sign(p1.Y - p2.Y));
209 0: if s1 + s2 = 1 then begin
210 if s1 = 0 then
211 count += Ord(p1.X >= AP.X)
212 else
213 count += Ord(p2.X >= AP.X)
214 end;
215 end;
216 p1 := p2;
217 end;
218 Result := count mod 2 = 1;
219 end;
220
IsPointInRectnull221 function IsPointInRect(const AP, A1, A2: TPoint): Boolean;
222 begin
223 Result := SafeInRange(AP.X, A1.X, A2.X) and SafeInRange(AP.Y, A1.Y, A2.Y);
224 end;
225
IsPointInRectnull226 function IsPointInRect(const AP: TPoint; const AR: TRect): Boolean;
227 begin
228 Result :=
229 SafeInRange(AP.X, AR.Left, AR.Right) and
230 SafeInRange(AP.Y, AR.Top, AR.Bottom);
231 end;
232
IsRectInRectnull233 function IsRectInRect(const AInner, AOuter: TRect): Boolean;
234 begin
235 Result :=
236 IsPointInRect(AInner.TopLeft, AOuter) and
237 IsPointInRect(AInner.BottomRight, AOuter);
238 end;
239
IsLineIntersectsLinenull240 function IsLineIntersectsLine(const AA, AB, AC, AD: TPoint): Boolean;
241 var
242 sa, sb, sc, sd: TValueSign;
243 begin
244 sa := PointLineSide(AA, AC, AD);
245 sb := PointLineSide(AB, AC, AD);
246 if (sa = 0) and (sb = 0) then
247 // All points are on the same infinite line.
248 Result :=
249 IsPointInRect(AA, AC, AD) or IsPointInRect(AB, AC, AD) or
250 IsPointInRect(AC, AA, AB) or IsPointInRect(AD, AA, AB)
251 else begin
252 sc := PointLineSide(AC, AA, AB);
253 sd := PointLineSide(AD, AA, AB);
254 Result := (sa * sb <= 0) and (sc * sd <= 0);
255 end;
256 end;
257
IsPolygonIntersectsPolygonnull258 function IsPolygonIntersectsPolygon(const AP1, AP2: array of TPoint): Boolean;
259 var
260 i, j: Integer;
261 p1, p2: TPoint;
262 begin
263 if (Length(AP1) = 0) or (Length(AP2) = 0) then exit(false);
264 if IsPointInPolygon(AP1[0], AP2) or IsPointInPolygon(AP2[0], AP1) then
265 exit(true);
266 for i := 0 to High(AP1) do begin
267 p1 := AP1[i];
268 p2 := AP1[(i + 1) mod Length(AP1)];
269 for j := 0 to High(AP2) do
270 if IsLineIntersectsLine(p1, p2, AP2[j], AP2[(j + 1) mod Length(AP2)]) then
271 exit(true);
272 end;
273 Result := false;
274 end;
275
LineIntersectsRectnull276 function LineIntersectsRect(
277 var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
278
279 procedure AdjustX(var AP: TDoublePoint; ANewX: Double); inline;
280 var
281 dx: Double;
282 begin
283 dx := AB.X - AA.X;
284 if not IsInfinite(dx) and not IsInfinite(AP.Y) then
285 AP.Y += (AB.Y - AA.Y) / dx * (ANewX - AP.X);
286 AP.X := ANewX;
287 end;
288
289 procedure AdjustY(var AP: TDoublePoint; ANewY: Double); inline;
290 var
291 dy: Double;
292 begin
293 dy := AB.Y - AA.Y;
294 if not IsInfinite(dy) and not IsInfinite(AP.X) then
295 AP.X += (AB.X - AA.X) / dy * (ANewY - AP.Y);
296 AP.Y := ANewY;
297 end;
298
299 begin
300 case CASE_OF_TWO[AA.X < ARect.a.X, AB.X < ARect.a.X] of
301 cotFirst: AdjustX(AA, ARect.a.X);
302 cotSecond: AdjustX(AB, ARect.a.X);
303 cotBoth: exit(false);
304 end;
305 case CASE_OF_TWO[AA.X > ARect.b.X, AB.X > ARect.b.X] of
306 cotFirst: AdjustX(AA, ARect.b.X);
307 cotSecond: AdjustX(AB, ARect.b.X);
308 cotBoth: exit(false);
309 end;
310 case CASE_OF_TWO[AA.Y < ARect.a.Y, AB.Y < ARect.a.Y] of
311 cotFirst: AdjustY(AA, ARect.a.Y);
312 cotSecond: AdjustY(AB, ARect.a.Y);
313 cotBoth: exit(false);
314 end;
315 case CASE_OF_TWO[AA.Y > ARect.b.Y, AB.Y > ARect.b.Y] of
316 cotFirst: AdjustY(AA, ARect.b.Y);
317 cotSecond: AdjustY(AB, ARect.b.Y);
318 cotBoth: exit(false);
319 end;
320 Result := true;
321 end;
322
MakeSquarenull323 function MakeSquare(const ARect: TRect): TRect;
324 var
325 c: TPoint;
326 w, h: Integer;
327 begin
328 c := CenterPoint(ARect);
329 Result := ARect;
330 w := Abs(Result.Right - Result.Left);
331 h := Abs(Result.Bottom - Result.Top);
332 if w > h then begin
333 Result.Left := c.X - h div 2;
334 Result.Right := c.X + h div 2;
335 end
336 else begin
337 Result.Top := c.Y - w div 2;
338 Result.Bottom := c.Y + w div 2;
339 end;
340 end;
341
MakeCalloutnull342 function MakeCallout(
343 const AShape: TPointArray; const ACenter, ATarget: TPoint;
344 AAngle: Double): TPointArray;
345 var
346 AVector: TPoint;
347
Nextnull348 function Next(AIndex, ADir: Integer): Integer; inline;
349 begin
350 Result := (AIndex + Length(AShape) + ADir) mod Length(AShape);
351 end;
352
NearestSidenull353 function NearestSide: Integer;
354 begin
355 for Result := 0 to High(AShape) do
356 if
357 IsLineIntersectsLine(
358 ACenter, ATarget, AShape[Result], AShape[Next(Result, 1)])
359 then
360 exit;
361 Result := -1;
362 end;
363
ScalarProductnull364 function ScalarProduct(const AP1, AP2: TPoint): Double; inline;
365 begin
366 Result := Double(AP1.X) * AP2.X + Double(AP1.Y) * AP2.Y;
367 end;
368
CrossProductSignnull369 function CrossProductSign(const AP1, AP2: TPoint): Integer; inline;
370 begin
371 Result := Sign(Double(AP1.X) * AP2.Y - Double(AP1.Y) * AP2.X);
372 end;
373
CrossProductSignByIndexnull374 function CrossProductSignByIndex(AIndex: Integer): Integer; inline;
375 begin
376 Result := CrossProductSign(AVector, AShape[AIndex] - ATarget);
377 end;
378
CosVectornull379 function CosVector(AIndex: Integer): Double;
380 begin
381 Result :=
382 ScalarProduct(AShape[AIndex] - ATarget, AVector) /
383 Sqrt(Double(PointDist(AShape[AIndex], ATarget)) * PointDist(ACenter, ATarget));
384 end;
385
LineIntersectsRaynull386 function LineIntersectsRay(
387 const AFrom: TPoint; const ARay: TDoublePoint; const AA, AB: TPoint): TPoint;
388 var
389 line: TDoublePoint;
390 det, t: Double;
391 begin
392 line := DoublePoint(AB - AA);
393 // x = t * ARay.X + AFrom.X; y = t * ARay.Y + AFrom.Y;
394 // (x - AA.X) * line.Y = (y - AA.Y) * line.X
395 // t * ARay.X * line.Y + (AFrom.X - AA.X) * line.Y =
396 // t * ARay.Y * line.X + (AFrom.Y - AA.Y) * line.X
397 det := ARay.X * line.Y - ARay.Y * line.X;
398 if det = 0 then exit(AB);
399 with (AFrom - AA) do // Workaround for issue #17005.
400 t := (Y * line.X - X * line.Y) / det;
401 if t <= 0 then exit(AB);
402 Result := RoundPoint(DoublePoint(t, t) * ARay) + AFrom;
403 end;
404
405 procedure PointOnAngle(ADir: Integer; var AIndex: Integer; out APt: TPoint);
406 var
407 targetCos, c, maxCos: Double;
408 this, prev: TPoint;
409 ray: TDoublePoint;
410 s, n: Integer;
411 begin
412 targetCos := Cos(AAngle / 2);
413 maxCos := 2.0;
414 while true do begin
415 // Central vector of the callout passes exactly through the shape vertex.
416 s := CrossProductSignByIndex(AIndex);
417 if s <> 0 then break;
418 AIndex := Next(AIndex, ADir);
419 end;
420 prev := AShape[Next(AIndex, -ADir)];
421 while true do begin
422 this := AShape[AIndex];
423 c := CosVector(AIndex);
424 n := Next(AIndex, ADir);
425 if
426 (CrossProductSignByIndex(AIndex) <> s) or (c > maxCos) and
427 // Imprecision of integer grid may result in short concave segments on
428 // a convex figure. Skip them by a single-point lookahead.
429 ((CrossProductSignByIndex(n) <> s) or (CosVector(n) > maxCos))
430 then begin
431 APt := prev;
432 AIndex := Next(AIndex, -ADir);
433 exit;
434 end;
435 if c <= targetCos then begin
436 ray := RotatePoint(DoublePoint(AVector), s * AAngle / 2);
437 APt := LineIntersectsRay(ATarget, ray, prev, this);
438 exit;
439 end;
440 AIndex := Next(AIndex, ADir);
441 maxCos := c;
442 prev := this;
443 end;
444 end;
445
446 var
447 cnt: Integer = 0;
448
449 procedure Add(const APoint: TPoint);
450 begin
451 if (cnt = 0) or (Result[cnt - 1] <> APoint) then begin
452 Result[cnt] := APoint;
453 cnt += 1;
454 end;
455 end;
456
457 var
458 ni, li, ri, i: Integer;
459 lp, rp: TPoint;
460 begin
461 if
462 (Length(AShape) < 3) or
463 IsPointInPolygon(ATarget, AShape) or not IsPointInPolygon(ACenter, AShape)
464 then
465 exit(AShape);
466 ni := NearestSide;
467 if ni < 0 then exit(AShape);
468 AVector := ACenter - ATarget;
469 li := ni;
470 PointOnAngle(-1, li, lp);
471 ri := Next(ni, 1);
472 PointOnAngle(+1, ri, rp);
473 SetLength(Result, Length(AShape) + 3);
474 i := ri;
475 while i <> li do begin
476 Add(AShape[i]);
477 i := Next(i, 1);
478 end;
479 Add(AShape[li]);
480 Add(lp);
481 Add(ATarget);
482 Add(rp);
483 SetLength(Result, cnt);
484 end;
485
MaxPointnull486 function MaxPoint(const A, B: TPoint): TPoint;
487 begin
488 Result.X := Max(A.X, B.X);
489 Result.Y := Max(A.Y, B.Y);
490 end;
491
MeasureRotatedRectnull492 function MeasureRotatedRect(const ASize: TPoint; AAngle: Double): TSize;
493 var
494 pt1, pt2: TPoint;
495 begin
496 pt1 := RotatePoint(ASize, AAngle);
497 pt2 := RotatePoint(Point(ASize.X, -ASize.Y), AAngle);
498 Result.cx := Max(Abs(pt1.X), Abs(pt2.X));
499 Result.cy := Max(Abs(pt1.Y), Abs(pt2.Y));
500 end;
501
502 procedure NormalizeRect(var ARect: TRect);
503 begin
504 with ARect do begin
505 EnsureOrder(Left, Right);
506 EnsureOrder(Top, Bottom);
507 end;
508 end;
509
510 procedure NormalizeRect(var ARect: TDoubleRect); overload;
511 begin
512 with ARect do begin
513 EnsureOrder(a.X, b.X);
514 EnsureOrder(a.Y, b.Y);
515 end;
516 end;
517
PointLineSidenull518 function PointLineSide(AP, A1, A2: TPoint): TValueSign;
519 var
520 a1x, a1y: Int64;
521 begin
522 a1x := A1.X;
523 a1y := A1.Y;
524 Result := Sign((AP.X - a1x) * (A2.Y - a1y) - (AP.Y - a1y) * (A2.X - a1x));
525 end;
526
NextNumberSeqnull527 function NextNumberSeq(
528 const APoints: array of TDoublePoint; var AStart, AEnd: Integer): Boolean;
529 begin
530 AStart := AEnd + 2;
531 while (AStart <= High(APoints)) and IsNan(APoints[AStart]) do
532 AStart += 1;
533 AEnd := AStart;
534 while (AEnd + 1 <= High(APoints)) and not IsNan(APoints[AEnd + 1]) do
535 AEnd += 1;
536 Result := AStart <= High(APoints);
537 end;
538
PointDistnull539 function PointDist(const A, B: TPoint): Integer;
540 begin
541 Result := Min(Sqr(Int64(A.X) - B.X) + Sqr(Int64(A.Y) - B.Y), MaxInt);
542 end;
543
PointDistXnull544 function PointDistX(const A, B: TPoint): Integer;
545 begin
546 Result := Min(Abs(Int64(A.X) - B.X), MaxInt);
547 end;
548
PointDistYnull549 function PointDistY(const A, B: TPoint): Integer; inline;
550 begin
551 Result := Min(Abs(Int64(A.Y) - B.Y), MaxInt);
552 end;
553
PointLineDistnull554 function PointLineDist(const P, A,B: TPoint): Integer;
555 var
556 v, w, Q: TPoint;
557 dot: Int64;
558 lv: Integer;
559 begin
560 if A = B then
561 Result := PointDist(A, P)
562 else begin
563 v := B - A; // Vector pointing along line from A to B
564 w := P - A; // Vector pointing from A to P
565 dot := Int64(v.x) * w.x + Int64(v.y) * w.y; // dot product v . w
566 lv := PointDist(A, B); // Length of vector AB
567 Q := (v * dot) div lv; // Projection of P onto line A-B, seen from A
568 Result := PointDist(Q, w); // Length from A to Q
569 end;
570 end;
571
ProjToLinenull572 function ProjToLine(const P, A,B: TDoublePoint): TDoublePoint;
573 var
574 v, s: TDoublePoint;
575 begin
576 if P = A then
577 Result := A
578 else if P = B then
579 Result := B
580 else begin
581 s := B - A;
582 v := P - A;
583 Result := A + s * (DotProduct(v, s) / DotProduct(s, s));
584 end;
585 end;
586
ProjToLinenull587 function ProjToLine(const P, A, B: TPoint): TPoint;
588 begin
589 Result := RoundPoint(ProjToLine(DoublePoint(P), DoublePoint(A), DoublePoint(B)));
590 end;
591
ProjToRectnull592 function ProjToRect(
593 const APt: TDoublePoint; const ARect: TDoubleRect): TDoublePoint;
594 begin
595 Result.X := EnsureRange(APt.X, ARect.a.X, ARect.b.X);
596 Result.Y := EnsureRange(APt.Y, ARect.a.Y, ARect.b.Y);
597 end;
598
RectIntersectsRectnull599 function RectIntersectsRect(
600 var ARect: TDoubleRect; const AFixed: TDoubleRect): Boolean;
601
RangesIntersectnull602 function RangesIntersect(L1, R1, L2, R2: Double; out L, R: Double): Boolean;
603 begin
604 EnsureOrder(L1, R1);
605 EnsureOrder(L2, R2);
606 L := Max(L1, L2);
607 R := Min(R1, R2);
608 Result := L <= R;
609 end;
610
611 begin
612 with ARect do
613 Result :=
614 RangesIntersect(a.X, b.X, AFixed.a.X, AFixed.b.X, a.X, b.X) and
615 RangesIntersect(a.Y, b.Y, AFixed.a.Y, AFixed.b.Y, a.Y, b.Y);
616 end;
617
RotatePointnull618 function RotatePoint(const APoint: TDoublePoint; AAngle: Double): TDoublePoint;
619 var
620 sa, ca: Extended;
621 begin
622 SinCos(AAngle, sa, ca);
623 Result.X := ca * APoint.X - sa * APoint.Y;
624 Result.Y := sa * APoint.X + ca * APoint.Y;
625 end;
626
RotatePointnull627 function RotatePoint(const APoint: TPoint; AAngle: Double): TPoint;
628 var
629 sa, ca: Extended;
630 begin
631 SinCos(AAngle, sa, ca);
632 Result.X := Round(ca * APoint.X - sa * APoint.Y);
633 Result.Y := Round(sa * APoint.X + ca * APoint.Y);
634 end;
635
RotatePointXnull636 function RotatePointX(AX, AAngle: Double): TPoint;
637 var
638 sa, ca: Extended;
639 begin
640 SinCos(AAngle, sa, ca);
641 Result.X := Round(ca * AX);
642 Result.Y := Round(sa * AX);
643 end;
644
RoundPointnull645 function RoundPoint(APoint: TDoublePoint): TPoint;
646 begin
647 Result.X := Round(APoint.X);
648 Result.Y := Round(APoint.Y);
649 end;
650
TesselateRectnull651 function TesselateRect(const ARect: TRect): TPointArray;
652 begin
653 SetLength(Result, 4);
654 with ARect do begin
655 Result[0] := TopLeft;
656 Result[1] := Point(Left, Bottom);
657 Result[2] := BottomRight;
658 Result[3] := Point(Right, Top);
659 end;
660 end;
661
TesselateEllipsenull662 function TesselateEllipse(const ABounds: TRect; AStep: Integer): TPointArray;
663 var
664 e: TEllipse;
665 p: TPolygon;
666 begin
667 with ABounds do
668 e.InitBoundingBox(Left, Top, Right, Bottom);
669 p.Init;
670 e.SliceToPolygon(0, 2 * Pi, AStep, p);
671 Result := p.Purge;
672 end;
673
TesselateRoundRectnull674 function TesselateRoundRect(
675 const ARect: TRect; ARadius, AStep: Integer): TPointArray;
676 var
677 e: TEllipse;
678 p: TPolygon;
679 begin
680 with ARect do begin
681 if Min(Right - Left, Bottom - Top) < 2 * ARadius then exit(nil);
682
683 p.Init;
684 e.FR := DoublePoint(ARadius, ARadius);
685
686 p.AddNoDup(Point(Right, Bottom - ARadius));
687 p.AddNoDup(Point(Right, Top + ARadius));
688 e.FC := DoublePoint(Right - ARadius, Top + ARadius);
689 e.SliceToPolygon(0, Pi / 2, AStep, p);
690
691 p.AddNoDup(Point(Right - ARadius, Top));
692 p.AddNoDup(Point(Left + ARadius, Top));
693 e.FC := DoublePoint(Left + ARadius, Top + ARadius);
694 e.SliceToPolygon(Pi / 2, Pi / 2, AStep, p);
695
696 p.AddNoDup(Point(Left, Top + ARadius));
697 p.AddNoDup(Point(Left, Bottom - ARadius));
698 e.FC := DoublePoint(Left + ARadius, Bottom - ARadius);
699 e.SliceToPolygon(Pi, Pi / 2, AStep, p);
700
701 p.AddNoDup(Point(Left + ARadius, Bottom));
702 p.AddNoDup(Point(Right - ARadius, Bottom));
703 e.FC := DoublePoint(Right - ARadius, Bottom - ARadius);
704 e.SliceToPolygon(Pi * 3/2, Pi / 2, AStep, p);
705 end;
706
707 Result := p.Purge;
708 end;
709
710 operator + (const A: TPoint; B: TSize): TPoint;
711 begin
712 Result.X := A.X + B.cx;
713 Result.Y := A.Y + B.cy;
714 end;
715
716 operator + (const A, B: TPoint): TPoint;
717 begin
718 Result.X := A.X + B.X;
719 Result.Y := A.Y + B.Y;
720 end;
721
722 operator + (const A, B: TDoublePoint): TDoublePoint;
723 begin
724 Result.X := A.X + B.X;
725 Result.Y := A.Y + B.Y;
726 end;
727
728 operator - (const A: TPoint): TPoint;
729 begin
730 Result.X := - A.X;
731 Result.Y := - A.Y;
732 end;
733
734 operator - (const A, B: TPoint): TPoint;
735 begin
736 Result.X := A.X - B.X;
737 Result.Y := A.Y - B.Y;
738 end;
739
740 operator - (const A, B: TDoublePoint): TDoublePoint;
741 begin
742 Result.X := A.X - B.X;
743 Result.Y := A.Y - B.Y;
744 end;
745
746 operator div(const A: TPoint; ADivisor: Integer): TPoint;
747 begin
748 Result.X := A.X div ADivisor;
749 Result.Y := A.Y div ADivisor;
750 end;
751
752 operator * (const A: TPoint; AMultiplier: Integer): TPoint;
753 begin
754 Result.X := A.X * AMultiplier;
755 Result.Y := A.Y * AMultiplier;
756 end;
757
758 operator * (const A, B: TPoint): TPoint;
759 begin
760 Result.X := A.X * B.X;
761 Result.Y := A.Y * B.Y;
762 end;
763
764 operator * (const A, B: TDoublePoint): TDoublePoint;
765 begin
766 Result.X := A.X * B.X;
767 Result.Y := A.Y * B.Y;
768 end;
769
770 operator * (const A: TDoublePoint; B: Double): TDoublePoint;
771 begin
772 Result.X := A.X * B;
773 Result.Y := A.Y * B;
774 end;
775
776 operator / (const A, B: TDoublePoint): TDoublePoint;
777 begin
778 Result.X := A.X / B.X;
779 Result.Y := A.Y / B.Y;
780 end;
781
782 operator = (const A, B: TDoublePoint): Boolean;
783 begin
784 Result := (A.X = B.X) and (A.Y = B.Y);
785 end;
786
787 operator = (const A, B: TDoubleRect): Boolean;
788 begin
789 Result := (A.a = B.a) and (A.b = B.b);
790 end;
791
792 operator <= (const A, B: TDoublePoint): Boolean;
793 begin
794 Result := (A.X <= B.X) and (A.Y <= B.Y);
795 end;
796
797 operator := (const APoint: TPoint): TSize;
798 begin
799 Result.cx := APoint.X;
800 Result.cy := APoint.Y;
801 end;
802
803 operator := (const ASize: TSize): TPoint;
804 begin
805 Result.X := ASize.cx;
806 Result.Y := ASize.cy;
807 end;
808
809 { TPolygon }
810
811 procedure TPolygon.Add(const APoint: TPoint);
812 begin
813 if FCount > High(FPoints) then
814 SetLength(FPoints, Max(2 * FCount, 16));
815 FPoints[FCount] := APoint;
816 FCount += 1;
817 end;
818
819 procedure TPolygon.AddNoDup(const APoint: TPoint);
820 begin
821 if (FCount = 0) or (LastPoint <> APoint) then
822 Add(APoint);
823 end;
824
825 constructor TPolygon.Init;
826 begin
827 FCount := 0;
828 FPoints := nil;
829 end;
830
LastPointnull831 function TPolygon.LastPoint: TPoint;
832 begin
833 Result := FPoints[FCount - 1];
834 end;
835
Purgenull836 function TPolygon.Purge: TPointArray;
837 begin
838 SetLength(FPoints, FCount);
839 Result := FPoints;
840 end;
841
842 { TEllipse }
843
TEllipse.GetPointnull844 function TEllipse.GetPoint(AParametricAngle: Double): TDoublePoint;
845 var
846 s, c: Extended;
847 begin
848 SinCos(AParametricAngle, s, c);
849 Result := DoublePoint(c, -s) * FR + FC;
850 end;
851
852 constructor TEllipse.InitBoundingBox(AX1, AY1, AX2, AY2: Integer);
853 begin
854 FC.X := (AX1 + AX2) / 2;
855 FC.Y := (AY1 + AY2) / 2;
856 FR.X := Abs(AX1 - AX2) / 2;
857 FR.Y := Abs(AY1 - AY2) / 2;
858 end;
859
860 procedure TEllipse.SliceToPolygon(
861 AAngleStart, AAngleLength: Double; AStep: Integer; var APoly: TPolygon);
862 var
863 lastAngle: Double;
864
865 procedure SafeAddPoint(APoint: TPoint; AAngle: Double);
866 begin
867 if APoly.LastPoint <> APoint then begin
868 APoly.Add(APoint);
869 lastAngle := AAngle;
870 end;
871 end;
872
873 procedure Rec(ALo, AHi: Double);
874 var
875 pt: TPoint;
876 begin
877 pt := RoundPoint(GetPoint(AHi));
878 if PointDist(APoly.LastPoint, pt) <= Sqr(AStep) then
879 SafeAddPoint(pt, AHi)
880 else begin
881 Rec(ALo, (ALo + AHi) / 2);
882 Rec(lastAngle, AHi)
883 end;
884 end;
885
886 procedure Add(AAngle: Double);
887 begin
888 SafeAddPoint(RoundPoint(GetPoint(AAngle)), AAngle)
889 end;
890
891 const
892 HalfPi = Pi / 2;
893 var
894 t, tprev, tlast: Double;
895 begin
896 tprev := AAngleStart;
897 tlast := AAngleStart + AAngleLength;
898 APoly.Add(RoundPoint(GetPoint(tprev)));
899 if (FR.X < 1) or (FR.Y < 1) then begin
900 // Ellipse has degenerated into a line.
901 Add(tlast);
902 exit;
903 end;
904 APoly.Add(RoundPoint(GetPoint(tprev)));
905 lastAngle := tprev;
906 t := Ceil(tprev / HalfPi) * HalfPi;
907 while t < tlast do begin
908 Add(tprev);
909 Rec(tprev, t);
910 tprev := t;
911 t += HalfPi;
912 end;
913 Rec(tprev, tlast);
914 Add(tlast);
915 end;
916
917 // Represent the ellipse sector with a polygon on an integer grid.
918 // Polygon vertices are no more then AStep pixels apart.
TEllipse.TesselateRadialPienull919 function TEllipse.TesselateRadialPie(
920 AAngleStart, AAngleLength: Double; AStep: Integer): TPointArray;
921 var
922 resultPoly: TPolygon;
923 begin
924 resultPoly.Init;
925 SliceToPolygon(AAngleStart, AAngleLength, AStep, resultPoly);
926 resultPoly.AddNoDup(RoundPoint(FC));
927 Result := resultPoly.Purge;
928 end;
929
930 end.
931
932