Компьютерное приложение "Сечение многогранников"

Понятие и основные свойства точки, определение ее места в пространстве. Алгоритм построения сечения пространственных тел. Способы визуализации трехмерного пространства. Создание компьютерного приложения для проектирования в трехмерном пространстве.

Рубрика Программирование, компьютеры и кибернетика
Вид курсовая работа
Язык русский
Дата добавления 04.02.2010
Размер файла 636,0 K

Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже

Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.

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;

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.


Подобные документы

  • Разработка компьютерного приложения "Кипящая жидкость" с применением навыков программирования на языке Java. Проектирование алгоритма для решения поставленной задачи, его предметная область. Создание приложения с графическим пользовательским интерфейсом.

    отчет по практике [3,0 M], добавлен 29.10.2015

  • Особенности процесса проектирования систем компьютерного управления объектами. Принципы построения системы компьютерного управления мехатронной системой. Составление алгоритма и программы управления с использованием языка Pascal и Assembler-вставок.

    курсовая работа [692,7 K], добавлен 06.02.2016

  • Написание алгоритма по построению сглаженной поверхности для границы трех атомов в пространстве. Создание приложения для ОС Windows, которое по заданным координатам и радиусам 3-х атомов, а также радиусу большого атома строит сглаженную поверхность.

    контрольная работа [432,6 K], добавлен 26.04.2011

  • Разработка алгоритма автоматизации работы компьютерного магазина, изменив и доработав имеющиеся модули в системе "1С" в соответствии с заявленными требованиями. Состав выполняемых функций. Требования к составу и параметрам технических средств приложения.

    дипломная работа [1,2 M], добавлен 26.09.2014

  • Объемное (твердотельное) геометрическое пространственное моделирование. Правило правой руки для построения системы координат. Выбор точки зрения в трехмерном пространстве. Пространство модели и пространство листа. Построение обечаек и шпангоутов.

    дипломная работа [3,6 M], добавлен 28.11.2009

  • Обследование объекта, обоснование необходимости систем компьютерного тестирования. Анализ существующих разработок и обоснование выбора технологии проектирования. Создание системы компьютерного тестирования на основе случайного выбора в среде Visual Basic.

    дипломная работа [2,4 M], добавлен 18.08.2013

  • Анализ существующего подхода к построению трехмерного изображения данных из симметричных матричных форм. Технические характеристики ПЭВМ, требования к документации. Функции, автоматизирующие процесс взаимодействия пользователей с графической информацией.

    дипломная работа [192,8 K], добавлен 05.06.2011

  • Редактирование в трехмерном пространстве. Команды редактирования, способы изменения значений параметров. Ввод и редактирование содержимого ячеек. Рабочие книги и листы. Ввод текста, чисел, исправление, формулы. Создание презентации в режиме структуры.

    контрольная работа [151,7 K], добавлен 22.02.2011

  • Основные инструменты построения Web-приложения. Язык сценариев PHP. Системный анализ предметной области базы данных. Коды SQL запросов на создание таблиц. Разработка Web-приложения. Описание функциональности модулей. Система управления содержимым статей.

    курсовая работа [4,8 M], добавлен 28.04.2014

  • Назначение и возможности разработанного приложения для визуализации картографической информации. Хранимые процедуры, функции и триггеры. Взаимодействие пользователя с приложением. Описание экранной формы по работе с картами. Визуализация карты в MS Visio.

    курсовая работа [2,1 M], добавлен 14.08.2014

Работы в архивах красиво оформлены согласно требованиям ВУЗов и содержат рисунки, диаграммы, формулы и т.д.
PPT, PPTX и PDF-файлы представлены только в архивах.
Рекомендуем скачать работу.