1{
2/***************************************************************************
3                             GraphMath.pp
4                             ------------
5         Math helper routines for use within Graphics/Drawing & related
6                   Initial Revision  : Wed Aug 07 2002
7
8
9***************************************************************************/
10
11*****************************************************************************
12  This file is part of the Lazarus Component Library (LCL)
13
14  See the file COPYING.modifiedLGPL.txt, included in this distribution,
15  for details about the license.
16*****************************************************************************
17}
18{
19@abstract(A Set of Math Helper routines to simply Cross-Platfrom Canvas,
20etc)
21@author(Andrew Johnson <AJ_Genius@Hotmail.com>)
22@created(2002)
23@lastmod(2002)
24}
25unit GraphMath;
26
27{$Mode OBJFPC} {$H+}
28
29interface
30
31Uses
32  Types, Classes, SysUtils, Math,
33  LCLProc;
34
35Type
36  TFloatPoint = Record
37    X, Y : Extended;
38  end;
39
40  TBezier = Array[0..3] of TFloatPoint;
41
42  PPoint = ^TPoint;
43
44procedure Angles2Coords(X,Y, Width, Height : Integer;
45  Angle1, Angle2 : Extended; var SX, SY, EX, EY : Integer);
46
47procedure Arc2Bezier(X, Y, Width, Height : Longint; Angle1, Angle2,
48  Rotation : Extended; var Points : TBezier);
49
50function Bezier(const C1,C2,C3,C4 : TFloatPoint): TBezier; Overload; inline;
51function Bezier(const C1,C2,C3,C4 : TPoint): TBezier; Overload; inline;
52
53procedure Bezier2Polyline(const Bezier : TBezier; var Points : PPoint;
54  var Count : Longint);
55
56procedure BezierArcPoints(X, Y, Width, Height : Longint; Angle1, Angle2,
57  Rotation : Extended; var Points : PPoint; var Count : Longint);
58
59function BezierMidPoint(Bezier : TBezier) : TFloatPoint;
60
61procedure Coords2Angles(X, Y, Width, Height : Integer; SX, SY,
62  EX, EY : Integer; var Angle1, Angle2 : Extended);
63
64function Distance(PT1,Pt2 : TPoint) : Extended; overload;
65function Distance(Pt, SP, EP : TFloatPoint) : Extended; overload;
66
67function EccentricAngle(PT : TPoint; Rect : TRect) : Extended;
68
69function EllipseRadialLength(Rect : TRect; EccentricAngle : Extended) : Longint;
70
71function FloatPoint(AX,AY : Extended): TFloatPoint;
72
73function LineEndPoint(StartPoint : TPoint; Angle, Length : Extended) : TPoint;
74
75procedure PolyBezier2Polyline(Beziers: Array of TBezier;
76  var Points : PPoint; var Count : Longint); Overload;
77procedure PolyBezier2Polyline(Beziers : Array of TPoint;
78  var Points : PPoint; var Count : Longint;
79  Continuous : Boolean); Overload;
80procedure PolyBezier2Polyline(Beziers : PPoint; BCount : Longint;
81  var Points : PPoint; var Count : Longint;
82  Continuous : Boolean); Overload;
83
84procedure PolyBezierArcPoints(X, Y, Width, Height : Longint; Angle1,
85  Angle2, Rotation : Extended; var Points : PPoint; var Count : Longint);
86
87function Quadrant(PT, Center : TPoint) : Integer;
88
89function RadialPoint(EccentricAngle : Extended; Rect : TRect) : TPoint;
90
91procedure SplitBezier(Bezier : TBezier; var Left, Right : TBezier);
92
93Operator + (Addend1, Addend2 : TFloatPoint) : TFloatPoint;
94Operator + (Addend1 : TFloatPoint; Addend2 : Extended) : TFloatPoint;
95Operator + (Addend1 : Extended; Addend2 : TFloatPoint) : TFloatPoint;
96Operator + (Addend1 : TFloatPoint; Addend2 : TPoint) : TFloatPoint;
97Operator + (Addend1 : TPoint; Addend2 : TFloatPoint) : TFloatPoint;
98
99Operator - (Minuend : TFloatPoint; Subtrahend : Extended) : TFloatPoint;
100Operator - (Minuend, Subtrahend : TFloatPoint) : TFloatPoint;
101Operator - (Minuend : TFloatPoint; Subtrahend : TPoint) : TFloatPoint;
102Operator - (Minuend : TPoint; Subtrahend : TFloatPoint) : TFloatPoint;
103
104Operator * (Multiplicand, Multiplier : TFloatPoint) : TFloatPoint;
105Operator * (Multiplicand : TFloatPoint; Multiplier : Extended) : TFloatPoint;
106Operator * (Multiplicand : Extended; Multiplier : TFloatPoint) : TFloatPoint;
107Operator * (Multiplicand : TFloatPoint; Multiplier : TPoint) : TFloatPoint;
108Operator * (Multiplicand : TPoint; Multiplier : TFloatPoint) : TFloatPoint;
109
110Operator / (Dividend, Divisor : TFloatPoint) : TFloatPoint;
111Operator / (Dividend : TFloatPoint; Divisor : Extended) : TFloatPoint;
112Operator / (Dividend : TFloatPoint; Divisor : TPoint) : TFloatPoint;
113Operator / (Dividend : TPoint; Divisor : TFloatPoint) : TFloatPoint;
114
115Operator = (Compare1, Compare2  : TPoint) : Boolean;
116Operator = (Compare1, Compare2  : TFloatPoint) : Boolean;
117
118Operator := (Value : TFloatPoint) : TPoint;
119
120Operator := (Value : TPoint) : TFloatPoint;
121
122Operator = (Compare1, Compare2  : TRect) : Boolean;
123
124
125implementation
126
127
128Operator + (Addend1, Addend2 : TFloatPoint) : TFloatPoint;
129Begin
130  With Result do begin
131    X := Addend1.X + Addend2.X;
132    Y := Addend1.Y + Addend2.Y;
133  end;
134end;
135
136Operator + (Addend1 : TFloatPoint; Addend2 : Extended) : TFloatPoint;
137Begin
138  With Result do begin
139    X := Addend1.X + Addend2;
140    Y := Addend1.Y + Addend2;
141  end;
142end;
143
144Operator + (Addend1 : Extended; Addend2 : TFloatPoint) : TFloatPoint;
145begin
146  Result := Addend2 + Addend1;
147end;
148
149Operator + (Addend1 : TFloatPoint; Addend2 : TPoint) : TFloatPoint;
150Begin
151  With Result do begin
152    X := Addend1.X + Addend2.X;
153    Y := Addend1.Y + Addend2.Y;
154  end;
155end;
156
157Operator + (Addend1 : TPoint; Addend2 : TFloatPoint) : TFloatPoint;
158begin
159  Result := Addend2 + Addend1;
160end;
161
162Operator - (Minuend, Subtrahend:TFloatPoint) : TFloatPoint;
163Begin
164  With Result do begin
165    X := Minuend.X - Subtrahend.X;
166    Y := Minuend.Y - Subtrahend.Y;
167  end;
168end;
169
170Operator - (Minuend : TFloatPoint; Subtrahend : Extended) : TFloatPoint;
171Begin
172  With Result do begin
173    X := Minuend.X - Subtrahend;
174    Y := Minuend.Y - Subtrahend;
175  end;
176end;
177
178Operator - (Minuend : TFloatPoint; Subtrahend : TPoint) : TFloatPoint;
179begin
180  With Result do begin
181    X := Minuend.X - Subtrahend.X;
182    Y := Minuend.Y - Subtrahend.Y;
183  end;
184end;
185
186Operator - (Minuend : TPoint; Subtrahend : TFloatPoint) : TFloatPoint;
187begin
188  With Result do begin
189    X := Minuend.X - Subtrahend.X;
190    Y := Minuend.Y - Subtrahend.Y;
191  end;
192end;
193
194Operator * (Multiplicand, Multiplier : TFloatPoint) : TFloatPoint;
195Begin
196  With Result do begin
197    X := Multiplicand.X * Multiplier.X;
198    Y := Multiplicand.Y * Multiplier.Y;
199  end;
200end;
201
202Operator * (Multiplicand : TFloatPoint; Multiplier : Extended) : TFloatPoint;
203Begin
204  With Result do begin
205    X := Multiplicand.X * Multiplier;
206    Y := Multiplicand.Y * Multiplier;
207  end;
208end;
209
210Operator * (Multiplicand : Extended; Multiplier : TFloatPoint) : TFloatPoint;
211Begin
212  Result := Multiplier*Multiplicand;
213end;
214
215Operator * (Multiplicand : TFloatPoint; Multiplier : TPoint) : TFloatPoint;
216begin
217  With Result do begin
218    X := Multiplicand.X * Multiplier.X;
219    Y := Multiplicand.Y * Multiplier.Y;
220  end;
221end;
222
223Operator * (Multiplicand : TPoint; Multiplier : TFloatPoint) : TFloatPoint;
224begin
225  Result := Multiplier*Multiplicand;
226end;
227
228Operator / (Dividend, Divisor : TFloatPoint) : TFloatPoint;
229Begin
230  With Result do begin
231    X := Dividend.X / Divisor.X;
232    Y := Dividend.Y / Divisor.Y;
233  end;
234end;
235
236Operator / (Dividend : TFloatPoint; Divisor : Extended) : TFloatPoint;
237begin
238  With Result do begin
239    X := Dividend.X / Divisor;
240    Y := Dividend.Y / Divisor;
241  end;
242end;
243
244Operator / (Dividend : TFloatPoint; Divisor : TPoint) : TFloatPoint;
245begin
246  With Result do begin
247    X := Dividend.X / Divisor.X;
248    Y := Dividend.Y / Divisor.Y;
249  end;
250end;
251
252Operator / (Dividend : TPoint; Divisor : TFloatPoint) : TFloatPoint;
253begin
254  With Result do begin
255    X := Dividend.X / Divisor.X;
256    Y := Dividend.Y / Divisor.Y;
257  end;
258end;
259
260Operator = (Compare1, Compare2  : TPoint) : Boolean;
261begin
262  Result := (Compare1.X = Compare2.X) and (Compare1.Y = Compare2.Y);
263end;
264
265Operator = (Compare1, Compare2  : TFloatPoint) : Boolean;
266begin
267  Result := (Compare1.X = Compare2.X) and (Compare1.Y = Compare2.Y);
268end;
269
270Operator := (Value : TFloatPoint) : TPoint;
271begin
272  Result.X := Trunc(SimpleRoundTo(Value.X, 0));
273  Result.Y := Trunc(SimpleRoundTo(Value.Y, 0));
274end;
275
276Operator := (Value : TPoint) : TFloatPoint;
277begin
278  With Result do begin
279    X := Value.X;
280    Y := Value.Y;
281  end;
282end;
283
284Operator = (Compare1, Compare2  : TRect) : Boolean;
285begin
286  Result := (Compare1.Left = Compare2.Left) and
287            (Compare1.Top = Compare2.Top) and
288            (Compare1.Right = Compare2.Right) and
289            (Compare1.Bottom = Compare2.Bottom);
290end;
291
292{------------------------------------------------------------------------------
293  Method:   Angles2Coords
294  Params:   x,y,width,height,angle1,angle2, sx, sy, ex, ey
295  Returns:  Nothing
296
297  Use Angles2Coords to convert an Eccentric(aka Radial) Angle and an
298  Angle-Length, such as are used in X-Windows and GTK, into the coords,
299  for Start and End Radial-Points, such as are used in the Windows API Arc
300  Pie and Chord routines. The angles are 1/16th of a degree. For example, a
301  full circle equals 5760 (16*360). Positive values of Angle and AngleLength
302  mean counter-clockwise while negative values mean clockwise direction.
303  Zero degrees is at the 3'o clock position.
304
305------------------------------------------------------------------------------}
306procedure Angles2Coords(X, Y, Width, Height : Integer;
307  Angle1, Angle2 : Extended; var SX, SY, EX, EY : Integer);
308var
309  aRect : TRect;
310  SP, EP : TPoint;
311begin
312  aRect := Rect(X,Y,X + Width,Y + Height);
313  SP := RadialPoint(Angle1 , aRect);
314  If Angle2 + Angle1 > 360*16 then
315    Angle2 := (Angle2 + Angle1) - 360*16
316  else
317    Angle2 := Angle2 + Angle1;
318  EP := RadialPoint(Angle2, aRect);
319  SX := SP.X;
320  SY := SP.Y;
321  EX := EP.X;
322  EY := EP.Y;
323end;
324
325{------------------------------------------------------------------------------
326  Method:   Arc2Bezier
327  Params:   X, Y, Width, Height, Angle1, Angle2, Rotation, Points, Count
328  Returns:  Nothing
329
330  Use Arc2Bezier to convert an Arc and ArcLength into a Bezier Aproximation
331  of the Arc. The Rotation parameter accepts a Rotation-Angle for a rotated
332  Ellipse'- for a non-rotated ellipse this value would be 0, or 360. If the
333  AngleLength is greater than 90 degrees, or is equal to 0, it automatically
334  exits, as Bezier cannot accurately aproximate any angle greater then 90
335  degrees, and in fact for best result no angle greater than 45 should be
336  converted, instead an array of Bezier's should be created, each Bezier
337  descibing a portion of the total arc no greater than 45 degrees. The angles
338  are 1/16th of a degree. For example, a full circle equals 5760 (16*360).
339  Positive values of Angle and AngleLength mean counter-clockwise while
340  negative values mean clockwise direction. Zero degrees is at the 3'o clock
341  position.
342
343------------------------------------------------------------------------------}
344procedure Arc2Bezier(X, Y, Width, Height : Longint; Angle1, Angle2,
345  Rotation : Extended; var Points : TBezier);
346
347  function Rotate(Point : TFloatPoint; Rotation : Extended) : TFloatPoint;
348  var
349    SinA,CosA : Extended;
350  begin
351    CosA := cos(Rotation);
352    SinA := Sin(Rotation);
353    Result.X := Point.X*CosA + Point.Y*SinA;
354    Result.Y := Point.X*SinA - Point.Y*CosA;
355  end;
356
357  function Scale(Point : TFloatPoint; ScaleX, ScaleY : Extended) : TFloatPoint;
358  begin
359    Result := Point*FloatPoint(ScaleX,ScaleY);
360  end;
361
362var
363  Beta : Extended;
364  P : array[0..3] of TFLoatPoint;
365  SinA,CosA : Extended;
366  A,B : Extended;
367  I : Longint;
368  PT : TFloatPoint;
369  ScaleX, ScaleY : Extended;
370begin
371  If ABS(Angle2) > 90*16 then
372    exit;
373  If Angle2 = 0 then
374    exit;
375
376  B := Extended(Height) / 2;
377  A := Extended(Width) / 2;
378
379  If (A <> B) and (A <> 0) and (B <> 0) then begin
380    If A > B then begin
381      ScaleX := Extended(Width) / Height;
382      ScaleY := 1;
383      A := B;
384    end
385    else begin
386      ScaleX := 1;
387      ScaleY := Extended(Height) / Width;
388      B := A;
389    end;
390  end
391  else begin
392    ScaleX := 1;
393    ScaleY := 1;
394  end;
395
396  Angle1 := DegToRad(Angle1/16);
397  Angle2 := DegToRad(Angle2/16);
398  Rotation := -DegToRad(Rotation/16);
399  Beta := (4/3)*(1 - Cos(Angle2/2))/(Sin(Angle2/2));
400  PT.X := X + Width / 2;
401  PT.Y := Y + Height / 2;
402
403  CosA := cos(Angle1);
404  SinA := sin(Angle1);
405
406  P[0].X := A *CosA;
407  P[0].Y := B *SinA;
408  P[1].X := P[0].X - Beta * A * SinA;
409  P[1].Y := P[0].Y + Beta * B * CosA;
410
411  CosA := cos(Angle1 + Angle2);
412  SinA := sin(Angle1 + Angle2);
413
414  P[3].X := A *CosA;
415  P[3].Y := B *SinA;
416  P[2].X := P[3].X + Beta * A * SinA;
417  P[2].Y := P[3].Y - Beta * B * CosA;
418
419  For I := 0 to 3 do
420  begin
421    Points[I] := Scale(P[I],ScaleX, ScaleY); //Scale to proper size
422    Points[I] := Rotate(Points[I], Rotation); //Rotate Counter-Clockwise
423    Points[I] := Points[I] + PT; //Translate to Center
424  end;
425end;
426
427{------------------------------------------------------------------------------
428  Method:   Bezier
429  Params:   C1,C2,C3,C4
430  Returns:  TBezier
431
432  Use Bezier to get a TBezier. It is Primarily for use with and in Bezier
433  routines.
434
435------------------------------------------------------------------------------}
436function Bezier(const C1,C2,C3,C4 : TFloatPoint): TBezier;
437begin
438  Result[0] := C1;
439  Result[1] := C2;
440  Result[2] := C3;
441  Result[3] := C4;
442end;
443
444{------------------------------------------------------------------------------
445  Method:   Bezier
446  Params:   C1,C2,C3,C4
447  Returns:  TBezier
448
449  Use Bezier to get a TBezier. It is Primarily for use with and in Bezier
450  routines.
451
452------------------------------------------------------------------------------}
453function Bezier(const C1,C2,C3,C4 : TPoint): TBezier;
454begin
455  Result[0] := FloatPoint(C1.X,C1.Y);
456  Result[1] := FloatPoint(C2.X,C2.Y);
457  Result[2] := FloatPoint(C3.X,C3.Y);
458  Result[3] := FloatPoint(C4.X,C4.Y);
459end;
460
461{------------------------------------------------------------------------------
462  Method:   Bezier2Polyline
463  Params:   Bezier, Points, Count
464  Returns:  Nothing
465
466  Use BezierToPolyline to convert a 4-Point Bezier into a Pointer Array of
467  TPoint and a Count variable which can then be used within either a Polyline,
468  or Polygon routine. It is primarily for use within PolyBezier2Polyline. If
469  Points is not initialized or Count is less then 0, it is set to nil and
470  the array starts at 0, otherwise it tries to append points
471  to the array starting at Count. Points should ALWAYS be Freed when done
472  by calling to ReallocMem(Points, 0) or FreeMem.
473
474------------------------------------------------------------------------------}
475procedure Bezier2Polyline(const Bezier : TBezier; var Points : PPoint;
476  var Count : Longint);
477var
478  Pt : TPoint;
479
480  procedure AddPoint(const Point : TFloatPoint);
481  var
482    P : TPoint;
483  begin
484    P := Point;
485    if (Pt <> P) then
486    begin
487      Inc(Count);
488      ReallocMem(Points, SizeOf(TPoint) * Count);
489      Points[Count - 1] := P;
490      Pt := P;
491    end;
492  end;
493
494  function Colinear(BP : TBezier; Tolerance : Extended) : Boolean;
495  var
496    D : Extended;
497  begin
498    D := SQR(Distance(BP[1], BP[0], BP[3]));
499    Result := D < Tolerance;
500    D := SQR(Distance(BP[2], BP[0], BP[3]));
501    If Result then
502      Result := Result and (D < Tolerance);
503  end;
504
505  procedure SplitRecursive(B : TBezier);
506  var
507    Left,
508    Right : TBezier;
509  begin
510    If Colinear(B, 1) then begin
511      AddPoint(B[0]);
512      AddPoint(B[3]);
513    end
514    else begin
515      SplitBezier(B,left,right);
516      SplitRecursive(left);
517      SplitRecursive(right);
518    end;
519  end;
520
521begin
522  Pt := Point(-1,-1);
523  If (not Assigned(Points)) or (Count <= 0) then
524  begin
525    Count := 0;
526
527    if Assigned(Points) then
528      ReallocMem(Points, 0);
529  end;
530  SplitRecursive(Bezier);
531end;
532
533{------------------------------------------------------------------------------
534  Method:   BezierArcPoints
535  Params:   X, Y, Width, Height, Angle1, Angle2, Rotation, Points, Count
536  Returns:  Nothing
537
538  Use BezierArcPoints to convert an Arc and ArcLength into a Pointer Array
539  of TPoints for use with Polyline or Polygon. The Rotation parameter accepts
540  a Rotation-Angle for a rotated Ellipse'- for a non-rotated ellipse this
541  value would be 0, or 360. The result is an Aproximation based on 1 or more
542  Beziers. If the AngleLength is greater than 90 degrees, it calls
543  PolyBezierArcPoints, otherwise it Converts the angles into a Bezier by
544  calling to Arc2Bezier, and then converts the Bezier into an array of Points
545  by calling to Bezier2Polyline. The angles are 1/16th of a degree. For example,
546  a full circle equals 5760 (16*360). Positive values of Angle and AngleLength
547  mean counter-clockwise while negative values mean clockwise direction. Zero
548  degrees is at the 3'o clock position. If Points is not initialized or Count
549  is less then 0, it is set to nil and the array starts at 0,
550  otherwise it tries to append points to the array starting at Count. Points
551  should ALWAYS be Freed when done by calling ReallocMem(Points, 0) or FreeMem.
552
553------------------------------------------------------------------------------}
554procedure BezierArcPoints(X, Y, Width, Height : Longint; Angle1, Angle2,
555  Rotation : Extended; var Points : PPoint; var Count : Longint);
556var
557  B : TBezier;
558begin
559  If ABS(Angle2) > 90*16 then begin
560    PolyBezierArcPoints(X, Y, Width, Height, Angle1, Angle2, Rotation, Points,
561                        Count);
562    Exit;
563  end;
564  If Angle2 = 0 then
565    exit;
566
567  If (not Assigned(Points)) or (Count <= 0) then
568  begin
569    Count := 0;
570
571    if Assigned(Points) then
572      ReallocMem(Points, 0);
573  end;
574
575  Arc2Bezier(X, Y, Width, Height, Angle1, Angle2, Rotation, B);
576  Bezier2Polyline(B,Points,Count);
577end;
578
579{------------------------------------------------------------------------------
580  Method:   BezierMidPoint
581  Params:   Bezier
582  Returns:  TFloatPoint
583
584  Use BezierMidPoint to get the Mid-Point of any 4-Point Bezier. It is
585  primarily for use in SplitBezier.
586
587------------------------------------------------------------------------------}
588function BezierMidPoint(Bezier : TBezier) : TFloatPoint;
589begin
590  Result := (Bezier[0] + 3*Bezier[1] + 3*Bezier[2] + Bezier[3]) / 8;
591end;
592
593{------------------------------------------------------------------------------
594  Method:   Coords2Angles
595  Params:   x,y,width,height,sx,sy,ex,ey, angle1,angle2
596  Returns:  Nothing
597
598  Use Coords2Angles to convert the coords for Start and End Radial-Points, such
599  as are used in the Windows API Arc Pie and Chord routines, into an Eccentric
600  (aka Radial) counter clockwise Angle and an Angle-Length, such as are used in
601  X-Windows and GTK. The angles angle1 and angle2 are returned in 1/16th of a
602  degree. For example, a full circle equals 5760 (16*360). Zero degrees is at
603  the 3'o clock position.
604
605------------------------------------------------------------------------------}
606procedure Coords2Angles(X, Y, Width, Height : Integer; SX, SY,
607  EX, EY : Integer; var Angle1, Angle2 : Extended);
608var
609  aRect : TRect;
610  SP,EP : TPoint;
611begin
612  aRect := Rect(X,Y,X + Width,Y + Height);
613  SP := Point(SX,SY);
614  EP := Point(EX,EY);
615  Angle1 := EccentricAngle(SP, aRect);
616  Angle2 := EccentricAngle(EP, aRect);
617  If Angle2 < Angle1 then
618    Angle2 := 360*16 - (Angle1 - Angle2)
619  else
620    Angle2 := Angle2 - Angle1;
621end;
622
623{------------------------------------------------------------------------------
624  Method:   Distance
625  Params:   PT1, PT2
626  Returns:  Extended
627
628  Use Distance to get the distance between any two Points. It is primarily
629  for use in other routines such as EccentricAngle.
630
631------------------------------------------------------------------------------}
632function Distance(Pt1,Pt2 : TPoint) : Extended;
633begin
634  Result := Sqrt(Sqr(Pt2.X - Pt1.X) + Sqr(Pt2.Y - Pt1.Y));
635end;
636
637{------------------------------------------------------------------------------
638  Method:   Distance
639  Params:   PT, SP,EP
640  Returns:  Extended
641
642  Use Distance to get the distance between any point(PT) and a line defined
643  by any two points(SP, EP). Intended for use in Bezier2Polyline, so params
644  are TFloatPoint's, NOT TPoint's.
645
646------------------------------------------------------------------------------}
647function Distance(Pt, SP, EP : TFloatPoint) : Extended;
648var
649  A, B, C : Extended;
650
651  function Slope(PT1,Pt2 : TFloatPoint) : Extended;
652  begin
653    If Pt2.X <> Pt1.X then
654      Result := (Pt2.Y - Pt1.Y) / (Pt2.X - Pt1.X)
655    else
656      Result := 1;
657  end;
658
659  function YIntercept(PT1,Pt2 : TFloatPoint) : Extended;
660  begin
661    Result := Pt1.Y - Slope(Pt1,Pt2)*Pt1.X;
662  end;
663
664begin
665  A := -Slope(SP,EP);
666  B := 1;
667  C := -YIntercept(SP, EP);
668  Result := ABS(A*Pt.X + B*Pt.Y + C)/Sqrt(Sqr(A) + Sqr(B));
669end;
670
671{------------------------------------------------------------------------------
672  Method:   EccentricAngle
673  Params:   Pt, Rect
674  Returns:  Extended
675
676  Use EccentricAngle to get the Eccentric( aka Radial ) Angle of a given
677  point on any non-rotated ellipse. It is primarily for use in Coords2Angles.
678  The result is in 1/16th of a degree. For example, a full circle equals
679  5760 (16*360).  Zero degrees is at the 3'o clock position.
680
681------------------------------------------------------------------------------}
682function EccentricAngle(PT : TPoint; Rect : TRect) : Extended;
683var
684  CenterPt : TPoint;
685  Quad : Integer;
686  Theta : Extended;
687begin
688  CenterPt := CenterPoint(Rect);
689  Quad := Quadrant(Pt,CenterPt);
690  Theta := -1;
691  Case Quad of
692    1..4:
693      begin
694        Theta := Distance(CenterPt,Pt);
695        If Theta > 0 then
696          Theta := RadToDeg(ArcSin(ABS(PT.Y - CenterPt.Y) / Theta));
697      end;
698  end;
699  Case Quad of
700    0:{ 0, 0}
701      Theta := -1;
702    1:{ X, Y}
703      Theta := Theta;
704    2:{-X, Y}
705      Theta := 180 - Theta;
706    3:{-X,-Y}
707      Theta := 180 + Theta;
708    4:{ X,-Y}
709      Theta := 360 - Theta;
710    5:{ 0, Y}
711      Theta := 90;
712    6:{ X, 0}
713      Theta := 0;
714    7:{ 0,-Y}
715      Theta := 270;
716    8:{-X, 0}
717      Theta := 180;
718  end;
719  Result := Theta*16;
720end;
721
722{------------------------------------------------------------------------------
723  Method:   EllipseRadialLength
724  Params:   Rect, EccentricAngle
725  Returns:  Longint
726
727  Use EllipseRadialLength to get the Radial-Length of non-rotated ellipse at
728  any given Eccentric( aka Radial ) Angle. It is primarily for use in other
729  routines such as RadialPoint. The Eccentric angle is in 1/16th of a degree.
730  For example, a full circle equals 5760 (16*360).  Zero degrees is at the
731  3'o clock position.
732
733------------------------------------------------------------------------------}
734function EllipseRadialLength(Rect : TRect; EccentricAngle : Extended) : Longint;
735var
736  a, b, R : Extended;
737begin
738  a := (Rect.Right - Rect.Left) div 2;
739  b := (Rect.Bottom - Rect.Top) div 2;
740  R := Sqr(a)*Sqr(b);
741  if R <> 0 then
742    R := Sqrt(R / ((Sqr(b)*Sqr(Cos(DegToRad(EccentricAngle/16)))) +
743      (Sqr(a)*Sqr(Sin(DegToRad(EccentricAngle/16))))));
744  Result := TruncToInt(R);
745end;
746
747{------------------------------------------------------------------------------
748  Method:   FloatPoint
749  Params:   AX, AY
750  Returns:  TFloatPoint
751
752  Use FloatPoint to get a TFloatPoint. It is essentialy like Classes. Point in
753  use, except that it excepts Extended Parameters. It is Primarily for use with
754  and in Bezier routines.
755
756------------------------------------------------------------------------------}
757function FloatPoint(AX,AY : Extended): TFloatPoint;
758begin
759  With Result do begin
760    X := AX;
761    Y := AY;
762  end;
763end;
764
765{------------------------------------------------------------------------------
766  Method:   LineEndPoint
767  Params:   StartPoint, Angle, Length
768  Returns:  TPoint
769
770  Use LineEndPoint to get the End-Point of a line of any given Length at
771  any given angle with any given Start-Point. It is primarily for use in
772  other routines such as RadialPoint. The angle is in 1/16th of a degree.
773  For example, a full circle equals 5760 (16*360).  Zero degrees is at the
774  3'o clock position.
775
776------------------------------------------------------------------------------}
777function LineEndPoint(StartPoint : TPoint; Angle, Length : Extended) :
778TPoint;
779begin
780  if Angle > 360*16 then
781    Angle := Frac(Angle / 360*16) * 360*16;
782
783  if Angle < 0 then
784    Angle := 360*16 - abs(Angle);
785
786  Result.Y := StartPoint.Y - Round(Length*Sin(DegToRad(Angle/16)));
787  Result.X := StartPoint.X + Round(Length*Cos(DegToRad(Angle/16)));
788end;
789
790
791{------------------------------------------------------------------------------
792  Method:   PolyBezier2Polyline
793  Params:   Beziers, Points, Count
794  Returns:  Nothing
795
796  Use BezierToPolyline to convert an array of 4-Point Bezier into a Pointer
797  Array of TPoint and a Count variable which can then be used within either a
798  Polyline, or Polygon routine. Points is automatically initialized, so any
799  existing information is lost, and the array starts at 0. Points should ALWAYS
800  be Freed when done by calling to ReallocMem(Points, 0).
801
802------------------------------------------------------------------------------}
803procedure PolyBezier2Polyline(Beziers: Array of TBezier;
804  var Points : PPoint; var Count : Longint);
805var
806  I : Integer;
807begin
808  If (High(Beziers) < 1) then
809    exit;
810  Count := 0;
811  If Assigned(Points) then
812    Try
813      ReallocMem(Points, 0)
814    Finally
815      Points := nil;
816    end;
817  For I := 0 to High(Beziers) - 1 do
818    Bezier2PolyLine(Beziers[I], Points, Count);
819end;
820
821{------------------------------------------------------------------------------
822  Method:   PolyBezier2Polyline
823  Params:   Beziers, Points, Count, Continuous
824  Returns:  Nothing
825
826  Use BezierToPolyline to convert an array of TPoints descibing 1 or more
827  4-Point Beziers into a Pointer Array of TPoint and a Count variable which
828  can then be used within either a Polyline, or Polygon routine. If Continuous
829  is set to true then the first point of each Bezier is the last point of
830  the preceding Bezier, so every bezier must have 3 described points, in
831  addition to the initial Starting Point; otherwise each Bezier must have 4
832  points. If there are an uneven number of points then the last set of points
833  is ignored. Points is automatically initialized, so any existing information
834  is lost, and the array starts at 0. Points should ALWAYS be Freed when done
835  by calling to ReallocMem(Points, 0).
836
837------------------------------------------------------------------------------}
838procedure PolyBezier2Polyline(Beziers : Array of TPoint; var Points : PPoint;
839  var Count : Longint; Continuous : Boolean);
840begin
841  PolyBezier2Polyline(@Beziers[0],High(Beziers) + 1, Points, Count,
842    	              Continuous);
843end;
844
845procedure PolyBezier2Polyline(Beziers : PPoint; BCount : Longint;
846  var Points : PPoint; var Count : Longint; Continuous : Boolean);
847var
848  I : Integer;
849  NB : Longint;
850begin
851  If BCount < 4 then
852    exit;
853  Count := 0;
854  If Assigned(Points) then
855    Try
856      ReallocMem(Points, 0)
857    Finally
858      Points := nil;
859    end;
860  If Not Continuous then begin
861    NB := BCount;
862    NB := NB div 4;
863    For I := 0 to NB - 1 do
864      Bezier2PolyLine(Bezier(Beziers[I*4],Beziers[I*4+1],
865        Beziers[I*4+2],Beziers[I*4+3]), Points, Count);
866  end
867  else begin
868    NB := BCount - 1;
869    NB := NB div 3;
870    For I := 0 to NB-1 do
871      Bezier2PolyLine(Bezier(Beziers[(I - 1)*3 + 3],Beziers[I*3 + 1],
872        Beziers[I*3+2],Beziers[I*3+3]), Points, Count);
873  end;
874end;
875
876{------------------------------------------------------------------------------
877  Method:   PolyBezierArcPoints
878  Params:   X, Y, Width, Height, Angle1, Angle2, Rotation, Points, Count
879  Returns:  Nothing
880
881  Use PolyBezierArcPoints to convert an Agnle and AgnleLength into a
882  Pointer Array of TPoints for use with Polyline or Polygon.
883  The Rotation parameter accepts a Rotation-Angle for a rotated Ellipse'- for
884  a non-rotated ellipse this value would be 0, or 360*16.
885  The result is an Aproximation based on 1 or more Beziers. If the AngleLength
886  is greater than 45*16 degrees, it recursively breaks the Arc into Arcs of
887  45*16 degrees or less, and converts them into Beziers with BezierArcPoints.
888  The angles are 1/16th of a degree. For example, a full circle equals
889  5760 (16*360).
890  Positive values of Angle and AngleLength mean counter-clockwise while negative
891  values mean clockwise direction. Zero degrees is at the 3'o clock position.
892  Points is automatically initialized, so any existing information is lost,
893  and the array starts at 0. Points should ALWAYS be Freed when done by calling
894  to ReallocMem(Points, 0).
895
896------------------------------------------------------------------------------}
897procedure PolyBezierArcPoints(X, Y, Width, Height : Longint; Angle1, Angle2,
898  Rotation : Extended; var Points : PPoint; var Count : Longint);
899var
900  I,K : Integer;
901  FullAngle : Extended;
902  TST : Boolean;
903begin
904  If Abs(Angle2) > 360*16 then begin
905    Angle2 := 360*16;
906    Angle1 := 0;
907  end;
908  If Abs(Rotation) > 360*16 then
909    Rotation := Frac(Rotation / 360*16)*360*16;
910  FullAngle := Angle1 + Angle2;
911  K := Ceil(ABS(Angle2/16) / 45);
912  Count := 0;
913  If Assigned(Points) then
914    Try
915      ReallocMem(Points, 0)
916    Finally
917      Points := nil;
918    end;
919  If Angle2 > 45*16 then
920    Angle2 := 45*16
921  else
922    If Angle2 < -45*16 then
923      Angle2 := -45*16;
924  For I := 0 to K - 1 do begin
925    BezierArcPoints(X, Y, Width,Height,Angle1,Angle2,Rotation,Points,Count);
926    Angle1 := Angle1 + Angle2;
927    If Angle2 > 0 then
928      TST := (FullAngle - Angle1) > 45*16
929    else
930      TST := ABS(FullAngle - Angle1) > 45*16;
931    If TST then begin
932      If Angle2 > 0 then
933        Angle2 := 45*16
934      else
935        Angle2 := -45*16;
936    end
937    else begin
938      {If Angle2 > 0 then}
939        Angle2 := FullAngle - Angle1
940      {else
941        Angle2 := -(FullAngle - Angle1);
942        - Wrong: This gives the wrong sign to Angle2 - G. Colla
943        }
944    end;
945  end;
946end;
947
948{------------------------------------------------------------------------------
949  Method:   Quadrant
950  Params:   PT, Center
951  Returns:  Integer
952
953  Use Quadrant to determine the Quadrant of any point, given the Center.
954  It is primarily for use in other routines such as EccentricAngle. A result
955  of 1-4 represents the primary 4 quardants. A result of 5-8 means the point
956  lies on one of the Axis', 5 = -Y Axis, 6 = +X Axis, 7 = +Y Axis, and
957  8 = -X Axis. A result of -1 means that it does not fall in any quadrant,
958  that is, it is the Center.
959
960------------------------------------------------------------------------------}
961function Quadrant(Pt,Center : TPoint) : Integer;
962var
963  X,Y,CX,CY : Longint;
964begin
965  X  := Pt.X;
966  Y  := Pt.Y;
967  CX := Center.X;
968  CY := Center.Y;
969  Result := -1;
970  If (Y < CY) then begin
971    If (X > CX) then begin
972      Result := 1;
973    end
974    else
975      If (X < CX) then begin
976        Result := 2;
977      end
978    else begin
979      Result := 5;
980    end;
981  end
982  else
983    If (Y > CY) then begin
984      If (X < CX) then begin
985        Result := 3;
986      end
987      else
988        If (X > CX) then begin
989          Result := 4;
990        end
991      else begin
992        Result := 7;
993      end;
994    end
995  else
996    If (Y = CY) then begin
997      If (X > CX) then begin
998        Result := 6;
999      end
1000      else
1001        If (X < CX) then begin
1002          Result := 8;
1003        end;
1004    end;
1005end;
1006
1007{------------------------------------------------------------------------------
1008  Method:   RadialPointAngle
1009  Params:   EccentricAngle, Rect
1010  Returns:  TPoint
1011
1012  Use RadialPoint to get the Radial-Point at any given Eccentric( aka Radial )
1013  angle on any non-rotated ellipse. It is primarily for use in Angles2Coords.
1014  The EccentricAngle is in 1/16th of a degree. For example, a full circle
1015  equals 5760 (16*360).  Zero degrees is at the 3'o clock position.
1016
1017------------------------------------------------------------------------------}
1018function RadialPoint(EccentricAngle : Extended; Rect : TRect) : TPoint;
1019var
1020  R : Longint;
1021Begin
1022  R := EllipseRadialLength(Rect,EccentricAngle);
1023  Result := LineEndPoint(CenterPoint(Rect), EccentricAngle, R);
1024end;
1025
1026{------------------------------------------------------------------------------
1027  Method:   SplitBezier
1028  Params:   Bezier, Left, Right
1029  Returns:  Nothing
1030
1031  Use SplitBezier to split any 4-Point Bezier into two 4-Point Bezier's :
1032  a 'Left' and a 'Right'. It is primarily for use in Bezier2Polyline.
1033
1034------------------------------------------------------------------------------}
1035procedure SplitBezier(Bezier : TBezier; var Left, Right : TBezier);
1036var
1037  Tmp : TFloatPoint;
1038begin
1039  Tmp := (Bezier[1] + Bezier[2]) / 2;
1040
1041  left[0]  := Bezier[0];
1042  Left[1]  := (Bezier[0] + Bezier[1]) / 2;
1043  left[2]  := (Left[1] + Tmp) / 2;
1044  Left[3]  := BezierMidPoint(Bezier);
1045
1046  right[3] := Bezier[3];
1047  right[2] := (Bezier[2] + Bezier[3]) / 2;
1048  Right[1] := (Right[2] + Tmp) / 2;
1049  right[0] := BezierMidPoint(Bezier);
1050end;
1051
1052end.
1053