paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 02:59:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add IsPointInPolygon and IsPolygonIntersectsPolygon utility functions

Browse Source 
git-svn-id: trunk@26699 -
This commit is contained in:
ask 2010-07-16 20:44:54 +00:00
parent 761b821f12
commit aa11530e5a
2 changed files with 103 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
components/tachart/tachartutils.pas
View File

@ -54,6 +54,8 @@ type
);
end;
TPointArray = array of TPoint;
TChartDistance = 0..MaxInt;
TPointDistFunc = function (const A, B: TPoint): Integer;
@ -189,8 +191,11 @@ procedure ExpandRect(var ARect: TDoubleRect; const APoint: TDoublePoint); inline
function GetIntervals(AMin, AMax: Double; AInverted: Boolean): TDoubleDynArray;
function IsPointOnLine(const AP, A1, A2: TPoint): Boolean; inline;
function IsPointInPolygon(
const AP: TPoint; const APolygon: array of TPoint): Boolean;
function IsPointInRect(const AP, A1, A2: TPoint): Boolean; inline;
function IsLineIntersectsLine(const AA, AB, AC, AD: TPoint): Boolean;
function IsPolygonIntersectsPolygon(const AP1, AP2: array of TPoint): Boolean;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
@ -425,6 +430,40 @@ begin
Result := IsPointInRect(AP, A1, A2) and (PointLineSide(AP, A1, A2) = 0);
end;
function IsPointInPolygon(
const AP: TPoint; const APolygon: array of TPoint): Boolean;
var
i, count: Integer;
p1, p2: TPoint;
s1, s2: TValueSign;
begin
if Length(APolygon) = 0 then exit(false);
p1 := APolygon[High(APolygon)];
for i := 0 to High(APolygon) do begin
p2 := APolygon[i];
if IsPointOnLine(AP, p1, p2) then exit(true);
p1 := p2;
end;
count := 0;
p1 := APolygon[High(APolygon)];
for i := 0 to High(APolygon) do begin
p2 := APolygon[i];
s1 := Sign(p1.Y - AP.Y);
s2 := Sign(p2.Y - AP.Y);
case s1 * s2 of
-1: count += Ord(PointLineSide(AP, p1, p2) = Sign(p1.Y - p2.Y));
0: if s1 + s2 = 1 then begin
if s1 = 0 then
count += Ord(p1.X >= AP.X)
else
count += Ord(p2.X >= AP.X)
end;
end;
p1 := p2;
end;
Result := count mod 2 = 1;
end;
function IsPointInRect(const AP, A1, A2: TPoint): Boolean;
begin
Result := SafeInRange(AP.X, A1.X, A2.X) and SafeInRange(AP.Y, A1.Y, A2.Y);
@ -448,6 +487,24 @@ begin
end;
end;
function IsPolygonIntersectsPolygon(const AP1, AP2: array of TPoint): Boolean;
var
i, j: Integer;
p1, p2: TPoint;
begin
if (Length(AP1) = 0) or (Length(AP2) = 0) then exit(false);
if IsPointInPolygon(AP1[0], AP2) or IsPointInPolygon(AP2[0], AP1) then
exit(true);
for i := 0 to High(AP1) do begin
p1 := AP1[i];
p2 := AP1[(i + 1) mod Length(AP1)];
for j := 0 to High(AP2) do
if IsLineIntersectsLine(p1, p2, AP2[j], AP2[(j + 1) mod Length(AP2)]) then
exit(true);
end;
Result := false;
end;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
var

46
components/tachart/test/UtilsTest.pas
View File

@ -49,6 +49,8 @@ type
procedure TestLineIntersectsLine;
procedure TestLineIntersectsRect;
procedure TestPointOnLine;
procedure TestPointInPolygon;
procedure TestPolygonIntersectsPolygon;
end;
@ -183,6 +185,27 @@ begin
Check(p1, p2, DoublePoint(11.6667, 10), DoublePoint(13.3333, 0));
end;
procedure TGeometryTest.TestPointInPolygon;
var
p: TPoint;
r: array [1..4] of TPoint =
((X: 0; Y: 0), (X: 10; Y: 0), (X: 10; Y: 5), (X: 0; Y: 5));
begin
p := Point(1, 1);
AssertFalse(IsPointInPolygon(p, []));
AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(3, 0)]));
AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(3, 1)]));
AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(1, 1)]));
AssertFalse(IsPointInPolygon(p, [Point(2, 0), Point(2, 2), Point(3, 1)]));
AssertFalse(IsPointInPolygon(p, [Point(2, 0), Point(1, 2), Point(0, 10)]));
AssertTrue(IsPointInPolygon(Point(5, 5), r));
AssertTrue(IsPointInPolygon(Point(10, 5), r));
AssertFalse(IsPointInPolygon(Point(11, 5), r));
AssertFalse(IsPointInPolygon(Point(0, -1), r));
end;
procedure TGeometryTest.TestPointOnLine;
begin
AssertTrue(IsPointOnLine(Point(0, 0), Point(-1, -1), Point(1, 1)));
@ -195,6 +218,29 @@ begin
AssertFalse(IsPointOnLine(Point(0, 1), Point(-1, 0), Point(1, 0)));
end;
procedure TGeometryTest.TestPolygonIntersectsPolygon;
function OffsetPolygon(AP: array of TPoint; AOffset: TPoint): TPointArray;
var
i: Integer;
begin
SetLength(Result, Length(AP));
for i := 0 to High(AP) do
Result[i] := AP[i] + AOffset;
end;
var
p1: array [1..4] of TPoint =
((X: 0; Y: 0), (X: 10; Y: 0), (X: 10; Y: 5), (X: 0; Y: 5));
begin
AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(0, 0))));
AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(1, 1))));
AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(5, 0))));
AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(10, 0))));
AssertFalse(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(11, 0))));
AssertFalse(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(0, -6))));
end;
initialization
RegisterTests([TIntervalListTest, TGeometryTest]);