Министерство общего ипрофессионального образования Российской Федерации
Калужский ГосударственныйПедагогический Университет
им. К.Э. Циолковского
Физико-математическийфакультет
Кафедра алгебры иинформатики
Курсовая работа
Тема:
«Сечение многогранников»
Выполнил: студент IVкурса
физико-математическогофакультета
Мосин Евгений Валерьевич.
Научный руководитель:
Булычев В.А.
Калуга 2006г.
Содержание
Введение
Глава I. Пространственныетела и их сечения
1.1 Точка, прямая иплоскость в пространстве. Векторы
1.2 Преобразованияпространства
1.3 Пространственные тела
1.4 Поверхностивторого порядка
Глава II. Изучениесечений пространственных тел
2.1 Методы построениясечений многогранников
2.2 Задание сеченийпространственных тел
2.3 Построение сеченийпространственных тел. Алгоритм
2.4 Исследование свойствсечения
Глава III. Визуализация
3.1 Способывизуализации трехмерного пространства
3.2 Перекрытие
3.3 Освещенность
Глава IV. Созданиекомпьютерного приложения.
4.1 Постановка требованийк реализуемому проекту
4.2 Разработка интерфейсапрограммы
4.2.1 Окна проекций
4.2.2 Меню пользователя
4.2.3 Основные методыработы
4.2.4 Диалог просмотрасечения
Заключение
Приложение
Список литературы
Введение
Важнейшейзадачей педагогической науки является совершенствование планирования процессаобучения в целом и повышение эффективности управления познавательнойдеятельностью учащихся.
Поискиоптимальных путей управления обучением вылились в создание новой системыучебной работы, названной программированным обучением, одними из составляющихкоторого являются наглядность и интерактивность обучающих программ. В настоящейкурсовой работе мы рассмотрим возможность применения программированногообучения при изучении стереометрии, а именно сечения пространственных тел.
Но прежде всегонеобходимо отметить актуальность проблемы применения программированного (компьютерного)обучения.
В настоящеевремя наука и техника развиваются настолько быстро, что своевременное обобщениепотока научной информации без применения кибернетических средств, представляетзначительную трудность.
Не менее сложнымявляется сообщение учащимся знаний, так как их объем из года в годувеличивается, тогда как сроки и методы обучения остаются неизменными. В связис этим все большее число преподавателей приходит к выводу о недостаточноститрадиционных способов обучения и необходимости их совершенствования на основеновейших достижений науки и техники.
В школах ужепоявились компьютеры, но этого недостаточно. Самый лучший вариант – оснаститьподобным оборудованием каждый кабинет и включить элементы работы на компьютерев учебные программы по всем предметам. Но для этого необходима техническаябаза. Особо надо отметить содержание самих обучающих программ, применениекоторых должно быть эффективным, а для этого необходимо разработатьдидактический материал с учетом психолого-педагогических особенностей обучениягеометрии.
В настоящеевремя возможно использовать элементы программированного обучения в курсегеометрии, так как большинство способов решения задач требует наглядногопредставления, которое можно реализовать с помощью обучающих программ. Дляразвития у школьников стереометрического (пространственного) представления,плоских чертежей, представляющих собой проективное изображение пространственныхфигур, недостаточно необходимо создать инструмент, позволяющий интерактивноизучать стереометрию. В данном проекте мы остановимся на теме сеченияпространственных тел.
Задачипроекта:
1. Изучениетеоретического материала по теме проекта;
2. Созданиекомпьютерного приложения позволяющего изучать сечения пространственных тел;
3. Оценкапроделанной работы и выявление дальнейших путей развития данной темы.
Основная цельпроекта: создание инструмента, позволяющего наглядно и интерактивно изучатьпространственные тела и их сечения.
Промежуточныецели:
1. Разработатьспособ представления пространственных тел в памяти компьютера.
2. Разработатьспособ визуализации пространственных тел.
3. Создатьалгоритм построения сечения пространственных тел.
4. Рассмотретьиспользование и реализацию интерактивности создаваемого приложения.
5. Разработкаудобного, простого в обращении и достаточного полного интерфейса, создаваемогокомпьютерного приложения.
Программноеобеспечение: среда программирования Delphi 7, текстовые редакторы Блокнот и MSWord, графический редактор Paint.
Глава I. Пространственныетела
1.1 Точка,прямая и плоскость в пространстве. Векторы
Понятие точкаявляется определяющим понятием пространства, любая фигура пространства состоитиз множества точек. Хранение в памяти компьютера информации о элементахпространства будем осуществлять с помощью хранения координат точек определяющихданный элемент пространства. Так для хранения информации о прямой достаточновсего двух различных точек принадлежащих этой прямой. По двум точкам задающимпрямую можно составить каноническое уравнение прямой и далее оперировать этимуравнением:
/>, (1′)
где точки /> и /> принадлежатданной прямой. Или если использовать вектор /> т.е. />, получим следующее уравнениепрямой:
/>. (1′′)
Аналогичнопрямой, плоскость определяется тремя точками:
/>, (2′)
где точки />, />, /> принадлежатданной плоскости из этой матрицы можно получить уравнение плоскости:
/>, (2′′)
гдекоэффициенты />,/>,/>,/>определяются следующим способом:
/>;
/>;
/>;
/>.
Причем изэтих формул полезно знать, что координатами вектора нормального к даннойплоскости являются соответственно коэффициенты />,/>,/>. Этот вектор направлен вполупространство правого обхода точек.
Решая совместноуравнения (1′′) и (2′′) найдем координаты точки пересеченияпрямой и плоскости, при условии, что прямая пересекает плоскость. Пустьплоскость задана тремя точками: />, />, />, а прямая задана двумя точками: /> и />, тогдакоординаты точки пересечения />находятся по формулам:
/>,
где />, причем если />, то />; (1x)
/>,
где />, причем если />, то />; (1y)
/>,
где />, причем если />, то />. (1z)
В этихформулах координаты вектора />для прямой вычисляется следующимобразом: />.
1.2Преобразования пространства
Дляреализации интерактивности изучения пространственных тел необходимо реализоватьвозможность перемещения, поворота и масштабирования, а для этого необходимоизменять координаты точек фигур по соответствующему закону. Рассмотрим трипреобразования которые переводят каждую точку /> в точку />:
1. Перемещение(параллельный перенос на вектор />).
/> (1p)
2. Поворотвокруг прямой на угол />. Поворот будем осуществлятьвокруг одной из осей координат.
а) вокруг осиOX:
/> (2px)
б) вокруг осиOY:
/> (2py)
в) вокруг осиOZ:
/> (2pz)
3. Масштабированиес коэффициентом />.
/> (3p)
1.3 Пространственныетела
Как ужеговорилось, в памяти компьютера пространственные тела будем хранить в видекоординат точек определяющих эти тела. Рассмотрим далее, как хранить те илииные виды пространственных тел и рассмотрим основные способы создания фигур. Приописании многогранников необходимо задание координат всех вершинмногогранников, а также описание порядка обхода каждой грани. Удобно описыватьобход граней почасовой стрелке наблюдая многогранник из вне, тогда нормальныйвектор к грани, заданный тройкой следующих подряд вершин, будет направлен измногогранника. Это свойство удобно использовать при визуализации выпуклыхмногогранников, об этом будет рассказано позднее. С многогранниками всепонятно, а как описывать поверхности второго порядка (поверхности вращения, коническиеповерхности, цилиндрические поверхности, эллипсоид, гиперболоид, параболоид).Их можно представить в виде многогранника с большим количеством граней, и чембольше количество граней, тем точнее приближение. Этот метод являетсяуниверсальным, он позволяет описывать комбинированные пространственные тела, ноне позволяет изучать алгебраические кривые, которые получаются при построениисечений. Приведем общую структуру файла, описывающего многогранник. Файлпредставляет собой обычный текстовый документ.
Количество вершин многогранника.
Координаты 1й вершины через пробел.
Координаты 2й вершины через пробел.
Количество граней многогранника.
Порядок обхода 1й грани через пробел.
Порядок обхода 2й грани через пробел.
Примерописания куба с ребром равным 2.
8
0 0 2
2 0 2
2 2 2
0 2 2
0 0 0
2 0 0
2 2 0
0 2 0
6
1 5 8 4
2 3 7 6
5 6 7 8
4 3 2 1
3 4 8 7
2 6 5 1
/>
1.4 Поверхностивторого порядка№ Название. Способ описания. 1. Конус Как пирамида с большим числом вершин, в основании которой лежит правильный многоугольник. 2. Цилиндр Как призма с большим числом вершин, основаниями которой являются правильные многоугольники. 3. Сфера Многогранник, описанный по принципу параллелей и меридианов. 4. Тор Совокупность косоугольных цилиндров.
Пример1: Методовполучения координат точек сферы.
for iy:=0 to ny-1 do
for ix:=0 to nx do
begin
x:=r*sin(iy*pi/ny)*cos(2*ix*pi/nx);
y:=r*sin(iy*pi/ny)*sin(2*ix*pi/nx);
z:=r*cos(iy*pi/ny);
x:=r*sin((iy+1)*pi/ny)*cos(2*ix*pi/nx);
y:=r*sin((iy+1)*pi/ny)*sin(2*ix*pi/nx);
z:=r*cos((iy+1)*pi/ny);
end;
/>
Глава II.Изучение сечений пространственных тел
2.1Методы построения сечений многогранников
Геометрическиезадачи традиционно делятся на три типа:
1) навычисление;
2) надоказательство;
3) напостроение.
/>
Решениелюбых стереометрических задач требует не только вычислительных и логическихумений и навыков, но и умений изображать пространственные фигуры на плоскости(например, на листе бумаги, классной доске), что по сути своей тесно связано стемой «Геометрические построения на плоскости». Стереометрические задачи навычисления и доказательство легко можно решать, используя правильный рисунокпространственной фигуры. При изучении тем «Параллельность прямых и плоскостей впространстве», «Перпендикулярность прямых и плоскостей», «Углы между прямой иплоскостью, между двумя прямыми, между двумя плоскостями» и других темпрекрасным иллюстрационным материалом является решение позиционных иметрических задач на построение пространственных фигур и сечений этих фигурплоскостями. Основными методами построения сечений многогранников являютсяследующие методы:
1. Методследов. Суть метода заключается в построении вспомогательной прямой, являющейсяизображением линии пересечения секущей плоскости с плоскостью какой-либо гранифигуры. Удобнее всего строить изображение линии пересечения секущей плоскости сплоскостью нижнего основания. Эту линию называют следом секущей плоскости.Используя след, легко построить изображения точек секущей плоскости,находящихся на боковых ребрах или гранях фигуры. Последовательно соединяяобразы этих точек, получим изображение искомого сечения.
2. Методвспомогательных сечений. Этот метод построения сечений многогранников являетсяв достаточной мере универсальным. В тех случаях, когда нужный след (или следы)секущей плоскости оказывается за пределами чертежа, этот метод имеет дажеопределенные преимущества. Вместе с тем следует иметь в виду, что построения,выполняемые при использовании этого метода, зачастую получаются «скученными».Тем не менее, в некоторых случаях метод вспомогательных сечений оказываетсянаиболее рациональным.
3. Комбинированныйметод построения сечений. Суть комбинированного метода построения сечениймногогранников состоит в применении теорем о параллельности прямых и плоскостейв пространстве в сочетании с методом следов и методом вспомогательных сечений.
4. Координатныйметод построения сечений. Суть координатного метода заключается в вычислениикоординат точек пересечения ребер или многогранника с секущей плоскостью,которая задается уравнением плоскости. Уравнение плоскости сечения вычисляетсяна основе условий задачи.
Извсех перечисленных способов построения сечения наиболее приемлемым являетсякоординатный метод, так как он связан с большим объемом вычислений и имеетпростой алгоритм реализации, что целесообразно реализовать с помощью ЭВМ.Достаточно знать координаты вершин каждой грани многогранника и три точкизадающие плоскость сечения.
2.2Задание сечений пространственных тел
Какуже говорилось, удобнее всего задавать плоскость сечения тремя точками, причемкоординаты этих точек должны быть известны или должны вычисляться. Рассмотримвозможные варианты задания точек плоскости сечения:
1) точкарасположена вне многогранника;
2) точканаходится внутри многогранника;
3) точкарасположена в грани многогранника;
4) точкапринадлежит ребру многогранника;
5) точкапринадлежит диагонали многогранника;
6) точкасовпадает с вершиной многогранника.
Условиезадания секущей плоскости тремя точками будет выполняться не всегда и в этомслучае придется вычислять уравнение плоскости сечения, используя другие методы.В данной работе рассматривается лишь способ задания тремя точками.
2.3 Построениесечений пространственных тел. Алгоритм
Метод построениясечения заключается в нахождении точек пересечения секущей плоскости с гранямимногогранника, а вернее с ребрами многогранника. Проверка на пересечениесекущей плоскости и ребра многогранника производится следующим образом:
1. Составлениеуравнения секущей плоскости по трем точкам;
2. Подстановкав уравнение координат концов ребра с целью проверки: расположены ли точки вразных полупространствах относительно плоскости сечения.
3. Нахождениеточки пересечения ребра многогранника и плоскости сечения.
Для каждойграни записываются две точки, причем запись производится только для тех граней,где плоскость сечения пересекла два ребра. Далее используя полученные данные,строится многоугольник сечения следующим образом:
1. Беремпервую пару точек и ищем следующую пару точек в которой повторяется одна източек первой пары.
2. Найдяследующую пару проделываем для нее тоже самое, что и для первой пары, ноисключаем из поиска первую пару.
3. Проделываемвесь алгоритм для каждой пары, пока не останется одна ненайденная точка.
4. Полученнаяцепочка является последовательным описанием ребер многоугольника сечения.
Далеезапоминаем полученный многоугольник, как новую грань многогранника.
2.4 Исследованиесвойств сечения
Перечислимнекоторые свойства сечения (исходя из факта, что сечением являетсямногоугольник).
1. Уравнениеплоскости сечения.
2. Количествовершин многоугольника сечения.
3. Площадьмногоугольника сечения.
4. Координатывершин многоугольника сечения.
5. Двугранныйугол между плоскостью сечения и гранями многогранника.
6. Углыпри вершинах многоугольника сечения.
Некоторые изэтих свойств реализованы в программе (1,2,3,4).
/>
Пример:Нахождение площади сечения. Так как строятся сечения выпуклых многогранников,то многоугольник сечения будет тоже выпуклым, т.е. его площадь можно найтиразбиением на треугольники (площадь сечения равна сумме площадей треугольниковиз которых оно составлено).
Глава III.Визуализация
3.1 Способывизуализации трехмерного пространства
Длявизуализации используются два вида проекций: параллельные (аксонометрические)(на рисунке слева) и центральные (перспективные)
(на рисункесправа). При построении аксонометрической проекции пространственного тела его отдельныеточки сносятся на плоскость проекции параллельным пучком лучей, а припостроении центральной проекции – пучком лучей исходящих из одной точки,соответствующей положению глаз наблюдателя. Частным случаем аксонометрическойпроекции является проекция ортографическая, при построении которой плоскостьпроекции выравнивается параллельно одной из координатных плоскостей.
/>
3.2Перекрытие
Подперекрытием понимается тот факт, что невозможно одновременно видеть все гранимногогранника и какие — то грани обязательно окажутся невидимыми. Проблемасостоит в том, как узнать какие грани видны, а какие нет. В проекте мырассматриваем только выпуклые многогранники, поэтому для реализации перекрытияиспользуется тот факт, что нормальный вектор к каждой грани направлен извне.Т.е. если использовать ортографическую проекцию, то тот факт, что координатнаясоставляющая (оси проекции) нормального вектора положительна, то грань видима,если отрицательна, то грань перекрыта.
/>
3.3Освещенность
Освещенностьграней вычисляется путем, вычисления угла (синуса угла) между нормальнымвектором к грани и осью ортографической проекции.
Глава IV. Созданиекомпьютерного приложения
4.1 Постановкатребований к реализуемому проекту
1. Простотаиспользования.
2. Полнотанеобходимых инструментов и возможностей.
3. Интерактивность.
4. Быстротаработы.
5. Простотасоздания входного файла.
4.2 Разработкаинтерфейса программы
Приразработке интерфейса программы уклон делался на стандартизацию меню и удобствоиспользования. Также необходима функция встроенных подсказок (всплывающих и встроке состояния).
4.2.1 Окнапроекций
В программеиспользуются три окна проекции: вид сверху, вид слева, вид спереди,перспектива. Размер окон проекции изменяется путем перемещения центаразделителя. Также здесь показаны оси координат. Существует возможностьвключения координатной сетки.
/>
4.2.2 Менюпользователя
Файл
Открыть(загрузка файла многогранника).
Сохранить(сохранение файла).
Выход (выходиз программы).
Правка
Сброс (сбросвсех измененных параметров).
Вид
Каркас(отображаются ребра многогранника).
Заливка(вывод граней, с расчетом их освещенности).
Обозначить(обозначить вершины многогранника).
Сетка (выводсетки координат).
Инструменты
Выбрать(позволяет выбирать и перемещать точки задающие сечение).
Переместить(перемещение многогранника).
Повернуть(поворот многогранника).
Масштаб(масштаб окон проекций).
Стирка(позволяет отключать заливку выбранной грани).
Заливка(позволяет включить заливку выбранной грани).
Ограничить(ограничение манипулирования сценой по осям координат).
Цент поворота(изменение центра поворота).
Распространить(изменять координаты точек задающих сечение вместе с координатамимногогранника).
Сечение
Построить(построение сечения путем задания трех точек плоскости сечения).
Удалить(удаление сечения).
Вид (настройкавида сечения).
Привязать(привязка выбранной точки сечения к элементам многогранника).
Просмотр(окно просмотра сечения).
Настройка
Цвет (вызовдиалога изменения цветовой схемы)
4.2.3 Основныеметоды работы
Основнойметод работы заключается в выборе инструмента, затем наведении курсора наобъект действия и манипуляция с помощью нажатия клавиши мыши.
4.2.4 Диалогпросмотра сечения
Выводмногоугольника сечения производится с помощью поворота плоскости сечения вположение параллельности плоскости XOY.
/>
Заключение
В заключенииданного проекта рассмотрим возможные пути дальнейшего развития проекта и егоиспользования, а также оценку выполнения поставленной задачи и отметимполученные результаты. Поставленная перед началом работы цель: созданиеинструмента, позволяющего наглядно и интерактивно изучать пространственные телаи их сечения – реализована.
Созданоприложение, которое позволяет загружать пространственные тела и манипулироватьими – это уже можно использовать при начальном изучении пространственных тел.Далее в программе реализована функция построения сечения пространственных фигурплоскостью, которая задается тремя точками, координаты которых можно изменять.Минусом программы является возможность изучения только выпуклых фигур иневозможность построения более одного сечения.
Путидальнейшего развития проекта:
1. Построениенескольких сечений;
2. Возможностьзагрузки невыпуклых фигур;
3. Подборзадач решаемых с помощью созданного приложения;
4. Разработкаметодик применения программы в обучении;
5. Созданиеконструктора пространственных тел;
6. Созданиеинтерактивного инструмента для построения сечений пространственных фигураксиоматическим методом («Живая стереометрия»);
7. Созданиеобучающего модуля и методического сопровождения к нему;
8. Применениена практике.
Изучаемая вданной курсовой работе тема, должна быть изучена до конца, так как это можетнайти целесообразное и удачное применение на практике.
Приложение
Текстпрограммы
unit Unit1;
interface
uses
Windows, Messages,SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Menus,ExtCtrls, jpeg, ToolWin, StdCtrls, ImgList;
type
Point=record x,y,z:realend; {координаты точки}
Vector=record x,y,z:realend; {координаты ветора}
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);
procedureCentrMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedureCentrMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedure FormCreate(Sender:TObject); procedure FormResize(Sender: TObject); procedure N2Click(Sender:TObject);
procedureITopClick(Sender: TObject); procedure IFrontClick(Sender: TObject); procedureILeftClick(Sender: TObject);
procedureITopMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedureIFrontMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedureILeftMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure N3Click(Sender:TObject); procedure N33Click(Sender: TObject); procedureToolButton1Click(Sender: TObject); procedure ToolButton2Click(Sender: TObject);procedure FormPaint(Sender: TObject);
procedureITopMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureIFrontMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureILeftMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureN25Click(Sender: TObject); procedure N21Click(Sender: TObject);
procedureN22Click(Sender: TObject); procedure N8Click(Sender: TObject);
procedureN16Click(Sender: TObject); procedure IntWiewClick(Sender: TObject);
procedureN27Click(Sender: TObject); procedure N28Click(Sender: TObject);
procedureN29Click(Sender: TObject); procedure N34Click(Sender: TObject);
procedureN36Click(Sender: TObject); procedure N37Click(Sender: TObject);
procedure N9Click(Sender:TObject); procedure N10Click(Sender: TObject);
procedureIPerspectiveClick(Sender: TObject);
procedureN41Click(Sender: TObject); procedure N14Click(Sender: TObject);
procedureN18Click(Sender: TObject); procedure ToolButton4Click(Sender: TObject);
procedureToolButton5Click(Sender: TObject); procedure ToolButton6Click(Sender: TObject);
procedureToolButton7Click(Sender: TObject); procedure ToolButton8Click(Sender: TObject);
procedureToolButton9Click(Sender: TObject); procedure ToolButton12Click(Sender:TObject);
procedureToolButton11Click(Sender: TObject); procedure ToolButton19Click(Sender:TObject);
procedureToolButton13Click(Sender: TObject); procedure N24Click(Sender: TObject);
procedureN19Click(Sender: TObject); Function Normal (A,B,C:Point):Vector;
procedureMag1Click(Sender: TObject); procedure Mag2Click(Sender: TObject);
procedureMag3Click(Sender: TObject);
private
{ Private declarations }
Procedure DrawGrane;
public
{ Public declarations }
end;
constGran=10000;{Максимум ганей}
Pointer=10000;{Максимумвершин}
Lok=0.00001;{Погрешностьсечения}
SizeT=5;{Размер точексечения}
Sumbol='A';{Обозначениеточек}
type
TView=array [1..gran]ofrecord Visible:boolean;{Флаг активного окна}
Paint:boolean;
BrushGr:boolean;{Флагзаливки грани}
PenRb:boolean;{Флаготрисовки ребер}
Intersection:boolean;{Флагналичия сечения}
ColorGr,ColorRb:TColor{Цвет:грани, ребра} end;
TMainVar=recordCx,Cy:integer; Mash:real;Net:boolean; end;
var
Form1: TForm1;
V:array[1..pointer]ofPoint;{координаты вершин}
E:array[1..gran,0..pointer]ofinteger;{грани [номер грани, номер вершины]}
Scene:array[1..4]of recordG: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]ofPoint;
Count:byte;
kl:integer;
A,B,C,D,P1,P2,P3:real;
PanelWindow:array[1..4]ofTPanel;
WindowProection:array[1..4]ofTImage;
NameWindows:array[1..4]ofstring=('Вид сверху','Вид спереди','Вид слева','Перспектива');{Название окон}
OsiX:array[1..4]ofstring=('x','x','y','x');
OsiY:array[1..4]ofstring=('z','y','x','z');
OsiZ:array[1..4]ofstring=('y','z','z','y');
Magnit:array[1..3]ofTMenuItem;
MagPoint:array[1..3,1..2]ofPoint;
First:array[1..3]ofboolean;
MPI:boolean;
implementation
uses Unit2,Unit3;
//Перевод вещественныхкоординат в экранные
Function Ser(win:byte;T:Point; Main:TMainVar):TPoint;
var CopySer:Tpoint;
begin
case win of
1: beginCopySer.X:=round(Main.Cx+(T.x*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.y*Main.Mash))end;
2: beginCopySer.X:=round(Main.Cx+(T.x*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.z*Main.Mash))end;
3: beginCopySer.X:=round(Main.Cx+(T.y*Main.Mash));
CopySer.Y:=round(Main.Cy-(T.z*Main.Mash))end;
4: beginCopySer.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: beginCopyUnSer.x:=(X-Main.Cx)/Main.Mash;
CopyUnSer.y:=(Main.Cy-Y)/Main.Mash;CopyUnSer.z:=Tz end;
2: beginCopyUnSer.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.Mashend;
end;
UnSer:=CopyUnSer
end;
ProcedureTForm1.DrawGrane;
ProcedureGranBrush(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);
ifScene[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].PenRbthen
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;
//* Оси координат
ProcedureLineOs(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;
// Система координат
ProcedureInpOboz(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.Enabledand Form1.N46.Checked then
GranBrush(Scene[j].M,j,M+1,psSolid,WindowProection[j]);
for i:=1 to M do
if (notScene[j].G[i].Visible) then
GranBrush(Scene[j].M,j,i,psDot,WindowProection[j]);
if Form1.IntWiew.Enabledand 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].Visiblethen
GranBrush(Scene[j].M,j,i,psSolid,WindowProection[j]);
if Form1.N24.Checked orForm1.N19.Checked then
for i:=1 to M do
if Scene[j].G[i].Visiblethen
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}
//* Активация окна
ProcedureActivWindowProection(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;
//* Полуплоскость
FunctionSelectGran(i,x,y:integer):integer;
FunctionPoluploscost(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].Visiblethen
begin
for j:=1 to E[k,0]-1 do
case i of
1: ifPoluploscost(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 notPoluploscost(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: ifPoluploscost(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: ifPoluploscost(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 notPoluploscost(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: ifPoluploscost(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;
//* Выбор точек сечения
ProcedureMoveP(win,j,X,Y:integer);
ProcedurePNormal(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 (P1O0) and(P2O0) then
if(sqrt(Q)/P1O
if P1O/P2O
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;
ProcedureSelectPointIntersection(i,x,y:integer;var Num:integer);
FunctionSelP(X,Y,Xt,Yt,ST:real):boolean;
var Obl:boolean;
begin
Obl:=false;
if (X(Xt-ST)) then
if (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: ifSelP((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: ifSelP((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: ifSelP((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;
FunctionSelReber(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))
end;
ProcedureFindRb(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
ifScene[win].G[j].Visible then
begin
for k:=1 to E[j,0]-1 do
begin
case win of
1: ifLinEx(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: ifLinEx(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: ifLinEx(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: ifLinEx(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: ifLinEx(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;
ProcedurePenRebPr(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;
//* Реализация поворота
ProcedureRotate(Ax,Ay,Az:real;Ox,Oy,Oz:real);{поворот вокруг оси все точкимногогранника}
procedure Transfer(varT: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(varT: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; varP: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; varP:Point);{поворот вокруг оси OY одной точки}
var Q:Point;
beginQ.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; varP:Point);{поворот вокруг оси OZ одной точки}
var Q:Point;
beginQ.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 dobeginTransfer(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 beginTransfer(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;
//* Реализацияперемещение
ProcedureMove(Lx,Ly,Lz:real);
var i:integer;
begin
if Form1.N17.Checked then
for i:=1 to Count dobeginInterPoint[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 beginV[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
ifForm1.Centr.Left+Form1.Centr.Width>Form1.ClientWidth then
Form1.Centr.Left:=Form1.ClientWidth-Form1.Centr.Width;
ifForm1.Centr.Top+Form1.Centr.Height>Form1.GroupBox1.Top then
Form1.Centr.Top:=Form1.GroupBox1.Top-Form1.Centr.Height;
ifForm1.Centr.Top
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].Widthdiv 2;
Scene[i].M.Cy:=WindowProection[i].Heightdiv 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]ofPoint;
Para,Count:integer;
Gp:array[0..gran]ofPoint;
ProcedureUravPl(A1,A2,A3:Point; var A,B,C,D:real);{Уравнение плоскости сечения}
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;{Точки сечения}
varKx,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 beginIP:=p; Yes:=true end else
if P1*P2
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;{Построениемногоугольника сечения}
FunctionRavPoi(a,b:point; Er:real):boolean;
var rez:boolean;
begin
rez:=false;
if abs(a.x-b.x)
if abs(a.y-b.y)
if abs(a.z-b.z)
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
ifRavPoi(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;
ifRavPoi(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
ifSec(V[E[i,j]],V[E[i,j+1]],A,B,C,D,Gp[Para]) then inc(para);
if Para>2 then Break;
end;
ifSec(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;
ProcedureWindowsMove(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 beginMoveP(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) andForm1.N34.Checked then
if Scene[i].M.Mash-(Y-Y0)>0then 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 k0 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 k0 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 andForm1.IntWiew.Enabled then
for h:=1 to 3 do ifFirst[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 andForm1.IntWiew.Enabled and (not FirstTrue)then
begin
SelectPointIntersection(i,X,Y,kl);
if kl0 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.Checkedthen
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;
procedureTForm1.N5Click(Sender: TObject);
begin
Form1.Close;
end;
//* Изминение размер оконпроекций
procedureTForm1.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.Centr.Left:=Form1.Centr.Left+X;
if(Form1.Centr.Top+Y>=Form1.ToolBar1.Height)and((Form1.Centr.Top+Y)
Form1.Centr.Top:=Form1.Centr.Top+Y;
MoveOs;
end
end;
procedureTForm1.CentrMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
begin
MoveWindow;
end;
procedureTForm1.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;
procedureTForm1.FormResize(Sender: TObject);
begin
MoveOs;
MoveWindow;
end;
//Загрузка многогранникаиз файла
procedureTForm1.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 Mdo{Установка вида изображения}
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].Activethen{Активация окна проекции вид сверху}
ActivWindowProection(1);
end;
procedureTForm1.IFrontClick(Sender: TObject);
begin
if not Scene[2].Activethen{Активация окна проекции вид спереди}
ActivWindowProection(2);
end;
procedureTForm1.ILeftClick(Sender: TObject);
begin
if not Scene[3].Activethen{Активация окна проекции вид слева}
ActivWindowProection(3);
end;
procedureTForm1.ITopMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[1].Active then
begin
WindowsMove(X,Y,1,shift);
end;
end;
procedureTForm1.IFrontMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[2].Active then
WindowsMove(X,Y,2,shift);
end;
procedureTForm1.ILeftMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Scene[3].Active then
WindowsMove(X,Y,3,shift);
end;
//* Сохранениемногогранника
procedureTForm1.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;
procedureTForm1.N33Click(Sender: TObject);
begin
ShowMessage('Курсоваяработа. Мосин Е.В. ФМ-43');
end;
procedureTForm1.ToolButton1Click(Sender: TObject);
begin
Form1.N2.Click;
end;
procedureTForm1.ToolButton2Click(Sender: TObject);
begin
Form1.N3.Click;
end;
//* Перерисовка формы
procedureTForm1.FormPaint(Sender: TObject);
ProcedureColorLight(i:integer;ColorEder,ColorUnEder:TColor);
var
j:integer;
n:vector;
c:real;
NorVec:array[1..4]ofreal;
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].Visiblethen
Scene[j].G[i].colorgr:=(round(NorVec[j]/c*(ColorEdermod 256))*$1)+(round(NorVec[j]/c*((ColorEder div $100) mod256))*$100)+(round(NorVec[j]/c*((ColorEder div $10000) mod 256))*$10000)
else if c0 then
Scene[j].G[i].colorgr:=abs((round(NorVec[j]/c*(ColorUnEdermod 256))*$1)+(round(NorVec[j]/c*((ColorUnEder div $100) mod256))*$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.Enabledthen
begin
BildInter;
ColorLight(M+1,ColorIntersection,ColorIntersection);
for j:=1 to 3 do
Scene[j].G[M+1].Visible:=true;
end;
DrawGrane;
Puk;
end;
//* Задание точек сечения
ProcedureEnterPointIntersection(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 k0 then
Scene[i].G[k].Paint:=false;
end;
if Form1.N37.Checked then
begin
k:=SelectGran(i,X,Y);
if k0 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 andForm1.IntWiew.Enabled then
for k:=1 to 3 do
if First[k] andSelReber(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;
procedureTForm1.ITopMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
begin
EnterPointIntersection(1,X,Y);
end;
procedureTForm1.IFrontMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
begin
EnterPointIntersection(2,X,Y);
end;
procedureTForm1.ILeftMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
begin
EnterPointIntersection(3,X,Y);
end;
//* Включение сетки
procedureTForm1.N25Click(Sender: TObject);
var i:byte;
begin
for i:=1 to 3 do
if Scene[i].Active then
Scene[i].M.Net:=notScene[i].M.Net;
Form1.Repaint;
end;
//* Включение ребер
procedureTForm1.N21Click(Sender: TObject);
var i,j:integer;
begin
Form1.N21.Checked:=notForm1.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;
//* Включение заливки
procedureTForm1.N22Click(Sender: TObject);
var i,j:integer;
begin
Form1.N22.Checked:=notForm1.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;
//* Вызов диалогаизменения цвета
procedureTForm1.N16Click(Sender: TObject);
begin
Application.CreateForm(TForm2,Form2);
end;
//* Вызов окна просмотрасечения
procedureTForm1.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;
procedureTForm1.N27Click(Sender: TObject);
begin
Form1.ToolButton4.Down:=true;
end;
procedureTForm1.N28Click(Sender: TObject);
begin
Form1.ToolButton5.Down:=true;
end;
procedureTForm1.N29Click(Sender: TObject);
begin
Form1.ToolButton6.Down:=true;
end;
procedureTForm1.N34Click(Sender: TObject);
begin
Form1.ToolButton7.Down:=true;
end;
procedureTForm1.N36Click(Sender: TObject);
begin
Form1.ToolButton8.Down:=true;
end;
procedureTForm1.N37Click(Sender: TObject);
begin
Form1.ToolButton9.Down:=true;
end;
procedureTForm1.N9Click(Sender: TObject);
begin
Form1.ToolButton11.Down:=Form1.N9.Checked;
end;
procedureTForm1.N10Click(Sender: TObject);
begin
Form1.ToolButton19.Down:=Form1.N10.Checked;
end;
//---------------------------------------------------------
procedureTForm1.IPerspectiveClick(Sender: TObject);
begin
if not Scene[4].Activethen{Активация окна перспективы}
ActivWindowProection(4);
end;
//* Удаление сечения
procedureTForm1.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;
//* Сброс
procedureTForm1.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;
//---------------------------------------------------------
procedureTForm1.N18Click(Sender: TObject);
begin
Form1.Repaint;
end;
procedureTForm1.ToolButton4Click(Sender: TObject);
begin
Form1.N27.Click;
end;
procedureTForm1.ToolButton5Click(Sender: TObject);
begin
Form1.N28.Click;
end;
procedureTForm1.ToolButton6Click(Sender: TObject);
begin
Form1.N29.Click;
end;
procedureTForm1.ToolButton7Click(Sender: TObject);
begin
Form1.N34.Click;
end;
procedureTForm1.ToolButton8Click(Sender: TObject);
begin
Form1.N36.Click;
end;
procedureTForm1.ToolButton9Click(Sender: TObject);
begin
Form1.N37.Click;
end;
procedureTForm1.ToolButton12Click(Sender: TObject);
begin
Form1.N8.Click;
end;
procedureTForm1.ToolButton11Click(Sender: TObject);
begin
Form1.N9.Click;
end;
procedureTForm1.ToolButton19Click(Sender: TObject);
begin
Form1.N10.Click;
end;
procedureTForm1.ToolButton13Click(Sender: TObject);
begin
Form1.N40.Click;
end;
procedure TForm1.N24Click(Sender:TObject);
begin
Form1.Repaint;
end;
procedureTForm1.N19Click(Sender: TObject);
begin
Form1.Repaint;
end;
//---------------------------------------------------------
procedureTForm1.Mag1Click(Sender: TObject);
begin
if Mag1.Checked then
First[1]:=true;
end;
procedureTForm1.Mag2Click(Sender: TObject);
begin
if Mag2.Checked then
First[2]:=true;
end;
procedureTForm1.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;
procedureFormCreate(Sender: TObject);
procedureShape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureShape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureShape3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedure Shape4MouseUp(Sender:TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureShape5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureShape6MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:Integer);
procedureBitBtn1Click(Sender: TObject);
procedureCD1Close(Sender: TObject);
procedureShape7MouseUp(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}
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.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;
procedureTForm2.BitBtn1Click(Sender: TObject);
begin
Form2.Close
end;
procedureTForm2.CD1Close(Sender: TObject);
begin
Form1.Repaint;
end;
procedureTForm2.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;
procedureFormCreate(Sender: TObject);
procedureEdit2KeyPress(Sender: TObject; var Key: Char);
procedureEdit1KeyPress(Sender: TObject; var Key: Char);
procedureFormPaint(Sender: TObject);
procedureFormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedureBitBtn1Click(Sender: TObject);
private
{ Private declarations }
procedurePaintIntersection;
public
{ Public declarations }
end;
var
Form3: TForm3;
CxW,CyW,X0W,Y0W:integer;
MashW:real;
PInter:array of TPoint;
implementation
uses Unit1,Unit2;
procedureTForm3.PaintIntersection;
var i:integer;
Nor:Vector;
C1,S1,x:real;
FG:array[1..1000] ofPoint;
begin
CxW:=(Form3.Width+Form3.GroupBox1.Width)div 2;
CyW:=(Form3.Height) div2;
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.y0) and(Nor.z0) 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:=0end;
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.x0) and(Nor.z0) 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:=0end;
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}
procedureTForm3.FormCreate(Sender: TObject);
functionPloshad(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) div2;
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;
procedureTForm3.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
Key:=#0;
end;
procedureTForm3.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Key:=#0;
end;
procedureTForm3.FormPaint(Sender: TObject);
begin
PaintIntersection;
end;
procedureTForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then
begin
if MashW-(Y-Y0W)>0then MashW:=MashW-(Y-Y0W) else ShowMessage('Масштаб: меньше нельзя!');
Form3.Repaint;
end;
X0W:=X; Y0W:=Y;
end;
procedureTForm3.BitBtn1Click(Sender: TObject);
begin
Form3.Close;
end;
end.
Списоклитературы
1. Delphi6. Справочное пособие. Архангельский А.Я. – М.: ЗАО «Издательство БИНОМ», 2001.
2. Эффективнаяработа: 3ds max 4. Маров М. – СПб.: Питер, 2002.
3. Геометрия.В 2-х ч. Ч. I. Учебное пособие для студентов физ.-мат. фак. пед. ин-тов.Атанасян Л.С., Базылев В.Т. – М.: Просвещение, 1986.