unit uPolyeder;
// (c) 28.04.1985, 2.05.2012 Thomas Abel, Edgar Zocher
interface
uses
SysUtils, Dialogs;
const
MaxPoints = 500;
// NEck (Sprich N-Eck), Polyeder
MaxBegrenzungsEbenen = 50;
// Polyeder
MaxPointsJeBegrenzungsEbene = 20;
// Polyeder
type
TD2Point =
record
X, Y: double;
end;
TD2Points =
array [0..MaxPoints]
of TD2Point;
// Siehe auch CloseNEck
TNEck =
class
private
FCount: integer;
// Anzahl der Punkte
FPoints: TD2Points;
function Determinante(
const I: integer): double;
procedure CloseNEck;
function GetPoint(
Index: integer): TD2Point;
procedure SetPoint(
const Index: integer;
const X, Y: double);
procedure PutPoint(
Index: integer;
const Value: TD2Point);
public
property Points[
Index: integer]: TD2Point
read GetPoint
write PutPoint;
property Count: integer
read FCount;
procedure Clear;
procedure AddPoint(
const X, Y: double);
overload;
procedure AddPoint(
const Index: integer);
overload;
procedure DelPoint(
const Index: integer);
procedure InsPoint(
const Index: integer;
const X, Y: double);
function Schwerpunkt: TD2Point;
function Flaeche: double;
constructor Create;
end;
TD3Point =
record
X, Y, Z: double;
Exist: boolean;
end;
TD3Points =
array [0..MaxPoints - 1]
of TD3Point;
TBegrenzungsEbene =
record
Count: integer;
PointNumbers:
array [0..MaxPointsJeBegrenzungsEbene - 1]
of integer;
procedure AddPointNumber(
const Value: integer);
procedure DelPointNumber(
const Index: integer);
procedure InsPointNumber(
const Index, Value: integer);
procedure Clear;
end;
TBegrenzungsEbenen =
array [0..MaxBegrenzungsEbenen - 1]
of TBegrenzungsEbene;
TPolyederPoints =
array [1..3, 1..3]
of double;
TPolyeder =
class
private
FN: integer;
// Anzahl der BegrenzungsEbenen
FCount: integer;
// Anzahl der Punkte
FPoints: TD3Points;
FEbenen: TBegrenzungsEbenen;
function Determinante(
const U, V, W: integer): double;
function PolyederPoints(
const U, V, W: integer): TPolyederPoints;
function GetBegrenzungsEbene(
Index: integer): TBegrenzungsEbene;
function GetPoint(
Index: integer): TD3Point;
procedure SetPoint(
const Index: integer;
const X, Y, Z: double;
const Exist: boolean);
procedure PutPoint(
Index: integer;
const Value: TD3Point);
procedure PutBegrenzungsEbene(
Index: integer;
const Value: TBegrenzungsEbene);
public
property Points[
Index: integer]: TD3Point
read GetPoint
write PutPoint;
property Ebenen[
Index: integer]: TBegrenzungsEbene
read GetBegrenzungsEbene
write PutBegrenzungsEbene;
property Count: integer
read FCount;
property N: integer
read FN;
procedure Clear;
procedure AddPoint(
const X, Y, Z: double);
procedure DelPoint(
const Index: integer);
procedure InsPoint(
const Index: integer;
const X, Y, Z: double);
procedure AddBegrenzungsEbene(
const PointNumbers:
array of integer);
procedure DelBegrenzungsEbene(
const Index: integer);
procedure InsBegrenzungsEbene(
const Index: integer;
const PointNumbers:
array of integer);
function Schwerpunkt: TD3Point;
function Volumen: double;
constructor Create;
end;
implementation
{ NEck }
function TNEck.GetPoint(
Index: integer): TD2Point;
begin
Result:= FPoints[
Index];
end;
procedure TNEck.PutPoint(
Index: integer;
const Value: TD2Point);
begin
FPoints[
Index]:= Value;
end;
procedure TNEck.SetPoint(
const Index: integer;
const X, Y: double);
begin
FPoints[
Index].X:= X;
FPoints[
Index].Y:= Y;
end;
procedure TNEck.AddPoint(
const X, Y: double);
begin
Inc(FCount);
SetPoint(FCount - 1, X, Y);
end;
procedure TNEck.AddPoint(
const Index: integer);
begin
AddPoint(FPoints[
Index].X, FPoints[
Index].Y);
end;
procedure TNEck.DelPoint(
const Index: integer);
var
I: integer;
begin
for I:=
Index to FCount - 2
do
FPoints[I]:= FPoints[I + 1];
Dec(FCount);
end;
procedure TNEck.InsPoint(
const Index: integer;
const X, Y: double);
var
I: integer;
begin
Inc(FCount);
for I:= FCount - 1
downto Index + 1
do
FPoints[I]:= FPoints[I - 1];
SetPoint(
Index, X, Y)
end;
function TNEck.Determinante(
const I: integer): double;
begin
Result:= FPoints[I].X * FPoints[I + 1].Y - FPoints[I].Y * FPoints[I + 1].X;
end;
procedure TNEck.CloseNEck;
begin
FPoints[FCount].X:= FPoints[0].X;
FPoints[FCount].Y:= FPoints[0].Y;
end;
function TNEck.Flaeche: double;
var
I: integer;
begin
Result:= 0;
CloseNEck;
for I:= 0
to FCount - 1
do
Result:= Result + Determinante(I) / 2;
end;
function TNEck.Schwerpunkt: TD2Point;
var
I: integer;
begin
Result.X:= 0;
Result.Y:= 0;
CloseNEck;
for I:= 0
to FCount - 1
do
begin
Result.X:= Result.X + (FPoints[I].X + FPoints[I + 1].X) * Determinante(I) / 6;
Result.Y:= Result.Y + (FPoints[I].Y + FPoints[I + 1].Y) * Determinante(I) / 6;
end;
Result.X:= Result.X / Flaeche;
Result.Y:= Result.Y / Flaeche;
end;
procedure TNEck.Clear;
begin
FCount:= 0;
end;
constructor TNEck.Create;
begin
inherited Create;
Clear;
end;
{ TBegrenzungsEbene }
procedure TBegrenzungsEbene.Clear;
begin
Count:= 0;
end;
procedure TBegrenzungsEbene.AddPointNumber(
const Value: integer);
begin
Inc(Count);
PointNumbers[Count - 1]:= Value;
end;
procedure TBegrenzungsEbene.DelPointNumber(
const Index: integer);
var
I: integer;
begin
for I:=
Index to Count - 2
do
PointNumbers[I]:= PointNumbers[I + 1];
Dec(Count);
end;
procedure TBegrenzungsEbene.InsPointNumber(
const Index, Value: integer);
var
I: integer;
begin
Inc(Count);
for I:= Count - 1
downto Index + 1
do
PointNumbers[I]:= PointNumbers[I - 1];
PointNumbers[
Index]:= Value;
end;
{ TPolyeder }
function TPolyeder.GetPoint(
Index: integer): TD3Point;
begin
Result:= FPoints[
Index];
end;
procedure TPolyeder.PutPoint(
Index: integer;
const Value: TD3Point);
begin
FPoints[
Index]:= Value;
end;
procedure TPolyeder.SetPoint(
const Index: integer;
const X, Y, Z: double;
const Exist: boolean);
begin
FPoints[
Index].X:= X;
FPoints[
Index].Y:= Y;
FPoints[
Index].Z:= Z;
FPoints[
Index].Exist:= Exist;
end;
procedure TPolyeder.AddPoint(
const X, Y, Z: double);
begin
Inc(FCount);
SetPoint(FCount - 1, X, Y, Z, true);
end;
procedure TPolyeder.DelPoint(
const Index: integer);
var
I: integer;
begin
for I:=
Index to FCount - 2
do
FPoints[I]:= FPoints[I + 1];
FPoints[FCount - 1].Exist:= false;
Dec(FCount);
end;
procedure TPolyeder.InsPoint(
const Index: integer;
const X, Y, Z: double);
var
I: integer;
begin
Inc(FCount);
for I:= FCount - 1
downto Index + 1
do
FPoints[I]:= FPoints[I - 1];
SetPoint(
Index, X, Y, Z, true);
end;
function TPolyeder.GetBegrenzungsEbene(
Index: integer): TBegrenzungsEbene;
begin
Result:= FEbenen[
Index];
end;
procedure TPolyeder.PutBegrenzungsEbene(
Index: integer;
const Value: TBegrenzungsEbene);
begin
FEbenen[
Index]:= Value;
end;
procedure TPolyeder.AddBegrenzungsEbene(
const PointNumbers:
array of integer);
var
I: integer;
begin
Inc(FN);
for I:= 0
to Length(PointNumbers) - 1
do
FEbenen[FN - 1].AddPointNumber(PointNumbers[I]);
end;
procedure TPolyeder.DelBegrenzungsEbene(
const Index: integer);
var
I: integer;
begin
for I:=
Index to FN - 2
do
FEbenen[I]:= FEbenen[I + 1];
Dec(FN);
end;
procedure TPolyeder.InsBegrenzungsEbene(
const Index: integer;
const PointNumbers:
array of integer);
var
I: integer;
Value: TBegrenzungsEbene;
begin
Value.Clear;
for I:= 0
to Length(PointNumbers) - 1
do
Value.AddPointNumber(PointNumbers[I]);
Inc(FN);
for I:= FN - 1
downto Index + 1
do
FEbenen[I]:= FEbenen[I - 1];
FEbenen[
Index]:= Value;
end;
function TPolyeder.PolyederPoints(
const U, V, W: integer): TPolyederPoints;
begin
if not FPoints[U].Exist
then
raise Exception.Create('
Punkt '+IntToStr(U) + '
existiert nicht.');
if not FPoints[V].Exist
then
raise Exception.Create('
Punkt '+IntToStr(V) + '
existiert nicht.');
if not FPoints[W].Exist
then
raise Exception.Create('
Punkt '+IntToStr(W) + '
existiert nicht.');
Result[1, 1]:= FPoints[U].X;
Result[2, 1]:= FPoints[U].Y;
Result[3, 1]:= FPoints[U].Z;
Result[1, 2]:= FPoints[V].X;
Result[2, 2]:= FPoints[V].Y;
Result[3, 2]:= FPoints[V].Z;
Result[1, 3]:= FPoints[W].X;
Result[2, 3]:= FPoints[W].Y;
Result[3, 3]:= FPoints[W].Z;
end;
function TPolyeder.Determinante(
const U, V, W: integer): double;
var
P: TPolyederPoints;
begin
P:= PolyederPoints(U, V, W);
Result:= P[1, 1] * (P[2, 2] * P[3, 3] - P[3, 2] * P[2, 3])
- P[2, 1] * (P[1, 2] * P[3, 3] - P[3, 2] * P[1, 3])
+ P[3, 1] * (P[1, 2] * P[2, 3] - P[2, 2] * P[1, 3]);
end;
function TPolyeder.Volumen: double;
var
I, J, U, V, W: integer;
E: TBegrenzungsEbene;
begin
Result:= 0;
for I:= 0
to FN - 1
do
begin
E:= FEbenen[I];
U:= E.PointNumbers[0];
V:= E.PointNumbers[1];
for J:= 2
to E.Count - 1
do
begin
W:= E.PointNumbers[J];
Result:= Result + Determinante(U, V, W) / 6;
V:= W;
end;
end;
end;
function TPolyeder.Schwerpunkt: TD3Point;
var
I, J, U, V, W, k1, k2: integer;
E: TBegrenzungsEbene;
M:
array [1..3]
of double;
T: double;
P: TPolyederPoints;
begin
for k1:= 1
to 3
do
M[k1]:= 0;
for I:= 0
to FN - 1
do
begin
E:= FEbenen[I];
U:= E.PointNumbers[0];
V:= E.PointNumbers[1];
for J:= 2
to E.Count - 1
do
begin
W:= E.PointNumbers[J];
P:= PolyederPoints(U, V, W);
for k1:= 1
to 3
do
begin
T:= 0;
for k2:= 1
to 3
do
T:= T + P[k1, k2];
M[k1]:= M[k1] + Determinante(U, V, W) / 24 * T;
end;
V:= W;
end;
end;
Result.X:= M[1] / Volumen;
Result.Y:= M[2] / Volumen;
Result.Z:= M[3] / Volumen;
end;
procedure TPolyeder.Clear;
var
I: integer;
begin
FCount:= 0;
FN:= 0;
for I:= 0
to MaxBegrenzungsEbenen - 1
do
FEbenen[I].Clear;
for I:= 0
to MaxPoints - 1
do
FPoints[I].Exist:= false;
end;
constructor TPolyeder.Create;
begin
inherited Create;
Clear;
end;
end.