GRAPH |
Top Previous Next |
{ Geometriai transzformációk ========================== Nagy vonalas ábrák (rajzok, térképek) szerkesztésére Ált. jelölések: p : kérdéses pont porigo : centrum pont szog : szög fokokban tav : távolság
A végtelen értéke = 1E+-30}
unit Geom;
interface Uses WinTypes, WinProcs, Classes, Graphics, SysUtils, Szamok;
Type el = (bal,jobb,also,felso); kinnkod = set of el;
TPoint2D = record X, Y: double; end; TPoint3D = record X, Y, Z: double; end; TRect2D = record x1,y1,x2,y2 : double; end; Tegyenes = record x1,y1,x2,y2 : double; end; Tegyenesfgv = record a: double; {egyenes iránytangense } b: double; {egyenes tengelymetszete} end;
TTeglalap = record a,b,c,d : TPoint2d; {A négy csúcspont kooordinátája} end;
TKor = record u,v,r: double; {u,v=kör középpont x,y koord.; r=sugár} end;
TKorfgv = record {x2+y2+dx+ey+f=0} d,e,f: double; end;
T3Point2d = record p1,p2,p3 : TPoint2d; end;
Function Rad(fok:extended):extended;
Function Eltolas(p:TPoint2d;tav,szog:double):TPoint2d; Function Elforgatas(p,porigo:TPoint2d;szog:double):TPoint2d; Function VisszTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; Function FuggTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; Function TengelyesTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; Function KozeppontosTukrozes(p,porigo:TPoint2d):TPoint2d; Function Nagyitas(p,porigo:TPoint2d;n:double):TPoint2d;
{Egyéb segédrutinok}
Function KeTPontTavolsaga(x1,y1,x2,y2: double): double; Function SzakaszSzog(x1,y1,x2,y2: double): double; function Szogdiff(alapszog,szog:double):double; function RelSzogdiff(alfa1,alfa2,alfa3:double):double; Function FelezoPont(p1,p2:TPoint2d):TPoint2d; Function OsztoPont(p1,p2:TPoint2d;arany:double):TPoint2d; Function KeTPontonAtmenoEgyenes(x1,y1,x2,y2:double):Tegyenesfgv; Function EgypontonAtmenoMeroleges(e1:Tegyenesfgv;p1:TPoint2D):Tegyenesfgv; function PontEgyenesTavolsaga(e1:Tegyenesfgv;p:TPoint2d):double; { Egy ponton átmenő adott iránytangensű egyenes egyenletét adja: p1 = pont, a = iránztangens } Function Egyenes1(p1:TPoint2d;a:double):Tegyenesfgv; { Két ponton p1,p2 átmenő egyenes iránytangensét adja} Function Egyenes2(p1,p2:TPoint2d):double; { Két egyenes metszéspontjának koord.-ját adja} Function Egyenes12(e1,e2:Tegyenes):TPoint2d; Function KetEgyenesMetszespontja(ef1,ef2:Tegyenesfgv):TPoint2d; { Rajta van-e a pont a vonalszakaszon } Function Vonalonvan(e : Tegyenes; p: TPoint2d; tures: double):boolean; Function Kozben(a,b,x,tures: double): boolean; { Két végponttól r1,r2 távolságban lévő pont koor.-áit adja p-ban, ha nincs metszéspont = False } Function Ivmetszes(u1,v1,r1,u2,v2,r2: double;var p:TPoint2D):boolean; { True = a 3 oldal valóban háromszöget alkot} Function HaromszogEgyenlotlenseg(d1,d2,d3:double):boolean; Function Bemeres(u1,v1,r1,u2,v2,r2: double;var p:TPoint2D):boolean;
{ Egyenes vágó algoritmus: Meghatározza egy szakasznak a képernyőre eső részét xi,yi : a szakasz végpontjai, t : a metszendő téglalap alakú terület } Function Clip(var x1,y1,x2,y2:double;t:TRect2D):boolean; Function SzakaszNegyszogMetszes(var p1,p2:TPoint2D;t:TRect2D):boolean; Function PontInKep(x,y:double;t:TRect2D):boolean; {Előállítja a kör egyenlet 0-ra redukált alakját} Function SetKorfgv(u,v,r:double):Tkorfgv; Function Masodfoku(a,b,c:double;var p12: TPoint2d):integer; Function IsKorEgyenesMetszes(u,v,r:double; a,b: double):boolean; Function IsAblakSzakaszMetszes(u,v,r:double; p: TRect2d):boolean; Function IsAblakNegyszogMetszes(u,v,r:double; p: TRect2d):boolean; Function IsAblakEllipszisMetszes(u,v,r:double; p: TRect2d):boolean; {Van-e kör-egyenes metszés és hány ponton} Function KorEgyenesMetszes(u,v,r:double; a,b: double;var p12:TRect2d):integer; {3 ponton átmenő kör értékeit adja: (u,v,r) } Function HaromPontbolKor(p1,p2,p3:TPoint2D):TPoint3D; {Körív rajtolás: Ca canvasra, p1,p2,p3 pontokon megy át} procedure KorivRajzol(Ca:TCanvas;pp1,pp2,pp3:TPoint2D); {p1,p2 a teglalap egy oldala fix, pk=külső futópont a || oldalon} function KorivbolHarompont(u,v,r,StartAngle,endAngle:extended):T3Point2d; Function HaromPontbolTeglalap(p1,p2,pk:TPoint2D):TTeglalap; function CorrectRealRect(t:TRect2D):TRect2D;
function Point2D(X, Y: double): TPoint2D; function Rect2D(X1, Y1, X2, Y2: double): TRect2D; function RoundPoint(P: TPoint2D): TPoint; function FloatPoint(P: TPoint): TPoint2D; function Point3D(X, Y, Z: double): TPoint3D; function Angle2D(P: TPoint2D): double; function Dist2D(P: TPoint2D): double; function Dist3D(P: TPoint3D): double; function RelAngle2D(PA, PB: TPoint2D): double; function RelDist2D(PA, PB: TPoint2D): double; function RelDist3D(PA, PB: TPoint3D): double; procedure Rotate2D(var P: TPoint2D; Angle2D: double); procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: double); procedure Move2D(var P: TPoint2D; Angle2D, Distance: double); function Between(PA, PB: TPoint2D; Preference: double): TPoint2D; function DistLine(A, B, C: double; P: TPoint2D): double; function Dist2P(P, P1, P2: TPoint2D): double; function DistD1P(DX, DY: double; P1, P: TPoint2D): double; function NearLine2P(P, P1, P2: TPoint2D; D: double): Boolean; function AddPoints(P1, P2: TPoint2D): TPoint2D; function SubPoints(P1, P2: TPoint2D): TPoint2D;
function Invert(Col: TColor): TColor; function Dark(Col: TColor; Percentage: Byte): TColor; function Light(Col: TColor; Percentage: Byte): TColor; function Mix(Col1, Col2: TColor; Percentage: Byte): TColor; function MMix(Cols: array of TColor): TColor; function Log(Base, Value: double): double; function Modulator(Val, Max: double): double; function M(I, J: Integer): Integer; function Tan(Angle2D: double): double; procedure Limit(var Value: Integer; Min, Max: Integer); function Exp2(Exponent: Byte): Word; function GetSysDir: String; function GetWinDir: String;
{3D rutins} Procedure d3Coord(x, y, z : Real; {coordinates} a, b : Real; {View angles} Var newx, newy : Integer); {return coordinates} {Gömb koordináta körök} procedure RotEllipse(ca:TCanvas;porigo:TPoint;a,b:integer;szog:double); procedure RotEllipseArc(ca:TCanvas;porigo:TPoint;a,b:integer;szog:double; fi1,fi2:integer); Function GlobeAxis(ca:TCanvas;porigo:TPoint;R:integer;theta,fi:double):TRect; procedure GlobeSzelessegiKor(ca:TCanvas;porigo:TPoint;R:integer; theta,fi:double; delta:double);
{Geodézia} Function Elometszes(a,b:TPoint2D;alfa,beta:real):TPoint2D;
var xbal,xjobb,yalso,yfelso: double;
implementation
Function Rad(fok:extended):extended; begin Result := fok*pi/180; end;
Function KeTPontTavolsaga(x1,y1,x2,y2: double): double; begin Result := Sqrt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1)) end;
{ x1,y1 a kezdőpontból kiindulva megadja a szakasz irányszögét rad-ban} Function SzakaszSzog(x1,y1,x2,y2: double): double; var szog,dx,dy,d,sinalfa : double; p1,p2: TPoint2D; begin Result:=Relangle2d(Point2d(x1,y1),Point2d(x2,y2)); end;
{Ha a szög ellentétes =0, direkt irányban óramutató járásával ellentétesen 0..2*pi rad.} function Szogdiff(alapszog,szog:double):double; begin szog := szog - alapszog; If szog<0 then szog:=2*pi+szog; If szog>=2*pi then szog:=szog-2*pi; Result := szog; end;
{Köriv 3 pontja meghatároz egy középponti szöget: Result >0 pozitív szög (óramutató járásával ellentétes irányában); Result <0 negativ szög (óramutató járásával megegyező irányában)} function RelSzogdiff(alfa1,alfa2,alfa3:double):double; var szd12,szd13: double; begin alfa1 := 2*pi*Frac(alfa1/(2*pi)); alfa2 := 2*pi*Frac(alfa2/(2*pi)); alfa3 := 2*pi*Frac(alfa3/(2*pi)); szd12:=SzogDiff(alfa1,alfa2); szd13:=SzogDiff(alfa1,alfa3); if szd12>szd13 then Result:=-(2*pi-szd13) else Result:=szd13; end;
Function Eltolas(p:TPoint2d;tav,szog:double):TPoint2d; begin end;
{ ELFORGATAS( pont,elforgatás centruma,szöge )} Function Elforgatas(p,porigo:TPoint2d;szog:double):TPoint2d; var c,s : double; begin c := COS(szog); s := SIN(szog); {szög radiánban} p.x := p.x - porigo.x; p.y := p.y - porigo.y; Result.x := p.x * c + p.y * s + porigo.x; Result.y := p.y * c - p.x * s + porigo.y; end;
Function VisszTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; begin end;
Function FuggTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; begin end;
Function TengelyesTukrozes(p:TPoint2d;e:Tegyenes):TPoint2d; begin end;
Function KozeppontosTukrozes(p,porigo:TPoint2d):TPoint2d; begin end;
Function Nagyitas(p,porigo:TPoint2d;n:double):TPoint2d; begin Result.x := porigo.x + (p.x-porigo.x)*n; Result.y := porigo.y + (p.y-porigo.y)*n; end;
Function FelezoPont(p1,p2:TPoint2d):TPoint2d; begin Result.x := (p1.x+p2.x)/2; Result.y := (p1.y+p2.y)/2; end;
{A p1,p2 szakasz arany részekre osztja és az osztóponttal tér vissza. pl. arány = 1/4 : 0.25 a p1 ponthoz közelebbi az osztópont} Function OsztoPont(p1,p2:TPoint2d;arany:double):TPoint2d; begin Result.x := p1.x+(p2.x-p1.x)*arany; Result.y := p1.y+(p2.y-p1.y)*arany; end;
{Ha a = 10e+30!, akkor az egyenes || az y tengellyek és b=x1 pl.(x=5), ha a=0, akkor viszont || az x tengellyel pl. (y=3)} Function KetPontonAtmenoEgyenes(x1,y1,x2,y2:double):Tegyenesfgv; begin If x1<>x2 then begin Result.a := (y2 - y1)/(x2 - x1); Result.b := y1 - (Result.a * x1); end else If x1=x2 then begin Result.a:=10e+30; Result.b:=x1; end else If y1=y2 then begin Result.a:=0; Result.b:=y1; end; end;
Function EgypontonAtmenoMeroleges(e1:Tegyenesfgv;p1:TPoint2D):Tegyenesfgv; begin If e1.a<>0 then begin Result.a:=-1/e1.a; end else begin Result.a:= 10e+37; end; Result.b:=p1.y-Result.a*p1.x; end;
function PontEgyenesTavolsaga(e1:Tegyenesfgv;p:TPoint2d):double; var e2:Tegyenesfgv; p1:TPoint2d; begin e2 := EgypontonAtmenoMeroleges(e1,p); p1 := KetEgyenesMetszespontja(e1,e2); Result := KeTPontTavolsaga(p1.x,p1.y,p.x,p.y); end;
{ Egy ponton átmenő adott iránytangensű egyenes egyenletét adja: p1 = pont, a = iránztangens } Function Egyenes1(p1:TPoint2d;a:double):Tegyenesfgv; begin Result.a := a; Result.b := p1.y - (a*p1.x); end;
{ Két ponton p1,p2 átmenő egyenes iránytangensét adja} Function Egyenes2(p1,p2:TPoint2d):double; begin If Abs(p1.x-p2.x)>1e-30 then Result := (p2.y - p1.y)/(p2.x - p1.x) else Result := 1e+30 end;
{ Két egyenes metszéspontjának koord.-ját adja} Function Egyenes12(e1,e2:Tegyenes):TPoint2d; var ef1,ef2: Tegyenesfgv; begin ef1.a := (e1.y2 - e1.y1)/(e1.x2 - e1.x1); ef2.a := (e2.y2 - e2.y1)/(e2.x2 - e2.x1); ef1.b := e1.y1 - (ef1.a * e1.x1); ef2.b := e2.y1 - (ef2.a * e2.x1); Result.x := (ef1.b - ef2.b) / (ef2.a - ef1.a); Result.y := ef1.a * Result.x + ef1.b; end;
Function KetEgyenesMetszespontja(ef1,ef2:Tegyenesfgv):TPoint2d; begin If Abs(ef2.a - ef1.a)>1e-30 then begin Result.x := (ef1.b - ef2.b) / (ef2.a - ef1.a); Result.y := ef1.a * Result.x + ef1.b; end else Result:=Point2d(1e+30,1e+30); end;
{ Rajta van-e a pont a vonalszakaszon tures kb. 400 legyen } Function Vonalonvan(e : Tegyenes; p: TPoint2d; tures: double):boolean; var d: double; begin {A pontnak az egyenestől való távolsága = d} d := p.x*(e.y1-e.y2)-p.y*(e.x1-e.x2)+(e.x1*e.y2)-(e.y1*e.x2); if Abs(d)<=tures then Result:=True else Result:=False; end;
Function Kozben(a,b,x,tures: double): boolean; var k: double; begin If a>b then begin k:=a; a:=b; b:=k; end; Result := (a-tures<=x) and (x<=b+tures); end;
{Két kör metszéspontjait adja: In: u,v,r = a kör középpontjának x,y koord.-ja és r a sugár p1,p2 = a metszéspontok Out: 0 = Ha a körök nem metszik egymást; 1-2 = a metszéspontok száma} Function Ivmetszes(u1,v1,r1,u2,v2,r2: double;var p:TPoint2D):boolean; var d,a,b,x,y,szog: double; kpx,kpy: double; begin Result := False; d:=KetPonttavolsaga(u1,v1,u2,v2); szog:=SzakaszSzog(u1,v1,u2,v2); If HaromszogEgyenlotlenseg(d,r1,r2) and (d <= (r1+r2)) then begin {Origóba eltolva és x tengelyre beforgatva a szakaszt} x := ((d*d)-(r2*r2)+(r1*r1))/(2*d); y := sqrt((r1*r1)-(x*x)); p.x := x; p.y:=y; Rotate2D(p,szog); {Elforgatas a szakasz irányába} p.x := u1+p.x; p.y:=v1+p.y; {Visszatolva az eredeti helyére} Result := True; end; end;
{ A szakasz egyik végétől r1, rá merőlegesen r2 távolságban lévő pont helyzete In: u,v,r = a kör középpontjának x,y koord.-ja és r a sugár p = a metszéspont} Function Bemeres(u1,v1,r1,u2,v2,r2: double;var p:TPoint2D):boolean; var d,szog: double; begin d:=KetPonttavolsaga(u1,v1,u2,v2); szog:=SzakaszSzog(u1,v1,u2,v2); p.x := r1; p.y:=r2; Rotate2D(p,szog); {Elforgatas a szakasz irányába} p.x := u1+p.x; p.y:=v1+p.y; Result := True; end;
Function HaromszogEgyenlotlenseg(d1,d2,d3:double):boolean; begin Result := (d1+d2>d3) and (d1+d3>d2) and (d3+d2>d1); end;
function Point2D(X, Y: double): TPoint2D; begin Point2D.X := X; Point2D.Y := Y; end;
function Rect2D(X1, Y1, X2, Y2: double): TRect2D; begin Rect2D.X1 := X1; Rect2D.X2 := X2; Rect2D.Y1 := Y1; Rect2D.Y2 := Y2; end;
function RoundPoint(P: TPoint2D): TPoint; begin RoundPoint.X := Round(P.X); RoundPoint.Y := Round(P.Y); end;
function FloatPoint(P: TPoint): TPoint2D; begin FloatPoint.X := P.X; FloatPoint.Y := P.Y; end;
function Point3D(X, Y, Z: double): TPoint3D; begin Point3D.X := X; Point3D.Y := Y; Point3D.Z := Z; end;
function Angle2D(P: TPoint2D): double; begin if P.X = 0 then begin if P.Y > 0 then Result := Pi / 2; if P.Y = 0 then Result := 0; if P.Y < 0 then Result := Pi / -2; end else Result := Arctan(P.Y / P.X);
if P.X < 0 then begin if P.Y < 0 then Result := Result + Pi; if P.Y >= 0 then Result := Result - Pi; end;
If Result < 0 then Result := Result + 2 * Pi; end;
function Dist2D(P: TPoint2D): double; begin Result := Sqrt(P.X * P.X + P.Y * P.Y); end;
function Dist3D(P: TPoint3D): double; begin Dist3d := Sqrt(P.X * P.X + P.Y * P.Y + P.Z * P.Z); end;
function RelAngle2D(PA, PB: TPoint2D): double; begin RelAngle2D := Angle2D(Point2D(PB.X - PA.X, PB.Y - PA.Y)); end;
function RelDist2D(PA, PB: TPoint2D): double; begin Result := Dist2D(Point2D(PB.X - PA.X, PB.Y - PA.Y)); end;
function RelDist3D(PA, PB: TPoint3D): double; begin RelDist3D := Dist3D(Point3D(PB.X - PA.X, PB.Y - PA.Y, PB.Z - PA.Z)); end;
procedure Rotate2D(var P: TPoint2D; Angle2D: double); var Temp: TPoint2D; begin Temp.X := P.X * Cos(Angle2D) - P.Y * Sin(Angle2D); Temp.Y := P.X * Sin(Angle2D) + P.Y * Cos(Angle2D); P := Temp; end;
procedure RelRotate2D(var P: TPoint2D; PCentr: TPoint2D; Angle2D: double); var Temp: TPoint2D; begin Temp := SubPoints(P, PCentr); Rotate2D(Temp, Angle2D); P := AddPoints(Temp, PCentr); end;
procedure Move2D(var P: TPoint2D; Angle2D, Distance: double); var Temp: TPoint2D; begin Temp.X := P.X + (Cos(Angle2D) * Distance); Temp.Y := P.Y + (Sin(Angle2D) * Distance); P := Temp; end;
function Between(PA, PB: TPoint2D; Preference: double): TPoint2D; begin Between.X := PA.X * Preference + PB.X * (1 - Preference); Between.Y := PA.Y * Preference + PB.Y * (1 - Preference); end;
function DistLine(A, B, C: double; P: TPoint2D): double; begin Result := (A * P.X + B * P.Y + C) / Sqrt(Sqr(A) + Sqr(B)); end;
function Dist2P(P, P1, P2: TPoint2D): double; begin Result := DistLine(P1.Y - P2.Y, P2.X - P1.X, -P1.Y * P2.X + P1.X * P2.Y, P); end;
function DistD1P(DX, DY: double; P1, P: TPoint2D): double; begin Result := DistLine(DY, -DX, -DY * P1.X + DX * P1.Y, P); end;
function NearLine2P(P, P1, P2: TPoint2D; D: double): Boolean; begin Result := False; if DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P1, P) * DistD1P(-(P2.Y - P1.Y), P2.X - P1.X, P2, P) <= 0 then if Abs(Dist2P(P, P1, P2)) < D then Result := True; end;
function AddPoints(P1, P2: TPoint2D): TPoint2D; begin AddPoints := Point2D(P1.X + P2.X, P1.Y + P2.Y); end;
function SubPoints(P1, P2: TPoint2D): TPoint2D; begin SubPoints := Point2D(P1.X - P2.X, P1.Y - P2.Y); end;
function Invert(Col: TColor): TColor; begin Invert := not Col; end;
function Dark(Col: TColor; Percentage: Byte): TColor; var R, G, B: Byte; begin R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col); R := Round(R * Percentage / 100); G := Round(G * Percentage / 100); B := Round(B * Percentage / 100); Dark := RGB(R, G, B); end;
function Light(Col: TColor; Percentage: Byte): TColor; var R, G, B: Byte; begin R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col); R := Round(R * Percentage / 100) + Round(255 - Percentage / 100 * 255); G := Round(G * Percentage / 100) + Round(255 - Percentage / 100 * 255); B := Round(B * Percentage / 100) + Round(255 - Percentage / 100 * 255); Light := RGB(R, G, B); end;
function Mix(Col1, Col2: TColor; Percentage: Byte): TColor; var R, G, B: Byte; begin R := Round((GetRValue(Col1) * Percentage / 100) + (GetRValue(Col2) * (100 - Percentage) / 100)); G := Round((GetGValue(Col1) * Percentage / 100) + (GetGValue(Col2) * (100 - Percentage) / 100)); B := Round((GetBValue(Col1) * Percentage / 100) + (GetBValue(Col2) * (100 - Percentage) / 100)); Mix := RGB(R, G, B); end;
function MMix(Cols: array of TColor): TColor; var I, R, G, B, Length: Integer; begin Length := High(Cols) - Low(Cols) + 1; R := 0; G := 0; B := 0; for I := Low(Cols) to High(Cols) do begin R := R + GetRValue(Cols[I]); G := G + GetGValue(Cols[I]); B := B + GetBValue(Cols[I]); end; R := R div Length; G := G div Length; B := B div Length; MMix := RGB(R, G, B); end;
function Log(Base, Value: double): double; begin Log := Ln(Value) / Ln(Base); end;
function Power(Base, Exponent: double): double; begin Power := Ln(Base) * Exp(Exponent); end;
function Modulator(Val, Max: double): double; begin Modulator := (Val / Max - Round(Val / Max)) * Max; end;
function M(I, J: Integer): Integer; begin M := ((I mod J) + J) mod J; end;
function Tan(Angle2D: double): double; begin Tan := Sin(Angle2D) / Cos(Angle2D); end;
procedure Limit(var Value: Integer; Min, Max: Integer); begin if Value < Min then Value := Min; if Value > Max then Value := Max; end;
function Exp2(Exponent: Byte): Word; var Temp, I: Word; begin Temp := 1; for I := 1 to Exponent do Temp := Temp * 2; Result := Temp; end;
function GetSysDir: String; var Temp: array[0..255] of Char; begin GetSystemDirectory(Temp, 256); Result := StrPas(Temp); end;
function GetWinDir: String; var Temp: array[0..255] of Char; begin GetWindowsDirectory(Temp, 256); Result := StrPas(Temp); end;
{ Egyenes vágó algoritmus: Meghatározza egy szakasznak a képernyőre eső részét xi,yi : a szakasz végpontjai, t : a metszendő téglalap alakú terület } Function Clip(var x1,y1,x2,y2:double;t:TRect2D):boolean; label return; var c,c1,c2: kinnkod; x,y: double;
procedure Kod(x,y:double; var c :kinnkod); begin c:=[ ]; If x<xbal then c:=[bal] else if x>xjobb then c:=[jobb]; If y<yalso then c:=c+[also] else if y>yfelso then c:=c+[felso]; end;
begin Result:=False; xbal:=t.x1; xjobb:=t.x2; yalso:=t.y1; yfelso:=t.y2; Kod(x1,y1,c1); Kod(x2,y2,c2); while (c1<>[ ]) or (c2<>[ ]) do begin If (c1*c2)<>[ ] then goto return; c:=c1; if c=[ ] then c:=c2; If bal in c then begin {metszés a bal élen} y:=y1+(y2-y1)*(xbal-x1)/(x2-x1); x:=xbal end else If jobb in c then begin {metszés a jobb élen} y:=y1+(y2-y1)*(xjobb-x1)/(x2-x1); x:=xjobb end else If also in c then begin {metszés az alsó élen} x:=x1+(x2-x1)*(yalso-y1)/(y2-y1); y:=yalso end else If felso in c then begin {metszés a felső élen} x:=x1+(x2-x1)*(yfelso-y1)/(y2-y1); y:=yfelso end; if c=c1 then begin x1:=x;y1:=y;Kod(x,y,c1) end else begin x2:=x;y2:=y;Kod(x,y,c2) end; end; Result:=True; return: end;
{ Szakasz vágó rutin: Megvizsgálja, hogy a szakasz metszi-e a t téglalap alakú területet. Ha igen -> meghatározza a bele eső szakasz végpontjait: p1,p2 és True értékkel tér vissza } Function SzakaszNegyszogMetszes(var p1,p2:TPoint2D;t:TRect2D):boolean; label return; var k1,k2: kinnkod; begin Result:=False; k1:=[]; k2:=[]; {Vizsgálat a t 4 élére, hogy kivül esik-e a szakasz} If (p1.x<t.x1) and (p2.x<t.x1) then goto return; If (p1.x>t.x2) and (p2.x>t.x2) then goto return; If (p1.y<t.y1) and (p2.y<t.y1) then goto return; If (p1.y>t.y2) and (p2.y>t.y2) then goto return; {A szakasz teljesen a képernyőn van} {egyébként vágni kell} Result := Clip(p1.x,p1.y,p2.x,p2.y,t); return: end;
{Egy térképi pont rajta van-e a képterületen?} Function PontInKep(x,y:double;t:TRect2D):boolean; var tt: TRect2D; begin Result:=False; tt:=CorrectRealRect(t); If (x>=tt.x1) and (x<=tt.x2) and (y>=tt.y1) and (y<=tt.y2) then Result:=True; end;
{Előállítja a kör egyenlet 0-ra redukált alakját} Function SetKorfgv(u,v,r:double):Tkorfgv; begin With Result do begin d := -2*u; e := -2*v; f := (4*sqr(r)-sqr(d)-sqr(e))/4; end; end;
{Másodfokú egyenlet két megoldása: a,b,c egyenlet paraméterek, Result: a megoldások száma} Function Masodfoku(a,b,c:double;var p12: TPoint2d):integer; var d: double; begin d := sqr(b)-4*a*c; IF d<0 then Result:=0; IF d=0 then begin Result:=1; p12.x := -b/(2*a); p12.y := p12.x; end; IF d>0 then begin Result:=2; d := sqrt(d); p12.x := (-b+d)/(2*a); p12.y := (-b-d)/(2*a); end; end;
{Van-e kör-egyenes metszés és hány ponton} Function IsKorEgyenesMetszes(u,v,r:double; a,b: double):boolean; var kor: TKorfgv; x12: TPoint2d; begin Try If Abs(a)<10e+20 then begin kor := SetKorfgv(u,v,r); Result := Masodfoku(sqr(a)+1, 2*a*b+kor.d+a*kor.e, b*(b+kor.e)+kor.f, x12)>0; end else If (u-r<=b) and (u+r>=b) then Result:=True; except Result := False; end; end;
{Viysgálja hogy az u,v középpontú r sugarú négyzeten a p szakasz áthalad-e} Function IsAblakSzakaszMetszes(u,v,r:double; p: TRect2d):boolean; var ve : TEgyenesfgv; x12: TPoint2d; x1,y1,x2,y2: double; label return; begin Result := False; If (p.x1<u-r) and (p.x2<u-r) then goto return; If (p.x1>u+r) and (p.x2>u+r) then goto return; If (p.y1<v-r) and (p.y2<v-r) then goto return; If (p.y1>v+r) and (p.y2>v+r) then goto return; ve := KeTPontonAtmenoEgyenes(p.x1,p.y1,p.x2,p.y2); If Abs(ve.a)>10e+3 then begin Result:=Kozben(u-r,u+r,ve.b,0); goto return; end; If Abs(ve.a)<0.01 then Result:=Kozben(v-r,v+r,ve.b,0) else begin Result:=Kozben(u-r,u+r,((v-r)-ve.b)/ve.a,0); If Result then goto return; Result:=Kozben(u-r,u+r,((v+r)-ve.b)/ve.a,0); If Result then goto return; Result:=Kozben(v-r,v+r,ve.a*(u-r)+ve.b,0); If Result then goto return; Result:=Kozben(v-r,v+r,ve.a*(u+r)+ve.b,0); end; return:end;
{Kör és egyenes metszése: In : u,v,r kör középpont x,y és sugara, a,b az egyenes egyenletének paraméterei p12 a metszéspontok rekordja Result: a megoldások száma} Function KorEgyenesMetszes(u,v,r:double; a,b: double;var p12:TRect2d):integer; var kor: TKorfgv; p1,p2,p3,c: double; x12: TPoint2d; begin kor := SetKorfgv(u,v,r); c := -1; Result := Masodfoku(sqr(a)+1, 2*a*b+kor.d+a*kor.e, b*(b+kor.e)+kor.f, x12); Case Result of 1: begin p12.x1 := x12.x; p12.x2 := x12.x; p12.y1 := x12.x; p12.y2 := x12.x; end; 2: begin p12.x1 := x12.x; p12.x2 := x12.x; p12.y1 := x12.x; p12.y2 := x12.x; end; end; end;
{3 ponton átmenő kör értékeit adja: (u,v,r), ha a 3 pont egy egyenesre esik, akkor: Result=felezőpont,x,y; a sugár pedig = -1 } Function HaromPontbolKor(p1,p2,p3:TPoint2D):TPoint3D; var e1,e2 : Tegyenesfgv; m1,m2 : Tegyenesfgv; f1,f2 : TPoint2d; c : TPoint2d; begin { If ((p1.x=p2.x) and (p2.x=p3.x)) or ((p1.x=p2.x) and (p2.x=p3.x)) then begin} Try e1 := KeTPontonAtmenoEgyenes(p1.x,p1.y,p2.x,p2.y); f1 := FelezoPont(p1,p2); m1 := EgypontonAtmenoMeroleges(e1,f1); e2 := KeTPontonAtmenoEgyenes(p3.x,p3.y,p2.x,p2.y); f2 := FelezoPont(p3,p2); m2 := EgypontonAtmenoMeroleges(e2,f2); c := KetEgyenesMetszespontja(m1,m2); Result.x := c.x; Result.y := c.y; Result.z := RelDist2D(c,p1); except Result.x := Felezopont(p1,p3).x; Result.y := Felezopont(p1,p3).y; Result.z := -1; end; end;
{Körív rajtolás: Ca canvasra, p1,p2,p3 pontokon megy át} procedure KorivRajzol(Ca:TCanvas;pp1,pp2,pp3:TPoint2D); var c:TPoint3D; alfa1,alfa2,alfa3:double; alf1,alf2,alf3:double; begin Try c:=HaromPontbolKor(pp1,pp2,pp3); If (c.z>0) and (c.y<MaxInt+1) then begin { Ca.Ellipse(Trunc(c.x-2),Trunc(c.y-2),Trunc(c.x+2),Trunc(c.y+2));}
alfa1 := RelAngle2D(Point2d(c.x,c.y),pp1); alfa2 := RelAngle2D(Point2d(c.x,c.y),pp2); alfa3 := RelAngle2D(Point2d(c.x,c.y),pp3);
If ((alfa1<alfa2) and (alfa2<alfa3)) or ((alfa3>alfa2) and (alfa1>alfa3)) or ((alfa1<alfa2) and (alfa3<alfa1)) then Ca.Arc(Trunc(c.x-c.z),Trunc(c.y-c.z),Trunc(c.x+c.z),Trunc(c.y+c.z), Trunc(pp3.x),Trunc(pp3.y),Trunc(pp1.x),Trunc(pp1.y)) else Ca.Arc(Trunc(c.x-c.z),Trunc(c.y-c.z),Trunc(c.x+c.z),Trunc(c.y+c.z), Trunc(pp1.x),Trunc(pp1.y),Trunc(pp3.x),Trunc(pp3.y)); end else begin Ca.Moveto(Trunc(pp1.x),Trunc(pp1.y)); Ca.Lineto(Trunc(pp3.x),Trunc(pp3.y)); end; except exit; end; end;
function KorivbolHarompont(u,v,r,StartAngle,endAngle:extended):T3Point2d; VAR felszog : extended; begin Result.p1 := Point2d(u+R*COS(StartAngle),v+R*SIN(StartAngle)); If StartAngle<EndAngle then felszog := StartAngle+SzogDiff(StartAngle,endAngle)/2 else felszog := StartAngle+(EndAngle+(2*pi-StartAngle))/2; Result.p2 := Point2d(u+R*COS(felszog),v+R*SIN(felszog)); Result.p3 := Point2d(u+R*COS(endAngle),v+R*SIN(endAngle)); end;
{p1,p2 a teglalap egy oldala fix, pk=külső futópont a || oldalon} Function HaromPontbolTeglalap(p1,p2,pk:TPoint2D):TTeglalap; var e1,e2,ek : Tegyenesfgv; m1,m2 : Tegyenesfgv; alfa : double; begin Result.a := p1; Result.b := p2; If (p1.y <> p2.y) and (p1.x <> p2.x) then begin e1 := KeTPontonAtmenoEgyenes(p1.x,p1.y,p2.x,p2.y); alfa := Egyenes2(p1,p2); ek := Egyenes1(pk,alfa); m1 := EgypontonAtmenoMeroleges(e1,p1); m2 := EgypontonAtmenoMeroleges(e1,p2); Result.c := KetegyenesMetszespontja(m2,ek); Result.d := KetegyenesMetszespontja(m1,ek); end else begin {Ha a bázisvonal || az x tengellyel} If p1.y = p2.y then begin Result.c := Point2d(p2.x,p2.y+(pk.y-p2.y)); Result.d := Point2d(p1.x,p1.y+(pk.y-p1.y)); end; {Ha a bázisvonal || az y tengellyel} If p1.x = p2.x then begin Result.c := Point2d(p2.x+(pk.x-p2.x),p2.y); Result.d := Point2d(p1.x+(pk.x-p1.x),p1.y); end; end; end;
{Viysgálja hogy az u,v középpontú r sugarú négyzeten a p befoglalójú ellipszis kerületi íve áthalad-e} Function IsAblakEllipszisMetszes(u,v,r:double; p: TRect2d):boolean; var a,b,ux,uy,y: double; pp: TRect2d; begin pp:=CorrectRealRect(p); If PontInKep(u,v,pp) then begin a := (pp.x2-pp.x1)/2; {ellipszis félnagytengelye = a} b := (pp.y2-pp.y1)/2; {ellipszis félkistengelye = b} ux := u-(pp.x1+a); {Kereső pont eltolva} uy := v-(pp.y1+b); y := b*sqrt(1-sqr(ux/a)); {ell.pont y értéke a kereső pont x értéke mellett} Result := PontInKep(ux,y,Rect2d(ux-r,uy-r,ux+r,uy+r)); If not result then Result := PontInKep(ux,-y,Rect2d(ux-r,uy-r,ux+r,uy+r)); end else Result:=False; end;
{Viysgálja hogy az u,v középpontú r sugarú négyzeten a p téglalap kerületi vonala áthalad-e} Function IsAblakNegyszogMetszes(u,v,r:double; p: TRect2d):boolean; Var pp: TRect2d; begin pp:=CorrectRealRect(p); Result := PontInKep(u,v,Rect2d(pp.x1-r,pp.y1-r,pp.x2+r,pp.y2+r)) and not PontInKep(u,v,Rect2d(pp.x1+r,pp.y1+r,pp.x2-r,pp.y2-r)); end;
{Normal rectangle vizsgálata és átalakítás: ball felső-jobb alsó sarokká. pl Rect(-1,4,5,-3) => Rect(-1,-3,5,4)} function CorrectRealRect(t:TRect2D):TRect2D; var k: double; begin result:=t; With Result do begin If x1>x2 then begin k:=x1; x1:=x2; x2:=k; end; If y1>y2 then begin k:=y1; y1:=y2; y2:=k; end; end; end;
{Egy P(x,y,z) térbeli koordinátáit képernyőpont Pk(newx,newy)-á átszámítja} Procedure d3Coord(x, y, z : Real; {coordinates} a, b : Real; {View angles} Var newx, newy : Integer); {return coordinates} Var Xd, Yd, Zd : Real; begin Xd := cos(a * pi / 180) * cos(b * pi / 180); Yd := cos(b * pi / 180) * sin(a * pi / 180); Zd := -sin(b * pi / 180); {Set coordinates For X/Y system} If (zd+x)<>0 then newx:= round(-z * Xd / Zd + x) else newx:=0; If (zd+y)<>0 then newy:= round(-z * Yd / Zd + y) else newy:=0; end;
{ RotEllipse = Elforgatott ellipszis; ca : Canvas porigo : középpont koordináták a,b : fél nagy és kis tengely hossza szog : elforgatás szöge rad-ban } procedure RotEllipse(ca:TCanvas;porigo:TPoint;a,b:integer;szog:double); begin RotEllipseArc(ca,porigo,a,b,szog,0,360); end;
{Csak az elforgatott ellipszis fi1,f2 közötti ívet rajzolja meg} procedure RotEllipseArc(ca:TCanvas;porigo:TPoint;a,b:integer;szog:double; fi1,fi2:integer); var i:integer; p,p1,p2 : TPoint2d; j,si,co: real; begin For i:=fi1 to fi2 do begin j:=i*pi/180; p1.x:=a*sin(j); p1.y:=b*cos(j); p2.x:=a*sin((i+1)*pi/180); p2.y:=b*cos((i+1)*pi/180); p.x:=0; p.y:=0; p1:=Elforgatas(p1,p,szog); p2:=Elforgatas(p2,p,szog); ca.MoveTo(Trunc(porigo.x+p1.x),Trunc(porigo.y+p1.y)); ca.LineTo(Trunc(porigo.x+p2.x),Trunc(porigo.y+p2.y)); end; end;
{Az R sugarú gömb tengelyét rajzolja meg: theta szöggel oldal irányban, fi szöggel pedig a látóirányban megdöntött. [radiánban]} Function GlobeAxis(ca:TCanvas;porigo:TPoint;R:integer;theta,fi:double):TRect; var Rp: integer; {Fél tengely hossza} xp,yp: integer;{Fél tengely origótól való eltérése} begin Rp := Trunc(R * cos(fi)); xp := Trunc(Rp * sin(theta)); yp := Trunc(Rp * cos(theta)); ca.MoveTo(porigo.x-xp,porigo.y-yp); ca.LineTo(porigo.x+xp,porigo.y+yp); Result:=Rect(porigo.x-xp,porigo.y-yp,porigo.x+xp,porigo.y+yp); end;
procedure GlobeSzelessegiKor(ca:TCanvas;porigo:TPoint;R:integer; theta,fi:double; delta:double); var a,b: integer; {Ferde ellipszis nagy-kis féltengelyeinek hossza} Rp: real; {Fél tengely hossza} xp,yp: real; {Fél tengely origótól való eltérése} xd,yd: integer;{A szélességi kör középpontja} p: Tpoint2d; begin a := Trunc(R * cos(delta)); b := Trunc(R * sin(fi)*cos(delta)); Rp := R * cos(fi); { xp := Rp * COS(delta); yp := Rp * SIN(delta); p := Elforgatas(Point2D(porigo.x+xp,porigo.y+yp),Point2D(porigo.x,porigo.y),theta); xd := Trunc(p.x); yd := Trunc(p.y);} xp := R * sin(theta); yp := R * cos(theta); xd := Trunc(porigo.x+xp*delta/(pi/2)); yd := Trunc(porigo.y+yp*delta/(pi/2)); ca.rectangle(xd-2,yd-2,xd+2,yd+2); RotEllipse(ca,Point(xd,yd),a,b,theta); end;
{ELŐMETSZÉS: in : a,b a bázisvonal két végpontja, alfa,béta a végpontokbűl mért irányszög out : a keresett pont térképi koordinátái } Function Elometszes(a,b:TPoint2D;alfa,beta:real):TPoint2D; begin Result.x := a.x+((b.x-a.x)*cot(alfa)-(b.y-a.y))/(cot(alfa)+cot(beta)); Result.y := a.y+((b.y-a.y)*cot(alfa)+(b.x-a.x))/(cot(alfa)+cot(beta)); end;
end.
|