function TPBDelaunyTriangulation.InCircle(
const NodeIndex, TriangleIndex: integer): boolean;
var
A, B, C: integer;
xC, yC, m1, m2, mx1, mx2, my1, my2, SqrR1, SqrR2: double;
begin
A := FA[TriangleIndex];
B :=
FB[TriangleIndex];
C := FC[TriangleIndex];
if SameValue(FY[B], FY[A])
then
begin
m2 := -(FX[C] - FX[B]) / (FY[C] - FY[B]);
mx2 := (FX[B] + FX[C]) / 2;
my2 := (FY[B] + FY[C]) / 2;
xC := (FX[B] + FX[A]) / 2;
yC := m2 * (xC - mx2) + my2;
end
else
if SameValue(FY[C], FY[B])
then
begin
m1 := -(FX[B] - FX[A]) / (FY[B] - FY[A]);
mx1 := (FX[A] + FX[B]) / 2;
my1 := (FY[A] + FY[B]) / 2;
xC := (FX[C] + FX[B]) / 2;
yC := m1 * (xC - mx1) + my1;
end
else
begin
m1 := -(FX[B] - FX[A]) / (FY[B] - FY[A]);
m2 := -(FX[C] - FX[B]) / (FY[C] - FY[B]);
mx1 := (FX[A] + FX[B]) / 2;
mx2 := (FX[B] + FX[C]) / 2;
my1 := (FY[A] + FY[B]) / 2;
my2 := (FY[B] + FY[C]) / 2;
if not SameValue(m1 - m2, 0)
then
begin
xC := (m1 * mx1 - m2 * mx2 + my2 - my1) / (m1 - m2);
yC := m1 * (xC - mx1) + my1;
end
else
begin
xC := (FX[A] + FX[B] + FX[C]) / 3;
yC := (FY[A] + FY[B] + FY[C]) / 3;
end;
end;
SqrR1 := Sqr(FX[NodeIndex] - xC) + Sqr(FY[NodeIndex] - yC);
SqrR2 := Sqr(FX[B] - xC) + Sqr(FY[B] - yC);
Result := CompareValue(SqrR1, SqrR2) <= 0;
// = PtInCirlc(X, Y, xC, yC, R2);
end;
procedure TPBDelaunyTriangulation.RemoveInvalidEdges;
var
I, J: integer;
begin
for I := 1
to FEdgesCount - 1
do
if (FLeft[I] <> 0)
and (FRight[I] <> 0)
then
for J := I + 1
to FEdgesCount
do
if (FLeft[J] <> 0)
and (FRight[J] <> 0)
then
if (FLeft[I] = FRight[J])
and (FRight[I] = FLeft[J])
then
begin
FLeft[I] := 0;
FRight[I] := 0;
FLeft[J] := 0;
FRight[J] := 0;
end;
end;
function TPBDelaunyTriangulation.Triangulate: integer;
var
Triangle, Node, I: integer;
begin
SetSuperTriangle;
TriangulateClear;
Result := 1;
try
for Node := 1
to FNodesCount
do
begin
FEdgesCount := 0;
Triangle := 0;
while Triangle < Result
do
begin
Inc(Triangle);
if InCircle(Node, Triangle)
then
begin
FLeft[FEdgesCount + 1] := FA[Triangle];
FRight[FEdgesCount + 1] :=
FB[Triangle];
FLeft[FEdgesCount + 2] :=
FB[Triangle];
FRight[FEdgesCount + 2] := FC[Triangle];
FLeft[FEdgesCount + 3] := FC[Triangle];
FRight[FEdgesCount + 3] := FA[Triangle];
Inc(FEdgesCount, 3);
FA[Triangle] := FA[Result];
FB[Triangle] :=
FB[Result];
FC[Triangle] := FC[Result];
Dec(Triangle);
Dec(Result);
end;
end;
RemoveInvalidEdges;
for I := 1
to FEdgesCount
do
if (FLeft[I] <> 0)
and (FRight[I] <> 0)
then
begin
Inc(Result);
FA[Result] := FLeft[I];
FB[Result] := FRight[I];
FC[Result] := Node;
end;
end;
finally
FTrianglesCount := DeleteSuperTriangle(Result);
end;
end;