source: tags/1.0.0/UGeometric.pas

Last change on this file was 44, checked in by chronos, 6 years ago
  • Fixed: Removed compilation warnings.
  • Modified: Preparation for 1.0.0 version release.
File size: 4.1 KB
Line 
1unit UGeometric;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, Math;
9
10type
11 TPointArray = array of TPoint;
12
13function Distance(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(P1, P2: TPoint): Boolean;
19function RotatePoint(Center, P: TPoint; Angle: Double): TPoint;
20function RotatePoints(Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
21function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
22function ArcTan2Point(Point: TPoint): Float;
23function ArcTanPoint(Point: TPoint): Float;
24function RectEquals(A, B: TRect): Boolean;
25function RectEnlarge(Rect: TRect; Value: Integer): TRect;
26function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
27
28implementation
29
30function Distance(P1, P2: TPoint): Integer;
31begin
32 Result := Trunc(Sqrt(Sqr(P2.X - P1.X) + Sqr(P2.Y - P1.Y)));
33end;
34
35function Dot(const P1, P2: TPoint): Double;
36begin
37 Result := P1.X * P2.X + P1.Y * P2.Y;
38end;
39
40function AddPoint(const P1, P2: TPoint): TPoint;
41begin
42 Result.X := P1.X + P2.X;
43 Result.Y := P1.Y + P2.Y;
44end;
45
46function SubPoint(const P1, P2: TPoint): TPoint;
47begin
48 Result.X := P1.X - P2.X;
49 Result.Y := P1.Y - P2.Y;
50end;
51
52function PointToLineDistance(const P, V, W: TPoint): Integer;
53var
54 l2, t: Double;
55 tt: TPoint;
56begin
57 // Return minimum distance between line segment vw and point p
58 L2 := Distance(V, W); // i.e. |w-v|^2 - avoid a sqrt
59 L2 := Power(l2, 2);
60 if L2 = 0 then begin
61 Result := Distance(P, V); // v == w case
62 Exit;
63 end;
64 // Consider the line extending the segment, parameterized as v + t (w - v).
65 // We find projection of point p onto the line.
66 // It falls where t = [(p-v) . (w-v)] / |w-v|^2
67 T := Dot(SubPoint(P, V), SubPoint(W, V)) / L2;
68 if T < 0 then begin
69 Result := Distance(P, V); // Beyond the 'v' end of the segment
70 exit;
71 end
72 else if T > 1 then begin
73 Result := Distance(P, W); // Beyond the 'w' end of the segment
74 Exit;
75 end;
76 TT.X := Trunc(V.X + T * (W.X - V.X));
77 TT.Y := Trunc(V.Y + T * (W.Y - V.Y));
78 Result := Distance(P, TT);
79end;
80
81function ComparePoint(P1, P2: TPoint): Boolean;
82begin
83 Result := (P1.X = P2.X) and (P1.Y = P2.Y);
84end;
85
86function RotatePoint(Center, P: TPoint; Angle: Double): TPoint;
87begin
88 P := Point(P.X - Center.X, P.Y - Center.Y);
89 Result := Point(Center.X + Round(P.X * Cos(Angle) - P.Y * Sin(Angle)),
90 Center.Y + Round(P.X * Sin(Angle) + P.Y * Cos(Angle)));
91end;
92
93function RotatePoints(Center: TPoint; P: TPointArray; Angle: Double): TPointArray;
94var
95 I: Integer;
96begin
97 SetLength(Result, Length(P));
98 for I := 0 to High(P) do
99 Result[I] := RotatePoint(Center, P[I], Angle);
100end;
101
102function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2: TPoint): TPoint;
103Var
104 LDetLineA, LDetLineB, LDetDivInv: Double;
105 LDiffLA, LDiffLB: TPoint;
106begin
107 LDetLineA := LineAP1.X * LineAP2.Y - LineAP1.Y * LineAP2.X;
108 LDetLineB := LineBP1.X * LineBP2.Y - LineBP1.Y * LineBP2.X;
109
110 LDiffLA := SubPoint(LineAP1, LineAP2);
111 LDiffLB := SubPoint(LineBP1, LineBP2);
112
113 LDetDivInv := 1 / ((LDiffLA.X * LDiffLB.Y) - (LDiffLA.Y * LDiffLB.X));
114
115 Result.X := Trunc(((LDetLineA * LDiffLB.X) - (LDiffLA.X * LDetLineB)) * LDetDivInv);
116 Result.Y := Trunc(((LDetLineA * LDiffLB.Y) - (LDiffLA.Y * LDetLineB)) * LDetDivInv);
117end;
118
119function ArcTan2Point(Point: TPoint): Float;
120begin
121 Result := ArcTan2(Point.Y, Point.X);
122end;
123
124function ArcTanPoint(Point: TPoint): Float;
125begin
126 if Point.Y = 0 then Result := Infinity
127 else Result := ArcTan(Point.X / Point.Y);
128end;
129
130function RectEquals(A, B: TRect): Boolean;
131begin
132 Result := (A.Left = B.Left) and (A.Top = B.Top) and
133 (A.Right = B.Right) and (A.Bottom = B.Bottom);
134end;
135
136function RectEnlarge(Rect: TRect; Value: Integer): TRect;
137begin
138 Result.Left := Rect.Left - Value;
139 Result.Right := Rect.Right + Value;
140 Result.Top := Rect.Top - Value;
141 Result.Bottom := Rect.Bottom + Value;
142end;
143
144function ShiftRect(ARect: TRect; Delta: TPoint): TRect;
145begin
146 Result := Rect(ARect.Left + Delta.X, ARect.Top + Delta.Y,
147 ARect.Right + Delta.X, ARect.Bottom + Delta.Y);
148end;
149
150
151end.
152
Note: See TracBrowser for help on using the repository browser.