Размещено на http://allbest.ru

ВВЕДЕНИЕ

язык турбо паскаль

Что такое язык программирования, для чего нужен. Для чего используется графика.

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

В данной курсовой работе рассмотрены следующие вопросы:

Ш различие между текстовым и графическим режимами работы монитора.

Ш познакомиться с возможностями графических операторов;

Ш построение графических изображений в Паскале;

Ш познакомиться с возможностями анимации;

Ш построение анимационных изображений в Паскале.

В курсовой работе рассматривается теоретический материал и приведены примеры программ, заключается в возможностях управления выводом визуальной информации. В текстовом режиме минимальным объектом, отображаемым на экране, является символ, алфавитно-цифровой или какой-либо иной. В обычных условиях экран монитора, работающего в режиме алфавитно-цифрового дисплея, может содержать не более 80 символов по горизонтали и 25 символов по вертикали, то есть всего 2000 визуальных объектов. При этом имеются ограниченные возможности по управлению цветом символов. Конечно, в таком режиме можно выводить на экран не только обычный текст, но и некие графические изображения, однако понятно, что качество таких изображений будет вне всякой критики. Тем не менее, в «героическую» эпоху компьютерной эры этот метод был единственным и поэтому очень популярным способом вывода графиков и целых картин на экран (и на принтер). Программистам иногда удавалось создавать настоящие шедевры «компьютерной псевдографики». Но для серьезной работы с изображениями текстовый режим дисплея абсолютно не подходит.

В графическом режиме минимальным объектом, выводом которого может управлять программист, является так называемый пиксел (от английского Pixel, возникшего в результате объединения слов «рисунок» (picture) и «элемент» (element)). Пиксел имеет меньшие размеры по сравнению с символом (на один символ в текстовом режиме отводится площадка размером в несколько пикселов). Его геометрические размеры определяются разрешением монитора.

Разрешение монитора обычно задается в виде rx * ry , где rx -- количество пикселов на экране по горизонтали, а ry -- количество пикселов по вертикали.

На практике используются не произвольные, а некоторые определенные значения разрешения. Такими разрешениями являются, Например, 320х200, 640х480, 800х600, 1024х768, 1280х1024 и т.д.

1.Turbo Pascal

Среда разработки Turbo Pascal 7.1 (Рис 1)

1.1 О Turbo Pascal

Turbo Pascal (произносится «турбо паскаль») -- Интегрированная среда разработки программного обеспечения для платформ DOS и Windows 3.x и язык программирования в этой среде, диалект языка Паскаль от фирмы Borland.

Товарный знак Borland Pascal был зарезервирован для дорогих вариантов поставки (с большим количеством библиотек и исходным кодом стандартной библиотеки), оригинальная дешёвая и широко известная версия продавалась как Turbo Pascal. Название Borland Pascal также используется в более широком смысле -- как неофициальное название версии языка Паскаль от фирмы Borland.

1.2 История

Turbo Pascal -- это среда разработки для языка программирования Паскаль. Используемый в Turbo Pascal диалект базировался на более раннем UCSD Pascal, получившем распространение, в первую очередь, на компьютерах серии Apple II. Компилирующая компонента Turbo Pascal была основана на компиляторе Blue Label Pascal, первоначально созданном в 1981 году Андерсом Хейлсбергом для операционной системы NasSys микрокомпьютера Nascom. Позднее он был переписан как Compass Pascal для операционной системы CP/M, затем как Turbo Pascal для DOS и CP/M. Одна из версий Turbo Pascal была доступна под Apple Macintosh примерно с 1986 года, но её разработка прекратилась примерно в 1992 году.

В 1982 году Филипп Кан приобрёл компилятор у Андерса Хейлсберга и перебрался из Парижа в Калифорнию, где основал компанию Borland.

Когда в 1983 году появилась первая версия Turbo Pascal, такой тип среды разработки был относительно новым. Во время дебюта на американском рынке Turbo Pascal продавался по цене в $49,99. Помимо привлекательной цены, встроенный компилятор Паскаля также был очень высокого качества. Приставка «Turbo» намекала как на скорость компиляции, так и на скорость производимого им исполняемого кода. Turbo Pascal создавал машинный код за один проход, без шага компоновки.

После рекламной кампании за первый месяц поступило заказов на 150 тыс. долларов -- так много, что местные банки отказывались оплачивать чеки и кредитные карточки, подозревая мошенничество.

