OsiY:array[1..4]of string=('z','y','x','z');
OsiZ:array[1..4]of string=('y','z','z','y');
Magnit:array[1..3]of TMenuItem;
MagPoint:array[1..3,1..2]of Point;
First:array[1..3]of boolean;
MPI:boolean;
implementation
uses Unit2,Unit3;
//Перевод вещественных координат в экранные
Function Ser(win:byte; T:Point; Main:TMainVar):TPoint;
var CopySer:Tpoint;
begin
case win of
1: begin CopySer.X:=round(Main.Cx+(T.x*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.y*Main.Mash)) end;
2: begin CopySer.X:=round(Main.Cx+(T.x*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.z*Main.Mash)) end;
3: begin CopySer.X:=round(Main.Cx+(T.y*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.z*Main.Mash)) end;
4: begin CopySer.X:=round(Main.Cx+(T.x*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.y*Main.Mash)) end;
end;
Ser:=CopySer
end;
Function UnSer(win:byte; X,Y:integer;Tx,Ty,Tz:real; Main:TMainVar):Point;
var CopyUnSer:Point;
begin
case win of
1: begin CopyUnSer.x:=(X-Main.Cx)/Main.Mash;
CopyUnSer.y:=(Main.Cy-Y)/Main.Mash; CopyUnSer.z:=Tz end;
2: begin CopyUnSer.x:=(X-Main.Cx)/Main.Mash;
CopyUnSer.y:=Ty; CopyUnSer.z:=(Main.Cy-Y)/Main.Mash end;
3: begin CopyUnSer.x:=Tx; CopyUnSer.y:=(X-Main.Cx)/Main.Mash;
CopyUnSer.z:=(Main.Cy-Y)/Main.Mash end;
end;
UnSer:=CopyUnSer
end;
Procedure TForm1.DrawGrane;
Procedure GranBrush(Main:TMainVar; win:byte; i:integer; P:TPenStyle; var Can:TImage);
var j:integer;
w:array of TPoint;
begin
SetLength(w,E[i,0]);
for j:=1 to E[i,0] do
w[j-1]:=Ser(win,V[E[i,j]],Main);
if Scene[win].G[i].BrushGr and Scene[win].G[i].Paint then
begin
Can.Canvas.Pen.Style:=psSolid;
Can.Canvas.Pen.Color:=Scene[win].G[i].ColorGr;
Can.Canvas.Brush.Color:=Scene[win].G[i].ColorGr;
Can.Canvas.Polygon(w);
end;
if Scene[win].G[i].PenRb then
begin
Can.Canvas.Pen.Style:=P;
Can.Canvas.Pen.Color:=Scene[win].G[i].ColorRb;
Can.Canvas.Brush.Style:=bsClear;
Can.Canvas.MoveTo(w[0].X,w[0].Y);
for j:=1 to E[i,0]-1 do
Can.Canvas.LineTo(w[j].X,w[j].Y);
Can.Canvas.LineTo(w[0].X,w[0].Y);
end;
end;
//* Оси координат
Procedure LineOs(i:byte;var Can:TImage);
var j,k,a,b:integer;
begin
Can.Canvas.Pen.Color:=ColorNet;
a:=round(Can.Width/Scene[i].M.Mash) div 2;
b:=round(Can.Height/Scene[i].M.Mash) div 2;
for j:=-a to a do
begin
Can.Canvas.MoveTo(Scene[i].M.Cx+round(j*Scene[i].M.Mash),0);
Can.Canvas.LineTo(Scene[i].M.Cx+round(j*Scene[i].M.Mash),Can.Height);
end;
for j:=-b to b do
begin
Can.Canvas.MoveTo(0,Scene[i].M.Cy+round(j*Scene[i].M.Mash));
Can.Canvas.LineTo(Can.Width,Scene[i].M.Cy+round(j*Scene[i].M.Mash));
end;
Can.Canvas.Pen.Color:=clBlack;
Can.Canvas.MoveTo(Scene[i].M.Cx,0);
Can.Canvas.LineTo(Scene[i].M.Cx,Can.Height);
Can.Canvas.MoveTo(0,Scene[i].M.Cy);
Can.Canvas.LineTo(Can.Width,Scene[i].M.Cy);
end;
// Система координат
Procedure InpOboz(i,k:integer);
var j:integer;
A:TPoint;
s:string;
begin
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 (P1O<>0) and (P2O<>0) 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)) and (X>(Xt-ST)) then
if (Y<(Yt+ST)) and (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);{поворот вокруг оси все точки многогранника}
procedure Transfer(var T:Point;Ox,Oy,Oz:real);
var W:Point;
begin
T.x:=T.x-Ox;
T.y:=T.y-Oy;
T.z:=T.z-Oz;
end;
Procedure UnTransfer(var T:Point;Ox,Oy,Oz:real);
var W:Point;
begin
T.x:=T.x+Ox;
T.y:=T.y+Oy;
T.z:=T.z+Oz;
end;
Procedure RX(a:real; var P:Point);{поворот вокруг оси OX одной точки}
var Q:Point;
begin Q.x:=P.x; Q.y:=P.y*Cos(a)+P.z*Sin(a); Q.z:=-P.y*sin(a)+P.z*Cos(a); P:=Q end;
Procedure RY(a:real; var P:Point);{поворот вокруг оси OY одной точки}
var Q:Point;
begin Q.x:=P.x*Cos(a)-P.z*Sin(a);Q.y:=P.y;Q.z:=P.x*sin(a)+P.z*Cos(a); P:=Q end;
Procedure RZ(a:real; var P:Point);{поворот вокруг оси OZ одной точки}
var Q:Point;
begin Q.x:=P.x*Cos(a)-P.y*Sin(a);Q.y:=P.x*Sin(a)+P.y*Cos(a);Q.z:=P.z; P:=Q end;
var i:integer;
begin
if Form1.N17.Checked then
for i:=1 to Count do begin Transfer(InterPoint[i],Ox,Oy,Oz);RX(Ax,InterPoint[i]);RY(Ay,InterPoint[i]);RZ(Az,InterPoint[i]);UnTransfer(InterPoint[i],Ox,Oy,Oz) end;
for i:=1 to N do begin Transfer(V[i],Ox,Oy,Oz);RX(Ax,V[i]);RY(Ay,V[i]);RZ(Az,V[i]);UnTransfer(V[i],Ox,Oy,Oz); end;
end;
//* Реализация перемещение
Procedure Move(Lx,Ly,Lz:real);
var i:integer;
begin
if Form1.N17.Checked then
for i:=1 to Count do begin InterPoint[i].x:=InterPoint[i].x+Lx;InterPoint[i].y:=InterPoint[i].y+Ly;InterPoint[i].z:=InterPoint[i].z+Lz; end;
for i:=1 to N do begin V[i].x:=V[i].x+Lx;V[i].y:=V[i].y+Ly;V[i].z:=V[i].z+Lz end;
end;
//* Размещение осей перемещения
Procedure MoveOs;
begin
if Form1.Centr.Left+Form1.Centr.Width>Form1.ClientWidth then
Form1.Centr.Left:=Form1.ClientWidth-Form1.Centr.Width;
if Form1.Centr.Top+Form1.Centr.Height>Form1.GroupBox1.Top then
Form1.Centr.Top:=Form1.GroupBox1.Top-Form1.Centr.Height;
if Form1.Centr.Top<Form1.ToolBar1.Top+Form1.ToolBar1.Height then
Form1.Centr.Top:=Form1.ToolBar1.Top+Form1.ToolBar1.Height;
Form1.Vertikal.Top:=Form1.ToolBar1.Height;
Form1.Vertikal.Left:=Form1.Centr.Left;
Form1.Vertikal.Height:=Form1.GroupBox1.Top-Form1.ToolBar1.Height;
Form1.Vertikal.Width:=Form1.Centr.Width;
Form1.Horizontal.Top:=Form1.Centr.Top;
Form1.Horizontal.Left:=0;
Form1.Horizontal.Height:=Form1.Centr.Height;
Form1.Horizontal.Width:=Form1.ClientWidth
end;
//* Размещение окон проекций.
Procedure MoveWindow;
var i:byte;
begin
{Вид сверху}
Form1.PTop.Top:=Form1.ToolBar1.Height;
Form1.PTop.Left:=0;
Form1.PTop.Height:=Form1.Centr.Top-Form1.PTop.Top;
Form1.PTop.Width:=Form1.Centr.Left;
{Вид спереди}
Form1.PFront.Top:=Form1.ToolBar1.Height;
Form1.PFront.Left:=Form1.Centr.Left+Form1.Centr.Width;
Form1.PFront.Height:=Form1.Centr.Top-Form1.PFront.Top;
Form1.PFront.Width:=Form1.ClientWidth-Form1.Centr.Left-Form1.Centr.Width;
{Вид слева}
Form1.PLeft.Top:=Form1.Centr.Top+Form1.Centr.Height;
Form1.PLeft.Left:=0;
Form1.PLeft.Height:=Form1.GroupBox1.Top-Form1.PLeft.Top;
Form1.PLeft.Width:=Form1.Centr.Left;
{Окно перспективы}
Form1.PPerspective.Top:=Form1.Centr.Top+Form1.Centr.Height;
Form1.PPerspective.Left:=Form1.Centr.Left+Form1.Centr.Width;
Form1.PPerspective.Height:=Form1.GroupBox1.Top-Form1.PPerspective.Top;
Form1.PPerspective.Width:=Form1.ClientWidth-Form1.Centr.Left-Form1.Centr.Width;
{Задаем координаты мирового центра}
for i:=1 to 4 do
begin
Scene[i].M.Cx:=WindowProection[i].Width div 2;
Scene[i].M.Cy:=WindowProection[i].Height div 2;
end;
end;
//* Вывод точек сечения
Procedure Puk;
var i,j:byte;
begin
for j:=1 to Count do
for i:=1 to 3 do
begin
WindowProection[i].Canvas.Pen.Color:=ColorPointIntersection;
WindowProection[i].Canvas.Ellipse(Ser(i,InterPoint[j],Scene[i].M).X-SizeT,Ser(i,InterPoint[j],Scene[i].M).Y-SizeT,Ser(i,InterPoint[j],Scene[i].M).X+SizeT,Ser(i,InterPoint[j],Scene[i].M).Y+SizeT);
end;
end;
//* Построение сечения
Procedure BildInter;
var i,j:integer;
Dipol:array[1..gran,1..2]of Point;
Para,Count:integer;
Gp:array[0..gran]of Point;
Procedure UravPl(A1,A2,A3:Point; var A,B,C,D:real);{Уравнение плоскости сечения}