Сечение многогранников

Курсовой проект - Математика и статистика

Другие курсовые по предмету Математика и статистика

Скачать Бесплатно!
Для того чтобы скачать эту работу.
1. Пожалуйста введите слова с картинки:

2. И нажмите на эту кнопку.
закрыть



p>WindowProection[k].Canvas.Pen.Color:=clBlack;

WindowProection[k].Canvas.Brush.Style:=bsClear;

WindowProection[k].Canvas.Font.Height:=8;

for j:=1 to E[i,0] do

begin

s:=;

A:=Ser(k,V[E[i,j]],Scene[k].M);

if Form1.N24.Checked then

s:=s+Sumbol+inttostr(E[i,j]);

if Form1.N19.Checked then

s:=s+(+floattostrf(V[E[i,j]].x,ffGeneral,3,5)+;+floattostrf(V[E[i,j]].y,ffGeneral,3,5)+;+floattostrf(V[E[i,j]].z,ffGeneral,3,5)+);

WindowProection[k].Canvas.TextOut(A.X,A.Y,s);

end;

end;

Procedure InpOsi(k:byte);

var i:integer;

begin

WindowProection[k].Canvas.Pen.Color:=clBlack;

WindowProection[k].Canvas.Brush.Style:=bsClear;

WindowProection[k].Canvas.MoveTo(10,WindowProection[k].Height-10);

WindowProection[k].Canvas.LineTo(10,WindowProection[k].Height-40);

WindowProection[k].Canvas.MoveTo(10,WindowProection[k].Height-10);

WindowProection[k].Canvas.LineTo(40,WindowProection[k].Height-10);

WindowProection[k].Canvas.Font.Height:=8;

WindowProection[k].Canvas.Font.Color:=clBlue;

WindowProection[k].Canvas.TextOut(12,WindowProection[k].Height-50,OsiX[K]);

WindowProection[k].Canvas.TextOut(12,WindowProection[k].Height-23,OsiY[K]);

WindowProection[k].Canvas.TextOut(40,WindowProection[k].Height-20,OsiZ[K]);

end;

var i,j:integer;

begin

for j:=1 to 4 do

begin

if Scene[j].M.Net then

LineOs(j,WindowProection[j]);

if Form1.IntWiew.Enabled and Form1.N46.Checked then

GranBrush(Scene[j].M,j,M+1,psSolid,WindowProection[j]);

for i:=1 to M do

if (not Scene[j].G[i].Visible) then

GranBrush(Scene[j].M,j,i,psDot,WindowProection[j]);

if Form1.IntWiew.Enabled and Form1.N45.Checked then

GranBrush(Scene[j].M,j,M+1,psSolid,WindowProection[j]);

for i:=1 to M do

if Scene[j].G[i].Visible then

GranBrush(Scene[j].M,j,i,psSolid,WindowProection[j]);

if Form1.N24.Checked or Form1.N19.Checked then

for i:=1 to M do

if Scene[j].G[i].Visible then

InpOboz(i,j);

WindowProection[j].Canvas.Brush.Style:=bsClear;

WindowProection[j].Canvas.Font.Height:=8;

WindowProection[j].Canvas.Font.Color:=clBlack;

WindowProection[j].Canvas.TextOut(1,1,NameWindows[j]);

InpOsi(j);

end;

end;

{$R *.dfm}

//* Активация окна

Procedure ActivWindowProection(i:byte);

var j:byte;

begin

for j:=1 to 3 do

begin

PanelWindow[j].Color:=clBtnFace;

Scene[j].Active:=false

end;

PanelWindow[i].Color:=ActivColor;

Scene[i].Active:=true

end;

//* Полуплоскость

Function SelectGran(i,x,y:integer):integer;

Function Poluploscost(x1,y1,x2,y2,x,y:real):boolean;

begin

Poluploscost:=((x-x1)*(y2-y1)-((y-y1)*(x2-x1)))>0

end;

var j,k,l,rez:integer;

