function Intersect(const x1, y1, x2, y2, x3, y3, x4, y4: Double): Boolean;
var
UpperX: Double;
UpperY: Double;
LowerX: Double;
LowerY: Double;
Ax: Double;
Bx: Double;
Cx: Double;
Ay: Double;
By: Double;
Cy: Double;
D: Double;
F: Double;
E: Double;
begin
Result := False;
Ax := x2 - x1;
Bx := x3 - x4;
if Ax < 0.0 then
begin
LowerX := x2;
UpperX := x1;
end
else
begin
UpperX := x2;
LowerX := x1;
end;
if Bx > 0.0 then
begin
if (UpperX < x4) or (x3 < LowerX) then
Exit;
end
else if (Upperx < x3) or (x4 < LowerX) then
Exit;
Ay := y2 - y1;
By := y3 - y4;
if Ay < 0.0 then
begin
LowerY := y2;
UpperY := y1;
end
else
begin
UpperY := y2;
LowerY := y1;
end;
if By > 0.0 then
begin
if (UpperY < y4) or (y3 < LowerY) then
Exit;
end
else if (UpperY < y3) or (y4 < LowerY) then
Exit;
Cx := x1 - x3;
Cy := y1 - y3;
d := (By * Cx) - (Bx * Cy);
f := (Ay * Bx) - (Ax * By);
if f > 0.0 then
begin
if (d < 0.0) or (d > f) then
Exit;
end
else if (d > 0.0) or (d < f) then
Exit;
e := (Ax * Cy) - (Ay * Cx);
if f > 0.0 then
begin
if (e < 0.0) or (e > f) then
Exit;
end
else if (e > 0.0) or (e < f) then
Exit;
Result := True;
(*
Simple method, yet not so accurate for certain situations and a little more
inefficient (roughly 19.5%).
Result := (
((Orientation(x1,y1, x2,y2, x3,y3) * Orientation(x1,y1, x2,y2, x4,y4)) <= 0) and
((Orientation(x3,y3, x4,y4, x1,y1) * Orientation(x3,y3, x4,y4, x2,y2)) <= 0)
);
*)
end;
{---------------------------------------------------------------------
Two routines are made available, the first takes into account a segment
and will produce point on the given segment that is of least distance
to an external point.
The second routine is similar to the first other than the fact that it
will extended the given segment into a ray and hence also produce a point
on the ray which will produce a segment of least distance between that
point and an external point, the segment produced between the point on
the ray and the external point is guaranteed to be perpendicular to the
ray in all cases except for the instance where the external point is
collinear to ray.
Both routines come from the computational geometry library
FastGEO (url: http://fastgeo.partow.net)
---------------------------------------------------------------------}
procedure PerpendicularPntToSegment(const x1, y1, x2, y2, Px, Py: Double;
out Nx, Ny: Double);
var
Ratio: Double;
Dx: Double;
Dy: Double;
begin
Dx := x2 - x1;
Dy := y2 - y1;
Ratio := ((Px - x1) * Dx + (Py - y1) * Dy) / (Dx * Dx + Dy * Dy);
if Ratio < 0 then
begin
Nx := x1;
Ny := y1;
end
else if Ratio > 1 then
begin
Nx := x2;
Ny := y2;
end
else
begin
Nx := x1 + (Ratio * Dx);
Ny := y1 + (Ratio * Dy);
end;
end;
(* End PerpendicularPntSegment *)
procedure PerpendicularPntToLine(const Rx1, Ry1, Rx2, Ry2, Px, Py: Double;
out Nx, Ny: Double);
var
Ratio: Double;
Gr1, Gr2: Double;
Gr3, Gr4: Double;
begin
(* The ray is defined by the coordinate pairs (Rx1,Ry1) and (Rx2,Ry2) *)
if NotEqual(Rx1, Rx2) then
Gr1 := (Ry2 - Ry1) / (Rx2 - Rx1)
else
Gr1 := 1e300;
Gr3 := Ry1 - Gr1 * Rx1;
if NotEqual(Gr1, 0) then
begin
Gr2 := -1 / Gr1;
Gr4 := Py - (Gr2 * Px);
Ratio := (Gr4 - Gr3) / (Gr1 - Gr2);
Nx := Ratio;
Ny := (Gr2 * Ratio) + Gr4;
end
else
begin
Nx := Px;
Ny := Ry2;
end;
end;
(* End PerpendicularPntToLine *)
---------------------------------------
http://www.swissdelphicenter.ch/torry/showcode.php?id=2229
test if 2 lines cross and find the intersection?
Author: Peter Bone
// determine if 2 line cross given their end-points
function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TPoint) : boolean;
Var
diffLA, diffLB : TPoint;
CompareA, CompareB : integer;
begin
Result := False;
diffLA := Subtract(LineAP2, LineAP1);
diffLB := Subtract(LineBP2, LineBP1);
CompareA := diffLA.X*LineAP1.Y - diffLA.Y*LineAP1.X;
CompareB := diffLB.X*LineBP1.Y - diffLB.Y*LineBP1.X;
if ( ((diffLA.X*LineBP1.Y - diffLA.Y*LineBP1.X) < CompareA) xor
((diffLA.X*LineBP2.Y - diffLA.Y*LineBP2.X) < CompareA) ) and
( ((diffLB.X*LineAP1.Y - diffLB.Y*LineAP1.X) < CompareB) xor
((diffLB.X*LineAP2.Y - diffLB.Y*LineAP2.X) < CompareB) ) then
Result := True;
end;
function LineIntersect(LineAP1, LineAP2, LineBP1, LineBP2 : TPoint) : TPointFloat;
Var
LDetLineA, LDetLineB, LDetDivInv : Real;
LDiffLA, LDiffLB : TPoint;
begin
LDetLineA := LineAP1.X*LineAP2.Y - LineAP1.Y*LineAP2.X;
LDetLineB := LineBP1.X*LineBP2.Y - LineBP1.Y*LineBP2.X;
LDiffLA := Subtract(LineAP1, LineAP2);
LDiffLB := Subtract(LineBP1, LineBP2);
LDetDivInv := 1 / ((LDiffLA.X*LDiffLB.Y) - (LDiffLA.Y*LDiffLB.X));
Result.X := ((LDetLineA*LDiffLB.X) - (LDiffLA.X*LDetLineB)) * LDetDivInv;
Result.Y := ((LDetLineA*LDiffLB.Y) - (LDiffLA.Y*LDetLineB)) * LDetDivInv;
end;
function Subtract(AVec1, AVec2 : TPoint) : TPoint;
begin
Result.X := AVec1.X - AVec2.X;
Result.Y := AVec1.Y - AVec2.Y;
end;