source: tags/1.3.0/UGeometryClasses.pas

Last change on this file was 192, checked in by chronos, 7 years ago
  • Modified: Updated newer Common package files.
File size: 5.8 KB
Line 
1unit UGeometryClasses;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, Math;
9
10type
11 TPointArray = array of TPoint;
12
13function Distance(const P1, P2: TPoint): Integer;
14function Dot(const P1, P2: TPoint): Double;
15function AddPoint(const P1, P2: TPoint): TPoint;
16function SubPoint(const P1, P2: TPoint): TPoint;
17function PointToLineDistance(const P, V, W: TPoint): Integer;
18function ComparePoint(const P1, P2: TPoint): Boolean;
19function RotatePoint(const Center, P: TPoint; Angle: Double): TPoint;
20function RotatePoints(const Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
21function ArcTan2Point(const Point: TPoint): Double;
22function ArcTanPoint(const Point: TPoint): Double;
23function RectEquals(const A, B: Classes.TRect): Boolean;
24function RectEnlarge(const Rect: Classes.TRect; Value: Integer): Classes.TRect;
25function ShiftRect(const ARect: TRect; Delta: TPoint): TRect;
26function PointsToRect(const P1, P2: TPoint): TRect;
27function PointInRect(const P: TPoint; aRect: TRect): Boolean;
28function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
29function HalfDistancePoint(const P1, P2: TPoint): TPoint;
30function NormalizeAngle(const Angle: Double): Double;
31function SubAngle(A1, A2: Double): Double;
32
33
34implementation
35
36function Distance(const P1, P2: TPoint): Integer;
37begin
38 Result := Trunc(Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y)));
39end;
40
41function Dot(const P1, P2: TPoint): Double;
42begin
43 Result := P1.X * P2.X + P1.Y * P2.Y;
44end;
45
46function AddPoint(const P1, P2: TPoint): TPoint;
47begin
48 Result.X := P1.X + P2.X;
49 Result.Y := P1.Y + P2.Y;
50end;
51
52function SubPoint(const P1, P2: TPoint): TPoint;
53begin
54 Result.X := P1.X - P2.X;
55 Result.Y := P1.Y - P2.Y;
56end;
57
58function PointToLineDistance(const P, V, W: TPoint): Integer;
59var
60 l2, t: Double;
61 tt: TPoint;
62begin
63 // Return minimum distance between line segment vw and point p
64 L2 := Distance(V, W); // i.e. |w-v|^2 - avoid a sqrt
65 L2 := Power(l2, 2);
66 if L2 = 0 then begin
67 Result := Distance(P, V); // v == w case
68 Exit;
69 end;
70 // Consider the line extending the segment, parameterized as v + t (w - v).
71 // We find projection of point p onto the line.
72 // It falls where t = [(p-v) . (w-v)] / |w-v|^2
73 T := Dot(SubPoint(P, V), SubPoint(W, V)) / L2;
74 if T < 0 then begin
75 Result := Distance(P, V); // Beyond the 'v' end of the segment
76 exit;
77 end
78 else if T > 1 then begin
79 Result := Distance(P, W); // Beyond the 'w' end of the segment
80 Exit;
81 end;
82 TT.X := Trunc(V.X + T * (W.X - V.X));
83 TT.Y := Trunc(V.Y + T * (W.Y - V.Y));
84 Result := Distance(P, TT);
85end;
86
87function ComparePoint(const P1, P2: TPoint): Boolean;
88begin
89 Result := (P1.X = P2.X) and (P1.Y = P2.Y);
90end;
91
92function RotatePoint(const Center, P: TPoint; Angle: Double): TPoint;
93var
94 D: TPoint;
95begin
96 D := Point(P.X - Center.X, P.Y - Center.Y);
97 Result := Point(Center.X + Round(D.X * Cos(Angle) - D.Y * Sin(Angle)),
98 Center.Y + Round(D.X * Sin(Angle) + D.Y * Cos(Angle)));
99end;
100
101function RotatePoints(const Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
102var
103 I: Integer;
104begin
105 SetLength(Result, Length(P));
106 for I := 0 to High(P) do
107 Result[I] := RotatePoint(Center, P[I], Angle);
108end;
109
110function ArcTan2Point(const Point: TPoint): Double;
111begin
112 Result := ArcTan2(Point.Y, Point.X);
113end;
114
115function ArcTanPoint(const Point: TPoint): Double;
116begin
117 if Point.Y = 0 then Result := Infinity
118 else Result := ArcTan(Point.X / Point.Y);
119end;
120
121function RectEquals(const A, B: Classes.TRect): Boolean;
122begin
123 Result := (A.Left = B.Left) and (A.Top = B.Top) and
124 (A.Right = B.Right) and (A.Bottom = B.Bottom);
125end;
126
127function RectEnlarge(const Rect: Classes.TRect; Value: Integer): Classes.TRect;
128begin
129 Result.Left := Rect.Left - Value;
130 Result.Right := Rect.Right + Value;
131 Result.Top := Rect.Top - Value;
132 Result.Bottom := Rect.Bottom + Value;
133end;
134
135function ShiftRect(const ARect: TRect; Delta: TPoint): TRect;
136begin
137 Result := Rect(ARect.Left + Delta.X, ARect.Top + Delta.Y,
138 ARect.Right + Delta.X, ARect.Bottom + Delta.Y);
139end;
140
141function PointsToRect(const P1, P2: TPoint): TRect;
142begin
143 if P1.X < P2.X then Result.Left := P1.X else Result.Left := P2.X;
144 if P1.Y < P2.Y then Result.Top := P1.Y else Result.Top := P2.Y;
145 if P1.X > P2.X then Result.Right := P1.X else Result.Right := P2.X;
146 if P1.Y > P2.Y then Result.Bottom := P1.Y else Result.Bottom := P2.Y;
147end;
148
149function PointInRect(const P: TPoint; aRect: TRect): Boolean;
150begin
151 Result := (P.X >= aRect.Left) and (P.X <= aRect.Right) and
152 (P.Y >= aRect.Top) and (P.Y <= aRect.Bottom);
153end;
154
155function HalfDistancePoint(const P1, P2: TPoint): TPoint;
156begin
157 Result := Point(P1.X + (P2.X - P1.X) div 2, P1.Y + (P2.Y - P1.Y) div 2)
158end;
159
160function NormalizeAngle(const Angle: Double): Double;
161begin
162 if Angle < 0 then Result := Angle + (Trunc(Angle / (2 * Pi)) + 1) * (2 * Pi)
163 else if Angle > 2 * Pi then Result := Angle - Trunc(Angle / (2 * Pi)) * (2 * Pi)
164 else Result := Angle;
165end;
166
167function SubAngle(A1, A2: Double): Double;
168begin
169 A1 := NormalizeAngle(A1);
170 A2 := NormalizeAngle(A2);
171 if A1 < A2 then Result := A1 + 2 * Pi - A2
172 else Result := A1 - A2;
173end;
174
175function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
176var
177 Count, K, J : Integer;
178begin
179 Result := False;
180 Count := Length(Points) ;
181 J := Count - 1;
182 for K := 0 to Count - 1 do begin
183 if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
184 ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
185 begin
186 if (Pos.X < (Points[j].X - Points[K].X) *
187 (Pos.Y - Points[K].Y) /
188 (Points[j].Y - Points[K].Y) + Points[K].X) then
189 Result := not Result;
190 end;
191 J := K;
192 end;
193end;
194
195end.
196
Note: See TracBrowser for help on using the repository browser.