Inter:boolean;

begin

rez:=0; Inter:=true;

for k:=1 to M do

if Scene[i].G[k].Visible then

begin

for j:=1 to E[k,0]-1 do

case i of

1: if Poluploscost(V[E[k,j]].x,V[E[k,j]].y,V[E[k,j+1]].x,V[E[k,j+1]].y,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

2: if not Poluploscost(V[E[k,j]].x,V[E[k,j]].z,V[E[k,j+1]].x,V[E[k,j+1]].z,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

3: if Poluploscost(V[E[k,j]].y,V[E[k,j]].z,V[E[k,j+1]].y,V[E[k,j+1]].z,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

end;

if Inter then

case i of

1: if Poluploscost(V[E[k,E[k,0]]].x,V[E[k,E[k,0]]].y,V[E[k,1]].x,V[E[k,1]].y,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

2: if not Poluploscost(V[E[k,E[k,0]]].x,V[E[k,E[k,0]]].z,V[E[k,1]].x,V[E[k,1]].z,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

3: if Poluploscost(V[E[k,E[k,0]]].y,V[E[k,E[k,0]]].z,V[E[k,1]].y,V[E[k,1]].z,(X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash) then Inter:=false;

end;

if Inter then

begin

rez:=k;

Break;

end

else

begin

rez:=0;

Inter:=true;

end;

end;

SelectGran:=rez;

end;

//* Выбор точек сечения

Procedure MoveP(win,j,X,Y:integer);

Procedure PNormal(P1,P2:Point;var M:Point);

var i:integer;

Li,No:Vector;

O:Point;

Q,P1O,P2O:real;

begin

Li.x:=P1.x-P2.x;

Li.y:=P1.y-P2.y;

Li.z:=P1.z-P2.z;

No.x:=M.x-P1.x;

No.y:=M.y-P1.y;

No.z:=M.z-P1.z;

Q:=sqr(Li.x)+sqr(Li.y)+sqr(Li.z);

O.x:=(Li.x*((Li.y*No.y)+(Li.z*No.z)+(Li.x*M.x))+(P1.x*(sqr(Li.y)+sqr(Li.z))))/Q;

O.y:=(Li.y*((Li.x*No.x)+(Li.z*No.z)+(Li.y*M.x))+(P1.y*(sqr(Li.x)+sqr(Li.z))))/Q;

O.z:=(Li.z*((Li.x*No.x)+(Li.y*No.y)+(Li.z*M.x))+(P1.z*(sqr(Li.x)+sqr(Li.y))))/Q;

P1O:=sqrt(sqr(O.x-P1.x)+sqr(O.y-P1.y)+sqr(O.z-P1.z));

P2O:=sqrt(sqr(O.x-P2.x)+sqr(O.y-P2.y)+sqr(O.z-P2.z));

if (P1O0) then

if (sqrt(Q)/P1O<1)or(sqrt(Q)/P2O<1) then

if P1O/P2O<1 then O:=P1 else O:=P2;

M:=O;

end;

begin

InterPoint[j]:=UnSer(win,X,Y,InterPoint[j].x,InterPoint[j].y,InterPoint[j].z,Scene[win].M);

if Magnit[j].Checked and (not first[j]) then

PNormal(MagPoint[j,1],MagPoint[j,2], InterPoint[j]);

Form1.StatusBar2.Panels[0].Text:=X= +floattostrf(InterPoint[j].x,ffGeneral,3,5);

Form1.StatusBar2.Panels[1].Text:=Y= +floattostrf(InterPoint[j].y,ffGeneral,3,5);

Form1.StatusBar2.Panels[2].Text:=Z= +floattostrf(InterPoint[j].z,ffGeneral,3,5);

end;

Procedure SelectPointIntersection(i,x,y:integer;var Num:integer);

Function SelP(X,Y,Xt,Yt,ST:real):boolean;

var Obl:boolean;

begin

Obl:=false;

if (X(Xt-ST)) then

if (Y(Yt-ST)) then

Obl:=true;

SelP:=Obl;

end;

var j:integer;

begin

Num:=0;

for j:=1 to 3 do

case i of

1: if SelP((X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash,InterPoint[j].x,InterPoint[j].y,SizeT/Scene[i].M.Mash) then Num:=j;

2: if SelP((X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash,InterPoint[j].x,InterPoint[j].z,SizeT/Scene[i].M.Mash) then Num:=j;

3: if SelP((X-Scene[i].M.Cx)/Scene[i].M.Mash,(Scene[i].M.Cy-Y)/Scene[i].M.Mash,InterPoint[j].y,InterPoint[j].z,SizeT/Scene[i].M.Mash) then Num:=j;

end;

end;

Function SelReber(win,x,y:integer;var ds:TPoint):boolean;

var rez:boolean;

Function LinEx(i:integer; x1,y1,x2,y2,x,y:real):boolean;

begin

LinEx:=abs(round(((x-x1)*(y2-y1)-((y-y1)*(x2-x1)))*Scene[i].M.Mash))<5

end;

Procedure FindRb(ind1,ind2:integer);

begin

ds.x:=ind1;

ds.y:=ind2;

rez:=true;

end;

var j,k:integer;

begin

rez:=false;

for j:=1 to M do

if Scene[win].G[j].Visible then

begin

for k:=1 to E[j,0]-1 do

begin

case win of

1: if LinEx(win,V[E[j,k]].x,V[E[j,k]].y,V[E[j,k+1]].x,V[E[j,k+1]].y,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,k],E[j,k+1]);

2: if LinEx(win,V[E[j,k]].x,V[E[j,k]].z,V[E[j,k+1]].x,V[E[j,k+1]].z,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,k],E[j,k+1]);

3: if LinEx(win,V[E[j,k]].y,V[E[j,k]].z,V[E[j,k+1]].y,V[E[j,k+1]].z,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,k],E[j,k+1]);

end;

end;

case win of

1: if LinEx(win,V[E[j,E[j,0]]].x,V[E[j,E[j,0]]].y,V[E[j,1]].x,V[E[j,1]].y,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,E[j,0]],E[j,1]);

2: if LinEx(win,V[E[j,E[j,0]]].x,V[E[j,E[j,0]]].z,V[E[j,1]].x,V[E[j,1]].z,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,E[j,0]],E[j,1]);

3: if LinEx(win,V[E[j,E[j,0]]].y,V[E[j,E[j,0]]].z,V[E[j,1]].y,V[E[j,1]].z,(X-Scene[win].M.Cx)/Scene[win].M.Mash,(Scene[win].M.Cy-Y)/Scene[win].M.Mash) then FindRb(E[j,E[j,0]],E[j,1]);

end;

end;

SelReber:=rez;

end;

Procedure PenRebPr(d,ind1,ind2:integer);

var t:integer;

begin

WindowProection[d].Canvas.Pen.Color:=clRed;

WindowProection[d].Canvas.MoveTo(Ser(d,V[ind1],Scene[d].M).X,Ser(d,V[ind1],Scene[d].M).Y);

WindowProection[d].Canvas.LineTo(Ser(d,V[ind2],Scene[d].M).X,Ser(d,V[ind2],Scene[d].M).Y);

end;

//* Нормальный вектор к грани

Function TForm1.Normal (A,B,C:Point):Vector;

begin

Normal.x:=((B.y-A.y)*(C.z-B.z))-((B.z-A.z)*(C.y-B.y));

Normal.y:=((B.z-A.z)*(C.x-B.x))-((B.x-A.x)*(C.z-B.z));

Normal.z:=((B.x-A.x)*(C.y-B.y))-((B.y-A.Y)*(C.x-B.x));

end;

//* Реализация поворота

Procedure Rotate(Ax,Ay,Az:real;Ox,Oy,Oz:real);{поворот вокруг оси все точки многогранника}

s