Mathematische Berechnungen (Schnittpunkte,Streckenlaenge,etc) geschrieben am 24.11.2006
Hier einmal meine Matheunit in Delphi:
Delphi/Pascalunit myMath;
interface
uses Dialogs,SysUtils;
type
t_doublepoint=record
x:Double;
y:Double;
end;
type
t_dp9arrary=array[1..3,1..3]of t_doublepoint; //Arraytyp für Berechnung einer Flächenteilung mit Perspektive
//Geometrie
//Schnittpunkt zweier Geraden die durch jeweils 2 Punkte gehen
function schnittpunkte_suchen(qp1,qp2,qp3,qp4:t_doublepoint):t_doublepoint;
function punktnaeher(pa,pb,px:t_doublepoint):boolean; //ist Punkt-pa näher an Punkt-px als Punkt-pb?
function punktecalc(ap1,ap2,ap3,ap4:t_doublepoint):t_dp9arrary; //Teilt Fläche in 4 Flächen, unter berücksichtigung des Fluchtpunktes
function drehe2Dpunkt(p0,p1:t_doublepoint;dgrad:Double):t_doublepoint;//dreht einen 2D-Punkt (p1) um p0
function streckenlaenge(p1,p2:t_doublepoint):double; //gibt Länge einer Strecke zwischen zwei Punkten zurück
procedure parallele(var p1,p2:t_doublepoint;verschiebung:double); //Verschiebt ein Punktepaar parallel in Vektorrichtung um verschiebung Pixel
function punktaufstrecke(p, A,B:t_doublepoint):boolean;
function TestBit(b:byte;bit:Byte): Boolean; //bit= Bitnummer 0..7
function setBit(b,bit:Byte): byte; //bit= Bitnummer 0..7
const
PIDiv180 = 0.017453292519943295769236907684886;
implementation
type
punkt_3d =
record
x:double;
y:double;
z:double;
end;
function TestBit(b:byte;bit:Byte): Boolean;
begin
Result :=( b shr bit and 1)=1;
end;
function setBit(b,bit:Byte): byte;
begin
Result :=b or (1 shl bit);
end;
function delBit(b,bit:Byte): byte;
begin
if TestBit(b,bit)then
Result :=b-(1 shl bit)
else
result:=b;
end;
function punktaufstrecke(p, A,B:t_doublepoint):boolean;
var ap,pb:double; //anstieg
apx,pbx:double; //anstieg
apy,pby:double; //anstieg
anstieg0:boolean;
m:double;
begin
result:=false;
anstieg0:=false;
apx:=(p.x-A.x);if apx=0 then anstieg0:=true;
apy:=(p.y-A.y);if apy=0 then anstieg0:=true;
if anstieg0 then ap:=0 else ap:=apx/apy;
anstieg0:=false;
pbx:=(B.x-p.x);if pbx=0 then anstieg0:=true;
pby:=(B.y-p.y);if pby=0 then anstieg0:=true;
if anstieg0 then pb:=0 else pb:=pbx/pby;
ap:=round(ap*1000)/1000;
pb:=round(pb*1000)/1000;
if (ap=pb)then //Punkt befindet sich auf Gerade
begin
//größeren nach b tauschen
if A.x>B.x then
begin
m:=a.x;
a.x:=b.x;
b.x:=m;
end;
if A.y>B.y then
begin
m:=a.y;
a.y:=b.y;
b.y:=m;
end;
//ist Punkt zwischen A und B
if (A.x<=p.x)and(p.x<=B.x) then
if (A.y<=p.y)and(p.y<=B.y) then result:=true;
end;
end;
function streckenlaenge(p1,p2:t_doublepoint):double;
begin
result:=Sqrt(sqr(p2.y-p1.y)+sqr(p2.x-p1.x));
end;
//winkel:=180+ArcTan2(p2.y - p1.y, p2.x - p1.x) * 180 / PIDiv180;
procedure parallele(var p1,p2:t_doublepoint;verschiebung:double);
var p1b,p2b:t_doublepoint;
verh,h:double;
begin
p1b:=drehe2Dpunkt(p1,p2,90);
p2b:=drehe2Dpunkt(p2,p1,-90);
h:=streckenlaenge(p1,p2);
if h<>0 then verh:=verschiebung/streckenlaenge(p1,p2) else verh:=1;
p1b.x:=p1.x+(p1b.x-p1.x)*verh;
p1b.y:=p1.y+(p1b.y-p1.y)*verh;
p2b.x:=p2.x+(p2b.x-p2.x)*verh;
p2b.y:=p2.y+(p2b.y-p2.y)*verh;
p1:=p1b;
p2:=p2b;
end;
function drehe2Dpunkt(p0,p1:t_doublepoint;dgrad:Double):t_doublepoint;
var ep:punkt_3d;
procedure Rotate2(Rx, Ry, Rz: Double; x, y, z: Double);
var
TempX,TempY,TempZ: Double;
SinX,SinY,SinZ: Double;
CosX,CosY,CosZ: Double;
XRadAng,YRadAng,ZRadAng: Double;
begin
XRadAng := Rx * PIDiv180;
YRadAng := Ry * PIDiv180;
ZRadAng := Rz * PIDiv180;
SinX := Sin(XRadAng);
SinY := Sin(YRadAng);
SinZ := Sin(ZRadAng);
CosX := Cos(XRadAng);
CosY := Cos(YRadAng);
CosZ := Cos(ZRadAng);
Tempy := y * CosY - z * SinY;
Tempz := y * SinY + z * CosY;
Tempx := x * CosX - Tempz * SinX;
ep.z := x * SinX + Tempz * CosX;
ep.x := Tempx * CosZ - TempY * SinZ;
ep.y := Tempx * SinZ + TempY * CosZ;
end;
procedure Rotate1(Rx, Ry, Rz: Double; x, y, z, ox, oy, oz: Double);
begin
Rotate2(Rx, Ry, Rz, x - ox, y - oy, z - oz);
ep.x := ep.x + ox;
ep.y := ep.y + oy;
ep.z := ep.z + oz;
end;
begin
Rotate1(0,0,dgrad, p1.x,p1.y,0, p0.x,p0.y,0);
result.x:=ep.x;
result.y:=ep.y;
end;
//strecken werden dabei als geraden behandelt
function schnittpunkte_suchen(qp1,qp2,qp3,qp4:t_doublepoint):t_doublepoint;
var a,h,schnitt_X,schnitt_Y : double;
begin
h:=((qp4.y-qp3.y) * (qp2.x-qp1.x)) - ((qp4.x-qp3.x) * (qp2.y-qp1.y));
if(h=0)then h:=1;
a := (((qp4.x-qp3.x) * (qp1.y - qp3.y)) - ((qp4.y-qp3.y) * (qp1.x-qp3.x))) / h;
schnitt_X := qp1.x + a * (qp2.x - qp1.x);
schnitt_Y := qp1.y + a * (qp2.y - qp1.y);
result.x:=schnitt_X;
result.y:=schnitt_Y;
end;
function punktnaeher(pa,pb,px:t_doublepoint):boolean;
begin
//Strecke papx kleiner pbpx? dann pa naäher sonst px näher
if(Sqrt(sqr(pa.x-px.x)+sqr(pa.y-px.y))<Sqrt(sqr(pb.x-px.x)+sqr(pb.y-px.y))) then
result:=true
else
result:=false;
end;
function punktecalc(ap1,ap2,ap3,ap4:t_doublepoint):t_dp9arrary;
var fp1,fp2,hmp:t_doublepoint;
begin
//showmessage(floattostr(ap1.x));
result[1][1]:=ap1; //Übergebene Punkte nach außen ziehen
result[3][1]:=ap2;
result[3][3]:=ap3;
result[1][3]:=ap4;
fp1:= schnittpunkte_suchen(ap1,ap2,ap4,ap3); //Fluchtpunkt 1
fp2:= schnittpunkte_suchen(ap1,ap4,ap2,ap3); //Fluchtpunkt 2
hmp:= schnittpunkte_suchen(ap1,ap3,ap2,ap4); //Mittelpunkt
result[2][2]:=hmp; //merken
result[2][1]:= schnittpunkte_suchen(ap1,ap2,hmp,fp2);
result[2][3]:= schnittpunkte_suchen(ap4,ap3,hmp,fp2);
result[1][2]:= schnittpunkte_suchen(ap1,ap4,hmp,fp1);
result[3][2]:= schnittpunkte_suchen(ap2,ap3,hmp,fp1);
end;
end.