За первые два года было продано не менее 300 тысяч копий компилятора, что превзошло объём продаж всех прочих языков для микрокомпьютеров.

Для того времени это была потрясающая среда разработки. Она была проста и интуитивно понятна, с хорошо организованным меню. Ранние версии использовали раскладку горячих клавиш WordStar. В более поздних версиях появилась возможность быстро получить определение ключевого слова языка, просто поставив курсор на ключевое слово и нажав клавишу справки. Справочные статьи часто включали примеры кода, использующего данное ключевое слово. Это позволяло неопытным программистам изучать Паскаль даже без помощи книг, используя лишь среду разработки. В поставку входило большое количество исходных текстов демонстрационных и прикладных программ. В их числе были даже шахматы.

Среда позволяла легко встраивать в код на Паскале вставки на языке ассемблера. Пользователь имел возможность проходить программу шаг за шагом; при переходе на ассемблерный блок это также работало. В любой момент пользователь мог добавить переменную или регистр в удобно расположенное окно для наблюдения за ними. При построчной отладке программ, использующих графические режимы IBM PC, происходило корректное переключение между графическим режимом программы и текстовым режимом среды разработки.

Помимо всего этого, имелось средство профилирования. Книги, включённые в поставку Borland Pascal, давали детальное описание языка ассемблера Intel вплоть до указания количества тактовых циклов, необходимых для выполнения каждой инструкции. В общем и целом, система давала превосходные возможности для оптимизации кода; пользователю не требовалось пользоваться чем-либо, кроме среды разработки. Всё было сделано так идеально, что даже школьник мог этим пользоваться. Эти качества позволили версии Паскаля от Borland стать стандартом языка Паскаль де-факто.

С начала 1990-х TP/BP используется в университетах для изучения фундаментальных концепций программирования.

Вероятно, разработка Microsoft Pascal была прекращена из-за конкуренции с высоким качеством и небольшой ценой Turbo Pascal. Другая версия гласит, что Borland заключил соглашение с Microsoft на прекращение разработки Turbo Basic (среды разработки для BASIC, ответвившейся от Turbo Pascal), если Microsoft прекратит разработку Microsoft Pascal. Некоторое время Microsoft выпускал QuickPascal, который был почти 100%-совместим с Turbo Pascal.

В течение нескольких лет Borland улучшал не только среду разработки, но и язык. В версии 5.5 в него были введены передовые возможности объектно-ориентированного программирования. Последней выпущенной версией была версия 7. Borland Pascal 7 включал в себя среду разработки и компиляторы для создания программ под DOS, под DOS с расширителем DOS и Windows 3.x, в то время как Turbo Pascal 7 мог создавать только обычные DOS-программы.

С 1995 года в Borland прекратили разработку Turbo Pascal и предложили в качестве замены среду разработки Delphi. Новая версия языка подверглась изменению (в особенности ООП), и языку вернулось изначальное название, закреплённое разработчиками Apple Object Pascal. Старая объектная модель Turbo Pascal и соответствующий синтаксис поддерживался как устаревший, использование обеих объектных моделей одновременно в одной и той же программе не поддерживается.

2. ФУНКЦИИ И ПРОЦЕДУРЫ

2.1 Модуль Graph

Модуль Graph Турбо Паскаля содержит около пятидесяти различных процедур и функции, предназначенных для работы с графическим экраном. В этом же модуле некоторые встроенные константы, которые могут быть использованы в графических программах. Для того чтобы воспользоваться всеми возможностями модуля Graph, в начале программы( после заголовка)необходимо поместить оператор использования

Uses Graph;

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

Функция GraphErrorMsg. Возвращает значение типа String, в котором по указанному коду ошибки дается соответствующее текстовое сообщение.

Заголовок:

Fanctional GraphErrorMsg(Code: Integer): String;

Здесь Code - код ошибки, возвращаемый функцией GraphResult.

Функция CloseGraph. Завершает работу адаптера в графическом режиме и восстанавливает текстовый режим работы экрана.

2.2 Координаты, окна, страницы

Любое изображение формируется из достаточно простых геометрических фигур. Это точки, отрезки прямых, окружности и т.д. Из геометрии известно, что положение геометрического объекта и его форма задаются координатами его точек.

