source: trunk/Packages/Graphics32/GR32_VectorUtils.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 91.7 KB
Line 
1unit GR32_VectorUtils;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is Vectorial Polygon Rasterizer for Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Mattias Andersson <mattias@centaurix.com>
27 *
28 * Portions created by the Initial Developer are Copyright (C) 2008-2012
29 * the Initial Developer. All Rights Reserved.
30 *
31 * Contributor(s):
32 *
33 * ***** END LICENSE BLOCK ***** *)
34
35interface
36
37{$I GR32.inc}
38
39{$BOOLEVAL OFF}
40
41uses
42 Math, {$IFDEF FPC}Types, {$ENDIF} {$IFDEF COMPILERXE2_UP}Types, {$ENDIF}
43 GR32, GR32_Transforms, GR32_Polygons;
44
45const
46 DEFAULT_MITER_LIMIT = 4.0;
47 DEFAULT_MITER_LIMIT_FIXED = $40000;
48 TWOPI = 2 * Pi;
49
50function InSignedRange(const X, X1, X2: TFloat): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
51function InSignedRange(const X, X1, X2: TFixed): Boolean; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
52function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean; overload;
53function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
54
55function VertexReduction(Points: TArrayOfFloatPoint; Epsilon: TFloat = 1): TArrayOfFloatPoint; overload;
56function VertexReduction(Points: TArrayOfFixedPoint; Epsilon: TFixed = FixedOne): TArrayOfFixedPoint; overload;
57
58function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
59function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
60
61function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean; overload;
62function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean; overload;
63function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean; overload;
64function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean; overload;
65function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean; overload;
66function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean; overload;
67
68type
69 TTriangleVertexIndices = array [0 .. 2] of Integer;
70 TArrayOfTriangleVertexIndices = array of TTriangleVertexIndices;
71
72function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
73
74function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
75function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
76function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint;
77 const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter;
78 Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
79function Grow(const Points: TArrayOfFloatPoint;
80 const Delta: TFloat; JoinStyle: TJoinStyle = jsMiter;
81 Closed: Boolean = True; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
82function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint;
83 const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
84 Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
85function Grow(const Points: TArrayOfFixedPoint;
86 const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
87 Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
88function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint; overload;
89function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint; overload;
90
91function BuildPolyline(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat;
92 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
93 MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfFloatPoint; overload;
94function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint;
95 Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle = jsMiter;
96 EndStyle: TEndStyle = esButt; MiterLimit: TFloat = DEFAULT_MITER_LIMIT): TArrayOfArrayOfFloatPoint; overload;
97function BuildPolyline(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed;
98 JoinStyle: TJoinStyle = jsMiter; EndStyle: TEndStyle = esButt;
99 MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
100function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint;
101 Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle = jsMiter;
102 EndStyle: TEndStyle = esButt; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfArrayOfFixedPoint; overload;
103function BuildDashedLine(const Points: TArrayOfFloatPoint;
104 const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
105 Closed: Boolean = False): TArrayOfArrayOfFloatPoint; overload;
106function BuildDashedLine(const Points: TArrayOfFixedPoint;
107 const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
108 Closed: Boolean = False): TArrayOfArrayOfFixedPoint; overload;
109
110function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint; overload;
111function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint; overload;
112function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint; overload;
113function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload;
114
115function CalculateCircleSteps(Radius: TFloat): Cardinal; {$IFDEF USEINLINING} inline; {$ENDIF}
116function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
117function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint; overload;
118function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat; Steps: Integer): TArrayOfFixedPoint; overload;
119function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint; overload;
120function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint; overload;
121function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
122function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
123function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
124function Circle(const P: TFloatPoint; const Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
125function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
126function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
127function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
128function Circle(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
129function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
130function Circle(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
131function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
132function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload;
133function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
134function Pie(const P: TFloatPoint; const Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
135function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
136function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
137function Pie(const X, Y, Radius: TFloat; const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
138function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint; overload;
139function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
140function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
141function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
142function Ellipse(const R: TRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
143function Ellipse(const R: TFloatRect): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
144function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
145function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
146
147function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat;
148 Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
149function Star(const X, Y, InnerRadius, OuterRadius: TFloat;
150 Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
151function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5;
152 Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
153function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5;
154 Rotation: TFloat = 0): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING} inline; {$ENDIF}
155function Rectangle(const R: TFloatRect): TArrayOfFloatPoint; {$IFDEF USEINLINING} inline; {$ENDIF}
156function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint; {$IFDEF USEINLINING} inline; {$ENDIF}
157
158function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect; overload;
159function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect; overload;
160function PolypolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect; overload;
161function PolypolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect; overload;
162
163function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint; overload;
164function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint; overload;
165function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint; overload;
166function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint; overload;
167
168procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
169procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
170procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; ScaleX, ScaleY: TFloat); overload;
171procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; ScaleX, ScaleY: TFixed); overload;
172
173function TranslatePolygon(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfFloatPoint; overload;
174function TranslatePolygon(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed): TArrayOfFixedPoint; overload;
175function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat): TArrayOfArrayOfFloatPoint; overload;
176function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint; overload;
177
178procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
179procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint; Offsetx, OffsetY: TFixed); overload;
180procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX, OffsetY: TFloat); overload;
181procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint; OffsetX, OffsetY: TFixed); overload;
182
183function TransformPolygon(const Points: TArrayOfFloatPoint; Transformation: TTransformation): TArrayOfFloatPoint; overload;
184function TransformPolygon(const Points: TArrayOfFixedPoint; Transformation: TTransformation): TArrayOfFixedPoint; overload;
185function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint; Transformation: TTransformation): TArrayOfArrayOfFloatPoint; overload;
186function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint; overload;
187
188function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint; overload;
189function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint; overload;
190
191function PolyPolygon(const Points: TArrayOfFloatPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
192function PolyPolygon(const Points: TArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
193
194function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint; overload;
195function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint; overload;
196function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint; overload;
197function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint; overload;
198function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint): TArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
199function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFloatPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
200function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint): TArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
201function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFixedPoint; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
202
203implementation
204
205uses
206 SysUtils, GR32_Math, GR32_Geometry, GR32_LowLevel;
207
208type
209 TTransformationAccess = class(TTransformation);
210
211// Returns True if Min(X1, X2) <= X < Max(X1, X2)
212function InSignedRange(const X, X1, X2: TFloat): Boolean;
213begin
214 Result := (X < X1) xor (X < X2);
215end;
216
217// Returns True if Min(X1, X2) <= X < Max(X1, X2)
218function InSignedRange(const X, X1, X2: TFixed): Boolean;
219begin
220 Result := (X < X1) xor (X < X2);
221end;
222
223// Returns True if the line segments (A1, A2) and (B1, B2) intersects
224// P is the point of intersection
225function Intersect(const A1, A2, B1, B2: TFloatPoint; out P: TFloatPoint): Boolean;
226var
227 Adx, Ady, Bdx, Bdy, ABy, ABx: TFloat;
228 t, ta, tb: TFloat;
229begin
230 Result := False;
231 Adx := A2.X - A1.X;
232 Ady := A2.Y - A1.Y;
233 Bdx := B2.X - B1.X;
234 Bdy := B2.Y - B1.Y;
235 t := (Bdy * Adx) - (Bdx * Ady);
236
237 if t = 0 then Exit; // lines are parallell
238
239 ABx := A1.X - B1.X;
240 ABy := A1.Y - B1.Y;
241 ta := Bdx * ABy - Bdy * ABx;
242 tb := Adx * ABy - Ady * ABx;
243 if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
244 begin
245 Result := True;
246 ta := ta / t;
247 P.X := A1.X + ta * Adx;
248 P.Y := A1.Y + ta * Ady;
249 end;
250end;
251
252function Intersect(const A1, A2, B1, B2: TFixedPoint; out P: TFixedPoint): Boolean; overload;
253var
254 Adx, Ady, Bdx, Bdy, ABy, ABx: TFixed;
255 t, ta, tb: TFixed;
256begin
257 Result := False;
258 Adx := A2.X - A1.X;
259 Ady := A2.Y - A1.Y;
260 Bdx := B2.X - B1.X;
261 Bdy := B2.Y - B1.Y;
262 t := (Bdy * Adx) - (Bdx * Ady);
263
264 if t = 0 then Exit; // lines are parallell
265
266 ABx := A1.X - B1.X;
267 ABy := A1.Y - B1.Y;
268 ta := Bdx * ABy - Bdy * ABx;
269 tb := Adx * ABy - Ady * ABx;
270 if InSignedRange(ta, 0, t) and InSignedRange(tb, 0, t) then
271 begin
272 Result := True;
273 ta := FixedDiv(ta, t);
274 P.X := A1.X + ta * Adx;
275 P.Y := A1.Y + ta * Ady;
276 end;
277end;
278
279function RamerDouglasPeucker(Points: TArrayOfFloatPoint; FirstIndex,
280 LastIndex: Integer; Epsilon: TFloat = 1): TArrayOfFloatPoint; overload;
281var
282 Index, DeltaMaxIndex: Integer;
283 Delta, DeltaMax: TFloat;
284 Parts: array [0 .. 1] of TArrayOfFloatPoint;
285begin
286 if LastIndex - FirstIndex > 1 then
287 begin
288 // find the point with the maximum distance
289 DeltaMax := 0;
290 DeltaMaxIndex := 0;
291 for Index := FirstIndex + 1 to LastIndex - 1 do
292 begin
293 with Points[LastIndex] do
294 Delta := Abs((Points[Index].x - x) * (Points[FirstIndex].y - y) -
295 (Points[Index].y - y) * (Points[FirstIndex].x - x));
296 if Delta > DeltaMax then
297 begin
298 DeltaMaxIndex := Index;
299 DeltaMax := Delta;
300 end;
301 end;
302
303 // if max distance is greater than epsilon, recursively simplify
304 if DeltaMax >= Epsilon * GR32_Math.Hypot(Points[FirstIndex].x - Points[LastIndex].x,
305 Points[FirstIndex].y - Points[LastIndex].y) then
306 begin
307 // Recursive call
308 Parts[0] := RamerDouglasPeucker(Points, FirstIndex, DeltaMaxIndex, Epsilon);
309 Parts[1] := RamerDouglasPeucker(Points, DeltaMaxIndex, LastIndex, Epsilon);
310
311 // Build the result list
312 SetLength(Result, Length(Parts[0]) + Length(Parts[1]) - 1);
313 Move(Parts[0, 0], Result[0], (Length(Parts[0]) - 1) * SizeOf(TFloatPoint));
314 Move(Parts[1, 0], Result[Length(Parts[0]) - 1], Length(Parts[1]) *
315 SizeOf(TFloatPoint));
316 Exit;
317 end;
318 end;
319
320 SetLength(Result, 2);
321 Result[0] := Points[FirstIndex];
322 Result[1] := Points[LastIndex];
323end;
324
325function RamerDouglasPeucker(Points: TArrayOfFixedPoint; FirstIndex,
326 LastIndex: Integer; Epsilon: TFixed = 1): TArrayOfFixedPoint; overload;
327var
328 Index, DeltaMaxIndex: Integer;
329 Delta, DeltaMax: TFixed;
330 Parts: array [0 .. 1] of TArrayOfFixedPoint;
331
332
333 //Finds the perpendicular distance from a point to a straight line.
334 //The coordinates of the point are specified as $ptX and $ptY.
335 //The line passes through points l1 and l2, specified respectively with their
336 //coordinates $l1x and $l1y, and $l2x and $l2y
337 function PerpendicularDistance(ptX, ptY, l1x, l1y, l2x, l2y: TFixed): TFixed;
338 var
339 Slope, PassThroughY: TFixed;
340 begin
341 if (l2x = l1x) then
342 begin
343 //vertical lines - treat this case specially to avoid divide by zero
344 Result := Abs(ptX - l2x);
345 end
346 else
347 begin
348 Slope := FixedDiv(l2y-l1y, l2x-l1x);
349 PassThroughY := FixedMul(0 - l1x, Slope) + l1y;
350 Result := FixedDiv(Abs(FixedMul(Slope, ptX) - ptY + PassThroughY),
351 FixedSqrtHP(FixedSqr(Slope) + 1));
352 end;
353 end;
354
355begin
356 if LastIndex - FirstIndex > 1 then
357 begin
358 // find the point with the maximum distance
359 DeltaMax := 0;
360 DeltaMaxIndex := 0;
361 for Index := FirstIndex + 1 to LastIndex - 1 do
362 begin
363 Delta := PerpendicularDistance(
364 Points[Index].x, Points[Index].y,
365 Points[FirstIndex].x, Points[FirstIndex].y,
366 Points[LastIndex].x, Points[LastIndex].y);
367 if Delta > DeltaMax then
368 begin
369 DeltaMaxIndex := Index;
370 DeltaMax := Delta;
371 end;
372 end;
373
374 // if max distance is greater than epsilon, recursively simplify
375 if DeltaMax > Epsilon then
376 begin
377 // Recursive call
378 Parts[0] := RamerDouglasPeucker(Points, FirstIndex, DeltaMaxIndex, Epsilon);
379 Parts[1] := RamerDouglasPeucker(Points, DeltaMaxIndex, LastIndex, Epsilon);
380
381 // Build the result list
382 SetLength(Result, Length(Parts[0]) + Length(Parts[1]) - 1);
383 Move(Parts[0, 0], Result[0], (Length(Parts[0]) - 1) * SizeOf(TFixedPoint));
384 Move(Parts[1, 0], Result[Length(Parts[0]) - 1], Length(Parts[1]) * SizeOf(TFixedPoint));
385 Exit;
386 end;
387 end;
388
389 SetLength(Result, 2);
390 Result[0] := Points[FirstIndex];
391 Result[1] := Points[LastIndex];
392end;
393
394function VertexReduction(Points: TArrayOfFloatPoint; Epsilon: TFloat = 1): TArrayOfFloatPoint;
395var
396 Index: Integer;
397 SqrEpsilon: TFloat;
398begin
399 SqrEpsilon := Sqr(Epsilon);
400 SetLength(Result, 1);
401 Result[0] := Points[0];
402 Index := 1;
403 while Index < Length(Points) do
404 begin
405 if SqrDistance(Result[Length(Result) - 1], Points[Index]) > SqrEpsilon then
406 begin
407 SetLength(Result, Length(Result) + 1);
408 Result[Length(Result) - 1] := Points[Index];
409 end;
410 Inc(Index);
411 end;
412
413 if Length(Result) > 2 then
414 Result := RamerDouglasPeucker(Result, 0, Length(Result) - 1, Epsilon);
415end;
416
417function VertexReduction(Points: TArrayOfFixedPoint; Epsilon: TFixed): TArrayOfFixedPoint;
418var
419 Index: Integer;
420 SqrEpsilon: TFixed;
421begin
422 SqrEpsilon := FixedSqr(Epsilon);
423 SetLength(Result, 1);
424 Result[0] := Points[0];
425 Index := 1;
426 while Index < Length(Points) do
427 begin
428 if SqrDistance(Result[Length(Result) - 1], Points[Index]) > SqrEpsilon then
429 begin
430 SetLength(Result, Length(Result) + 1);
431 Result[Length(Result) - 1] := Points[Index];
432 end;
433 Inc(Index);
434 end;
435
436 Result := RamerDouglasPeucker(Points, 0, Length(Points) - 1, Epsilon);
437end;
438
439function ClosePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
440var
441 L: Integer;
442 P1, P2: TFloatPoint;
443begin
444 L := Length(Points);
445 Result := Points;
446 if L <= 1 then
447 Exit;
448
449 P1 := Result[0];
450 P2 := Result[L - 1];
451 if (P1.X = P2.X) and (P1.Y = P2.Y) then
452 Exit;
453
454 SetLength(Result, L + 1);
455 Move(Result[0], Points[0], L * SizeOf(TFloatPoint));
456 Result[L] := P1;
457end;
458
459function ClosePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
460var
461 L: Integer;
462 P1, P2: TFixedPoint;
463begin
464 L := Length(Points);
465 Result := Points;
466 if L <= 1 then
467 Exit;
468
469 P1 := Result[0];
470 P2 := Result[L - 1];
471 if (P1.X = P2.X) and (P1.Y = P2.Y) then
472 Exit;
473
474 SetLength(Result, L + 1);
475 Move(Result[0], Points[0], L * SizeOf(TFixedPoint));
476 Result[L] := P1;
477end;
478
479function ClipLine(var X1, Y1, X2, Y2: Integer; MinX, MinY, MaxX, MaxY: Integer): Boolean;
480var
481 C1, C2: Integer;
482 V: Integer;
483begin
484 { Get edge codes }
485 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
486 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
487
488 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
489 begin
490 if (C1 and 12) <> 0 then
491 begin
492 if C1 < 8 then V := MinY else V := MaxY;
493 Inc(X1, MulDiv(V - Y1, X2 - X1, Y2 - Y1));
494 Y1 := V;
495 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
496 end;
497
498 if (C2 and 12) <> 0 then
499 begin
500 if C2 < 8 then V := MinY else V := MaxY;
501 Inc(X2, MulDiv(V - Y2, X2 - X1, Y2 - Y1));
502 Y2 := V;
503 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
504 end;
505
506 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
507 begin
508 if C1 <> 0 then
509 begin
510 if C1 = 1 then V := MinX else V := MaxX;
511 Inc(Y1, MulDiv(V - X1, Y2 - Y1, X2 - X1));
512 X1 := V;
513 C1 := 0;
514 end;
515
516 if C2 <> 0 then
517 begin
518 if C2 = 1 then V := MinX else V := MaxX;
519 Inc(Y2, MulDiv(V - X2, Y2 - Y1, X2 - X1));
520 X2 := V;
521 C2 := 0;
522 end;
523 end;
524 end;
525
526 Result := (C1 or C2) = 0;
527end;
528
529function ClipLine(var X1, Y1, X2, Y2: TFloat; MinX, MinY, MaxX, MaxY: TFloat): Boolean;
530var
531 C1, C2: Integer;
532 V: TFloat;
533begin
534 { Get edge codes }
535 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
536 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
537
538 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
539 begin
540 if (C1 and 12) <> 0 then
541 begin
542 if C1 < 8 then V := MinY else V := MaxY;
543 X1 := X1 + (V - Y1) * (X2 - X1) / (Y2 - Y1);
544 Y1 := V;
545 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
546 end;
547
548 if (C2 and 12) <> 0 then
549 begin
550 if C2 < 8 then V := MinY else V := MaxY;
551 X2 := X2 + (V - Y2) * (X2 - X1) / (Y2 - Y1);
552 Y2 := V;
553 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
554 end;
555
556 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
557 begin
558 if C1 <> 0 then
559 begin
560 if C1 = 1 then V := MinX else V := MaxX;
561 Y1 := Y1 + (V - X1) * (Y2 - Y1) / (X2 - X1);
562 X1 := V;
563 C1 := 0;
564 end;
565
566 if C2 <> 0 then
567 begin
568 if C2 = 1 then V := MinX else V := MaxX;
569 Y2 := Y2 + (V - X2) * (Y2 - Y1) / (X2 - X1);
570 X2 := V;
571 C2 := 0;
572 end;
573 end;
574 end;
575
576 Result := (C1 or C2) = 0;
577end;
578
579function ClipLine(var X1, Y1, X2, Y2: TFixed; MinX, MinY, MaxX, MaxY: TFixed): Boolean;
580var
581 C1, C2: Integer;
582 V: TFixed;
583begin
584 { Get edge codes }
585 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1 + Ord(Y1 < MinY) shl 2 + Ord(Y1 > MaxY) shl 3;
586 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1 + Ord(Y2 < MinY) shl 2 + Ord(Y2 > MaxY) shl 3;
587
588 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
589 begin
590 if (C1 and 12) <> 0 then
591 begin
592 if C1 < 8 then V := MinY else V := MaxY;
593 X1 := X1 + FixedDiv(FixedMul(V - Y1, X2 - X1), Y2 - Y1);
594 Y1 := V;
595 C1 := Ord(X1 < MinX) + Ord(X1 > MaxX) shl 1;
596 end;
597
598 if (C2 and 12) <> 0 then
599 begin
600 if C2 < 8 then V := MinY else V := MaxY;
601 X2 := X2 + FixedDiv(FixedMul(V - Y2, X2 - X1), Y2 - Y1);
602 Y2 := V;
603 C2 := Ord(X2 < MinX) + Ord(X2 > MaxX) shl 1;
604 end;
605
606 if ((C1 and C2) = 0) and ((C1 or C2) <> 0) then
607 begin
608 if C1 <> 0 then
609 begin
610 if C1 = 1 then V := MinX else V := MaxX;
611 Y1 := Y1 + FixedDiv(FixedMul(V - X1, Y2 - Y1), X2 - X1);
612 X1 := V;
613 C1 := 0;
614 end;
615
616 if C2 <> 0 then
617 begin
618 if C2 = 1 then V := MinX else V := MaxX;
619 Y2 := Y2 + FixedDiv(FixedMul(V - X2, Y2 - Y1), X2 - X1);
620 X2 := V;
621 C2 := 0;
622 end;
623 end;
624 end;
625
626 Result := (C1 or C2) = 0;
627end;
628
629function ClipLine(var P1, P2: TPoint; const ClipRect: TRect): Boolean;
630begin
631 Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
632 ClipRect.Right, ClipRect.Bottom);
633end;
634
635function ClipLine(var P1, P2: TFloatPoint; const ClipRect: TFloatRect): Boolean;
636begin
637 Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
638 ClipRect.Right, ClipRect.Bottom);
639end;
640
641function ClipLine(var P1, P2: TFixedPoint; const ClipRect: TFixedRect): Boolean;
642begin
643 Result := ClipLine(P1.X, P1.Y, P2.X, P2.Y, ClipRect.Left, ClipRect.Top,
644 ClipRect.Right, ClipRect.Bottom);
645end;
646
647procedure FastMergeSortX(const Values: TArrayOfFloatPoint;
648 out Indexes: TArrayOfInteger; out Bounds: TFloatRect);
649var
650 Temp: TArrayOfInteger;
651
652 procedure Merge(I1, I2, J1, J2: Integer);
653 var
654 I, J, K: Integer;
655 begin
656 if Values[Indexes[I2]].X < Values[Indexes[J1]].X then Exit;
657 I := I1;
658 J := J1;
659 K := 0;
660 repeat
661 if Values[Indexes[I]].X < Values[Indexes[J]].X then
662 begin
663 Temp[K] := Indexes[I];
664 Inc(I);
665 end
666 else
667 begin
668 Temp[K] := Indexes[J];
669 Inc(J);
670 end;
671 Inc(K);
672 until (I > I2) or (J > J2);
673
674 while I <= I2 do
675 begin
676 Temp[K] := Indexes[I];
677 Inc(I); Inc(K);
678 end;
679 while J <= J2 do
680 begin
681 Temp[K] := Indexes[J];
682 Inc(J); Inc(K);
683 end;
684 for I := 0 to K - 1 do
685 begin
686 Indexes[I + I1] := Temp[I];
687 end;
688 end;
689
690 procedure Recurse(I1, I2: Integer);
691 var
692 I, IX: Integer;
693 begin
694 if I1 = I2 then
695 Indexes[I1] := I1
696 else if Indexes[I1] = Indexes[I2] then
697 begin
698 if Values[I1].X <= Values[I2].X then
699 begin
700 for I := I1 to I2 do Indexes[I] := I;
701 end
702 else
703 begin
704 IX := I1 + I2;
705 for I := I1 to I2 do Indexes[I] := IX - I;
706 end;
707 end
708 else
709 begin
710 IX := (I1 + I2) div 2;
711 Recurse(I1, IX);
712 Recurse(IX + 1, I2);
713 Merge(I1, IX, IX + 1, I2);
714 end;
715 end;
716
717var
718 I, Index, S: Integer;
719begin
720 SetLength(Temp, Length(Values));
721 SetLength(Indexes, Length(Values));
722
723 Index := 0;
724 S := Math.Sign(Values[1].X - Values[0].X);
725 if S = 0 then S := 1;
726
727 Indexes[0] := 0;
728 Bounds.Left := Values[0].X;
729 Bounds.Top := Values[0].Y;
730 Bounds.Right := Bounds.Left;
731 Bounds.Bottom := Bounds.Top;
732 for I := 1 to High(Values) do
733 begin
734 if Math.Sign(Values[I].X - Values[I - 1].X) = -S then
735 begin
736 S := -S;
737 Inc(Index);
738 end;
739
740 if Values[I].X < Bounds.Left then
741 Bounds.Left := Values[I].X;
742 if Values[I].Y < Bounds.Top then
743 Bounds.Top := Values[I].Y;
744 if Values[I].X > Bounds.Right then
745 Bounds.Right := Values[I].X;
746 if Values[I].Y > Bounds.Bottom then
747 Bounds.Bottom := Values[I].Y;
748
749 Indexes[I] := Index;
750 end;
751
752 Recurse(0, High(Values));
753end;
754
755function DelaunayTriangulation(Points: TArrayOfFloatPoint): TArrayOfTriangleVertexIndices;
756var
757 Complete: array of Byte;
758 Edges: array of array [0 .. 1] of Integer;
759 ByteIndex, Bit: Byte;
760 MaxVerticesCount, EdgeCount, MaxEdgeCount, MaxTriangleCount: Integer;
761
762 // For super triangle
763 ScaledDeltaMax: TFloat;
764 Mid: TFloatPoint;
765 Bounds: TFloatRect;
766
767 // General Variables
768 SortedVertexIndices: TArrayOfInteger;
769 TriangleCount, VertexCount, I, J, K: Integer;
770 CenterX, CenterY, RadSqr: TFloat;
771 Inside: Boolean;
772const
773 CSuperTriangleCount = 3; // -> super triangle
774 CTolerance = 0.000001;
775
776 function InCircle(Pt, Pt1, Pt2, Pt3: TFloatPoint): Boolean;
777 // Return TRUE if the point Pt(x, y) lies inside the circumcircle made up by
778 // points Pt1(x, y) Pt2(x, y) Pt3(x, y)
779 // The circumcircle centre is returned in (CenterX, CenterY) and the radius r
780 // NOTE: A point on the edge is inside the circumcircle
781 var
782 M1, M2, MX1, MY1, MX2, MY2: Double;
783 DeltaX, DeltaY, DeltaRadSqr, AbsY1Y2, AbsY2Y3: Double;
784 begin
785 AbsY1Y2 := Abs(Pt1.Y - Pt2.Y);
786 AbsY2Y3 := Abs(Pt2.Y - Pt3.Y);
787
788 // Check for coincident points
789 if (AbsY1Y2 < CTolerance) and (AbsY2Y3 < CTolerance) then
790 begin
791 Result := False;
792 Exit;
793 end;
794
795 if AbsY1Y2 < CTolerance then
796 begin
797 M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
798 MX2 := (Pt2.X + Pt3.X) * 0.5;
799 MY2 := (Pt2.Y + Pt3.Y) * 0.5;
800 CenterX := (Pt2.X + Pt1.X) * 0.5;
801 CenterY := M2 * (CenterX - MX2) + MY2;
802 end
803 else if AbsY2Y3 < CTolerance then
804 begin
805 M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
806 MX1 := (Pt1.X + Pt2.X) * 0.5;
807 MY1 := (Pt1.Y + Pt2.Y) * 0.5;
808 CenterX := (Pt3.X + Pt2.X) * 0.5;
809 CenterY := M1 * (CenterX - MX1) + MY1;
810 end
811 else
812 begin
813 M1 := -(Pt2.X - Pt1.X) / (Pt2.Y - Pt1.Y);
814 M2 := -(Pt3.X - Pt2.X) / (Pt3.Y - Pt2.Y);
815 MX1 := (Pt1.X + Pt2.X) * 0.5;
816 MX2 := (Pt2.X + Pt3.X) * 0.5;
817 MY1 := (Pt1.Y + Pt2.Y) * 0.5;
818 MY2 := (Pt2.Y + Pt3.Y) * 0.5;
819
820 CenterX := (M1 * MX1 - M2 * Mx2 + My2 - MY1) / (M1 - M2);
821 if (AbsY1Y2 > AbsY2Y3) then
822 CenterY := M1 * (CenterX - MX1) + MY1
823 else
824 CenterY := M2 * (CenterX - MX2) + MY2;
825 end;
826
827 DeltaX := Pt2.X - CenterX;
828 DeltaY := Pt2.Y - CenterY;
829 RadSqr := DeltaX * DeltaX + DeltaY * DeltaY;
830 DeltaX := Pt.X - CenterX;
831 DeltaY := Pt.Y - CenterY;
832 DeltaRadSqr := Sqr(DeltaX) + Sqr(DeltaY);
833
834 Result := (DeltaRadSqr - RadSqr) <= CTolerance;
835 end;
836
837begin
838 VertexCount := Length(Points);
839 MaxVerticesCount := VertexCount + CSuperTriangleCount;
840
841 // Sort points by x value and find maximum and minimum vertex bounds.
842 FastMergeSortX(Points, SortedVertexIndices, Bounds);
843
844 // set dynamic array sizes
845 SetLength(Points, MaxVerticesCount);
846 MaxTriangleCount := 2 * (MaxVerticesCount - 1);
847 SetLength(Result, MaxTriangleCount);
848 MaxEdgeCount := 3 * (MaxVerticesCount - 1);
849 SetLength(Edges, MaxEdgeCount);
850 SetLength(Complete, (MaxTriangleCount + 7) shr 3);
851
852 // This is to allow calculation of the bounding triangle
853 with Bounds do
854 begin
855 ScaledDeltaMax := 30 * Max(Right - Left, Bottom - Top);
856 Mid := FloatPoint((Left + Right) * 0.5, (Top + Bottom) * 0.5);
857 end;
858
859 // Set up the super triangle
860 // This is a triangle which encompasses all the sample points. The super
861 // triangle coordinates are added to the end of the vertex list. The super
862 // triangle is the first triangle in the triangle list.
863 Points[VertexCount] := FloatPoint(Mid.X - ScaledDeltaMax, Mid.Y - ScaledDeltaMax);
864 Points[VertexCount + 1] := FloatPoint(Mid.X + ScaledDeltaMax, Mid.Y);
865 Points[VertexCount + 2] := FloatPoint(Mid.X, Mid.Y + ScaledDeltaMax);
866
867 Result[0, 0] := VertexCount;
868 Result[0, 1] := VertexCount + 1;
869 Result[0, 2] := VertexCount + 2;
870
871 Complete[0] := 0;
872 TriangleCount := 1;
873
874 // Include each point one at a time into the existing mesh
875 for I := 0 to VertexCount - 1 do
876 begin
877 EdgeCount := 0;
878
879 // Set up the edge buffer.
880 // If the point [x, y] lies inside the circumcircle then the hree edges of
881 // that triangle are added to the edge buffer.
882 J := 0;
883 repeat
884 if Complete[J shr 3] and (1 shl (J and $7)) = 0 then
885 begin
886 Inside := InCircle(Points[SortedVertexIndices[I]],
887 Points[Result[J, 0]], Points[Result[J, 1]], Points[Result[J, 2]]);
888
889 ByteIndex := J shr 3;
890 Bit := 1 shl (J and $7);
891 if (CenterX < Points[SortedVertexIndices[I]].X) and
892 ((Sqr(Points[SortedVertexIndices[I]].X - CenterX)) > RadSqr) then
893 Complete[ByteIndex] := Complete[ByteIndex] or Bit
894 else
895 if Inside then
896 begin
897 Edges[EdgeCount + 0, 0] := Result[J, 0];
898 Edges[EdgeCount + 0, 1] := Result[J, 1];
899 Edges[EdgeCount + 1, 0] := Result[J, 1];
900 Edges[EdgeCount + 1, 1] := Result[J, 2];
901 Edges[EdgeCount + 2, 0] := Result[J, 2];
902 Edges[EdgeCount + 2, 1] := Result[J, 0];
903 EdgeCount := EdgeCount + 3;
904 Assert(EdgeCount <= MaxEdgeCount);
905
906 TriangleCount := TriangleCount - 1;
907 Result[J] := Result[TriangleCount];
908
909 Complete[ByteIndex] := (Complete[ByteIndex] and (not Bit))
910 or (Complete[TriangleCount shr 3] and Bit);
911 Continue;
912 end;
913 end;
914 J := J + 1;
915 until J >= TriangleCount;
916
917 // Tag multiple edges
918 // Note: if all triangles are specified anticlockwise then all
919 // interior edges are opposite pointing in direction.
920 for J := 0 to EdgeCount - 2 do
921 begin
922 if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
923 begin
924 for K := J + 1 to EdgeCount - 1 do
925 begin
926 if (Edges[K, 0] <> -1) or (Edges[K, 1] <> -1) then
927 begin
928 if (Edges[J, 0] = Edges[K, 1]) and
929 (Edges[J, 1] = Edges[K, 0]) then
930 begin
931 Edges[J, 0] := -1;
932 Edges[J, 1] := -1;
933 Edges[K, 1] := -1;
934 Edges[K, 0] := -1;
935 end;
936 end;
937 end;
938 end;
939 end;
940
941 // Form new triangles for the current point.
942 // Skipping over any tagged edges. All edges are arranged in clockwise
943 // order.
944 for J := 0 to EdgeCount - 1 do
945 begin
946 if (Edges[J, 0] <> -1) or (Edges[J, 1] <> -1) then
947 begin
948 Result[TriangleCount, 0] := Edges[J, 0];
949 Result[TriangleCount, 1] := Edges[J, 1];
950 Result[TriangleCount, 2] := SortedVertexIndices[I];
951 ByteIndex := TriangleCount shr 3;
952 Bit := 1 shl (TriangleCount and $7);
953 Complete[ByteIndex] := Complete[ByteIndex] and not Bit;
954 Inc(TriangleCount);
955 Assert(TriangleCount <= MaxTriangleCount);
956 end;
957 end;
958 end;
959
960 // Remove triangles with supertriangle vertices
961 // These are triangles which have a vertex number greater than VertexCount
962 I := 0;
963 repeat
964 if (Result[I, 0] >= VertexCount) or
965 (Result[I, 1] >= VertexCount) or
966 (Result[I, 2] >= VertexCount) then
967 begin
968 TriangleCount := TriangleCount - 1;
969 Result[I, 0] := Result[TriangleCount, 0];
970 Result[I, 1] := Result[TriangleCount, 1];
971 Result[I, 2] := Result[TriangleCount, 2];
972 I := I - 1;
973 end;
974 I := I + 1;
975 until I >= TriangleCount;
976
977 SetLength(Points, Length(Points) - 3);
978 SetLength(Result, TriangleCount);
979end;
980
981function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat;
982 Steps: Integer): TArrayOfFloatPoint;
983var
984 I: Integer;
985 C, D: TFloatPoint;
986begin
987 SetLength(Result, Steps);
988 SinCos(StartAngle, Radius, C.Y, C.X);
989 Result[0] := OffsetPoint(P, C);
990
991 GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
992 for I := 1 to Steps - 1 do
993 begin
994 C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
995 Result[I] := OffsetPoint(P, C);
996 end;
997end;
998
999function BuildArc(const P: TFloatPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFloatPoint;
1000const
1001 MINSTEPS = 6;
1002 SQUAREDMINSTEPS = Sqr(MINSTEPS);
1003var
1004 Temp: TFloat;
1005 Steps: Integer;
1006begin
1007 // The code below was previously:
1008 //
1009 // Steps := Max(MINSTEPS, System.Round(Sqrt(Abs(Radius)) *
1010 // Abs(EndAngle - StartAngle)));
1011 //
1012 // However, for small radii, the square root calculation is performed with
1013 // the result that the output is set to 6 anyway. In this case (only a few
1014 // drawing operations), the performance spend for this calculation is dominant
1015 // for large radii (when a lot of CPU intensive drawing takes place), the
1016 // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
1017 // significant
1018
1019 Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
1020 if Temp < SQUAREDMINSTEPS then
1021 Steps := 6
1022 else
1023 Steps := Round(Sqrt(Temp));
1024 Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
1025end;
1026
1027function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat;
1028 Steps: Integer): TArrayOfFixedPoint;
1029var
1030 I: Integer;
1031 C, D: TFloatPoint;
1032begin
1033 SetLength(Result, Steps);
1034 SinCos(StartAngle, Radius, C.Y, C.X);
1035 Result[0] := OffsetPoint(P, C);
1036
1037 GR32_Math.SinCos((EndAngle - StartAngle) / (Steps - 1), D.Y, D.X);
1038 for I := 1 to Steps - 1 do
1039 begin
1040 C := FloatPoint(C.X * D.X - C.Y * D.Y, C.Y * D.X + C.X * D.Y);
1041 Result[I] := OffsetPoint(P, FixedPoint(C));
1042 end;
1043end;
1044
1045function BuildArc(const P: TFixedPoint; StartAngle, EndAngle, Radius: TFloat): TArrayOfFixedPoint;
1046const
1047 MINSTEPS = 6;
1048 SQUAREDMINSTEPS = Sqr(MINSTEPS);
1049var
1050 Temp: TFloat;
1051 Steps: Integer;
1052begin
1053 // The code below was previously:
1054 //
1055 // Steps := Clamp(System.Round(Sqrt(Abs(Radius)) *
1056 // Abs(EndAngle - StartAngle)), MINSTEPS, $100000);
1057 //
1058 // However, for small radii, the square root calculation is performed with
1059 // the result that the output is set to 6 anyway. In this case (only a few
1060 // drawing operations), the performance spend for this calculation is dominant
1061 // for large radii (when a lot of CPU intensive drawing takes place), the
1062 // more expensive float point comparison (Temp < SQUAREDMINSTEPS) is not very
1063 // significant
1064
1065 Temp := Abs(Radius) * Sqr(EndAngle - StartAngle);
1066 if Temp < SQUAREDMINSTEPS then
1067 Steps := MINSTEPS
1068 else
1069 Steps := Clamp(Round(Sqrt(Temp)), $100000);
1070 Result := BuildArc(P, StartAngle, EndAngle, Radius, Steps);
1071end;
1072
1073function Line(const P1, P2: TFloatPoint): TArrayOfFloatPoint;
1074begin
1075 SetLength(Result, 2);
1076 Result[0] := P1;
1077 Result[1] := P2;
1078end;
1079
1080function Line(const X1, Y1, X2, Y2: TFloat): TArrayOfFloatPoint; overload;
1081begin
1082 SetLength(Result, 2);
1083 Result[0] := FloatPoint(X1, Y1);
1084 Result[1] := FloatPoint(X2, Y2);
1085end;
1086
1087function VertLine(const X, Y1, Y2: TFloat): TArrayOfFloatPoint;
1088begin
1089 SetLength(Result, 2);
1090 Result[0] := FloatPoint(X, Y1);
1091 Result[1] := FloatPoint(X, Y2);
1092end;
1093
1094function HorzLine(const X1, Y, X2: TFloat): TArrayOfFloatPoint;
1095begin
1096 SetLength(Result, 2);
1097 Result[0] := FloatPoint(X1, Y);
1098 Result[1] := FloatPoint(X2, Y);
1099end;
1100
1101function CalculateCircleSteps(Radius: TFloat): Cardinal;
1102var
1103 AbsRadius: TFloat;
1104begin
1105 AbsRadius := Abs(Radius);
1106 Result := Trunc(Pi / (ArcCos(AbsRadius / (AbsRadius + 0.125))));
1107end;
1108
1109function Circle(const P: TFloatPoint; const Radius: TFloat;
1110 Steps: Integer): TArrayOfFloatPoint;
1111var
1112 I: Integer;
1113 M: TFloat;
1114 C, D: TFloatPoint;
1115begin
1116 if Steps <= 0 then
1117 Steps := CalculateCircleSteps(Radius);
1118
1119 SetLength(Result, Steps);
1120 M := 2 * System.Pi / Steps;
1121
1122 // first item
1123 Result[0].X := Radius + P.X;
1124 Result[0].Y := P.Y;
1125
1126 // calculate complex offset
1127 GR32_Math.SinCos(M, C.Y, C.X);
1128 D.X := Radius * C.X;
1129 D.Y := Radius * C.Y;
1130
1131 // second item
1132 Result[1].X := D.X + P.X;
1133 Result[1].Y := D.Y + P.Y;
1134
1135 // other items
1136 for I := 2 to Steps - 1 do
1137 begin
1138 D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
1139
1140 Result[I].X := D.X + P.X;
1141 Result[I].Y := D.Y + P.Y;
1142 end;
1143end;
1144
1145function Circle(const P: TFloatPoint; const Radius: TFloat): TArrayOfFloatPoint;
1146begin
1147 Result := Circle(P, Radius, CalculateCircleSteps(Radius));
1148end;
1149
1150function Circle(const X, Y, Radius: TFloat; Steps: Integer): TArrayOfFloatPoint;
1151begin
1152 Result := Circle(FloatPoint(X, Y), Radius, Steps);
1153end;
1154
1155function Circle(const X, Y, Radius: TFloat): TArrayOfFloatPoint;
1156begin
1157 Result := Circle(FloatPoint(X, Y), Radius, CalculateCircleSteps(Radius));
1158end;
1159
1160function Circle(const R: TRect): TArrayOfFloatPoint;
1161begin
1162 Result := Circle(
1163 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1164 Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
1165end;
1166
1167function Circle(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
1168begin
1169 Result := Circle(
1170 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1171 Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
1172end;
1173
1174function Circle(const R: TFloatRect): TArrayOfFloatPoint;
1175begin
1176 Result := Circle(
1177 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1178 Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
1179end;
1180
1181function Circle(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
1182begin
1183 Result := Circle(
1184 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1185 Min(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
1186end;
1187
1188function Pie(const P: TFloatPoint; const Radius: TFloat;
1189 const Angle, Offset: TFloat; Steps: Integer): TArrayOfFloatPoint;
1190var
1191 I: Integer;
1192 C, D: TFloatPoint;
1193begin
1194 SetLength(Result, Steps + 2);
1195
1196 Result[0] := P;
1197
1198 // calculate initial position
1199 GR32_Math.SinCos(Offset, Radius, D.Y, D.X);
1200 Result[1].X := D.X + P.X;
1201 Result[1].Y := D.Y + P.Y;
1202
1203 // calculate complex offset
1204 GR32_Math.SinCos(Angle / Steps, C.Y, C.X);
1205
1206 // other items
1207 for I := 2 to Steps + 1 do
1208 begin
1209 D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
1210
1211 Result[I].X := D.X + P.X;
1212 Result[I].Y := D.Y + P.Y;
1213 end;
1214end;
1215
1216function Pie(const P: TFloatPoint; const Radius: TFloat;
1217 const Angle: TFloat; const Offset: TFloat = 0): TArrayOfFloatPoint;
1218begin
1219 Result := Pie(P, Radius, Angle, Offset, CalculateCircleSteps(Radius));
1220end;
1221
1222function Pie(const P: TFloatPoint; const Radius: TFloat;
1223 const Angle: TFloat; Steps: Integer): TArrayOfFloatPoint;
1224begin
1225 Result := Pie(P, Radius, Angle, 0, Steps);
1226end;
1227
1228function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
1229 const Offset: TFloat = 0): TArrayOfFloatPoint;
1230begin
1231 Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, CalculateCircleSteps(Radius));
1232end;
1233
1234function Pie(const X, Y, Radius: TFloat; const Angle, Offset: TFloat;
1235 Steps: Integer): TArrayOfFloatPoint;
1236begin
1237 Result := Pie(FloatPoint(X, Y), Radius, Angle, Offset, Steps);
1238end;
1239
1240function Pie(const X, Y, Radius: TFloat; const Angle: TFloat;
1241 Steps: Integer): TArrayOfFloatPoint;
1242begin
1243 Result := Pie(FloatPoint(X, Y), Radius, Angle, 0, Steps);
1244end;
1245
1246function Ellipse(const P, R: TFloatPoint; Steps: Integer): TArrayOfFloatPoint;
1247var
1248 I: Integer;
1249 M: TFloat;
1250 C, D: TFloatPoint;
1251begin
1252 SetLength(Result, Steps);
1253 M := 2 * System.Pi / Steps;
1254
1255 // first item
1256 Result[0].X := R.X + P.X;
1257 Result[0].Y := P.Y;
1258
1259 // calculate complex offset
1260 GR32_Math.SinCos(M, C.Y, C.X);
1261 D := C;
1262
1263 // second item
1264 Result[1].X := R.X * D.X + P.X;
1265 Result[1].Y := R.Y * D.Y + P.Y;
1266
1267 // other items
1268 for I := 2 to Steps - 1 do
1269 begin
1270 D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
1271
1272 Result[I].X := R.X * D.X + P.X;
1273 Result[I].Y := R.Y * D.Y + P.Y;
1274 end;
1275end;
1276
1277function Ellipse(const P, R: TFloatPoint): TArrayOfFloatPoint;
1278begin
1279 Result := Ellipse(P, R, CalculateCircleSteps(Min(R.X, R.Y)));
1280end;
1281
1282function Ellipse(const X, Y, Rx, Ry: TFloat; Steps: Integer): TArrayOfFloatPoint;
1283begin
1284 Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry), Steps);
1285end;
1286
1287function Ellipse(const X, Y, Rx, Ry: TFloat): TArrayOfFloatPoint;
1288begin
1289 Result := Ellipse(FloatPoint(X, Y), FloatPoint(Rx, Ry),
1290 CalculateCircleSteps(Min(Rx, Ry)));
1291end;
1292
1293function Ellipse(const R: TRect): TArrayOfFloatPoint;
1294begin
1295 Result := Ellipse(
1296 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1297 FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
1298end;
1299
1300function Ellipse(const R: TFloatRect): TArrayOfFloatPoint;
1301begin
1302 Result := Ellipse(
1303 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1304 FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)));
1305end;
1306
1307function Ellipse(const R: TRect; Steps: Integer): TArrayOfFloatPoint;
1308begin
1309 Result := Ellipse(
1310 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1311 FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
1312end;
1313
1314function Ellipse(const R: TFloatRect; Steps: Integer): TArrayOfFloatPoint;
1315begin
1316 Result := Ellipse(
1317 FloatPoint(0.5 * (R.Right + R.Left), 0.5 * (R.Bottom + R.Top)),
1318 FloatPoint(0.5 * (R.Right - R.Left), 0.5 * (R.Bottom - R.Top)), Steps);
1319end;
1320
1321function Star(const X, Y, Radius: TFloat; Vertices: Integer = 5;
1322 Rotation: TFloat = 0): TArrayOfFloatPoint;
1323var
1324 Alpha, Ratio: TFloat;
1325begin
1326 Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
1327 Ratio := Sin(Alpha * 0.5) / Sin( Alpha * 0.5 + Pi / Vertices);
1328 Result := Star(X, Y, Ratio * Radius, Radius, Vertices, Rotation);
1329end;
1330
1331function Star(const P: TFloatPoint; const Radius: TFloat; Vertices: Integer = 5;
1332 Rotation: TFloat = 0): TArrayOfFloatPoint;
1333var
1334 Alpha, Ratio: TFloat;
1335begin
1336 Alpha := Pi * (Vertices - 2 * ((Vertices - 1) shr 1)) / Vertices;
1337 Ratio := Sin(Alpha * 0.5) / Sin(Alpha * 0.5 + Pi / Vertices);
1338 Result := Star(P, Ratio * Radius, Radius, Vertices, Rotation);
1339end;
1340
1341function Star(const X, Y, InnerRadius, OuterRadius: TFloat;
1342 Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
1343begin
1344 Result := Star(FloatPoint(X, Y), InnerRadius, OuterRadius, Vertices, Rotation);
1345end;
1346
1347function Star(const P: TFloatPoint; const InnerRadius, OuterRadius: TFloat;
1348 Vertices: Integer = 5; Rotation: TFloat = 0): TArrayOfFloatPoint;
1349var
1350 I: Integer;
1351 M: TFloat;
1352 C, D: TFloatPoint;
1353begin
1354 SetLength(Result, 2 * Vertices);
1355 M := System.Pi / Vertices;
1356
1357 // calculate complex offset
1358 GR32_Math.SinCos(M, C.Y, C.X);
1359
1360 // first item
1361 if Rotation = 0 then
1362 begin
1363 Result[0].X := OuterRadius + P.X;
1364 Result[0].Y := P.Y;
1365 D := C;
1366 end
1367 else
1368 begin
1369 GR32_Math.SinCos(Rotation, D.Y, D.X);
1370 Result[0].X := OuterRadius * D.X + P.X;
1371 Result[0].Y := OuterRadius * D.Y + P.Y;
1372 D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
1373 end;
1374
1375 // second item
1376 Result[1].X := InnerRadius * D.X + P.X;
1377 Result[1].Y := InnerRadius * D.Y + P.Y;
1378
1379 // other items
1380 for I := 2 to (2 * Vertices) - 1 do
1381 begin
1382 D := FloatPoint(D.X * C.X - D.Y * C.Y, D.Y * C.X + D.X * C.Y);
1383
1384 if I mod 2 = 0 then
1385 begin
1386 Result[I].X := OuterRadius * D.X + P.X;
1387 Result[I].Y := OuterRadius * D.Y + P.Y;
1388 end
1389 else
1390 begin
1391 Result[I].X := InnerRadius * D.X + P.X;
1392 Result[I].Y := InnerRadius * D.Y + P.Y;
1393 end;
1394 end;
1395end;
1396
1397function Rectangle(const R: TFloatRect): TArrayOfFloatPoint;
1398begin
1399 SetLength(Result, 4);
1400 Result[0] := R.TopLeft;
1401 Result[1] := FloatPoint(R.Right, R.Top);
1402 Result[2] := R.BottomRight;
1403 Result[3] := FloatPoint(R.Left, R.Bottom);
1404end;
1405
1406function RoundRect(const R: TFloatRect; const Radius: TFloat): TArrayOfFloatPoint;
1407var
1408 R2: TFloatRect;
1409begin
1410 R2 := R;
1411 GR32.InflateRect(R2, -Radius, -Radius);
1412 Result := Grow(Rectangle(R2), Radius, jsRound, True);
1413end;
1414
1415function BuildNormals(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
1416const
1417 EPSILON = 1E-4;
1418var
1419 I, Count, NextI: Integer;
1420 dx, dy, f: Double;
1421begin
1422 Count := Length(Points);
1423 SetLength(Result, Count);
1424
1425 I := 0;
1426 NextI := 1;
1427
1428 while I < Count do
1429 begin
1430 if NextI >= Count then NextI := 0;
1431
1432 dx := Points[NextI].X - Points[I].X;
1433 dy := Points[NextI].Y - Points[I].Y;
1434 f := GR32_Math.Hypot(dx, dy);
1435 if (f > EPSILON) then
1436 begin
1437 f := 1 / f;
1438 dx := dx * f;
1439 dy := dy * f;
1440 end;
1441 Result[I].X := dy;
1442
1443 Result[I].Y := -dx;
1444
1445 Inc(I);
1446 Inc(NextI);
1447 end;
1448end;
1449
1450function BuildNormals(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
1451var
1452 I, Count, NextI: Integer;
1453 dx, dy, f: TFixed;
1454begin
1455 Count := Length(Points);
1456 SetLength(Result, Count);
1457
1458 I := 0;
1459 NextI := 1;
1460
1461 while I < Count do
1462 begin
1463 if NextI >= Count then NextI := 0;
1464
1465 dx := Points[NextI].X - Points[I].X;
1466 dy := Points[NextI].Y - Points[I].Y;
1467 f := GR32_Math.Hypot(dx, dy);
1468 if (f <> 0) then
1469 begin
1470 dx := FixedDiv(dx, f);
1471 dy := FixedDiv(dy, f);
1472 end;
1473
1474 Result[I].X := dy;
1475 Result[I].Y := -dx;
1476
1477 Inc(I);
1478 Inc(NextI);
1479 end;
1480end;
1481
1482function Grow(const Points: TArrayOfFloatPoint; const Normals: TArrayOfFloatPoint;
1483 const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean; MiterLimit: TFloat): TArrayOfFloatPoint; overload;
1484const
1485 BUFFSIZEINCREMENT = 128;
1486 MINDISTPIXEL = 1.414; // just a little bit smaller than sqrt(2),
1487 // -> set to about 2.5 for a similar output with the previous version
1488var
1489 I, L, H: Integer;
1490 ResSize, BuffSize: Integer;
1491 PX, PY: TFloat;
1492 AngleInv, RMin: TFloat;
1493 A, B, Dm: TFloatPoint;
1494
1495 procedure AddPoint(const LongDeltaX, LongDeltaY: TFloat);
1496 begin
1497 if ResSize = BuffSize then
1498 begin
1499 Inc(BuffSize, BUFFSIZEINCREMENT);
1500 SetLength(Result, BuffSize);
1501 end;
1502 Result[ResSize] := FloatPoint(PX + LongDeltaX, PY + LongDeltaY);
1503 Inc(ResSize);
1504 end;
1505
1506 procedure AddMitered(const X1, Y1, X2, Y2: TFloat);
1507 var
1508 R, CX, CY: TFloat;
1509 begin
1510 CX := X1 + X2;
1511 CY := Y1 + Y2;
1512
1513 R := X1 * CX + Y1 * CY; //(1 - cos(ß)) (range: 0 <= R <= 2)
1514 if R < RMin then
1515 begin
1516 AddPoint(Delta * X1, Delta * Y1);
1517 AddPoint(Delta * X2, Delta * Y2);
1518 end
1519 else
1520 begin
1521 R := Delta / R;
1522 AddPoint(CX * R, CY * R)
1523 end;
1524 end;
1525
1526 procedure AddBevelled(const X1, Y1, X2, Y2: TFloat);
1527 var
1528 R: TFloat;
1529 begin
1530 R := X1 * Y2 - X2 * Y1; // cross product
1531 if R * Delta <= 0 then // ie angle is concave
1532 AddMitered(X1, Y1, X2, Y2)
1533 else
1534 begin
1535 AddPoint(Delta * X1, Delta * Y1);
1536 AddPoint(Delta * X2, Delta * Y2);
1537 end;
1538 end;
1539
1540 procedure AddRoundedJoin(const X1, Y1, X2, Y2: TFloat);
1541 var
1542 sinA, cosA, A, d: TFloat;
1543 steps: Integer;
1544 ii, m,n: Integer;
1545 C, C2, C3: TFloatPoint;
1546 begin
1547 sinA := X1 * Y2 - X2 * Y1;
1548 cosA := X1 * X2 + Y1 * Y2;
1549 A := ArcTan2(sinA, cosA);
1550 steps := Round(Abs(A * AngleInv));
1551
1552 if sinA < 0 then
1553 Dm.Y := -Abs(Dm.Y) else
1554 Dm.Y := Abs(Dm.Y);
1555
1556 if sinA * Delta < 0 then // ie angle is concave
1557 begin
1558 A := Delta / (cosA +1);
1559 //C = offset pt of concave vertex ...
1560 C.X := PX + (X1 + X2) * A;
1561 C.Y := PY + (Y1 + Y2) * A;
1562
1563 if (I = 0) then m := H else m := I -1;
1564 if I = H then n := 0 else n := I +1;
1565 A := Min(SqrDistance(Points[m], Points[I]),
1566 SqrDistance(Points[n], Points[I]));
1567
1568 if SqrDistance(C, Points[I]) > A then
1569 begin
1570 //there's no room to draw anything ...
1571 //now get the perpendic. offset from pt2 ...
1572 C2.X := X1 * Delta;
1573 C2.Y := Y1 * Delta;
1574 C3.X := X2 * Delta;
1575 C3.Y := Y2 * Delta;
1576 //this will create a self-intersection but it also ensures that
1577 //the offset will be maintained beyond this intersection ...
1578 AddPoint(C2.X, C2.Y);
1579 AddPoint(C3.X, C3.Y);
1580 Exit;
1581 end;
1582 A := Sqrt(A);
1583
1584 //get the point on the both edges that's same distance from
1585 //the concave vertex as its closest adjacent vertex.
1586 //nb: using unit normals as unit vectors here ...
1587 C2.X := PX + Y1 * A;
1588 C2.Y := PY - X1 * A;
1589 C3.X := PX - Y2 * A;
1590 C3.Y := PY + X2 * A;
1591
1592 //now Delta offset these points ...
1593 C2.X := C2.X + X1 * Delta;
1594 C2.Y := C2.Y + Y1 * Delta;
1595 C3.X := C3.X + X2 * Delta;
1596 C3.Y := C3.Y + Y2 * Delta;
1597
1598 //this will do Delta/MiterLimit radius rounding of concavities ...
1599 if SqrDistance(C2, C3) < Sqr(Delta *2/MiterLimit) then
1600 d := Sqrt(SqrDistance(C2, C3))/2 else
1601 d := Delta/MiterLimit;
1602
1603 //move point(PX,PY) across the offset path so the
1604 //rounding path will curve around this new point ...
1605 A := (d + Delta) / (cosA +1);
1606 PX := PX + (X1 + X2) * A;
1607 PY := PY + (Y1 + Y2) * A;
1608
1609 C2.X := -X1 * d;
1610 C2.Y := -Y1 * d;
1611 AddPoint(C2.X, C2.Y);
1612 for ii := 1 to steps -1 do
1613 begin
1614 C2 := FloatPoint(
1615 C2.X * Dm.X - Dm.Y * C2.Y,
1616 C2.X * Dm.Y + C2.Y * Dm.X);
1617 AddPoint(C2.X, C2.Y);
1618 end;
1619 end
1620 else
1621 begin
1622 C.X := X1 * Delta;
1623 C.Y := Y1 * Delta;
1624 AddPoint(C.X, C.Y);
1625 for ii := 1 to steps - 1 do
1626 begin
1627 C := FloatPoint(
1628 C.X * Dm.X - C.Y * Dm.Y,
1629 C.Y * Dm.X + C.X * Dm.Y);
1630 AddPoint(C.X, C.Y);
1631 end;
1632 end;
1633 end;
1634
1635 procedure AddJoin(const X, Y, X1, Y1, X2, Y2: TFloat);
1636 begin
1637 PX := X;
1638 PY := Y;
1639 case JoinStyle of
1640 jsMiter: AddMitered(A.X, A.Y, B.X, B.Y);
1641 jsBevel: AddBevelled(A.X, A.Y, B.X, B.Y);
1642 jsRoundEx: AddRoundedJoin(A.X, A.Y, B.X, B.Y);
1643 else if (X1 * Y2 - X2 * Y1) * Delta < 0 then //miter when concave
1644 AddMitered(A.X, A.Y, B.X, B.Y) else
1645 AddRoundedJoin(A.X, A.Y, B.X, B.Y);
1646 end;
1647 end;
1648
1649begin
1650 Result := nil;
1651
1652 if Length(Points) <= 1 then Exit;
1653 RMin := 2 / Sqr(MiterLimit);
1654
1655 H := High(Points) - Ord(not Closed);
1656 while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
1657
1658{** all normals zeroed => Exit }
1659 if H < 0 then Exit;
1660
1661 L := 0;
1662 while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
1663
1664 if Closed then
1665 A := Normals[H]
1666 else
1667 A := Normals[L];
1668
1669 ResSize := 0;
1670 BuffSize := BUFFSIZEINCREMENT;
1671 SetLength(Result, BuffSize);
1672
1673 // prepare
1674 if JoinStyle in [jsRound, jsRoundEx] then
1675 begin
1676 Dm.X := 1 - 0.5 * Min(3, Sqr(MINDISTPIXEL / Abs(Delta)));
1677 Dm.Y := Sqrt(1 - Sqr(Dm.X));
1678 AngleInv := 1 / ArcCos(Dm.X);
1679 end;
1680
1681 for I := L to H do
1682 begin
1683 B := Normals[I];
1684 if (B.X = 0) and (B.Y = 0) then Continue;
1685 with Points[I] do AddJoin(X, Y, A.X, A.Y, B.X, B.Y);
1686 A := B;
1687 end;
1688 if not Closed then
1689 with Points[High(Points)] do AddJoin(X, Y, A.X, A.Y, A.X, A.Y);
1690 SetLength(Result, ResSize);
1691end;
1692
1693function Grow(const Points: TArrayOfFloatPoint;
1694 const Delta: TFloat; JoinStyle: TJoinStyle; Closed: Boolean;
1695 MiterLimit: TFloat): TArrayOfFloatPoint; overload;
1696var
1697 Normals: TArrayOfFloatPoint;
1698begin
1699 Normals := BuildNormals(Points);
1700 Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
1701end;
1702
1703function Grow(const Points: TArrayOfFixedPoint; const Normals: TArrayOfFixedPoint;
1704 const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
1705 Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
1706var
1707 tmp: TArrayOfFloatPoint;
1708begin
1709 tmp := Grow(FixedPointToFloatPoint(Points), FixedPointToFloatPoint(Normals),
1710 Delta * FixedToFloat, JoinStyle, Closed, MiterLimit * FixedToFloat);
1711 result := FloatPointToFixedPoint(tmp);
1712end;
1713
1714function Grow(const Points: TArrayOfFixedPoint;
1715 const Delta: TFixed; JoinStyle: TJoinStyle = jsMiter;
1716 Closed: Boolean = True; MiterLimit: TFixed = DEFAULT_MITER_LIMIT_FIXED): TArrayOfFixedPoint; overload;
1717var
1718 Normals: TArrayOfFixedPoint;
1719begin
1720 Normals := BuildNormals(Points);
1721 Result := Grow(Points, Normals, Delta, JoinStyle, Closed, MiterLimit);
1722end;
1723
1724function ReversePolygon(const Points: TArrayOfFloatPoint): TArrayOfFloatPoint;
1725var
1726 I, L: Integer;
1727begin
1728 L := Length(Points);
1729 SetLength(Result, L);
1730 Dec(L);
1731 for I := 0 to L do
1732 Result[I] := Points[L - I];
1733end;
1734
1735function ReversePolygon(const Points: TArrayOfFixedPoint): TArrayOfFixedPoint;
1736var
1737 I, L: Integer;
1738begin
1739 L := Length(Points);
1740 SetLength(Result, L);
1741 Dec(L);
1742 for I := 0 to L do
1743 Result[I] := Points[L - I];
1744end;
1745
1746function BuildLineEnd(const P, N: TFloatPoint; const W: TFloat;
1747 EndStyle: TEndStyle): TArrayOfFloatPoint; overload;
1748var
1749 a1, a2: TFloat;
1750begin
1751 case EndStyle of
1752 esButt:
1753 begin
1754 Result := nil;
1755 end;
1756 esSquare:
1757 begin
1758 SetLength(Result, 2);
1759 Result[0].X := P.X + (N.X - N.Y) * W;
1760 Result[0].Y := P.Y + (N.Y + N.X) * W;
1761 Result[1].X := P.X - (N.X + N.Y) * W;
1762 Result[1].Y := P.Y - (N.Y - N.X) * W;
1763 end;
1764 esRound:
1765 begin
1766 a1 := ArcTan2(N.Y, N.X);
1767 a2 := ArcTan2(-N.Y, -N.X);
1768 if a2 < a1 then a2 := a2 + TWOPI;
1769 Result := BuildArc(P, a1, a2, W);
1770 end;
1771 end;
1772end;
1773
1774function BuildLineEnd(const P, N: TFixedPoint; const W: TFixed;
1775 EndStyle: TEndStyle): TArrayOfFixedPoint; overload;
1776var
1777 a1, a2: TFloat;
1778begin
1779 case EndStyle of
1780 esButt:
1781 begin
1782 Result := nil;
1783 end;
1784 esSquare:
1785 begin
1786 SetLength(Result, 2);
1787 Result[0].X := P.X + (N.X - N.Y) * W;
1788 Result[0].Y := P.Y + (N.Y + N.X) * W;
1789 Result[1].X := P.X - (N.X + N.Y) * W;
1790 Result[1].Y := P.Y - (N.Y - N.X) * W;
1791 end;
1792 esRound:
1793 begin
1794 a1 := ArcTan2(N.Y, N.X);
1795 a2 := ArcTan2(-N.Y, -N.X);
1796 if a2 < a1 then a2 := a2 + TWOPI;
1797 Result := BuildArc(P, a1, a2, W);
1798 end;
1799 end;
1800end;
1801
1802function BuildPolyline(const Points: TArrayOfFloatPoint; StrokeWidth: TFloat;
1803 JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfFloatPoint;
1804var
1805 L, H: Integer;
1806 Normals: TArrayOfFloatPoint;
1807 P1, P2, E1, E2: TArrayOfFloatPoint;
1808 V: TFloat;
1809 P: PFloatPoint;
1810begin
1811 Result := nil;
1812 V := StrokeWidth * 0.5;
1813 Normals := BuildNormals(Points);
1814
1815 H := High(Points) - 1;
1816 while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
1817 if H < 0 then Exit;
1818 L := 0;
1819 while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
1820
1821 P1 := Grow(Points, Normals, V, JoinStyle, False, MiterLimit);
1822 P2 := ReversePolygon(Grow(Points, Normals, -V, JoinStyle, False, MiterLimit));
1823
1824 E1 := BuildLineEnd(Points[0], Normals[L], -V, EndStyle);
1825 E2 := BuildLineEnd(Points[High(Points)], Normals[H], V, EndStyle);
1826
1827 SetLength(Result, Length(P1) + Length(P2) + Length(E1) + Length(E2));
1828 P := @Result[0];
1829 Move(E1[0], P^, Length(E1) * SizeOf(TFloatPoint)); Inc(P, Length(E1));
1830 Move(P1[0], P^, Length(P1) * SizeOf(TFloatPoint)); Inc(P, Length(P1));
1831 Move(E2[0], P^, Length(E2) * SizeOf(TFloatPoint)); Inc(P, Length(E2));
1832 Move(P2[0], P^, Length(P2) * SizeOf(TFloatPoint));
1833end;
1834
1835function BuildPolyPolyLine(const Points: TArrayOfArrayOfFloatPoint;
1836 Closed: Boolean; StrokeWidth: TFloat; JoinStyle: TJoinStyle;
1837 EndStyle: TEndStyle; MiterLimit: TFloat): TArrayOfArrayOfFloatPoint;
1838var
1839 I: Integer;
1840 P1, P2: TArrayOfFloatPoint;
1841 Dst: TArrayOfArrayOfFloatPoint;
1842 Normals: TArrayOfFloatPoint;
1843begin
1844 if Closed then
1845 begin
1846 SetLength(Dst, Length(Points) * 2);
1847 for I := 0 to High(Points) do
1848 begin
1849 Normals := BuildNormals(Points[I]);
1850 P1 := Grow(Points[I], Normals, StrokeWidth * 0.5, JoinStyle, True, MiterLimit);
1851 P2 := Grow(Points[I], Normals, -StrokeWidth * 0.5, JoinStyle, True, MiterLimit);
1852 Dst[I * 2] := P1;
1853 Dst[I * 2 + 1] := ReversePolygon(P2);
1854 end;
1855 end
1856 else
1857 begin
1858 SetLength(Dst, Length(Points));
1859 for I := 0 to High(Points) do
1860 Dst[I] := BuildPolyline(Points[I], StrokeWidth, JoinStyle, EndStyle);
1861 end;
1862 Result := Dst;
1863end;
1864
1865function BuildPolyline(const Points: TArrayOfFixedPoint; StrokeWidth: TFixed;
1866 JoinStyle: TJoinStyle; EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfFixedPoint;
1867var
1868 L, H: Integer;
1869 Normals: TArrayOfFixedPoint;
1870 P1, P2, E1, E2: TArrayOfFixedPoint;
1871 V: TFixed;
1872 P: PFixedPoint;
1873begin
1874 Result := nil;
1875 V := StrokeWidth shr 1;
1876 Normals := BuildNormals(Points);
1877
1878 H := High(Points) - 1;
1879 while (H >= 0) and (Normals[H].X = 0) and (Normals[H].Y = 0) do Dec(H);
1880 if H < 0 then Exit;
1881 L := 0;
1882 while (Normals[L].X = 0) and (Normals[L].Y = 0) do Inc(L);
1883
1884 P1 := Grow(Points, Normals, V, JoinStyle, False, MiterLimit);
1885 P2 := ReversePolygon(Grow(Points, Normals, -V, JoinStyle, False, MiterLimit));
1886
1887 E1 := BuildLineEnd(Points[0], Normals[L], -V, EndStyle);
1888 E2 := BuildLineEnd(Points[High(Points)], Normals[H], V, EndStyle);
1889
1890 SetLength(Result, Length(P1) + Length(P2) + Length(E1) + Length(E2));
1891 P := @Result[0];
1892 Move(E1[0], P^, Length(E1) * SizeOf(TFixedPoint)); Inc(P, Length(E1));
1893 Move(P1[0], P^, Length(P1) * SizeOf(TFixedPoint)); Inc(P, Length(P1));
1894 Move(E2[0], P^, Length(E2) * SizeOf(TFixedPoint)); Inc(P, Length(E2));
1895 Move(P2[0], P^, Length(P2) * SizeOf(TFixedPoint));
1896end;
1897
1898function BuildPolyPolyLine(const Points: TArrayOfArrayOfFixedPoint;
1899 Closed: Boolean; StrokeWidth: TFixed; JoinStyle: TJoinStyle;
1900 EndStyle: TEndStyle; MiterLimit: TFixed): TArrayOfArrayOfFixedPoint;
1901var
1902 I: Integer;
1903 P1, P2: TArrayOfFixedPoint;
1904 Dst: TArrayOfArrayOfFixedPoint;
1905 Normals: TArrayOfFixedPoint;
1906begin
1907 if Closed then
1908 begin
1909 SetLength(Dst, Length(Points) * 2);
1910 for I := 0 to High(Points) do
1911 begin
1912 Normals := BuildNormals(Points[I]);
1913 P1 := Grow(Points[I], Normals, StrokeWidth shr 1, JoinStyle, True, MiterLimit);
1914 P2 := Grow(Points[I], Normals, -StrokeWidth shr 1, JoinStyle, True, MiterLimit);
1915 Dst[I * 2] := P1;
1916 Dst[I * 2 + 1] := ReversePolygon(P2);
1917 end;
1918 end
1919 else
1920 begin
1921 SetLength(Dst, Length(Points));
1922 for I := 0 to High(Points) do
1923 Dst[I] := BuildPolyline(Points[I], StrokeWidth, JoinStyle, EndStyle);
1924 end;
1925 Result := Dst;
1926end;
1927
1928function BuildDashedLine(const Points: TArrayOfFloatPoint;
1929 const DashArray: TArrayOfFloat; DashOffset: TFloat = 0;
1930 Closed: Boolean = False): TArrayOfArrayOfFloatPoint;
1931const
1932 EPSILON = 1E-4;
1933var
1934 I, J, DashIndex, len1, len2: Integer;
1935 Offset, Dist, v: TFloat;
1936 Delta: TFloatPoint;
1937
1938 procedure AddPoint(X, Y: TFloat);
1939 var
1940 K: Integer;
1941 begin
1942 K := Length(Result[J]);
1943 SetLength(Result[J], K + 1);
1944 Result[J][K].X := X;
1945 Result[J][K].Y := Y;
1946 end;
1947
1948 procedure AddDash(I: Integer);
1949 begin
1950 if i = 0 then
1951 begin
1952 Delta.X := Points[0].X - Points[High(Points)].X;
1953 Delta.Y := Points[0].Y - Points[High(Points)].Y;
1954 end else
1955 begin
1956 Delta.X := Points[I].X - Points[I - 1].X;
1957 Delta.Y := Points[I].Y - Points[I - 1].Y;
1958 end;
1959 Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
1960 Offset := Offset + Dist;
1961 if (Dist > EPSILON) then
1962 begin
1963 Dist := 1 / Dist;
1964 Delta.X := Delta.X * Dist;
1965 Delta.Y := Delta.Y * Dist;
1966 end;
1967 while Offset > DashOffset do
1968 begin
1969 v := Offset - DashOffset;
1970 AddPoint(Points[I].X - v * Delta.X, Points[I].Y - v * Delta.Y);
1971 DashIndex := (DashIndex + 1) mod Length(DashArray);
1972 DashOffset := DashOffset + DashArray[DashIndex];
1973 if Odd(DashIndex) then
1974 begin
1975 Inc(J);
1976 SetLength(Result, J + 1);
1977 end;
1978 end;
1979 if not Odd(DashIndex) then
1980 AddPoint(Points[I].X, Points[I].Y);
1981 end;
1982
1983begin
1984 Result := nil;
1985 if Length(Points) <= 0 then Exit;
1986 DashIndex := -1;
1987 Offset := 0;
1988
1989 V := 0;
1990 for I := 0 to High(DashArray) do
1991 V := V + DashArray[I];
1992 DashOffset := Wrap(DashOffset, V);
1993
1994 DashOffset := DashOffset - V;
1995 while DashOffset < 0 do
1996 begin
1997 Inc(DashIndex);
1998 DashOffset := DashOffset + DashArray[DashIndex];
1999 end;
2000
2001 J := 0;
2002 // note to self: second dimension might not be zero by default!
2003 SetLength(Result, 1, 0);
2004
2005 if not Odd(DashIndex) then
2006 AddPoint(Points[0].X, Points[0].Y);
2007 for I := 1 to High(Points) do
2008 AddDash(I);
2009
2010 if Closed then
2011 begin
2012 AddDash(0);
2013 len1 := Length(Result[0]);
2014 len2 := Length(Result[J]);
2015 if (len1 > 0) and (len2 > 0) then
2016 begin
2017 SetLength(Result[0], len1 + len2 -1);
2018 Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFloatPoint) * len1);
2019 Move(Result[J][0], Result[0][0], SizeOf(TFloatPoint) * len2);
2020 SetLength(Result, J);
2021 Dec(J);
2022 end;
2023 end;
2024
2025 if (J >= 0) and (Length(Result[J]) = 0) then SetLength(Result, J);
2026end;
2027
2028function BuildDashedLine(const Points: TArrayOfFixedPoint;
2029 const DashArray: TArrayOfFixed; DashOffset: TFixed = 0;
2030 Closed: Boolean = False): TArrayOfArrayOfFixedPoint;
2031var
2032 I, J, DashIndex, Len1, Len2: Integer;
2033 Offset, Dist, v: TFixed;
2034 Delta: TFixedPoint;
2035
2036 procedure AddPoint(X, Y: TFixed);
2037 var
2038 K: Integer;
2039 begin
2040 K := Length(Result[J]);
2041 SetLength(Result[J], K + 1);
2042 Result[J][K].X := X;
2043 Result[J][K].Y := Y;
2044 end;
2045
2046 procedure AddDash(I: Integer);
2047 begin
2048 if i = 0 then
2049 begin
2050 Delta.X := Points[0].X - Points[High(Points)].X;
2051 Delta.Y := Points[0].Y - Points[High(Points)].Y;
2052 end else
2053 begin
2054 Delta.X := Points[I].X - Points[I - 1].X;
2055 Delta.Y := Points[I].Y - Points[I - 1].Y;
2056 end;
2057 Dist := GR32_Math.Hypot(Delta.X, Delta.Y);
2058 Offset := Offset + Dist;
2059 if (Dist > 0) then
2060 begin
2061 Delta.X := FixedDiv(Delta.X, Dist);
2062 Delta.Y := FixedDiv(Delta.Y, Dist);
2063 end;
2064 while Offset > DashOffset do
2065 begin
2066 v := Offset - DashOffset;
2067 AddPoint(Points[I].X - FixedMul(v, Delta.X), Points[I].Y - FixedMul(v,
2068 Delta.Y));
2069 DashIndex := (DashIndex + 1) mod Length(DashArray);
2070 DashOffset := DashOffset + DashArray[DashIndex];
2071 if Odd(DashIndex) then
2072 begin
2073 Inc(J);
2074 SetLength(Result, J + 1);
2075 end;
2076 end;
2077 if not Odd(DashIndex) then
2078 AddPoint(Points[I].X, Points[I].Y);
2079 end;
2080
2081begin
2082 Result := nil;
2083 if Length(Points) <= 0 then Exit;
2084 DashIndex := -1;
2085 Offset := 0;
2086
2087 V := 0;
2088 for I := 0 to High(DashArray) do
2089 V := V + DashArray[I];
2090 DashOffset := Wrap(DashOffset, V);
2091
2092 DashOffset := DashOffset - V;
2093 while DashOffset < 0 do
2094 begin
2095 Inc(DashIndex);
2096 DashOffset := DashOffset + DashArray[DashIndex];
2097 end;
2098
2099 J := 0;
2100 // note to self: second dimension might not be zero by default!
2101 SetLength(Result, 1, 0);
2102
2103 if not Odd(DashIndex) then
2104 AddPoint(Points[0].X, Points[0].Y);
2105 for I := 1 to High(Points) do
2106 AddDash(I);
2107
2108 if Closed then
2109 begin
2110 AddDash(0);
2111 Len1 := Length(Result[0]);
2112 Len2 := Length(Result[J]);
2113 if (Len1 > 0) and (Len2 > 0) then
2114 begin
2115 SetLength(Result[0], len1 + len2 -1);
2116 Move(Result[0][0], Result[0][len2 - 1], SizeOf(TFixedPoint) * Len1);
2117 Move(Result[J][0], Result[0][0], SizeOf(TFixedPoint) * Len2);
2118 SetLength(Result, J);
2119 Dec(J);
2120 end;
2121 end;
2122
2123 if (J >= 0) and (Length(Result[J]) = 0) then SetLength(Result, J);
2124end;
2125
2126function InterpolateX(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
2127var
2128 W: Double;
2129begin
2130 W := (X - P1.X) / (P2.X - P1.X);
2131 Result.X := X;
2132 Result.Y := P1.Y + W * (P2.Y - P1.Y);
2133end;
2134
2135function InterpolateY(Y: TFloat; const P1, P2: TFloatPoint): TFloatPoint; overload;
2136var
2137 W: Double;
2138begin
2139 W := (Y - P1.Y) / (P2.Y - P1.Y);
2140 Result.Y := Y;
2141 Result.X := P1.X + W * (P2.X - P1.X);
2142end;
2143
2144function GetCode(const P: TFloatPoint; const R: TFloatRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
2145begin
2146 Result := Ord(P.X >= R.Left) or
2147 (Ord(P.X <= R.Right) shl 1) or
2148 (Ord(P.Y >= R.Top) shl 2) or
2149 (Ord(P.Y <= R.Bottom) shl 3);
2150end;
2151
2152function ClipPolygon(const Points: TArrayOfFloatPoint; const ClipRect: TFloatRect): TArrayOfFloatPoint;
2153type
2154 TInterpolateProc = function(X: TFloat; const P1, P2: TFloatPoint): TFloatPoint;
2155const
2156 SAFEOVERSIZE = 5;
2157 POPCOUNT: array [0..15] of Integer =
2158 (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
2159var
2160 I, J, K, L, N: Integer;
2161 X, Y, Z, Code, Count: Integer;
2162 Codes: PByteArray;
2163 NextIndex: PIntegerArray;
2164 Temp: PFloatPointArray;
2165label
2166 ExitProc;
2167
2168 procedure AddPoint(Index: Integer; const P: TFloatPoint);
2169 begin
2170 Temp[K] := P;
2171 Codes[K] := GetCode(P, ClipRect);
2172 Inc(K);
2173 Inc(Count);
2174 end;
2175
2176 function ClipEdges(Mask: Integer; V: TFloat; Interpolate: TInterpolateProc): Boolean;
2177 var
2178 I, NextI, StopIndex: Integer;
2179 begin
2180 I := 0;
2181 while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
2182
2183 Result := I = K;
2184 if Result then { all points outside }
2185 begin
2186 ClipPolygon := nil;
2187 Result := True;
2188 Exit;
2189 end;
2190
2191 StopIndex := I;
2192 repeat
2193 NextI := NextIndex[I];
2194
2195 if Codes[NextI] and Mask = 0 then { inside -> outside }
2196 begin
2197 NextIndex[I] := K;
2198 NextIndex[K] := K + 1;
2199 AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
2200
2201 while Codes[NextI] and Mask = 0 do
2202 begin
2203 Dec(Count);
2204 Codes[NextI] := 0;
2205 I := NextI;
2206 NextI := NextIndex[I];
2207 end;
2208 { outside -> inside }
2209 NextIndex[I] := K;
2210 NextIndex[K] := NextI;
2211 AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
2212 end;
2213
2214 I := NextI;
2215 until I = StopIndex;
2216 end;
2217
2218begin
2219 N := Length(Points);
2220{$IFDEF USESTACKALLOC}
2221 Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
2222{$ELSE}
2223 GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
2224{$ENDIF}
2225 X := 15;
2226 Y := 0;
2227 for I := 0 to N - 1 do
2228 begin
2229 Code := GetCode(Points[I], ClipRect);
2230 Codes[I] := Code;
2231 X := X and Code;
2232 Y := Y or Code;
2233 end;
2234 if X = 15 then { all points inside }
2235 begin
2236 Result := Points;
2237 end
2238 else if Y <> 15 then { all points outside }
2239 begin
2240 Result := nil;
2241 end
2242 else
2243 begin
2244 Count := N;
2245 Z := Codes[N - 1];
2246 for I := 0 to N - 1 do
2247 begin
2248 Code := Codes[I];
2249 Inc(Count, POPCOUNT[Z xor Code]);
2250 Z := Code;
2251 end;
2252{$IFDEF USESTACKALLOC}
2253 Temp := StackAlloc(Count * SizeOf(TFloatPoint));
2254 NextIndex := StackAlloc(Count * SizeOf(TFloatPoint));
2255{$ELSE}
2256 GetMem(Temp, Count * SizeOf(TFloatPoint));
2257 GetMem(NextIndex, Count * SizeOf(TFloatPoint));
2258{$ENDIF}
2259
2260 Move(Points[0], Temp[0], N * SizeOf(TFloatPoint));
2261 for I := 0 to N - 2 do NextIndex[I] := I + 1;
2262 NextIndex[N - 1] := 0;
2263
2264 Count := N;
2265 K := N;
2266 if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
2267 if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
2268 if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
2269 if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
2270
2271 SetLength(Result, Count);
2272
2273 { start with first point inside the clipping rectangle }
2274 I := 0;
2275 while Codes[I] = 0 do
2276 I := NextIndex[I];
2277
2278 J := I;
2279 L := 0;
2280 repeat
2281 Result[L] := Temp[I];
2282 Inc(L);
2283 I := NextIndex[I];
2284 until I = J;
2285
2286ExitProc:
2287{$IFDEF USESTACKALLOC}
2288 StackFree(NextIndex);
2289 StackFree(Temp);
2290{$ELSE}
2291 FreeMem(NextIndex);
2292 FreeMem(Temp);
2293{$ENDIF}
2294 end;
2295{$IFDEF USESTACKALLOC}
2296 StackFree(Codes);
2297{$ELSE}
2298 FreeMem(Codes);
2299{$ENDIF}
2300end;
2301
2302function InterpolateX(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
2303var
2304 W: TFixed;
2305begin
2306 W := FixedDiv(X - P1.X, P2.X - P1.X);
2307 Result.X := X;
2308 Result.Y := P1.Y + FixedMul(W, P2.Y - P1.Y);
2309end;
2310
2311function InterpolateY(Y: TFixed; const P1, P2: TFixedPoint): TFixedPoint; overload;
2312var
2313 W: TFixed;
2314begin
2315 W := FixedDiv(Y - P1.Y, P2.Y - P1.Y);
2316 Result.Y := Y;
2317 Result.X := P1.X + FixedMul(W, P2.X - P1.X);
2318end;
2319
2320function GetCode(const P: TFixedPoint; const R: TFixedRect): Integer; overload; {$IFDEF USEINLINING}inline;{$ENDIF}
2321begin
2322 Result := Ord(P.X >= R.Left) or
2323 (Ord(P.X <= R.Right) shl 1) or
2324 (Ord(P.Y >= R.Top) shl 2) or
2325 (Ord(P.Y <= R.Bottom) shl 3);
2326end;
2327
2328function ClipPolygon(const Points: TArrayOfFixedPoint; const ClipRect: TFixedRect): TArrayOfFixedPoint;
2329type
2330 TInterpolateProc = function(X: TFixed; const P1, P2: TFixedPoint): TFixedPoint;
2331const
2332 SAFEOVERSIZE = 5;
2333 POPCOUNT: array [0..15] of Integer =
2334 (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);
2335var
2336 I, J, K, L, N: Integer;
2337 X, Y, Z, Code, Count: Integer;
2338 Codes: PByteArray;
2339 NextIndex: PIntegerArray;
2340 Temp: PFixedPointArray;
2341label
2342 ExitProc;
2343
2344 procedure AddPoint(Index: Integer; const P: TFixedPoint);
2345 begin
2346 Temp[K] := P;
2347 Codes[K] := GetCode(P, ClipRect);
2348 Inc(K);
2349 Inc(Count);
2350 end;
2351
2352 function ClipEdges(Mask: Integer; V: TFixed; Interpolate: TInterpolateProc): Boolean;
2353 var
2354 I, NextI, StopIndex: Integer;
2355 begin
2356 I := 0;
2357 while (I < K) and (Codes[I] and Mask = 0) do Inc(I);
2358
2359 Result := I = K;
2360 if Result then { all points outside }
2361 begin
2362 ClipPolygon := nil;
2363 Result := True;
2364 Exit;
2365 end;
2366
2367 StopIndex := I;
2368 repeat
2369 NextI := NextIndex[I];
2370
2371 if Codes[NextI] and Mask = 0 then { inside -> outside }
2372 begin
2373 NextIndex[I] := K;
2374 NextIndex[K] := K + 1;
2375 AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
2376
2377 while Codes[NextI] and Mask = 0 do
2378 begin
2379 Dec(Count);
2380 Codes[NextI] := 0;
2381 I := NextI;
2382 NextI := NextIndex[I];
2383 end;
2384 { outside -> inside }
2385 NextIndex[I] := K;
2386 NextIndex[K] := NextI;
2387 AddPoint(I, Interpolate(V, Temp[I], Temp[NextI]));
2388 end;
2389
2390 I := NextI;
2391 until I = StopIndex;
2392 end;
2393
2394begin
2395 N := Length(Points);
2396{$IFDEF USESTACKALLOC}
2397 Codes := StackAlloc(N * SAFEOVERSIZE * SizeOf(Byte));
2398{$ELSE}
2399 GetMem(Codes, N * SAFEOVERSIZE * SizeOf(Byte));
2400{$ENDIF}
2401 X := 15;
2402 Y := 0;
2403 for I := 0 to N - 1 do
2404 begin
2405 Code := GetCode(Points[I], ClipRect);
2406 Codes[I] := Code;
2407 X := X and Code;
2408 Y := Y or Code;
2409 end;
2410 if X = 15 then { all points inside }
2411 begin
2412 Result := Points;
2413 end
2414 else if Y <> 15 then { all points outside }
2415 begin
2416 Result := nil;
2417 end
2418 else
2419 begin
2420 Count := N;
2421 Z := Codes[N - 1];
2422 for I := 0 to N - 1 do
2423 begin
2424 Code := Codes[I];
2425 Inc(Count, POPCOUNT[Z xor Code]);
2426 Z := Code;
2427 end;
2428{$IFDEF USESTACKALLOC}
2429 Temp := StackAlloc(Count * SizeOf(TFixedPoint));
2430 NextIndex := StackAlloc(Count * SizeOf(TFixedPoint));
2431{$ELSE}
2432 GetMem(Temp, Count * SizeOf(TFixedPoint));
2433 GetMem(NextIndex, Count * SizeOf(TFixedPoint));
2434{$ENDIF}
2435
2436 Move(Points[0], Temp[0], N * SizeOf(TFixedPoint));
2437 for I := 0 to N - 2 do NextIndex[I] := I + 1;
2438 NextIndex[N - 1] := 0;
2439
2440 Count := N;
2441 K := N;
2442 if X and 1 = 0 then if ClipEdges(1, ClipRect.Left, InterpolateX) then goto ExitProc;
2443 if X and 2 = 0 then if ClipEdges(2, ClipRect.Right, InterpolateX) then goto ExitProc;
2444 if X and 4 = 0 then if ClipEdges(4, ClipRect.Top, InterpolateY) then goto ExitProc;
2445 if X and 8 = 0 then if ClipEdges(8, ClipRect.Bottom, InterpolateY) then goto ExitProc;
2446
2447 SetLength(Result, Count);
2448
2449 { start with first point inside the clipping rectangle }
2450 I := 0;
2451 while Codes[I] = 0 do
2452 I := NextIndex[I];
2453
2454 J := I;
2455 L := 0;
2456 repeat
2457 Result[L] := Temp[I];
2458 Inc(L);
2459 I := NextIndex[I];
2460 until I = J;
2461
2462ExitProc:
2463{$IFDEF USESTACKALLOC}
2464 StackFree(NextIndex);
2465 StackFree(Temp);
2466{$ELSE}
2467 FreeMem(NextIndex);
2468 FreeMem(Temp);
2469{$ENDIF}
2470 end;
2471{$IFDEF USESTACKALLOC}
2472 StackFree(Codes);
2473{$ELSE}
2474 FreeMem(Codes);
2475{$ENDIF}
2476end;
2477
2478function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFloatPoint): TArrayOfArrayOfFloatPoint;
2479var
2480 L1, L2: Integer;
2481begin
2482 L1 := Length(P1);
2483 L2 := Length(P2);
2484 SetLength(Result, L1 + L2);
2485 Move(P1[0], Result[0], L1 * SizeOf(TFloatPoint));
2486 Move(P2[0], Result[L1], L2 * SizeOf(TFloatPoint));
2487end;
2488
2489function CatPolyPolygon(const P1, P2: TArrayOfArrayOfFixedPoint): TArrayOfArrayOfFixedPoint; overload;
2490var
2491 L1, L2: Integer;
2492begin
2493 L1 := Length(P1);
2494 L2 := Length(P2);
2495 SetLength(Result, L1 + L2);
2496 Move(P1[0], Result[0], L1 * SizeOf(TFixedPoint));
2497 Move(P2[0], Result[L1], L2 * SizeOf(TFixedPoint));
2498end;
2499
2500function PolygonBounds(const Points: TArrayOfFloatPoint): TFloatRect;
2501var
2502 I: Integer;
2503begin
2504 Assert(Length(Points) > 0);
2505 Result.Left := Points[0].X;
2506 Result.Top := Points[0].Y;
2507 Result.Right := Points[0].X;
2508 Result.Bottom := Points[0].Y;
2509 for I := 1 to High(Points) do
2510 begin
2511 Result.Left := Min(Result.Left, Points[I].X);
2512 Result.Right := Max(Result.Right, Points[I].X);
2513 Result.Top := Min(Result.Top, Points[I].Y);
2514 Result.Bottom := Max(Result.Bottom, Points[I].Y);
2515 end;
2516end;
2517
2518function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect;
2519var
2520 I: Integer;
2521begin
2522 Assert(Length(Points) > 0);
2523 Result.Left := Points[0].X;
2524 Result.Top := Points[0].Y;
2525 Result.Right := Points[0].X;
2526 Result.Bottom := Points[0].Y;
2527 for I := 1 to High(Points) do
2528 begin
2529 Result.Left := Min(Result.Left, Points[I].X);
2530 Result.Right := Max(Result.Right, Points[I].X);
2531 Result.Top := Min(Result.Top, Points[I].Y);
2532 Result.Bottom := Max(Result.Bottom, Points[I].Y);
2533 end;
2534end;
2535
2536function PolypolygonBounds(const Points: TArrayOfArrayOfFloatPoint): TFloatRect;
2537var
2538 I: Integer;
2539 R: TFloatRect;
2540begin
2541 Assert(Length(Points) > 0);
2542 Result := PolygonBounds(Points[0]);
2543 for I := 1 to High(Points) do
2544 begin
2545 R := PolygonBounds(Points[I]);
2546 Result.Left := Min(Result.Left, R.Left);
2547 Result.Right := Max(Result.Right, R.Right);
2548 Result.Top := Min(Result.Top, R.Top);
2549 Result.Bottom := Max(Result.Bottom, R.Bottom);
2550 end;
2551end;
2552
2553function PolypolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect;
2554var
2555 I: Integer;
2556 R: TFixedRect;
2557begin
2558 Assert(Length(Points) > 0);
2559 Result := PolygonBounds(Points[0]);
2560 for I := 1 to High(Points) do
2561 begin
2562 R := PolygonBounds(Points[I]);
2563 Result.Left := Min(Result.Left, R.Left);
2564 Result.Right := Max(Result.Right, R.Right);
2565 Result.Top := Min(Result.Top, R.Top);
2566 Result.Bottom := Max(Result.Bottom, R.Bottom);
2567 end;
2568end;
2569
2570
2571// Scales to a polygon (TArrayOfFloatPoint)
2572function ScalePolygon(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat): TArrayOfFloatPoint;
2573var
2574 I, L: Integer;
2575begin
2576 L := Length(Points);
2577 SetLength(Result, L);
2578 for I := 0 to L - 1 do
2579 begin
2580 Result[I].X := Points[I].X * ScaleX;
2581 Result[I].Y := Points[I].Y * ScaleY;
2582 end;
2583end;
2584
2585// Scales to a polygon (TArrayOfFixedPoint)
2586function ScalePolygon(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed): TArrayOfFixedPoint;
2587var
2588 I, L: Integer;
2589begin
2590 L := Length(Points);
2591 SetLength(Result, L);
2592 for I := 0 to L - 1 do
2593 begin
2594 Result[I].X := FixedMul(Points[I].X, ScaleX);
2595 Result[I].Y := FixedMul(Points[I].Y, ScaleY);
2596 end;
2597end;
2598
2599// Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
2600function ScalePolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
2601 ScaleX, ScaleY: TFloat): TArrayOfArrayOfFloatPoint;
2602var
2603 I, L: Integer;
2604begin
2605 L := Length(Points);
2606 SetLength(Result, L);
2607 for I := 0 to L - 1 do
2608 Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
2609end;
2610
2611// Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
2612function ScalePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
2613 ScaleX, ScaleY: TFixed): TArrayOfArrayOfFixedPoint;
2614var
2615 I, L: Integer;
2616begin
2617 L := Length(Points);
2618 SetLength(Result, L);
2619 for I := 0 to L - 1 do
2620 Result[I] := ScalePolygon(Points[I], ScaleX, ScaleY);
2621end;
2622
2623// Scales a polygon (TArrayOfFloatPoint)
2624procedure ScalePolygonInplace(const Points: TArrayOfFloatPoint; ScaleX, ScaleY: TFloat);
2625var
2626 I: Integer;
2627begin
2628 for I := 0 to Length(Points) - 1 do
2629 begin
2630 Points[I].X := Points[I].X * ScaleX;
2631 Points[I].Y := Points[I].Y * ScaleY;
2632 end;
2633end;
2634
2635// Scales a polygon (TArrayOfFixedPoint)
2636procedure ScalePolygonInplace(const Points: TArrayOfFixedPoint; ScaleX, ScaleY: TFixed);
2637var
2638 I: Integer;
2639begin
2640 for I := 0 to Length(Points) - 1 do
2641 begin
2642 Points[I].X := FixedMul(Points[I].X, ScaleX);
2643 Points[I].Y := FixedMul(Points[I].Y, ScaleY);
2644 end;
2645end;
2646
2647// Scales all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
2648procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint;
2649 ScaleX, ScaleY: TFloat);
2650var
2651 I: Integer;
2652begin
2653 for I := 0 to Length(Points) - 1 do
2654 ScalePolygonInplace(Points[I], ScaleX, ScaleY);
2655end;
2656
2657// Scales all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
2658procedure ScalePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
2659 ScaleX, ScaleY: TFixed);
2660var
2661 I: Integer;
2662begin
2663 for I := 0 to Length(Points) - 1 do
2664 ScalePolygonInplace(Points[I], ScaleX, ScaleY);
2665end;
2666
2667// Translates a polygon (TArrayOfFloatPoint)
2668function TranslatePolygon(const Points: TArrayOfFloatPoint;
2669 OffsetX, OffsetY: TFloat): TArrayOfFloatPoint;
2670var
2671 I, Len: Integer;
2672begin
2673 Len := Length(Points);
2674 SetLength(Result, Len);
2675 for I := 0 to Len - 1 do
2676 begin
2677 Result[I].X := Points[I].X + OffsetX;
2678 Result[I].Y := Points[I].Y + OffsetY;
2679 end;
2680end;
2681
2682// Translates a polygon (TArrayOfFixedPoint)
2683function TranslatePolygon(const Points: TArrayOfFixedPoint;
2684 OffsetX, OffsetY: TFixed): TArrayOfFixedPoint;
2685var
2686 I, Len: Integer;
2687begin
2688 Len := Length(Points);
2689 SetLength(Result, Len);
2690 for I := 0 to Len - 1 do
2691 begin
2692 Result[I].X := Points[I].X + OffsetX;
2693 Result[I].Y := Points[I].Y + OffsetY;
2694 end;
2695end;
2696
2697// Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
2698function TranslatePolyPolygon(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
2699 OffsetY: TFloat): TArrayOfArrayOfFloatPoint;
2700var
2701 I, L: Integer;
2702begin
2703 L := Length(Points);
2704 SetLength(Result, L);
2705 for I := 0 to L - 1 do
2706 Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
2707end;
2708
2709// Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
2710function TranslatePolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
2711 OffsetX, OffsetY: TFixed): TArrayOfArrayOfFixedPoint;
2712var
2713 I, L: Integer;
2714begin
2715 L := Length(Points);
2716 SetLength(Result, L);
2717 for I := 0 to L - 1 do
2718 Result[I] := TranslatePolygon(Points[I], OffsetX, OffsetY);
2719end;
2720
2721procedure TranslatePolygonInplace(const Points: TArrayOfFloatPoint;
2722 OffsetX, OffsetY: TFloat);
2723var
2724 I: Integer;
2725begin
2726 for I := 0 to Length(Points) - 1 do
2727 begin
2728 Points[I].X := Points[I].X + OffsetX;
2729 Points[I].Y := Points[I].Y + OffsetY;
2730 end;
2731end;
2732
2733procedure TranslatePolygonInplace(const Points: TArrayOfFixedPoint;
2734 OffsetX, OffsetY: TFixed);
2735var
2736 I: Integer;
2737begin
2738 for I := 0 to Length(Points) - 1 do
2739 begin
2740 Points[I].X := Points[I].X + OffsetX;
2741 Points[I].Y := Points[I].Y + OffsetY;
2742 end;
2743end;
2744
2745// Translates all sub polygons in a complex polygon (TArrayOfArrayOfFloatPoint)
2746procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFloatPoint; OffsetX,
2747 OffsetY: TFloat);
2748var
2749 I: Integer;
2750begin
2751 for I := 0 to Length(Points) - 1 do
2752 TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
2753end;
2754
2755// Translates all sub polygons in a complex polygon (TArrayOfArrayOfFixedPoint)
2756procedure TranslatePolyPolygonInplace(const Points: TArrayOfArrayOfFixedPoint;
2757 OffsetX, OffsetY: TFixed);
2758var
2759 I: Integer;
2760begin
2761 for I := 0 to Length(Points) - 1 do
2762 TranslatePolygonInplace(Points[I], OffsetX, OffsetY);
2763end;
2764
2765// Applies transformation to a polygon (TArrayOfFloatPoint)
2766function TransformPolygon(const Points: TArrayOfFloatPoint;
2767 Transformation: TTransformation): TArrayOfFloatPoint;
2768var
2769 I: Integer;
2770begin
2771 SetLength(Result, Length(Points));
2772 for I := 0 to High(Result) do
2773 TTransformationAccess(Transformation).TransformFloat(Points[I].X,
2774 Points[I].Y, Result[I].X, Result[I].Y);
2775end;
2776
2777// Applies transformation to a polygon (TArrayOfFixedPoint)
2778function TransformPolygon(const Points: TArrayOfFixedPoint;
2779 Transformation: TTransformation): TArrayOfFixedPoint;
2780var
2781 I: Integer;
2782begin
2783 SetLength(Result, Length(Points));
2784 for I := 0 to High(Result) do
2785 TTransformationAccess(Transformation).TransformFixed(Points[I].X,
2786 Points[I].Y, Result[I].X, Result[I].Y);
2787end;
2788
2789// Applies transformation to all sub polygons in a complex polygon
2790function TransformPolyPolygon(const Points: TArrayOfArrayOfFloatPoint;
2791 Transformation: TTransformation): TArrayOfArrayOfFloatPoint;
2792var
2793 I: Integer;
2794begin
2795 SetLength(Result, Length(Points));
2796 TTransformationAccess(Transformation).PrepareTransform;
2797
2798 for I := 0 to High(Result) do
2799 Result[I] := TransformPolygon(Points[I], Transformation);
2800end;
2801
2802// Applies transformation to all sub polygons in a complex polygon
2803function TransformPolyPolygon(const Points: TArrayOfArrayOfFixedPoint;
2804 Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
2805var
2806 I: Integer;
2807begin
2808 SetLength(Result, Length(Points));
2809 TTransformationAccess(Transformation).PrepareTransform;
2810
2811 for I := 0 to High(Result) do
2812 Result[I] := TransformPolygon(Points[I], Transformation);
2813end;
2814
2815function BuildPolygonF(const Data: array of TFloat): TArrayOfFloatPoint;
2816var
2817 Index, Count: Integer;
2818begin
2819 Count := Length(Data) div 2;
2820 SetLength(Result, Count);
2821 if Count = 0 then Exit;
2822 for Index := 0 to Count - 1 do
2823 begin
2824 Result[Index].X := Data[Index * 2];
2825 Result[Index].Y := Data[Index * 2 + 1];
2826 end;
2827end;
2828
2829function BuildPolygonX(const Data: array of TFixed): TArrayOfFixedPoint;
2830var
2831 Index, Count: Integer;
2832begin
2833 Count := Length(Data) div 2;
2834 SetLength(Result, Count);
2835 if Count = 0 then Exit;
2836 for Index := 0 to Count - 1 do
2837 begin
2838 Result[Index].X := Data[Index * 2];
2839 Result[Index].Y := Data[Index * 2 + 1];
2840 end;
2841end;
2842
2843// Copy data from Polygon to simple PolyPolygon (using 1 sub polygon only)
2844function PolyPolygon(const Points: TArrayOfFloatPoint)
2845 : TArrayOfArrayOfFloatPoint;
2846begin
2847 SetLength(Result, 1);
2848 Result[0] := Points;
2849end;
2850
2851function PolyPolygon(const Points: TArrayOfFixedPoint)
2852 : TArrayOfArrayOfFixedPoint;
2853begin
2854 SetLength(Result, 1);
2855 Result[0] := Points;
2856end;
2857
2858function PointToFloatPoint(const Points: TArrayOfPoint): TArrayOfFloatPoint;
2859var
2860 Index: Integer;
2861begin
2862 if Length(Points) > 0 then
2863 begin
2864 SetLength(Result, Length(Points));
2865 for Index := 0 to Length(Points) - 1 do
2866 begin
2867 Result[Index].X := Points[Index].X;
2868 Result[Index].Y := Points[Index].Y;
2869 end;
2870 end;
2871end;
2872
2873function PointToFloatPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFloatPoint;
2874var
2875 Index, PointIndex: Integer;
2876begin
2877 if Length(Points) > 0 then
2878 begin
2879 SetLength(Result, Length(Points));
2880 for Index := 0 to Length(Points) - 1 do
2881 begin
2882 SetLength(Result[Index], Length(Points[Index]));
2883 for PointIndex := 0 to Length(Points[Index]) - 1 do
2884 begin
2885 Result[Index, PointIndex].X := Points[Index, PointIndex].X;
2886 Result[Index, PointIndex].Y := Points[Index, PointIndex].Y;
2887 end;
2888 end;
2889 end;
2890end;
2891
2892function PointToFixedPoint(const Points: TArrayOfPoint): TArrayOfFixedPoint;
2893var
2894 Index: Integer;
2895begin
2896 if Length(Points) > 0 then
2897 begin
2898 SetLength(Result, Length(Points));
2899 for Index := 0 to Length(Points) - 1 do
2900 begin
2901 Result[Index].X := Fixed(Points[Index].X);
2902 Result[Index].Y := Fixed(Points[Index].Y);
2903 end;
2904 end;
2905end;
2906
2907function PointToFixedPoint(const Points: TArrayOfArrayOfPoint): TArrayOfArrayOfFixedPoint;
2908var
2909 Index, PointIndex: Integer;
2910begin
2911 if Length(Points) > 0 then
2912 begin
2913 SetLength(Result, Length(Points));
2914 for Index := 0 to Length(Points) - 1 do
2915 begin
2916 SetLength(Result[Index], Length(Points[Index]));
2917 for PointIndex := 0 to Length(Points[Index]) - 1 do
2918 begin
2919 Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
2920 Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
2921 end;
2922 end;
2923 end;
2924end;
2925
2926// Converts an array of points in TFixed format to an array of points in TFloat format
2927function FixedPointToFloatPoint(const Points: TArrayOfFixedPoint)
2928 : TArrayOfFloatPoint;
2929var
2930 Index: Integer;
2931begin
2932 if Length(Points) > 0 then
2933 begin
2934 SetLength(Result, Length(Points));
2935 for Index := 0 to Length(Points) - 1 do
2936 begin
2937 Result[Index].X := Points[Index].X * FixedToFloat;
2938 Result[Index].Y := Points[Index].Y * FixedToFloat;
2939 end;
2940 end;
2941end;
2942
2943// Converts an array of array of points in TFixed format to an array of array of points in TFloat format
2944function FixedPointToFloatPoint(const Points: TArrayOfArrayOfFixedPoint)
2945 : TArrayOfArrayOfFloatPoint;
2946var
2947 Index, PointIndex: Integer;
2948begin
2949 if Length(Points) > 0 then
2950 begin
2951 SetLength(Result, Length(Points));
2952 for Index := 0 to Length(Points) - 1 do
2953 begin
2954 SetLength(Result[Index], Length(Points[Index]));
2955 for PointIndex := 0 to Length(Points[Index]) - 1 do
2956 begin
2957 Result[Index, PointIndex].X := Points[Index, PointIndex].X * FixedToFloat;
2958 Result[Index, PointIndex].Y := Points[Index, PointIndex].Y * FixedToFloat;
2959 end;
2960 end;
2961 end;
2962end;
2963
2964// Converts an array of points in TFixed format to an array of points in TFloat format
2965function FloatPointToFixedPoint(const Points: TArrayOfFloatPoint)
2966 : TArrayOfFixedPoint;
2967var
2968 Index: Integer;
2969begin
2970 if Length(Points) > 0 then
2971 begin
2972 SetLength(Result, Length(Points));
2973 for Index := 0 to Length(Points) - 1 do
2974 begin
2975 Result[Index].X := Fixed(Points[Index].X);
2976 Result[Index].Y := Fixed(Points[Index].Y);
2977 end;
2978 end;
2979end;
2980
2981// Converts an array of array of points in TFixed format to an array of array of points in TFloat format
2982function FloatPointToFixedPoint(const Points: TArrayOfArrayOfFloatPoint)
2983 : TArrayOfArrayOfFixedPoint;
2984var
2985 Index, PointIndex: Integer;
2986begin
2987 if Length(Points) > 0 then
2988 begin
2989 SetLength(Result, Length(Points));
2990 for Index := 0 to Length(Points) - 1 do
2991 begin
2992 SetLength(Result[Index], Length(Points[Index]));
2993 for PointIndex := 0 to Length(Points[Index]) - 1 do
2994 begin
2995 Result[Index, PointIndex].X := Fixed(Points[Index, PointIndex].X);
2996 Result[Index, PointIndex].Y := Fixed(Points[Index, PointIndex].Y);
2997 end;
2998 end;
2999 end;
3000end;
3001
3002end.
Note: See TracBrowser for help on using the repository browser.