end;
procedure TForm1.N37Click(Sender: TObject);
begin
Form1.ToolButton9.Down:=true;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Form1.ToolButton11.Down:=Form1.N9.Checked;
end;
procedure TForm1.N10Click(Sender: TObject);
begin
Form1.ToolButton19.Down:=Form1.N10.Checked;
end;
//---------------------------------------------------------
procedure TForm1.IPerspectiveClick(Sender: TObject);
begin
if not Scene[4].Active then{Активация окна перспективы}
ActivWindowProection(4);
end;
//* Удаление сечения
procedure TForm1.N41Click(Sender: TObject);
var i:integer;
begin
Count:=0;
for i:=1 to 3 do
First[i]:=false;
Form1.N40.Enabled:=true;
Form1.N40.Checked:=false;
Form1.N41.Enabled:=false;
Form1.ToolButton13.Enabled:=true;
Form1.ToolButton13.Down:=false;
Form1.IntWiew.Enabled:=false;
Form1.Label1.Caption:='Сечение не задано.';
for i:=1 to 3 do
Scene[i].G[M+1].Visible:=false;
Form1.Repaint;
end;
//* Сброс
procedure TForm1.N14Click(Sender: TObject);
var i:integer;
begin
ActivColor:=clYellow;
ColorEder:=clAqua;
ColorUnEder:=clSilver;
ColorRebro:=clBlack;
ColorIntersection:=clRed;
ColorPointIntersection:=clBlue;
ColorNet:=clBtnFace;
for i:=1 to 3 do
Scene[i].M.Mash:=100;
Form1.N41.Click;
M:=0;
N:=0;
Form1.StatusBar2.Panels[3].Text:='Файл не загружен';
Form1.Repaint;
end;
//---------------------------------------------------------
procedure TForm1.N18Click(Sender: TObject);
begin
Form1.Repaint;
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
Form1.N27.Click;
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
Form1.N28.Click;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
Form1.N29.Click;
end;
procedure TForm1.ToolButton7Click(Sender: TObject);
begin
Form1.N34.Click;
end;
procedure TForm1.ToolButton8Click(Sender: TObject);
begin
Form1.N36.Click;
end;
procedure TForm1.ToolButton9Click(Sender: TObject);
begin
Form1.N37.Click;
end;
procedure TForm1.ToolButton12Click(Sender: TObject);
begin
Form1.N8.Click;
end;
procedure TForm1.ToolButton11Click(Sender: TObject);
begin
Form1.N9.Click;
end;
procedure TForm1.ToolButton19Click(Sender: TObject);
begin
Form1.N10.Click;
end;
procedure TForm1.ToolButton13Click(Sender: TObject);
begin
Form1.N40.Click;
end;
procedure TForm1.N24Click(Sender: TObject);
begin
Form1.Repaint;
end;
procedure TForm1.N19Click(Sender: TObject);
begin
Form1.Repaint;
end;
//---------------------------------------------------------
procedure TForm1.Mag1Click(Sender: TObject);
begin
if Mag1.Checked then
First[1]:=true;
end;
procedure TForm1.Mag2Click(Sender: TObject);
begin
if Mag2.Checked then
First[2]:=true;
end;
procedure TForm1.Mag3Click(Sender: TObject);
begin
if Mag3.Checked then
First[3]:=true;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;
type
TForm2 = class(TForm)
BitBtn1: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Shape5: TShape;
Label6: TLabel;
Shape6: TShape;
CD1: TColorDialog;
Label7: TLabel;
Shape7: TShape;
procedure FormCreate(Sender: TObject);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape6MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure CD1Close(Sender: TObject);
procedure Shape7MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1,Unit3;
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
Shape1.Brush.Color:=ColorIntersection;
Shape2.Brush.Color:=ColorEder;
Shape3.Brush.Color:=ColorRebro;
Shape4.Brush.Color:=ColorNet;
Shape5.Brush.Color:=ActivColor;
Shape6.Brush.Color:=ColorPointIntersection;
Shape7.Brush.Color:=ColorUnEder;
end;
procedure TForm2.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ColorIntersection:=Form2.CD1.Color;
Form2.Shape1.Brush.Color:=Form2.CD1.Color
end
end;
procedure TForm2.Shape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ColorEder:=Form2.CD1.Color;
Form2.Shape2.Brush.Color:=Form2.CD1.Color
end
end;
procedure TForm2.Shape3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var i,j:word;
begin
if Form2.CD1.Execute then
begin
ColorRebro:=Form2.CD1.Color;
Form2.Shape3.Brush.Color:=Form2.CD1.Color;
for i:=1 to 3 do
for j:=1 to M do
Scene[i].G[j].ColorRb:=ColorRebro;
end
end;
procedure TForm2.Shape4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ColorNet:=Form2.CD1.Color;
Form2.Shape4.Brush.Color:=Form2.CD1.Color
end
end;
procedure TForm2.Shape5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ActivColor:=Form2.CD1.Color;
Form2.Shape5.Brush.Color:=Form2.CD1.Color
end
end;
procedure TForm2.Shape6MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ColorPointIntersection:=Form2.CD1.Color;
Form2.Shape6.Brush.Color:=Form2.CD1.Color
end
end;
procedure TForm2.BitBtn1Click(Sender: TObject);
begin
Form2.Close
end;
procedure TForm2.CD1Close(Sender: TObject);
begin
Form1.Repaint;
end;
procedure TForm2.Shape7MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Form2.CD1.Execute then
begin
ColorUnEder:=Form2.CD1.Color;
Form2.Shape7.Brush.Color:=Form2.CD1.Color
end
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls,Math;
type
TForm3 = class(TForm)
GroupBox1: TGroupBox;
ListBox1: TListBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Splitter1: TSplitter;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
procedure PaintIntersection;
public
{ Public declarations }
end;
var
Form3: TForm3;
CxW,CyW,X0W,Y0W:integer;
MashW:real;
PInter:array of TPoint;
implementation
uses Unit1,Unit2;
procedure TForm3.PaintIntersection;
var i:integer;
Nor:Vector;
C1,S1,x:real;
FG:array[1..1000] of Point;
begin
CxW:=(Form3.Width+Form3.GroupBox1.Width) div 2;
CyW:=(Form3.Height) div 2;
for i:=1 to E[M+1,0] do
FG[i]:=V[N+i];
Nor:=Form1.Normal(FG[1],FG[2],FG[3]);
if (Nor.y<>0) and (Nor.z<>0) then
begin
C1:=Nor.z/sqrt(sqr(Nor.y)+sqr(Nor.z));
S1:=Nor.y/sqrt(sqr(Nor.y)+sqr(Nor.z));
end
else begin C1:=1; S1:=0 end;
for i:=1 to E[M+1,0] do
begin
x:=(FG[i].y*C1)-(FG[i].z*S1);
FG[i].z:=(FG[i].y*S1)+(FG[i].z*C1);
FG[i].y:=x;
end;
Nor:=Form1.Normal(FG[1],FG[2],FG[3]);
if (Nor.x<>0) and (Nor.z<>0) then
begin
C1:=Nor.z/sqrt(sqr(Nor.x)+sqr(Nor.z));
S1:=Nor.x/sqrt(sqr(Nor.x)+sqr(Nor.z));
end
else begin C1:=1; S1:=0 end;
for i:=1 to E[M+1,0] do
begin
FG[i].x:=(FG[i].x*C1)-(FG[i].z*S1);
end;
SetLength(PInter,E[M+1,0]);
for i:=1 to E[M+1,0] do
begin
PInter[i-1].X:=round(CxW+(FG[i].x*MashW));
PInter[i-1].Y:=round(CyW-(FG[i].y*MashW));
end;
Form3.Canvas.Brush.Color:=ColorIntersection;
Form3.Canvas.Pen.Color:=ColorRebro;
Form3.Canvas.Polygon(PInter);
Form3.Canvas.Font.Height:=8;
Form3.Canvas.Brush.Style:=bsClear;
Form3.Canvas.Pen.Color:=clBlack;
for i:=1 to E[M+1,0] do
Form3.Canvas.TextOut(PInter[i-1].X,PInter[i-1].Y,'S'+inttostr(i));
end;
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
function Ploshad(A,B,C:Point):real;
var i:integer;
Al,Bl,Cl,p:real;
begin
Al:=sqrt(sqr(A.x-B.x)+sqr(A.y-B.y)+sqr(A.z-B.z));
Bl:=sqrt(sqr(B.x-c.x)+sqr(B.y-C.y)+sqr(B.z-C.z));
Cl:=sqrt(sqr(C.x-A.x)+sqr(C.y-A.y)+sqr(C.z-A.z));
p:=(Al+Bl+Cl)/2;
Ploshad:=sqrt(p*(p-Al)*(p-Bl)*(p-Cl));
end;
var i:integer;
S:real;
begin
Form3.Caption:='Просмотр сечения. ('+inttostr(E[M+1,0])+' угольник)';
for i:=1 to E[M+1,0] do
Form3.ListBox1.Items[i-1]:='S'+inttostr(i)+': '+floattostrf(V[E[M+1,i]].x,ffGeneral,3,5)+'; '+floattostrf(V[E[M+1,i]].y,ffGeneral,3,5)+'; '+floattostrf(V[E[M+1,i]].z,ffGeneral,3,5);
Form3.Edit2.Text:='('+floattostrf(A,ffGeneral,3,5)+')*X+('+floattostrf(B,ffGeneral,3,5)+')*Y+('+floattostrf(C,ffGeneral,3,5)+')*Z+('+floattostrf(D,ffGeneral,3,5)+')'+'=0';
CxW:=(Form3.Width+Form3.GroupBox1.Width) div 2;
CyW:=(Form3.Height) div 2;
MashW:=Scene[4].M.Mash;
S:=0;
for i:=1 to E[M+1,0]-2 do
S:=S+Ploshad(V[M+1],V[M+i+1],V[M+i+2]);
Form3.Edit1.Text:=floattostrf(S,ffGeneral,3,5)+' Ед.Кв.';
end;
procedure TForm3.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
Key:=#0;
end;
procedure TForm3.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Key:=#0;
end;
procedure TForm3.FormPaint(Sender: TObject);
begin
PaintIntersection;
end;
procedure TForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then
begin
if MashW-(Y-Y0W)>0 then MashW:=MashW-(Y-Y0W) else ShowMessage('Масштаб: меньше нельзя!');
Form3.Repaint;
end;
X0W:=X; Y0W:=Y;
end;
procedure TForm3.BitBtn1Click(Sender: TObject);
begin
Form3.Close;
end;
end.
Список литературы
1. Delphi 6. Справочное пособие. Архангельский А.Я. – М.: ЗАО «Издательство БИНОМ», 2001.
2. Эффективная работа: 3ds max 4. Маров М. – СПб.: Питер, 2002.
3. Геометрия. В 2-х ч. Ч. I. Учебное пособие для студентов физ.-мат. фак. пед. ин-тов. Атанасян Л.С., Базылев В.Т. – М.: Просвещение, 1986.