Следовательно, для того чтобы запрограммировать графический вывод, надо научиться задавать координаты графических объектов. Многие графические процедуры и функции используют указатель текущей позиции на экране, который в отличие от текстового курсора невидим. Положение этого указателя, как и вообще любая координата на графическом экране, задается относительно левого верхнего угла, который, в свою очередь, имеет координаты 0,0. Таким образом, горизонтальная координата экрана увеличивается слева направо, а вертикальная - сверху вниз.

Функции GetMaxX и GetMaxY.

Возвращают значения типа Word, содержащие максимальные координаты экрана в текущем режиме работы соответственно по горизонтали и вертикали.

Процедура SetViewPort. Устанавливает прямоугольное окно на графическом экране. Заголовок:

Procedure SetVievPort(X1, Y1, X2, Y2: Integer; ClipOn: Boolean);

Здесь X1..Y2 - координаты левого верхнего(Х1,Y1) и правого нижнего(X2,Y2) углов окна; ClipOn - выражение типа Boolean, определяющее «отсечку» не умещающихся в окне элементов изображения.

Процедура ClearDevice. Очищает графический экран. После обращения к процедуре указатель устанавливается в левый верхний угол, а сам экран заполняется цветом фона, заданным процедурой SetBkColor.

2.3 Линии и точки

Процедура PutPixel. Выводит заданным цветом точку по указанным координатам. Заголовок:

Procedure PutPixel(X, Y: Inteder; Color: word);

Здесь X, Y - координаты точки; Color - цвет точки.

Процедура Line. Вычерчивает линию с указанными координатами начала и конца.

Заголовок:

Procedure Line(X1, Y1, X2, Y2: Integer);

Здесь X1..Y1 - координаты начала(X1,Y1) и конца(X2,Y2) линии. Линия вычерчивается текущем стилем и текущим цветом.

Процедура SetLineStyle. Устанавливает новый стиль вычерчиваемых линий.

Заголовок:

Procedure SetLineStyle(Type, Pattern, Thick: Word);

Здесь Type, Pattern, Thick - соответственно тип, образец и толщина линии. Тип линии может быть создан с помощью одной из следующих констант:

Const

SolidLn= 0; (Сплошная линия)

DottedLn= 1; (Точечная линия)

CenterLn= 2; (Штрих-пунктирная линия)

DashedLn= 3; (Пунктирная линия)

UserBitLn= 4; (Узор линии определяемый пользователем)

2.4 Многоугольники

Процедура Rectangle. Вычерчивает прямоугольник с указанными координатами углов.

Заголовок:

Procedure Rectangle(X1, Y1, X2, Y2: Integer);

Здесь X1..Y2 - координаты левого верхнего угла(X1,Y1) и правого нижнего(X2,Y2) углов прямоугольника. Прямоугольник вычерчивается с использованием текущего цвета и текущего стиля линий.

2.5 Дуги, окружности, эллипсы

Процедура Circle. Вычерчивает окружность.

Заголовок:

Procedure Circle(X, Y: Integer; R: Word);

Здесь X,Y - координаты центра; R - радиус в пикселях.

Окружность выводится текущим цветом. Толщина линии устанавливается текущим стилем, вид линии всегда SolidLn(Сплошная). Процедура вычерчивает правильную окружность с учетом изменения линейного размера радиуса в зависимости от его направления относительно сторон графического экрана, т.е. с учетом коэффициента GetAspectRatio. В связи с этим параметр R определяет количество пикселей в горизонтальном направлении.

Процедура Arc. Чертит дугу окружности.

Заголовок:

Procedure Arc(X, Y: Integer; BegA, EndA, R: Word);

Здесь X, Y - координаты центра; BegA, EndA -соответственно начальный и конечный углы дуги; R - радиус.

Углы описываются против часовой стрелки и указываются в градусах.

Нулевой угол соответствует горизонтальному направлению вектора слева направо. Если задать значения начального угла 0 и конечного - 359, то будет выведена полная окружность. При вычерчивании дуги окружности используется те же соглашения относительно линии радиуса, что и в процедуре Circle.

Процедура Ellipse. Вычерчивает эллипсную дугу.

Заголовок:

Procedure Ellipse(X, Y: Integer; BegA, EndA, Rx, RY: Word);

Здесь X,Y - координаты центра; BegA, EndA - соответственно начальный и конечный углы дуги; RX, RY - горизонтальный и вертикальный радиусы эллипса в пикселях.

