Impressum
  • Artikel ist eingeordnet in:
  • Delphi


Mathematische Berechnungen (Schnittpunkte,Streckenlaenge,etc) geschrieben am 24.11.2006

Hier einmal meine Matheunit:

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.


schreibe den ersten Kommentar:


Inhalt zur freien Verwendung gibs es beim Thema Downloads.
nach oben springen
mehr auf: Instagram, github, thingiverse