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

TAChart: Add SafeInRange and IsPointOnLine utility functions

Browse Source 
git-svn-id: trunk@26688 -
This commit is contained in:
ask 2010-07-16 16:35:50 +00:00
parent 6e6c409098
commit 67561b71a3
3 changed files with 38 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/tachart/tachartutils.pas
View File

@ -188,6 +188,7 @@ 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;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
@ -203,6 +204,8 @@ function RectIntersectsRect(
function RoundChecked(A: Double): Integer; inline;
function SafeInRange(AValue, ABound1, ABound2: Double): Boolean;
// Call this to silence 'parameter is unused' hint
procedure Unused(const A1);
procedure Unused(const A1, A2);
@ -413,6 +416,14 @@ begin
end;
end;
function IsPointOnLine(const AP, A1, A2: TPoint): Boolean;
begin
Result :=
SafeInRange(AP.X, A1.X, A2.X) and
SafeInRange(AP.Y, A1.Y, A2.Y) and
((AP.X - A1.X) * (A2.Y - A1.Y) = (AP.Y - A1.Y) * (A2.X - A1.X));
end;
function LineIntersectsRect(
var AA, AB: TDoublePoint; const ARect: TDoubleRect): Boolean;
var
@ -512,6 +523,13 @@ begin
end;
{$HINTS OFF}
function SafeInRange(AValue, ABound1, ABound2: Double): Boolean;
begin
EnsureOrder(ABound1, ABound2);
Result := InRange(AValue, ABound1, ABound2);
end;
procedure Unused(const A1);
begin
end;

4
components/tachart/tasources.pas
View File

@ -22,7 +22,7 @@ unit TASources;
interface
uses
Classes, Graphics, SysUtils, Types, TAChartUtils, TADrawUtils;
Classes, Graphics, SysUtils, Types, TAChartUtils;
type
EEditableSourceRequired = class(EChartError);
@ -217,7 +217,7 @@ procedure SetDataItemDefaults(var AItem: TChartDataItem);
implementation
uses
LCLIntf, Math, StrUtils;
LCLIntf, Math, StrUtils, TADrawUtils;
{$IFOPT R+}{$DEFINE RangeChecking}{$ELSE}{$UNDEF RangeChecking}{$ENDIF}
{$IFOPT Q+}{$DEFINE OverflowChecking}{$ELSE}{$UNDEF OverflowChecking}{$ENDIF}

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

@ -47,6 +47,7 @@ type
procedure AssertEquals(const Expected, Actual: TDoublePoint); overload;
published
procedure TestLineIntersectsRect;
procedure TestPointOnLine;
end;
@ -144,21 +145,38 @@ begin
p1 := DoublePoint(-1, -1);
p2 := DoublePoint(0, 20);
AssertFalse(LineIntersectsRect(p1, p2, r));
p1 := DoublePoint(100, 20);
AssertFalse(LineIntersectsRect(p1, p2, r));
p1 := DoublePoint(-1, -1);
p2 := DoublePoint(1, 1);
Check(p1, p2, DoublePoint(0, 0), p2);
p1 := DoublePoint(0, 0);
Check(p1, p2, p1, p2);
p1 := DoublePoint(20, 20);
p2 := DoublePoint(20, -10);
Check(p1, p2, DoublePoint(20, 10), DoublePoint(20, 0));
p1 := DoublePoint(10, 20);
p2 := DoublePoint(15, -10);
Check(p1, p2, DoublePoint(11.6667, 10), DoublePoint(13.3333, 0));
end;
procedure TGeometryTest.TestPointOnLine;
begin
AssertTrue(IsPointOnLine(Point(0, 0), Point(-1, -1), Point(1, 1)));
AssertFalse(IsPointOnLine(Point(1, 0), Point(-1, -1), Point(1, 1)));
AssertTrue(IsPointOnLine(Point(0, 0), Point(0, -1), Point(0, 1)));
AssertFalse(IsPointOnLine(Point(-1, 0), Point(0, -1), Point(0, 1)));
AssertTrue(IsPointOnLine(Point(0, 0), Point(-1, 0), Point(1, 0)));
AssertFalse(IsPointOnLine(Point(0, 1), Point(-1, 0), Point(1, 0)));
end;
initialization
RegisterTests([TIntervalListTest, TGeometryTest]);