При вычерчивании дуги эллипса используется те же соглашения относительно линии, что и в процедуре Circle, ите же соглашения относительно углов, что и в процедуре Arc. Если радиусы согласовать с учетом масштабного коэффициента GetAspectRatio, будут вычерчена правильная окружность.

2.6 Краски, палитры, заполнения

Процедура SetCOlor. Устанавливает текущий цвет для вводимых линий и символов.

Заголовок:

Procedure SetColor(Color: Word);

Здесь Color - текущий цвет.

Процедура SetBkColor. Устанавливает цвет фона.

Заголовок:

Procedure SetBkColor (Color: Word);

Здесь Color - цвет фона.

В отличие от текстового режима, в котором цвет фона может быть только темного оттенка, в графическом режиме он может быть любым. Установка нового цвета фона, немедленно изменяет цвет графического экрана. Это означает, что нельзя создать изображение, два участка которого имели бы разный цвет фона.

Для GGA-адаптера в режиме высокого разрешения установка цвета фона изменяет цвет активных пикселей. Замечу, что после замены цвета фона на любой, отличный от 0 (Black) цвет. Вы не сможете более использовать цвет 0 как черный, он будет заменяться на цвет фона, т.к. процедуры модуля Graph интерпретируют цвет с номером 0 как цвет фона. Это означает, в частности, что Вы уже не сможете вернуть фону черный цвет!

Если Ваш ПК оснащен цветным экраном, следующая программа продемонстрирует работу процедуры SetBkColor. Программа выводит десять вложенных друг в друга прямоугольников, после чего циклически меняет цвет фона. Для выхода из программы достаточно нажать на любую клавишу.

Процедура SetFillStyle. Устанавливает стиль (тип и цвет).

Заголовок:

Procedure SetFillStile(Fill, Color: Word);

Здесь Fill - тип заполнения; Color - цвет заполнения.

С помощью заполнения можно покрывать какие-либо фрагменты изображения периодически повторяющимся узором.

Процедура FloodFill. Заполняет произвольную замкнутую фигуру, используя текущий стиль заполнения(узор и цвет).

Заголовок:

Procedure FloodFill(X, Y: Integer; Border: Word);

Здесь X, Y - координаты любой точки внутри замкнутой фигуры; Border - цвет граничной линии. Если фигура не замкнута, заполнение «разольется по всему экрану.

2.7 Сохранение и выдача изображений

Функция ImageSize. Возвращает размер памяти в байтах, необходимый для размещения прямоугольного фрагмента изображения.

Заголовок:

Function ImageSize(X1, Y2, X2, Y2: Integer): Word;

Здесь X1..Y2 - координаты левого верхнего(X1,Y1) и правого нижнего(X2,Y2) углов фрагмента изображения.

Процедура GetImage. Помещает в память копию прямоугольного фрагмента изображения.

Заголовок:

Procedure GetImage(X1, Y1, X2, Y2: Integer; var Buf);

Здесь X1..Y2 - координаты углов фрагмента изображения; Buf - переменная или участок кучи, куда будут помещена копия видеопамяти с фрагментом изображения.

Размер Buf должен быть не меньше значения, возвращаемого функцией ImageSize с теме же координатами X1..Y2.

Процедура PutImage. Выводит в заданное место экрана копию фрагмента изображения, ранее помещенную в память процедурой GetImage.

Заголовок:

Procedure PutImage(X, Y: Integer; var Buf; Mode: Word);

Здесь X, Y -координаты левого верхнего угла того места на экране, куда будет скопирован фрагмент изображения; Buf - переменная или участок кучи, откуда берется изображение; Mode - способ копирования.

Как видим, координаты правого нижнего угла не указываются, так как они полностью определяются размерами вновь выводимой на экран копии изображения. Координаты левого верхнего угла могут быть какими угодно, лишь бы только выводимая копия уместилась в пределах экрана (если копия не сможет разместиться на экране, она не выводится и экран остается без изменений).

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

3. Методика анимации

Эффект анимации достигается быстрым чередованием кадров постепенно изменяемого изображения. При этом нежелательно формировать каждый кадр целиком, поскольку движутся, как правило, лишь некоторые части изображения. Изображение формируется из примитивов вывода. Они могут быть объединены в части, к которым можно обращаться и которыми можно манипулировать как единым целым. Эти части изображения называются сегментами. Стандарт GKS определяет следующие действия над сегментами: изменение атрибутов сегмента, возможность посылать копии сегмента на графические станции или вставлять их в другие сегменты и др.

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

