GRAPH

{ 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.