var P:Vector;
begin
p:=Form1.Normal(A1,A2,A3);
A:=p.x;
B:=p.y;
C:=P.z;
D:=-((A*A1.x)+(B*A1.y)+(C*A1.z))
end;
Function Sec(n,p:Point; A,B,C,D:real; var IP:Point):boolean;{Точки сечения}
var Kx,Ky,Kz,P1,P2,P3:real;
Yes:boolean;
begin
Yes:=false;
P1:=(A*n.x)+(B*n.y)+(C*n.z)+D;
P2:=(A*p.x)+(B*p.y)+(C*p.z)+D;
if P1=0 then begin IP:=n; Yes:=true end
else if P2=0 then begin IP:=p; Yes:=true end else
if P1*P2<0 then
begin
Yes:=true;
P1:=n.x-p.x; P2:=n.y-p.y; P3:=n.z-p.z;
if P1=0 then IP.x:=n.x
else
begin
Kx:=((B*P2)+(C*P3))/P1;
IP.x:=((Kx*n.x)-(B*n.y)-(C*n.z)-D)/(A+Kx);
end;
if P2=0 then IP.y:=n.y
else
begin
Ky:=((A*P1)+(C*P3))/P2;
IP.y:=((Ky*n.y)-(A*n.x)-(C*n.z)-D)/(B+Ky);
end;
if P3=0 then IP.z:=n.z
else
begin
Kz:=((A*P1)+(B*P2))/P3;
IP.z:=((Kz*n.z)-(A*n.x)-(B*n.y)-D)/(C+Kz);
end;
end;
Sec:=Yes;
end;
Procedure Cep;{Построение многоугольника сечения}
Function RavPoi(a,b:point; Er:real):boolean;
var rez:boolean;
begin
rez:=false;
if abs(a.x-b.x)<Er then
if abs(a.y-b.y)<Er then
if abs(a.z-b.z)<Er then rez:=true;
RavPoi:=rez;
end;
var i,j:integer;
h,f:Point;
begin
for i:=1 to Count-1 do
begin
for j:=i+1 to Count do
begin
if RavPoi(Dipol[j,1],Dipol[i,2],Lok) then
begin
h:=Dipol[i+1,1];
f:=Dipol[i+1,2];
Dipol[i+1,1]:=Dipol[j,1];
Dipol[i+1,2]:=Dipol[j,2];
Dipol[j,1]:=h;
Dipol[j,2]:=f;
Break;
end;
if RavPoi(Dipol[j,2],Dipol[i,2],Lok) then
begin
h:=Dipol[i+1,1];
f:=Dipol[i+1,2];
Dipol[i+1,1]:=Dipol[j,2];
Dipol[i+1,2]:=Dipol[j,1];
Dipol[j,2]:=h;
Dipol[j,1]:=f;
Break;
end;
end;
end;
Form1.Label1.Caption:='Сечение- '+inttostr(Count)+' угольник.';
E[M+1,0]:=Count;
for i:=1 to Count do
begin
V[N+i]:=Dipol[i,1];
E[M+1,i]:=N+i;
end;
for i:=1 to 3 do
begin
Scene[i].G[M+1].Visible:=true;
Scene[i].G[M+1].Paint:=true;
Scene[i].G[M+1].BrushGr:=true;
end;
end;
begin
UravPl(InterPoint[1],InterPoint[2],InterPoint[3],A,B,C,D);
Count:=0;
for i:=1 to M do
begin
Para:=0;
for j:=1 to E[i,0]-1 do
begin
if Sec(V[E[i,j]],V[E[i,j+1]],A,B,C,D,Gp[Para]) then inc(para);
if Para>2 then Break;
end;
if Sec(V[E[i,E[i,0]]],V[E[i,1]],A,B,C,D,Gp[Para])then inc(para);
if Para=2 then
begin
inc(Count);
Dipol[Count,1]:=Gp[0];
Dipol[Count,2]:=Gp[1];
end;
end;
if Count>2 then
begin
Form1.IntWiew.Enabled:=true;
Cep;
end;
end;
Procedure WindowsMove(X,Y,i:integer;shift:TShiftState);
var a,b,c:string;
h,k:integer;
Par:TPoint;
t,firsttrue:boolean;
begin
firsttrue:=false;
if MPI then begin MoveP(i,kl,X,Y); MPI:=false end;
Form1.StatusBar2.Panels[0].Text:='X= '+floattostrf(UnSer(i,X,Y,0,0,0,Scene[i].M).x,ffGeneral,3,5);
Form1.StatusBar2.Panels[1].Text:='Y= '+floattostrf(UnSer(i,X,Y,0,0,0,Scene[i].M).y,ffGeneral,3,5);
Form1.StatusBar2.Panels[2].Text:='Z= '+floattostrf(UnSer(i,X,Y,0,0,0,Scene[i].M).z,ffGeneral,3,5);
if (ssleft in shift) and Form1.N34.Checked then
if Scene[i].M.Mash-(Y-Y0)>0 then Scene[i].M.Mash:=Scene[i].M.Mash-(Y-Y0) else ShowMessage('Масштаб: меньше нельзя!');
if Form1.N8.Checked and ((i=1) or (i=2))then X0:=X;
if Form1.N9.Checked and (i=1) then Y0:=Y;
if Form1.N10.Checked and ((i=2)or(i=3)) then Y0:=Y;
if Form1.N9.Checked and (i=3) then X0:=X;
if Form1.N36.Checked then
begin
k:=SelectGran(i,X,Y);
if k<>0 then
begin
t:=Scene[i].G[k].Paint;
Scene[i].G[k].Paint:=false;
Form1.Repaint;
Scene[i].G[k].Paint:=t;
end
else Form1.Repaint;
end;
if Form1.N37.Checked then
begin
k:=SelectGran(i,X,Y);
if k<>0 then
begin
t:=Scene[i].G[k].Paint;
Scene[i].G[k].Paint:=true;
Form1.Repaint;
Scene[i].G[k].Paint:=t;
end
else Form1.Repaint;
end;
if Form1.N27.Checked and Form1.IntWiew.Enabled then
for h:=1 to 3 do if First[h] then
begin
Firsttrue:=true;
Form1.Repaint;
if SelReber(i,x,y,Par) then
PenRebPr(i,Par.x,Par.y);
end;
if ssleft in shift then
begin
if Form1.N27.Checked and Form1.IntWiew.Enabled and (not FirstTrue)then
begin
SelectPointIntersection(i,X,Y,kl);
if kl<>0 then
begin
MoveP(i,kl,X,Y);
MPI:=true
end
else MPI:=false
end;
if Form1.N29.Checked then
if Form1.N12.Checked then
Rotate((UnSer(i,Y,X,0,0,0,Scene[i].M).x-UnSer(i,Y0,X0,0,0,0,Scene[i].M).x)*Pi/180*Scene[i].M.Mash,(UnSer(i,Y,X,0,0,0,Scene[i].M).y-UnSer(i,Y0,X0,0,0,0,Scene[i].M).y)*Pi/180*Scene[i].M.Mash,(UnSer(i,Y,X,0,0,0,Scene[i].M).z-UnSer(i,Y0,X0,0,0,0,Scene[i].M).z)*Pi/180*Scene[i].M.Mash,V[1].x,V[1].y,V[1].z)
else if Form1.N13.Checked then
Rotate((UnSer(i,Y,X,0,0,0,Scene[i].M).x-UnSer(i,Y0,X0,0,0,0,Scene[i].M).x)*Pi/180*Scene[i].M.Mash,(UnSer(i,Y,X,0,0,0,Scene[i].M).y-UnSer(i,Y0,X0,0,0,0,Scene[i].M).y)*Pi/180*Scene[i].M.Mash,(UnSer(i,Y,X,0,0,0,Scene[i].M).z-UnSer(i,Y0,X0,0,0,0,Scene[i].M).z)*Pi/180*Scene[i].M.Mash,0,0,0);
if Form1.N28.Checked then
Move(UnSer(i,X,Y,0,0,0,Scene[i].M).x-UnSer(i,X0,Y0,0,0,0,Scene[i].M).x,UnSer(i,X,Y,0,0,0,Scene[i].M).y-UnSer(i,X0,Y0,0,0,0,Scene[i].M).y,UnSer(i,X,Y,0,0,0,Scene[i].M).z-UnSer(i,X0,Y0,0,0,0,Scene[i].M).z);
X0:=X; Y0:=Y; Form1.Repaint;
end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
Form1.Close;
end;
//* Изминение размер окон проекций
procedure TForm1.CentrMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
if (Form1.Centr.Left+X>=0)and(Form1.Centr.Left+X<Form1.ClientWidth-Form1.Centr.Width) then
Form1.Centr.Left:=Form1.Centr.Left+X;
if (Form1.Centr.Top+Y>=Form1.ToolBar1.Height)and((Form1.Centr.Top+Y)<=(Form1.ToolBar1.Height+Form1.Vertikal.Height-Form1.Centr.Height)) then
Form1.Centr.Top:=Form1.Centr.Top+Y;
MoveOs;
end
end;
procedure TForm1.CentrMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MoveWindow;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
begin
//* Присваиваем ярлыки
WindowProection[1]:=Form1.ITop;
WindowProection[2]:=Form1.IFront;
WindowProection[3]:=Form1.ILeft;
WindowProection[4]:=Form1.IPerspective;
PanelWindow[1]:=Form1.PTop;
PanelWindow[2]:=Form1.PFront;
PanelWindow[3]:=Form1.PLeft;
PanelWindow[4]:=Form1.PPerspective;
Magnit[1]:=Mag1;
Magnit[2]:=Mag2;
Magnit[3]:=Mag3;
//* Первоначальная установка цвета
ActivColor:=clYellow;
ColorEder:=clAqua;
ColorUnEder:=clSilver;
ColorRebro:=clBlack;
ColorIntersection:=clRed;
ColorPointIntersection:=clBlue;
ColorNet:=clBtnFace;
//* Рапологаем окна проекций и оси
MoveWindow;
MoveOs;
//* Задаем масштаб окон проекций
for i:=1 to 3 do
Scene[i].M.Mash:=100;
Scene[4].M.Mash:=50;
for i:=1 to 3 do
First[i]:=false;
//Установка режима
Form1.IntWiew.Enabled:=false;
Count:=0;
MPI:=false;
//Активация вида сверху
ActivWindowProection(1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
MoveOs;
MoveWindow;
end;
//Загрузка многогранника из файла
procedure TForm1.N2Click(Sender: TObject);
var
f:textfile;
i,j,k,l:integer;
Max,Q:real;
begin
if Form1.OD1.Execute then
begin
assignfile(f,Form1.OD1.FileName);
reset(f);
readln(f,N);
for i:=1 to N do{загрузка координат вершин}
readln(f,V[i].x,V[i].y,V[i].z);
readln(f,M);
for i:=1 to M do
begin
j:=0;
while not eoln(f) do{загрузка граней}
begin
inc(j);
read(f,E[i,j]);
end;
readln(f);
E[i,0]:=j;
end;
Form1.StatusBar2.Panels[3].Text:='Файл: '+Form1.OD1.FileName;
Form1.N3.Enabled:=true;
Form1.ToolButton2.Enabled:=true;
closefile(f);
for i:=1 to 4 do
begin
for j:=1 to M do{Установка вида изображения}
begin
Scene[i].G[j].Paint:=true;
Scene[i].G[j].BrushGr:=true;
Scene[i].G[j].PenRb:=false;
Scene[i].G[j].ColorRb:=ColorRebro;
Form1.N21.Checked:=false;
Form1.N22.Checked:=true;
Form1.N41.Click;
Num:=1;
end;
Max:=sqrt(sqr(V[1].x-V[N].x)+sqr(V[1].y-V[N].y)+sqr(V[1].z-V[N].z));
for l:=1 to N-1 do
for k:=1 to N-1 do
begin
Q:=sqrt(sqr(V[i].x-V[l].x)+sqr(V[i].y-V[l].y)+sqr(V[i].z-V[l].z));
if Q>Max then Max:=Q
end;
for k:=1 to 4 do
Scene[k].M.Mash:=WindowProection[k].Height/Max;
end;
Form1.Repaint;
end;
end;
procedure TForm1.ITopClick(Sender: TObject);
begin
if not Scene[1].Active then{Активация окна проекции вид сверху}
ActivWindowProection(1);
end;
procedure TForm1.IFrontClick(Sender: TObject);
begin
if not Scene[2].Active then{Активация окна проекции вид спереди}
ActivWindowProection(2);
end;
procedure TForm1.ILeftClick(Sender: TObject);
begin
if not Scene[3].Active then{Активация окна проекции вид слева}
ActivWindowProection(3);
end;
procedure TForm1.ITopMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[1].Active then
begin
WindowsMove(X,Y,1,shift);
end;
end;
procedure TForm1.IFrontMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[2].Active then
WindowsMove(X,Y,2,shift);
end;
procedure TForm1.ILeftMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[3].Active then
WindowsMove(X,Y,3,shift);
end;
//* Сохранение многогранника
procedure TForm1.N3Click(Sender: TObject);
var
f:textfile;
i,j:integer;
begin
if Form1.SD1.Execute then
begin
assignfile(f,Form1.SD1.FileName+'.txt');
rewrite(f);
writeln(f,N);
for i:=1 to N do{запись координат вершин}
begin
writeln(f,V[i].x:5:3,' ',V[i].y:5:3,' ',V[i].z:5:3);
end;
writeln(f,M);
for i:=1 to M do
begin
for j:=1 to E[i,0] do{запись обхода гнаней}
write(f,' ',E[i,j]);
writeln(f);
end;
Form1.StatusBar2.Panels[3].Text:='Файл: '+Form1.SD1.FileName;
closefile(f);
Repaint;
end;
end;
procedure TForm1.N33Click(Sender: TObject);
begin
ShowMessage('Курсовая работа. Мосин Е.В. ФМ-43');
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
Form1.N2.Click;
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
Form1.N3.Click;
end;
//* Перерисовка формы
procedure TForm1.FormPaint(Sender: TObject);
Procedure ColorLight(i:integer;ColorEder,ColorUnEder:TColor);
var
j:integer;
n:vector;
c:real;
NorVec:array[1..4]of real;
begin
{Нормальный вектор}
n:=Normal(V[E[i,1]],V[E[i,2]],V[E[i,3]]);
NorVec[1]:=n.z;NorVec[2]:=n.y;NorVec[3]:=n.x;NorVec[4]:=n.z;
for j:=1 to 4 do
Scene[j].G[i].Visible:=NorVec[j]>0;
{Освещенность}
c:=sqrt(sqr(n.x)+sqr(n.y)+sqr(n.z));
for j:=1 to 4 do
if Scene[j].G[i].Visible then
Scene[j].G[i].colorgr:=(round(NorVec[j]/c*(ColorEder mod 256))*$1)+(round(NorVec[j]/c*((ColorEder div $100) mod 256))*$100)+(round(NorVec[j]/c*((ColorEder div $10000) mod 256))*$10000)
else if c<>0 then
Scene[j].G[i].colorgr:=abs((round(NorVec[j]/c*(ColorUnEder mod 256))*$1)+(round(NorVec[j]/c*((ColorUnEder div $100) mod 256))*$100)+(round(NorVec[j]/c*((ColorUnEder div $10000) mod 256))*$10000));
end;
var
i,j:integer;
k:TColor;
begin
{Стираем старое изображение}
for j:=1 to 4 do
WindowProection[j].Picture:=nil;
for i:=1 to M do
ColorLight(i,ColorEder,ColorUnEder);
if Form1.IntWiew.Enabled then
begin
BildInter;
ColorLight(M+1,ColorIntersection,ColorIntersection);
for j:=1 to 3 do
Scene[j].G[M+1].Visible:=true;
end;
DrawGrane;
Puk;
end;
//* Задание точек сечения
Procedure EnterPointIntersection(i:byte;X,Y:integer);
var k:integer;
Par:TPoint;
begin
if Scene[i].Active then
begin
X0:=X;
Y0:=Y;
if Form1.N36.Checked then
begin
k:=SelectGran(i,X,Y);
if k<>0 then
Scene[i].G[k].Paint:=false;
end;
if Form1.N37.Checked then
begin
k:=SelectGran(i,X,Y);
if k<>0 then
Scene[i].G[k].Paint:=true;
end;
if Form1.N40.Checked then
begin
inc(Count);
InterPoint[Count]:=UnSer(i,X,Y,0,0,0,Scene[i].M);
Puk;
if Count=3 then
begin
Form1.N40.Checked:=false;
Form1.N40.Enabled:=false;
Form1.N41.Enabled:=true;
Form1.ToolButton13.Enabled:=false;
BildInter;
end;
end;
if Form1.N27.Checked and Form1.IntWiew.Enabled then
for k:=1 to 3 do
if First[k] and SelReber(i,x,y,Par) then
begin
MagPoint[k,1]:=V[Par.x];
MagPoint[k,2]:=V[Par.y];
First[k]:=false;
end;
Form1.Repaint;
end;
end;
procedure TForm1.ITopMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EnterPointIntersection(1,X,Y);
end;
procedure TForm1.IFrontMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EnterPointIntersection(2,X,Y);
end;
procedure TForm1.ILeftMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EnterPointIntersection(3,X,Y);
end;
//* Включение сетки
procedure TForm1.N25Click(Sender: TObject);
var i:byte;
begin
for i:=1 to 3 do
if Scene[i].Active then
Scene[i].M.Net:=not Scene[i].M.Net;
Form1.Repaint;
end;
//* Включение ребер
procedure TForm1.N21Click(Sender: TObject);
var i,j:integer;
begin
Form1.N21.Checked:=not Form1.N21.Checked;
for i:=1 to 4 do
for j:=1 to M do
Scene[i].G[j].PenRb:=Form1.N21.Checked;
Form1.Repaint;
end;
//* Включение заливки
procedure TForm1.N22Click(Sender: TObject);
var i,j:integer;
begin
Form1.N22.Checked:=not Form1.N22.Checked;
for i:=1 to 3 do
for j:=1 to M do
Scene[i].G[j].BrushGr:=Form1.N22.Checked;
Form1.Repaint;
end;
//* Вызов диалога изменения цвета
procedure TForm1.N16Click(Sender: TObject);
begin
Application.CreateForm(TForm2,Form2);
end;
//* Вызов окна просмотра сечения
procedure TForm1.IntWiewClick(Sender: TObject);
begin
Application.CreateForm(TForm3,Form3);
end;
//Панель инструментов--------------------------------------
procedure TForm1.N8Click(Sender: TObject);
var i:integer;
begin
Form1.ToolButton12.Down:=Form1.N8.Checked;
end;
procedure TForm1.N27Click(Sender: TObject);
begin
Form1.ToolButton4.Down:=true;
end;
procedure TForm1.N28Click(Sender: TObject);
begin
Form1.ToolButton5.Down:=true;
end;
procedure TForm1.N29Click(Sender: TObject);
begin
Form1.ToolButton6.Down:=true;
end;
procedure TForm1.N34Click(Sender: TObject);
begin
Form1.ToolButton7.Down:=true;
end;
procedure TForm1.N36Click(Sender: TObject);
begin
Form1.ToolButton8.Down:=true;