Видимость - атрибут, определяющий присутствие сегмента на носителе изображения графических станций.

Выделение - независимый от устройства способ подчеркивания значения сегмента путем изменения атрибутов, от которых зависит его визуальное представление (например, мерцание сегмента изображения).

Чувствительность - атрибут сегмента, определяющий возможность обращения к нему функции ввода для указания объекта.

Приоритет сегмента - используется для определения, какой из нескольких перекрывающихся сегментов имеет предпочтение для графического ввода и вывода.

Матрица преобразования сегмента - задает преобразование, результатом которого является изменение на носителе изображения положения (перенос), размера (масштабирование) и/или ориентации (поворот) элементов изображения, определяемых сегментом.

При разрабоке программы анимации рекомендуется продумать сценарий движения, разработаь фон на котором будет производиться движение, определить движущиеся сегменты и на каждом кадре изменять атрибуты лишь тех сегментов, которые должны в нем изменять свое местоположение. Для улучшения эффекта анимации следует пользоваться несколькими видеостраницами. Необходимо готовить новый кадр на невидимой странице и делать ее видимой лишь после подготовки кадра, готовя в это время следующий кадр на другой невидимой странице.

4. ЛИСТИНГ ПРОГРАММЫ

4.1 Рекурсивная программа построения снежинки

Написать программу, строящую на экране изображение:

Изображение строится по следующему правилу: строится окружность с заданным радиусом r. Затем на диаметрально противоположных точках окружности ( x- r и x+ r)строится вновь окружность меньшего радиуса ( r=3 r/5). Для каждой меньшей окружности на диаметрально противоположных точках вновь строится окружность меньшего радиуса, и т.д., пока радиус не уменьшится до 10.

program recurs;

uses graph;

var x,y,r,d,m:integer;

procedure ris(x,y,r:integer);

var i:integer;

begin

if r<10 then exit;

circle(x,y,r);

for i:=1 to 1000 do; { просто цикл задержки }

ris(x+r,y,r*3 div 5);

ris(x-r,y,r*3 div 5);

end ;

begin {начало основной программы}

d:=detect;

initgraph(d,m,"e:\bp\bgi");

x:=320;

y:=240;

r:=120;

ris(x,y,r);

readln ;

end.

4.2 Пример рекурсивной программы построения снежинки

Как видно из рисунка, здесь опять повторяются одни и те же фрагменты. Построение выполняется так: на окружности заданного радиуса r берется 6 равноотстоящих точек (начиная от угла в 0 0, с шагом ?/3), из каждой точки к центру окружности проводятся радиусы. Затем каждая из этих точек выступает центром новой, меньшей окружности с радиусом r=2 r/5. На каждой меньшей окружности вновь берется 6 равноотстоящих точек, из которых строятся радиусы к центру, и т.д., пока радиус не станет меньше или равен 1.

program sneg;

uses graph, crt;

var

x,y,r,d,m:integer;

procedure ris(x,y,r:integer);

var

x1,y1,t:integer;

begin

if r<=1 then begin putpixel(x,y,15);exit end;

for t:=0 to 6 do

begin

x1:=x+trunc(r*cos(t*pi/3));

y1:=y+trunc(r*sin(t*pi/3));

line(x,y,x1,y1);

ris(x1,y1,r*2 div 5);

delay(500);

end;

end;

begin

d:=detect;

initgraph(d,m,"e:\bp\bgi");

x:=320;

y:=240;

r:=80;

ris(x,y,r);

readln;

end.

4.3 Пример программы построения анимации

Unit unit1;

interface uses graph;

type arpo = array [1..4] of PointType; {хранит коорд. Вершин прямоугольника}

{ Справка: PointType = Record

X, Y : Integer;

End; }

var grdriver, graphmode,errcode,maxx,maxy,ImSize: integer;

ch1,ch2: char;

bufs: string;

bcol,gcol: byte; {хранит цвет символов и фона}

alfa: double; {угол наклона основания (радиан)}

P1: Pointer; {указатель на область памяти, где будет храниться картинка (мячик)}

ara: arpo; {хранит коорд. Вершин прямоугольника}

Procedure Nacalo; {инициирует графический режим}

Procedure Menu1(x0,y0: integer); {выводит меню в графическом режиме }

procedure TTT; {Выводит образцы графических шрифтов}

