Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

b0m64t



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

PROGRAM HEXAEDR_ISOMETRY;
USES Crt, Graph;
VAR Gd, Gm: Integer; {Переменные для работы в графическом режиме}
hex: array[1..8, 1..3] of real; {Массив с координатами вершин}
hex2: array[1..8, 1..2] of integer; {Массив с координатами вершин в проекции}
grani: array[1..6, 1..4] of integer; {Массив граней гексаэдра}
i, j: integer; {Цикловые переменные}
ch: char; {Значение нажатой клавиши}
{=============================}
PROCEDURE Projectiya; {Расчет координат проекции}
CONST UgolX=35.26*Pi/180; {Угол вращения вокруг оси X}
UgolY=45*Pi/180; {Угол вращения вокруг оси Y}
BEGIN
For i:=1 To 8 Do Begin
hex2[i,1]:=round(hex[i,1]*cos(UgolY)+hex[i,3]*sin(UgolY))+320;
hex2[i,2]:=290-round(hex[i,1]*sin(UgolY)*sin(UgolX)+hex[i,2]*cos(UgolX)-hex[i,3]*cos(UgolY)*sin(UgolX));
End;
END;
{=============================}
FUNCTION VidimayaGran(i:integer): boolean; {Определение видимости i-й грани}
VAR V1,V2,N: array[1..3] of real;
scalar: real;
BEGIN
{Расчет значений 2-х векторов, лежащих в плоскости грани}
For j:=1 To 3 Do Begin
V1[j]:=hex[grani[i,2],j]-hex[grani[i,1],j];
V2[j]:=hex[grani[i,3],j]-hex[grani[i,1],j];
End;
{Вычисление вектора нормали грани}
N[1]:=V1[2]*V2[3]-V2[2]*V1[3];
N[2]:=V1[3]*V2[1]-V2[3]*V1[1];
N[3]:=V1[1]*V2[2]-V2[1]*V1[2];
{Определение видимости грани}
scalar:=N[1]-N[2]-N[3];
If scalar>0 Then
VidimayaGran:=true
Else
VidimayaGran:=false;
END;
{=============================}
PROCEDURE Draw; {Вывод на экран}
VAR gran: array[1..4] of PointType;
BEGIN
Projectiya;
For i:=1 To 6 Do Begin
If VidimayaGran(i) Then Begin {Если грань видима, то выводим ее на экран}
For j:=1 To 4 Do Begin
gran[j].x:=hex2[grani[i,j],1];
gran[j].y:=hex2[grani[i,j],2];
End;
SetFillStyle(1,i+8); {Устанавливаем цвет и стиль закраски}
FillPoly(4,gran);
End;
End;
END;
{=============================}
PROCEDURE VrachOY(Ugol: real); {Поворот вокруг оси OY}
VAR x,z: real;
BEGIN
For i:=1 To 8 Do Begin
x:=hex[i,1];
z:=hex[i,3];
hex[i,1]:=x*cos(Ugol)+z*sin(Ugol);
hex[i,3]:=-x*sin(Ugol)+z*cos(Ugol);
End;
END;
{=============================}
BEGIN
{Описываем гексаэдр}
hex[1,1]:=30; hex[1,2]:=0; hex[1,3]:=0;
hex[2,1]:=30; hex[2,2]:=150; hex[2,3]:=0;
hex[3,1]:=180; hex[3,2]:=150; hex[3,3]:=0;
hex[4,1]:=180; hex[4,2]:=0; hex[4,3]:=0;
hex[5,1]:=30; hex[5,2]:=0; hex[5,3]:=150;
hex[6,1]:=30; hex[6,2]:=150; hex[6,3]:=150;
hex[7,1]:=180; hex[7,2]:=150; hex[7,3]:=150;
hex[8,1]:=180; hex[8,2]:=0; hex[8,3]:=150;
{и грани}
grani[1,1]:=1; grani[1,2]:=2; grani[1,3]:=3; grani[1,4]:=4;
grani[2,1]:=5; grani[2,2]:=6; grani[2,3]:=2; grani[2,4]:=1;
grani[3,1]:=2; grani[3,2]:=6; grani[3,3]:=7; grani[3,4]:=3;
grani[4,1]:=4; grani[4,2]:=3; grani[4,3]:=7; grani[4,4]:=8;
grani[5,1]:=1; grani[5,2]:=4; grani[5,3]:=8; grani[5,4]:=5;
grani[6,1]:=5; grani[6,2]:=8; grani[6,3]:=7; grani[6,4]:=6;
 
Gd := Detect;
InitGraph(Gd, Gm, ''); {Инициализация графического режима}
If GraphResult <> grOk Then
Halt(1);
 
SetBkColor(Blue); {Устанавливаем цвет фона}
ClearDevice; {Очищаем экран}
Draw; {Выводим}
While ch<>#27 Do Begin {Пока не нажата клавиша "Esc", вращаем}
If keypressed Then
ch:=readkey; {Считываем значение нажатой клавиши}
VrachOY(pi/40); {Делаем поворот вокруг оси OY}
ClearDevice; {Очищаем экран}
Draw; {Выводим}
OuttextXY(10,465,'Press <Esc> to Exit');
Delay(8000);
End;
CloseGraph; {Завершение работы в графическом режиме}
END.

Всего записей: 46 | Зарегистр. 14-04-2007 | Отправлено: 15:10 26-04-2008
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Pascal/Object Pascal/Free Pascal (Delphi/Lazarus)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru