85846 (Сечение многогранников), страница 3

Dialogs, ComCtrls, Menus, ExtCtrls, jpeg, ToolWin, StdCtrls, ImgList;

type

Point=record x,y,z:real end; {координаты точки}

Vector=record x,y,z:real end; {координаты ветора}

type

TForm1 = class(TForm)

StatusBar1: TStatusBar; StatusBar2: TStatusBar; MainMenu1: TMainMenu;

N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem;

N20: TMenuItem; N21: TMenuItem; N22: TMenuItem; N18: TMenuItem; N25: TMenuItem; N30: TMenuItem;

N31: TMenuItem; N32: TMenuItem; N33: TMenuItem; OD1: TOpenDialog; SD1: TSaveDialog;

PTop: TPanel; ITop: TImage; PFront: TPanel; PLeft: TPanel; PPerspective: TPanel; IFront: TImage;

ILeft: TImage; IPerspective: TImage; GroupBox1: TGroupBox; Vertikal: TPanel; Horizontal: TPanel; Panel3: TPanel;

Centr: TPanel; ImList1: TImageList; N23: TMenuItem; ToolBar1: TToolBar;

ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton;

ToolButton5: TToolButton; ToolButton6: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton;

ToolButton9: TToolButton; ToolButton10: TToolButton; ToolButton14: TToolButton; ToolButton19: TToolButton;

ToolButton11: TToolButton; ToolButton12: TToolButton; Label1: TLabel; ToolButton13: TToolButton;

N26: TMenuItem; N27: TMenuItem; N28: TMenuItem; N29: TMenuItem; N34: TMenuItem; N35: TMenuItem;

N36: TMenuItem; N37: TMenuItem; N38: TMenuItem; N39: TMenuItem; N40: TMenuItem; N41: TMenuItem;

N42: TMenuItem; N43: TMenuItem; N45: TMenuItem; N46: TMenuItem; N47: TMenuItem; N51: TMenuItem;

IntWiew: TMenuItem; N7: TMenuItem; N8: TMenuItem; N9: TMenuItem; N10: TMenuItem; N11: TMenuItem;

N12: TMenuItem; N13: TMenuItem; N14: TMenuItem; N15: TMenuItem; N16: TMenuItem; N17: TMenuItem;

N24: TMenuItem; N19: TMenuItem; Mag1: TMenuItem; Mag2: TMenuItem; Mag3: TMenuItem;

procedure N5Click(Sender: TObject);

procedure CentrMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure CentrMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure N2Click(Sender: TObject);

procedure ITopClick(Sender: TObject); procedure IFrontClick(Sender: TObject); procedure ILeftClick(Sender: TObject);

procedure ITopMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure IFrontMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure ILeftMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure N3Click(Sender: TObject); procedure N33Click(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure ToolButton2Click(Sender: TObject); procedure FormPaint(Sender: TObject);

procedure ITopMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure IFrontMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ILeftMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure N25Click(Sender: TObject); procedure N21Click(Sender: TObject);

procedure N22Click(Sender: TObject); procedure N8Click(Sender: TObject);

procedure N16Click(Sender: TObject); procedure IntWiewClick(Sender: TObject);

procedure N27Click(Sender: TObject); procedure N28Click(Sender: TObject);

procedure N29Click(Sender: TObject); procedure N34Click(Sender: TObject);

procedure N36Click(Sender: TObject); procedure N37Click(Sender: TObject);

procedure N9Click(Sender: TObject); procedure N10Click(Sender: TObject);

procedure IPerspectiveClick(Sender: TObject);

procedure N41Click(Sender: TObject); procedure N14Click(Sender: TObject);

procedure N18Click(Sender: TObject); procedure ToolButton4Click(Sender: TObject);

procedure ToolButton5Click(Sender: TObject); procedure ToolButton6Click(Sender: TObject);

procedure ToolButton7Click(Sender: TObject); procedure ToolButton8Click(Sender: TObject);

procedure ToolButton9Click(Sender: TObject); procedure ToolButton12Click(Sender: TObject);

procedure ToolButton11Click(Sender: TObject); procedure ToolButton19Click(Sender: TObject);

procedure ToolButton13Click(Sender: TObject); procedure N24Click(Sender: TObject);

procedure N19Click(Sender: TObject); Function Normal (A,B,C:Point):Vector;

procedure Mag1Click(Sender: TObject); procedure Mag2Click(Sender: TObject);

procedure Mag3Click(Sender: TObject);

private

{ Private declarations }

Procedure DrawGrane;

public

{ Public declarations }

end;

const Gran=10000;{Максимум ганей}

Pointer=10000;{Максимум вершин}

Lok=0.00001;{Погрешность сечения}

SizeT=5;{Размер точек сечения}

Sumbol='A';{Обозначение точек}

type

TView=array [1..gran]of record Visible:boolean;{Флаг активного окна}

Paint:boolean;

BrushGr:boolean;{Флаг заливки грани}

PenRb:boolean;{Флаг отрисовки ребер}

Intersection:boolean;{Флаг наличия сечения}

ColorGr,ColorRb:TColor{Цвет: грани,ребра} end;

TMainVar=record Cx,Cy:integer; Mash:real;Net:boolean; end;

var

Form1: TForm1;

V:array[1..pointer]of Point;{координаты вершин}

E:array[1..gran,0..pointer]of integer;{грани [номер грани, номер вершины]}

Scene:array[1..4]of record G:TView; M:TMainVar; Active:boolean; end;

M,N:word;{количество граней, количество вершин}

X0,Y0,Num:integer;{координаты щелчка мыши}

ActivColor,ColorEder,ColorUnEder,ColorRebro,ColorIntersection,ColorPointIntersection,ColorNet:TColor;{Цвет: активного окна}

InterPoint:array[1..3]of Point;

Count:byte;

kl:integer;

A,B,C,D,P1,P2,P3:real;

PanelWindow:array[1..4]of TPanel;

WindowProection:array[1..4]of TImage;

NameWindows:array[1..4]of string=('Вид сверху','Вид спереди','Вид слева','Перспектива');{Название окон}

OsiX:array[1..4]of string=('x','x','y','x');

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;