procedure Osnova(x0: integer); {рисует треугольное основание}

procedure gaubica(x0,y0: integer; beta,vel: double; typ:char);

{бросает мячик}

procedure siezd(var ara: arpo); {шкаф скользит}

procedure pramoug(var ara: arPo); {падает шкаф}

procedure clearkey;

procedure stopka;

implementation uses crt;

var hh, {высота шкафа}

ww: {ширина шкафа} integer;

beta: double; {угол наклона основания}

Procedure Menu1(x0,y0: integer); {рисует меню}

var buf1,buf2: string;

begin

SetTextStyle(2,0,6); {устанавливаю шрифт SmallFont, горизонтальное направление, размер = 6}

str(maxx,buf1); str(maxy,buf2); {преобразую maxx,maxy в строки }

setcolor(green); {устанавливаю цвет = зеленый (для рамки меню) }

rectangle(x0+5,y0+5,x0+215,y0+160); {прямоугольник (рамка меню)}

setfillstyle(SolidFill,8); {устанавливаю тип и цвет заливки

(темносерый)}

FloodFill(x0+7,y0+7, green); {Заливает фигуру, начиная от точки

(x0+7,y0+7) и до границы цвета green}

setcolor(11); {устанавливаю цвет (светлоголубой) - для надписей меню }

OutTextXY(x0+10,y0+15, 'MaxX= '+buf1+' MaxY= '+buf2);

OutTextXY(x0+10,y0+35, ' --- Menu: --- ');

OutTextXY(x0+10,y0+55, ' Esc - Exit ');

OutTextXY(x0+10,y0+75, ' T - Шрифты ');

OutTextXY(x0+10,y0+95, ' C - CLEAR ');

OutTextXY(x0+10,y0+115, ' S - NormalPut ');

OutTextXY(x0+10,y0+135, ' s - XORPut ');

end;

Procedure Nacalo; {устанавливает графический режим и его параметры}

begin

bcol := 7; gcol := 11; {цвета по умолчанию}

grdriver:= detect; {установка для автоматического определения

графического драйвера}

graphmode := 0;

InitGraph(grdriver,graphmode,'..\');

{'..\'означает, что драйвер EGAVGA.BGI должен находиться во внешней папке по отношению к папке этой программы}

errcode := graphresult; {проверяем успешность выполнения процедуры

InitGraph }

if errcode <> grOk then { если произошла ошибка}

begin writeln (' ошибка инит граф режима N ',errcode);

halt(1); {выход в систему с кодом возврата=1, т е аварийно}

end

else

begin

setgraphmode(graphmode);

setcolor (gcol); setbkcolor(bcol);

SetLineStyle(SolidLn, 0, 2); {устанавливаю: линия сплошная, толщиной 2}

maxx:= getmaxx; maxy:= getmaxy; { сохраняю размеры экрана }

SetTextStyle(2,0,6); {устанавливаю шрифт SmallFont, горизонтальное направление, размер = 6}

end;

end;

procedure TTT;

begin setcolor(blue); {цвет - синий (для вывода текста)}

OutTextXY(10,10,'- Графические шрифты -');

SetTextStyle(1,0,4);

if graphresult <> grOK then

OutTextXY(10,30,'gr - ERROR') else

OutTextXY(10,30,'Text ПРОБА');

SetTextStyle(2,0,8);

if graphresult <> grOK then

OutTextXY(10,60,'gr - ERROR') else

OutTextXY(10,60,'Text ПРОБА');

SetTextStyle(3,0,4);

if graphresult <> grOK then

OutTextXY(10,80,'gr - ERROR') else

OutTextXY(10,80,'Text ПРОБА');

SetTextStyle(4,0,4);

if graphresult <> grOK then

OutTextXY(10,110,'gr - ERROR') else

OutTextXY(10,110,'Text ПРОБА');

SetTextStyle(4,0,6);

if graphresult <> grOK then

OutTextXY(10,150,'gr - ERROR') else

OutTextXY(10,150,'Text ПРОБА');

setcolor(gcol); {восстанавливаю цвет по умоляанию}

end;

procedure moveto2(t: PointType);

begin {это процедура moveto, приспособленная для работы с точками PointType}

moveto(t.x,t.y);

end;

procedure lineto2(t: PointType);

begin {это процедура lineto, приспособленная для работы с точками PointType}

lineto(t.x,t.y);

end;

procedure siezd(var ara: arpo);

var ii: Integer; sdvig,sdvigX,sdvigY: double;

ar0: arpo;

begin

ar0:= ara; {запоминаю координаты прямоуг-ка в начальном положении }

sdvig:=0; {в этой переменной хранится сдвиг (вдоль склона) скользящего шкафа относительно исходного положения }

repeat {цикл скольжения шкафа}

sdvig:=sdvig + 1; {на каждом шага перемещаю шкаф на 1 пикс}

sdvigX:= sdvig*cos(beta); {проекция сдвига на ось X }

sdvigY:= sdvig*sin(beta); {проекция сдвига на ось Y }

setcolor(green); {устанавливаю цвет границы }

setfillstyle(SolidFill,8); {устанавливаю режим заливки

(темно-серый) }

FillPoly(4, ara); {заливаю прямоугольник (шкаф) с коорд ara }

delay(3000); {задержка (мсек) - чтобы увидеть шкаф. 3000 - на IBM286, на современных компах много меньше}

setcolor(7); {готовлюсь стереть шкаф (цветом фона)}

setfillstyle(SolidFill,7); {устанавливаю режим заливки

(светло-серый, т е цвет фона) }

FillPoly(4, ara); {заливаю шкаф цветом фона, т е стираю его}

for ii:= 1 to 4 do {изменяю координаты шкафа, т е перемещаю его}

begin {для этого использую вычисленные ранее сдвиги относительно исходного положения (т е координат ar0)}

ara[ii].x := ar0[ii].x + round(sdvigX);

ara[ii].y := ar0[ii].y + round(sdvigY);

end;

until ara[2].x > 620; {ограничиваю перемещение}

setcolor(green); {делаю видимым шкаф в последнем положении}

setfillstyle(SolidFill,8);

FillPoly(4, ara);

end;

procedure pramoug(var ara: arPo);

var alfa: double; ch: char; {эта процедура роняет шкаф поворотом вокруг правой нижней точки на угол Pi/2 стирание осуществляется прорисовкой цветом фона }

begin

SetWriteMode(NormalPut);

alfa:= 0;

repeat {используя тригонометрию, вычмсляем координаты вершин шкафа как функции высоты hh, ширины ww и углов:

beta (наклон основания) и alfa (угол поворота относительно неподвижного правого-нижнего угла)}

ara[2].x := ara[1].x + round(hh*sin(alfa+beta));

ara[2].y := ara[1].y - round(hh*cos(alfa+beta));

ara[3].x := ara[2].x - round(ww*cos(alfa+beta));

ara[3].y := ara[2].y - round(ww*sin(alfa+beta));

ara[4].x := ara[1].x - round(ww*cos(alfa+beta));

ara[4].y := ara[1].y - round(ww*sin(alfa+beta));

setcolor(green);

setfillstyle(SolidFill,8);

FillPoly(4, ara); {рисую 4-угольник по координатам ara,

(заливка SolidFill цветом 8 - темносерый)}

delay(3000); {задержка (мсек) - чтобы увидеть шкаф. 3000 - на IBM286, на современных компах много меньше}

setcolor(7); {готовлюсь рисовать шкаф цветом фона, т е стирать}

setfillstyle(SolidFill,7);

FillPoly(4, ara); {стираю текущее положение шкафа}

alfa:= alfa + 0.02; {изменяю угол наклона шкафа на 0.02 рад}

until alfa > pi/2; {ограничиваю угол поворота - Pi/2 }

end;

procedure gaubica(x0,y0: integer; beta,vel: double; typ:char);

{бросает мячик}

var tt: PointType; {здесь храню коорд верхнего левого угла квадрата, описанного относительно мячика (круга), x0,y0 - координаты начального положения цнтра мячика.}

RR: integer; {радиус мячика}

function dy(xx: integer): integer;

{вычисляет (по законам физики) вертикальное перемещение мячика,

соответствующее заданному горизонтальному xx.

Так как горизонтальная компонента скорости постоянна, то время

движения t пропорционально xx (tt:= 0.1*xx), а вертикальное смещение

yyy за единицу времени пропррционально tt, например yyy := bb*tt + cc

коэффициенты bb,cc подобраны по картинке}

const bb= 0.3; cc=-4;

var t,yyy: double;

begin

t:= 0.1*xx;

yyy := bb*t + cc;

dy:=round(yyy);

end;

begin

RR:= 10;

tt.x:= x0-RR; tt.y:= y0-RR; {точка tt- верхний левый угол квадрата, описанного вокруг мячика (круга)}

setbkcolor(7);

setcolor(green);

ImSize := ImageSize(x0-RR, y0-RR, x0+RR, y0+RR);

{функция ImageSize вычисляет объем памяти, необходимый для

хранения картинки, расположенной внутри этого описанного квадрата }

GetMem(P1, ImSize); {указатель P1 будет указывать на этот фрагмент памяти}

circle(x0,y0,RR); {рисую окружноость. x0,y0 - центр}

setfillstyle(SolidFill,1); {готовлюсь залить круг цветом 1 = синий}

FloodFill(x0,y0, green); {заливаю внутренность фигуры начиная с точки x0,y0 и до границы, заданной цветом green}

GetImage(x0-RR, y0-RR, x0+RR, y0+RR, P1^);

{сохраняю изображение, ограниченное квадратом

(x0-RR, y0-RR, x0+RR, y0+RR) в памяти, связанной с указателем P1}

while (tt.x < 296) and (tt.y < 500) and (tt.y > RR) do

begin

PutImage(tt.x, tt.y, P1^, XORPut);

{помещаю картинку из памяти (P1) в ту же позицию, но

использую тип записи XOR. В результате мячик исчезает}

inc(tt.x,2); {увеличиваю координату x на 2}

tt.y:= tt.y + dy(tt.x-x0+RR); {вычисляю соответствующую коорд y, используя функцию dy. Аргумент = горизонтальному перемещению относительно исходного положения}

case typ of

'N': PutImage(tt.x, tt.y, P1^, NormalPut);

'X': PutImage(tt.x, tt.y, P1^, XORPut);

end;

{помещаю изображение в точку с новыми координатми. }

delay(3000);{делаю задержку чтобы глаз успел увидеть мячик, прежде его стирания. Далее в начале цикла мячик }

end;

PutImage(tt.x, tt.y, P1^, XORPut);

end;

procedure Osnova(x0: integer); {рисует треугольное основание}

var xx: Integer;

t1,t2,t3,t4,t5,t6,t7: PointType; alfa,dola:double;

ch2: char;

begin

setcolor(green);

t1.x:= x0; t1.y:= 300;

t2.x:= x0; t2.y:= 470;

t3.x:= 630; t3.y:= 470; {координаты вершин тр-ка}

moveto2(t1);

lineto2(t2);

lineto2(t3);

lineto2(t1);

setfillstyle(SolidFill,green); {готовлюсь залить зеленым}

FloodFill(x0+10,400, green); {заливаю до зеленой границы}

dola:= 0.1; {это доля длины гипотенузы. Определяет положение шкафа на склоне }

t4.x:= round(t1.x + dola*(t3.x-t1.x))+1;

{Это коорд левого нижнего угла шкафа. (отрываю шкаф на 1)}

t4.y:= round(t1.y + dola*(t3.y-t1.y))-1;

hh:= 100; ww:= 40; {задаю высоту и ширину шкафа}

beta:= arctan((t3.y-t1.y)/(t3.x-t1.x)); {вычисляю угол наклона основания}

t5.x:= t4.x+round(hh*sin(beta)); {вычисляю коорд остальных углов, используя тригонометрию}

t5.y:= t4.y-round(hh*cos(beta));

t6.x:= t5.x+round(ww*cos(beta));

t6.y:= t5.y+round(ww*sin(beta));

t7.x:= t6.x-round(hh*sin(beta));

t7.y:= t6.y+round(hh*cos(beta));

ara[1]:= t7; ara[2]:= t6; ara[3]:= t5; ara[4]:=t4;

{ помещаю эти коорд в массив, т к FillPoly использует массив }

setfillstyle(SolidFill,8); {готовлю тип заливки - темносерым}

FillPoly(4, ara); {рисую залитый 4-угольник}

end;

procedure clearkey;

var cc:char;

begin

while keypressed do cc:= readkey;

end;

procedure stopka; {останавливает программу до нажатия

любой клавиши}

var cc:char; colr: byte;

begin

clearkey;

colr:= getcolor;

outtextxy(300,20,'Press any key');

cc:= readkey;

setcolor(7);

outtextxy(300,20,'Press any key');

setcolor(colr);

end;

end.

Размещено на Allbest.ru