textcolor (k),

writeln ("цвет", k, "-", col [k] )

end;

textcolor (white+blink); {белые мигающие символы}

writeln ("мерцание символов");

{восстанавливаем стандартный цвет}

textcolor (lightgray),

writeln

end.

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

TextColor (lightgray);

Дело в том, что все цветовые определения предварительно заносятся в специальную переменную TextAttr модуля CRT и используются для настройки адаптера только при обращении к процедурам write/writeln.

Процедура ClrScr очищает экран или окно (см. ниже процедуру window). после обращения к ней экран (окно) заполняется цветом фона и курсор устанавливается в его левый верхний угол. например:

uses CRT;

Var

с: char

Begin

textbackground (red);

clrscr; {заполняем экран красным цветом}

writeln ("нажмите любую клавишу...");

с:= ReadKey, {ждем нажатия любой клавиши}

textbackground (black);

clrscr {восстанавливаем черный фон экрана}

end.

Процедура Window определяет текстовое окно - область экрана, которая в дальнейшем будет рассматриваться процедурами вывода, как весь экран. Сразу после вызова процедуры курсор помещается в левый верхний угол окна, а само окно очищается (заполняется цветом фона). По мере вывода курсор, как обычно, смещается вправо и при достижении правой границы окна переходит на новую строку, а если он к этому моменту находился на последней строке, содержимое окна сдвигается вверх на одну строку, т.е. осуществляется «прокрутка» окна. Заголовок процедуры:

Procedure Window (xi, yi, х2, y2: byte);

Здесь x1...y2 - координаты левого верхнего (х1, y1) и правого нижнего (х2, y2) углов окна. Они задаются в координатах экрана, причем левый верхний угол экрана имеет координаты (1,1), горизонтальная координата увеличивается слева направо, а вертикальная - сверху вниз.

В следующем примере иллюстрируется вывод достаточно длинного сообщения в двух разных окнах:

uses CRT;

Var

k: integer;

Begin {создать левое окно - желтые символы на синем фоне:}

textbackground (blue);

window (5, 2, 35, 17);

textcolor (yellow);

for k:= i to 100 do

write ("нажать клавишу enter... ");

readln, {ждем нажатия enter}

clrscr; {очищаем окно}

{создать правое окно - белые символы на красном фоне:}

textbackground (red);

textcolor (white);

window (40, 2, 70, 17);

for k:= i to 100 do

write ("нажать клавишу enter... ");

readln;

TextMode (Co8o) {сбросить все установки}

end.

Обращение к процедуре Window игнорируется, если какая-либо из координат выходит за границы экрана или если нарушается одно из условий: Х2>Х1 или Y2>Y1. Каждое новое обращение к Window отменяет предыдущее определение окна. Границы текущего окна запоминаются в двух глобальных переменных модулях CRT: переменная WindMin типа Word хранит X1 и Y1 (Х1 - в младшем байте), а переменная того же типа WindMax - Х2 и Y2 (Х2 - в младшем байте). При желании вы можете изменять их нужным образом без обращения к Window. например, вместо оператора

Window (40, 2, 70,17);

можно было бы использовать два оператора:

WindMin:=39+(lshl8); WindMax:= 69+(16 shl 8);

(в отличие от обращения к Window, координаты, хранящиеся в переменных WindMin и WindMax, соответствуют началу отсчета 0, 0).

Процедура GotoXY переводит курсор в нужное место экрана или текущего окна. Заголовок процедуры:

Procedure GotoXY (Х, Y: Byte);

Здесь X, Y - новые координаты курсора. Координаты задаются относительно границ экрана (окна), т.е. оператор

GotoXY (1,1);

Оператор указывает, перевести курсор в левый верхний угол экрана (или окна, если к этому моменту на экране определено окно). Обращение к процедуре игнорируется, если новые координаты выходят за границы экрана (окна).

Функции WhereX и WhereY. С помощью этих функций типа Byte можно определить текущие координаты курсора: WhereX возвращает его горизонтальную, а WhereY - вертикальную координаты.

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

Program Prim52;

Uses CRT; {подключить библиотеку (модуль) CRT}

Const { константы, определяющие графические символы }

{ необходимые для вычерчивания рамки окна }

lu=#218; { левый верхний угол рамки }

ru=#191; { правый верхний угол рамки }

ld=#192; { левый нижний угол рамки }

rd=#217; { правый нижний угол рамки }

h=#196; { горизонтальная черта }

v=#179; { вертикальная черта }

{ координаты окна: }

x1=14; y1=5; { верхний левый угол }

x2=66; y2=20; { нижний правый угол }

Var k:integer;

Begin ClrScr; { очиститъ экран}

textmode(co80); { сброситъ все установки }

textbackground(lightcyan); { фон окна светло-бирюзовый }

textcolor(yellow); { цвет текстов в окне желтый }

window(x1,y1,x2,y2); { открытъ окно с координатами }

ClrScr;

{ рисуем рамку вокруг окна}

Write(lu); { левый верхний угол }

for k:=x1+1 to x2-1 do

write(h); { верхнюю горизонтальную черту }

write(ru); { правый верхний угол }

for k:=y1+1 to y2-1 do { рисуем вертикальные линии }

{ посимвольно слева и справа и построчно за счет цикла} 

Begin GotoXY(1,k-y1+1); { курсор на левую границу }

write(v); { вывести вертикальную черточку }

GotoXY(x2-x1+1,whereY); { курсор на правую границу }

write(v); { вывести вертикальную черточку }

{ перейти на новую строку, пока не кончится цикл }

end;

write(ld); { левый нижний угол }

Window(x1,y1,x2,y2+1);

GotoXY(2,y2-y1+1); { kypcop в нижний левый угол+1}

{ нового окна, без учета рамки }

for k:=x1+1 to x2-1 do write(h);{ нижнюю горизонтальную черту}

write(rd); { нижний правый угол}

TextBackground(LightCyan);

GotoXY(2,2); { курсор в левый верхний угол}

{нового окна без учета рамки}

readln;

end.

Три следующие процедуры без параметров могут оказаться полезными при разработке текстовых редакторов.

Процедура ClrEOL стирает часть строки от текущего положения курсора до правой границы окна (экрана). Положение курсора не меняется.

Процедура DelLine уничтожает всю строку с курсором в текущем окне (или на экране, если окно не создано). При этом все строки ниже удаляемой (если она есть) сдвигаются вверх на одну строку.

Процедура InsLine вставляет строку: строка с курсором и все строки ниже ее сдвигаются вниз на одну строку; строка, вышедшая за нижнюю границу окна (экрана), безвозвратно теряется; текущее положение курсора не меняется.

Процедуры LowVideo, NormVideo и HighVideo. С помощью этих процедур без параметров можно устанавливать соответственно пониженную, нормальную и повышенную яркости символов. Например:

Uses CRT;

begin

LowVideo;

Writeln ('пониженная яркость');

NormVideo;

Writeln ('нормальная яркость');

HighVideo;

Writeln ('повышенная яркость')

end.

На практике нет разницы между пониженной и нормальной яркостью изображения.

Процедура Assign CRT связывает текстовую файловую переменную F с экраном с помощью непосредственного обращения к видеопамяти (т.е. к памяти, используемой адаптером для создания изображения на экране). В результате вывод в такой текстовый файл осуществляется значительно быстрее (в 3...5 раз), чем если бы этот файл был связан с экраном стандартной процедурой Assign. Заголовок процедуры: Procedure Assign CRT (F: Text);

В следующей программе измеряется скорость вывода на экран с помощью стандартной файловой процедуры и непосредственного обращения к видеопамяти. Вначале файловая переменная F связывается «медленной» процедурой Assign со стандартным устройством CON (т.е. с экраном) и подсчитывается количество N циклов вывода некоторого текста за 555=275 миллисекунд системных часов. Затем файловая переменная связывается с экраном с помощью процедуры быстрого доступа Assign CRT и точно так же подсчитывается количество N2 циклов вывода. В конце программы счетчики NI и N2 выводятся на экран.

Показания системных часов хранятся в оперативной памяти компьютера в виде четырехбайтного слова по адресу [$0040:$006С] и наращиваются на единицу каждые 55 миллисекунд.

Uses CRT;

var

F: Text;

t: Longint; {начало отсчета времени}

N1, N2: Word; {счетчик вывода}

const

txt= 'Text';

begin

{-----стандартный вывод в файл------}

Assign (F, “CON”);

Rewrite (F);

N1:=0; {готовим счетчик вывода}

ClrScr; {очищаем экран}

{запоминаем начальный момент:}

t:= Meml [$0040:$006C];

{ждем начало нового 55-миллисекундного интервала, чтобы исключить погрешность в определении времени:}

while Meml [$0040:$006C]=t do;

{цикл вывода за 5 интервалов}

while Meml [$0040:$006C]<t+6 do

begin

inc (N1);

Write (F, txt)

end;

Close (F);

{вывод с помощью быстрой процедуры прямого доступа к экрану}

AssignCRT (F);

Rewrite (F);

N2:=0;

ClrScr;

t:= Meml [$0040:$006C];

while Meml [$0040:$006]=t do;

while Meml [$0040:$006]<t+6 do

begin

inc (N2);

Write (F, txt)

end;

Close (F);

{печатаем результат}

ClrScr;

Writeln (N1, N2:10)

end.

Следует учесть, что вывод на экран обычным образом, без использования файловой переменной (например, оператором Write (txt)), также осуществляется с помощью непосредственного доступа к видеопамяти, поэтому ценность процедуры AssignCRT весьма сомнительна. Прямой доступ к видеопамяти регулируется глобальной логической переменной DirectVideo модуля CRT: если эта переменная имеет значение True, доступ разрешен, если False -- доступ к экрану осуществляется с помощью относительно медленных средств операционной системы MS--DOS. По умолчанию переменная DirectVideo имеет значение True.

11.3. Программирование звукового генератора

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

В модуль CRT включены три процедуры, с помощью которых вы сможете запрограммировать произвольную последовательность звуков.

Процедура Sound заставляет динамик звучать с нужной частотой. заголовок процедуры Procedure Sound (F: Word); здесь F - выражение типа Word, определяющее частоту звука в герцах. После обращения к процедуре включается динамик, и управление немедленно возвращается в основную программу, в то время как динамик будет звучать впредь до вызова процедуры NoSound.

Процедура NoSound выключает динамик. Если он к этому моменту не был включен, вызов процедуры игнорируется.

Процедура Delay oбеспечивает задержку работы программы на заданный интервал времени. Заголовок процедуры: Procedure Delay (T: Word);

Здесь Т -- выражение типа Word, определяющее интервал времени (в миллисекундах), в течение которого задерживается выполнение следующего оператора программы.

Для генерации звукового сигнала обычно используется вызов описанных процедур по схеме Sound--Delay--NoSound. следующая программа заставит пк воспроизвести простую музыкальную гамму. Используемый в ней массив F содержит частоты всех полутонов в первой октаве от «до» о «си». При переходе от одной октавы к соседней, частоты изменяются в два раза.

Uses CRT;

const

F: array [1..12] of Real =

(130.8, 138.6, 146.8, 155.6, 164.8, 174.6, 185.0, 196.0, 207.7,

220.0, 233.1, 246.9); {массив частот 1-й октавы}

Temp = 100; {темп исполнения}

var

k, n: integer;

begin

{восходящая гамма}

for k:=0 to 3 do

for n:=1 to 12 do

Begin

Sound (Round (F[n]*(1 shl k)));

Delay (Temp);

NoSound

end;

{нисходящая гамма}

for k:=3 downto 0 do

for n:=12 downto 1 do

begin

Sound (Round (F[n]*(1 shl k)));

Delay (Temp);

NoSound

end

end.

В следующей программе перемножается матрица на вектор, основу которой составляет ранее рассмотренные Program Prim 29 i Prim 29а. Здесь максимальные размеры матрицы - 1010 элементов типа byte. Ввод информации производится в окне светло-бирюзового цвета, вывод результатов - в окне малинового цвета, цвет букв - желтый.

Программа в начале работы издает звуки частотой от 130 до 2130 Гц, затем при вводе величины a - частотой 2000 Гц, b - 1500 Гц длительностью n=100 мс. В конце работы программа издает звуки от 2130 до 130 Гц. Программа использует подпрограмму Wind, написанную на основе Prim 52.

Program Prim53; Uses CRT; var i,j,n,m,k,l:integer; a:array[1..50,1..70] of byte; b:array[1..10] of byte;

c:array[1..10] of longint;

cv:byte;

{$i C:\TURBO\ wind.pas}

BEGIN

Clrscr; {очистить экран }

cv:=11; {цвет 11, светло-бирюзовый}

wind(1,1,50,7); { открыть окно, обращения к процедуре}

Sound(330); { включить звук, частотой 330 гц } Delay(1000); { задержать на 1000 миллисекунд } NoSound; { выключить звук }

writeln ('ввести количество строк и столбцов');

GotoXY(2,3); l:=4; {l устанавливает курсор по y}

readln(n,m);

for i:=1 to n do

for j:=1 to m do

begin GotoXY(2,l);

writeln(' введите a[',i,',',j,'] элемент матрицы а ');

GotoXY(34,l); { перевести курсор в конец текста:}

{ввести a[i,j] - элемент матрицы'}

ClrEol; { удалить конец строки до границы окна}

readln(a[i,j]); { ввести очередное а в конце текста }

end;

L:=L+1;{}

for j:=1 to m do

begin GotoXY(2,l);

writeln(ввести b[',j,'] элемент вектора  b');

GotoXY(33,l);

ClrEol;

readln(b[j]); end;

cv:=5; { фиолетовый цвет для нового окна }

wind(20,2,80,18); GotoXY(2,2); l:=3;

for i:=1 to n do { начало перемножения матрицы на векторы }

begin c[i]:=0;

for j:=1 to m do

c[i]:=c[i]+ a[i,j]*b[j]; end;

{ конец перемножения матрицы на вектор }

writeln(' распечатка массива а ');

for i:=1 to n do

begin GotoXY(2,l); l:=l+1; { начать новую строку }

for j:=1 to m do

write(a[i,j]:5); end;

GotoXY(2,l); l:=l+1; writeln('распечатка массива  b');

GotoXY(2,l);

for j:=1 to m do

write(' ',b[j]); L:=L+1;

GotoXY(2,L); L:=L+1; writeln('результирующий массив с');

GotoXY(2,L);

for i:=1 to n do

write(' ',c[i]);

readln; END.

12. Графика в Паскале

12.1. Инициализация графического режима

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

Program имя;

Uses Graph;

var

grDriver, grMode, errCode: integer;

begin

grDriver:= Detect; {определение номера, установленного в системе драйвера}

initGraph (grDriver, grMode,''); {инициализация графического режима}

if errCode= grOK then

begin { режим открыт и можно работать}

end else

begin {графический режим не удалось открыть, проанализируйте содержание переменной errCode}

end.

Замечание. Две кавычки в initGraph правомочны только тогда, когда графическая программа находится в том же каталоге, что и библиотека Graph. В противном случае в кавычках должен стоять путь - указание, где находится библиотека Graph.

12.2. Процедуры и функции библиотеки Graph

Функции GetMaxX и GetMaxY возвращают значения типа Word, содержащие максимальные координаты, соответственно, X и Y относительно левого верхнего угла в пикселах (точках).

Различные мониторы имеют различную разрешающую способность, например: VGA - 640480 точек, IBM 8514Hi - 1024768 точек.

Функции GetX и GetY возвращают текущие координаты указателя. Процедура SetViewPort (Х1, Y1, Х2, Y2, Clipon); устанавливает прямоугольное окно на графическом экране, X1, Y1 - координаты левого верхнего угла; Х2, Y2 - координаты нижнего правого угла окна.

Если выражение Clipon имеет значение true и элементы изображения не помещаются в окне, то они отсекаются, если - false, то отсечка игнорируется.

Процедура MoveTo (Х, Y); устанавливает новое текущее положение указателя.

Процедура MoveRel (Ox, Dy); устанавливает приращения новых координат указателя относительно старых.

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

Процедура PutPixel (Х, Y, Color); выводит на экран точку Color цвета. Процедура LineTo (Х, Y); вычерчивает линию от текущего положения указателя до точки Х, Y.

Процедура SetLineStyle (Туре, Pattern, Thick);

Где Туре - тип линии. Pattern - образец линии. Thick - толщина линии.

Тип линии:

0 - сплошная,

1 - точечная,

2 - штрихпунктирная,

3 - . . . . . . . .

4 - узор линии определяет пользователь параметром pattern.

Thick=l - толщина линии в 1 пиксел.

Thick=2 - толщина линии в 3 пиксела.

Процедура Rectangle (Х1, Y1, Х2, Y2); вычерчивает прямоугольник с использованием текущего цвета и текущего стиля линий.

Процедура DrawPoly (N, Р); вычерчивает произвольную ломаную линию. N - количество точек излома, включая крайние; Р - переменная типа PointType, которая в Graph имеет вид:

type

PointType=record

X, Y: Word

end;

При вычерчивании используются текущий цвет и текущий стиль линий. Процедура Circle (Х, Y, R); вычерчивает окружность с центром X, Y и радиусом R.

Процедура Arc (Х, Y, Beg А, End А, R); вычерчивает дугу окружности Beg А и End А, соответственно, начальный и конечный углы дуги.

Процедура Ellipse (Х, Y, Beg А, End А, RX, RY); вычерчивает дугу эллипса с центром X, Y; Beg А, End А - начальный и конечный угол, RX и RY - горизонтальный и вертикальный радиусы.

Процедура Bar (Х1, Y1, Х2, Y2); заполняет прямоугольную область экрана образцом узора и текущим цветом, которые устанавливаются процедурой SetFillStyle.

Процедура Ваr3D (Х1, Y1, Х2, Y2, Depth, Тор); вычерчивает трехмерное изображение параллелепипеда и закрашивает его переднюю грань. Depth - глубина третьего измерения, Top=true - верхняя грань вычерчивается, false - нет.

Процедура FillPoly (n, Coords); обводит линией и закрашивает замкнутый многоугольник; n - количество вершин, Coords - переменная типа PointType, содержащая координаты вершин (см. DrawPoly).

Процедура FillEllipse (Х, Y, Rx, Ry); обводит линией и заполняет эллипс.

Процедура Sector (Х, Y, Beg А, End А, Rx, Ry); вычерчивает и заполняет эллипсный сектор.

Процедура PieSlice (Х, Y, Beg А, End А, R); вычерчивает и заполняет сектор окружности.

Процедура SetColor (Color); устанавливает текущий цвет для выводимых линий и символов.

Процедура SetbkColor (Color); устанавливает цвет фона окна.

Процедура SetFillStyle (Fill, Color); устанавливает стиль Fill и цвет заполнения Color.

Значения Fill:

заполнение фоном (узор отсутствует);

сплошное заполнение;

заполнение - - - - -;

- « - /////// ;

- « - утолщенными ///////;

- « - утолщенными \\\\\\ ;

- « - \\\\\\ ;

- « - + + + + + +;

- « - ******;

- « - прямоугольной клеточкой;

- « - редкими точками ;

- « - частыми точками ;

- « - узор определяется пользователем.

Процедура FloodPill (Х, Y, Color); заполняет произвольную замкнутую линию (точки соединения должны совпадать, например, концы линий не могут пересекаться) текущим стилем и текущим цветом. X, Y - координаты точки внутри фигуры, Color -- цвет ограничений линии. Если линии разомкнуты или пересекаются и концы «торчат», то цвет «разольется» по всему окну.

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

Процедура GetImage (X1, Y1, X2, Y2, Buf); помещает в память копию прямоугольного фрагмента изображения. Buf -- переменная или участки кучи, куда будет помещена копия видеопамяти с фрагментом изображения. Размер Buf должен быть не меньше значения, возвращаемого функцией ImageSize с теми же координатами X1...Y2.

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

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

12.3. Примеры программ

Ниже приведены программы, демонстрирующие некоторые возможности графики в Паскале.

Программа Prim 54 демонстрирует вывод различных простых объектов-окружностей, дуг, эллипсов, прямоугольников, параллелепипедов.

Program Prim54;Uses Graph;var grDriver,grMode,errCode,Radius,i,Width,y0,y1,y2,x1,x2:integer;Begin grDriver:=detect; { определение номера драйвера }

InitGraph(grDriver,grMode,'');

{ инициализация графического режима }

errCode:=GraphResult;

if errCode=grOK then

begin { графический режим открыт, можно работать }

for radius:=1 to 5 do

begin { рисуем окружности с радиусами 10,20..50,

с центром x=200, y=70 точек растра }

Circle(200,70,Radius*10); readln; end;

{ Cleardevice;} { если бы этот оператор не был в

комментарных скобках, т.е. не заблокирован, то

сейчас окружности были бы стерты с экрана }

Ellipse(200,200,0,360,30,50); { рисуем дугу эллипса с центром 200,200, начальный угол=0, конечный - 360 (замкнутый,

эллипс радиусами 30,50 }

readln;

Ellipse(300,200,0,180,50,30); {полэллипса }

readln;

for Radius:=1 to 5 do

Arc(300,100,0,90,radius*10); {дуги с центром 300,100, от

0 до 90 градусов, радиусами 10,20..50}

readln;

Width:=10;

Bar(30,20,50,100); {прямоугольник с координатами 30,20 -

верхний левый угол и 50,100 - нижний правый угол}

for i:=1 to 5 do

Bar(10+i*Width,300+i*10,20+i*Width,400);

{пять прямоугольников: первый 20,310.30,400,

второй 30,320,40,400 и т.д. }

readln;

Bar3D(210,300,250,360,10,TopOn); {параллелепипед с крышкой}

readln;

x1:=410; y1:=300; x2:=450; y2:=360;

Bar3D(x1,y1,x2,y2,10,TopOff); { параллелепипед без крышки }

readln;

CloseGraph; {закрыть Graph}

end

else Halt(1); { режим Graph не удалось открыть. }

End.

Prim 55 рисует в динамике случайно расположенные цветные линии в окне до тех пор, пока не будет нажата клавиша Enter. Затем машина выводит последним случайным цветом главную диагональ окна, после Enter - случайные лучи и после Enter - прямоугольник.

Program Prim55;

Uses CRT,Graph;

var GrDriver,grMode,errCode:integer;

begin grDriver:=Detect;

InitGraph(grDriver,grMode,' ');

errCode:=GraphResult;

if errCode=grOK then

begin Randomize; {запустить генератор случайных чисел}

repeat {рисуются цветные линии в квадрате 500 x 500,

пока не будет нажата любая клавиша, координаты

линий случайны, цвета линий случайны}

SetColor(Random(GetMaxColor)+1);

Line(Random(500),Random(500),Random(500),Random(500));

Delay(1000); {каждая линия рисуется с задержкой}

until KeyPressed;

Cleardevice;

MoveTo(1,2); {перевести курсор}

LineRel(500,500); {провести линию из предыдущей точки в 500,500

последним цветом}

readln; readln;

repeat

LineTo(random(500),random(500)); {провести линию в случайную точку}

Delay(6000);

until KeyPressed; readln;

ClearDevice;

Rectangle(29,29,GetMaxX-29,GetMaxY-29); {прямоугольник}

readln;

CloseGraph; end

else Halt(1); end.

Prim56 рисует эллипсы и круги, закрашенные красным цветом.

Program Prim56;

Uses CRT, Graph;

Var grDriver,grMode,errCode:integer;

Begin grDriver:=Detect;

InitGraph(grDriver,grMode, ' ');

errCode:=Graphresult;

if errCode=grOK then

Begin SetBkColor(blue);

SetFillStyle(1,4);

FillEllipse(220,150,50,50);

FillEllipse(420,150,50,50);

FillEllipse(320,230,50,130);

FillEllipse(370,405,50,30);

FillEllipse(275,410,50,30);

readln; end

else Halt(1); end.

Prim56 рисует обезьяну с тазиком.

Program Prim57;

Uses Graph;

Var i,grDriver,grMode,TrrCode,errCode:integer; x,y:word;

xm,ym,rc,xc,yc,x1,y1,x2,y2,r:word;

k:arccoordsType; kr:array[1..20] of PointType;

Begin grDriver:=detect;

InitGraph(grDriver,grMode,' ' );

errCode:=GraphResult;

if errCode=grOK then

begin

x:=150; y:=150;

SetBkColor(white);

{уши}

y1:=y-30; x1:=x-30; x2:=x+40; r:=15;

SetColor(lightred);

SetFillStyle(solidfill,brown);

pieslice(x1,y1,0,360,r);

pieslice(x2,y1,0,360,r);

r:=r-3;

SetFillStyle(solidfill,lightred);

pieslice(x1,y1,0,360,r);

pieslice(x2,y1,0,360,r);

{голова}

r:=(x2-x1) div 2-3;

x1:=x1+r+2;

y1:=y1+2;

xc:=x1;

yc:=y1;

rc:=r;

setColor(brown);

SetFillStyle(solidfill,brown);

pieslice(x1,y1,0,360,r);

{майка}

setColor(brown);

SetFillStyle(solidfill,yellow);

y2:=y1+r-3;

x1:=x1-r div 2+2;

ym:=y2;

line(x1-5,y2-5,x1-27,y2+68);

x2:=x1+r+16;

xm:=x2;

line(x2-15,y2-5,x2+27,y2+68);

line(x1-27,y2+68,x2+27,y2+68);

putpixel(x2-22,y2+25,blue);

floodfill(x2-22,y2+25,brown);

{пояс}

setcolor(green);

setfillstyle(solidfill,green);

bar(112,215,214,225);

{штаны}

setcolor(blue);

setfillstyle(solidfill,blue);

kr[1].x:=113; kr[1].y:=223;

kr[2].x:=113; kr[2].y:=270;

kr[3].x:=165; kr[3].y:=270;

kr[4].x:=170; kr[4].y:=260;

kr[5].x:=180; kr[5].y:=270;

kr[6].x:=225; kr[6].y:=270;

kr[7].x:=212; kr[7].y:=223;

kr[8].x:=113; kr[8].y:=223;

fillpoly(8,kr);

{левая нога}

setcolor(brown);

setfillstyle(solidfill,brown);

kr[1].x:=135; kr[1].y:=270;

kr[2].x:=145; kr[2].y:=320;

kr[3].x:=123; kr[3].y:=350;

kr[4].x:=145; kr[4].y:=358;

kr[5].x:=145; kr[5].y:=350;

kr[6].x:=162; kr[6].y:=320;

kr[7].x:=145; kr[7].y:=270;

kr[8].x:=135; kr[8].y:=270;

fillpoly(8,kr);

{правая нога}

kr[1].x:=195; kr[1].y:=270;

kr[2].x:=205; kr[2].y:=320;

kr[3].x:=183; kr[3].y:=350;

kr[4].x:=205; kr[4].y:=358;

kr[5].x:=205; kr[5].y:=350;

kr[6].x:=222; kr[6].y:=320;

kr[7].x:=205; kr[7].y:=270;

kr[8].x:=195; kr[8].y:=270;

fillpoly(8,kr);

{башмаки}

setfillstyle(solidfill,red);

pieslice(160,360,0,360,10);

pieslice(200,370,10,160,20);

pieslice(215,360,0,360,10);

pieslice(142,370,10,160,20);

setfillstyle(solidfill,white);

fillellipse(145,115,5,8);

fillellipse(163,115,5,8);

setfillstyle(solidfill,blue);

pieslice(147,115,0,360,3);

pieslice(165,115,0,360,3);

setcolor(yellow);

arc(154,160,30,145,30);

setcolor(red);

setfillstyle(solidfill,lightmagenta);

fillellipse(154,146,5,8);

{бабочка}

kr[1].x:=140; kr[1].y:=153;

kr[2].x:=135; kr[2].y:=163;

kr[3].x:=155; kr[3].y:=158;

kr[4].x:=175; kr[4].y:=163;

kr[5].x:=170; kr[5].y:=153;

kr[6].x:=155; kr[6].y:=158;

kr[7].x:=140; kr[7].y:=153;

fillpoly(7,kr);

{тазик}

setfillstyle(solidfill,blue);

kr[1].x:=243; kr[1].y:=225;

kr[2].x:=255; kr[2].y:=280;

kr[3].x:=325; kr[3].y:=280;

kr[4].x:=335; kr[4].y:=225;

kr[5].x:=255; kr[5].y:=225;

fillpoly(5,kr);

sector(290,230,0,360,50,12);

setfillstyle(solidfill,lightcyan);

fillellipse(290,230,40,10);

{руки}

setfillstyle(solidfill,brown);

kr[1].x:=184; kr[1].y:=164;

kr[2].x:=295; kr[2].y:=225;

kr[3].x:=300; kr[3].y:=215;

kr[4].x:=175; kr[4].y:=150;

kr[5].x:=180; kr[5].y:=160;

fillpoly(5,kr);

pieslice(295,224,0,170,12);

pieslice(265,244,0,360,10);

kr[1].x:=136; kr[1].y:=184;

kr[2].x:=265; kr[2].y:=255;

kr[3].x:=270; kr[3].y:=245;

kr[4].x:=135; kr[4].y:=170;

kr[5].x:=136; kr[5].y:=184;

fillpoly(5,kr);

end else halt(1);

readln; end.

Prim58 демонстрирует возможности мультипликации: по фоновому рисунку - дом, луна, висящий "базовый" НЛО; мечется с переменной скоростью малый НЛО и издает звуки случайными частотами.

Program Prim58;

Uses CRT,Graph;

Label loop;

Const r=30; p=600; pr=1000; {константы, определяющие скорость}

{рисования и перемещения объектов}

Var d,m,e,xm,ym,x,y,lx,ly,rx,ry,size,i,dx,dy,

width,height,grDriver,grMode,errCode,a,b,c,

f,s,j:integer;

saucer:pointer;

Begin grDriver:=Detect;

InitGraph(grDriver,grMode,'');

errCode:=GraphResult;

if errCode=grOK then

Begin x:=r*3; y:=r*2; xm:=GetMaxX div 2; ym:=GetMaxY div 2;

{тарелка}

SetBkColor(blue);

SetFillStyle(solidfill,red);

Ellipse(x,y,0,360,r+40,r div 10);

Ellipse(x,y-4,0,360,r-1,r);

Line(x+7,y-6,x+10,y-12);

Line(x-7,y-6,x-10,y-12);

Circle(x+10,y-12,2);

Circle(x-10,y-12,2);

Floodfill(x+1,y+4,White);

{определяем габариты НЛО и помещаем данные о нем в кучу}

lx:=x-r-1;

ly:=y-14;

rx:=x+r+1;

ry:=y+r div 6;

Width:=rx-lx+1;

Height:=ry-ly+1;

Size:=Imagesize(lx-9,ly,rx+3,ry+10);

GetMem(Saucer,size);

GetiMage(lx-9,ly,rx+10,ry+3,saucer^);

{создаем звездное небо}

Rectangle(xm,ym,3*xm,3*ym);

SetViewPort(xm+1,ym+1,3*xm-1,3*ym-1,Clipon);

xm:=2*xm;

ym:=2*ym;

for i:=1 to 200 do

PutPixel(random(xm),random(ym),white);

{дом}

SetFillStyle(solidfill,DarkGray);

bar(320,240,640,480); Delay(p*10); {дом}

bar(370,220,600,240); Delay(p*10); {чердак}

Line(320,240,640,240); Delay(p*10); {крыша}

Line(370,240,370,220); Delay(p*10); {левая стена чердака}

Line(600,220,600,240); Delay(p*10); {правая стена чердака}

Line(370,220,600,220); Delay(p*10); {крыша чердака}

Line(430,220,430,180); Delay(p*10); {мачта антенны}

Line(430,180,410,170); Delay(p*10); {верхний ус антенны}

Line(430,180,410,190); Delay(p*10); {нижний ус антенны}

Line(430,180,410,180); Delay(p*10); {средний ус антенны}

bar(0,460,640,480); Delay(p*10); {земля}

Line(0,460,640,460); Delay(p*10);

SetFillStyle(solidfill,Yellow);

b:=270; {окна}

for i:=1 to 4 do

begin a:=350; f:=b+20; c:=a+15; Delay(p*5);

for j:=1 to 8 do

begin

bar(a,b,c,f); Delay(p*5);

SetColor(DarkGray);

Line(a,b+8,c,f-12); Delay(p*5);

Line(a+5,b+8,a+5,b+20); Delay(p*5);

a:=a+35; c:=c+35; end;

b:=b+50; end; Delay(p*10);

Pieslice(500,80,300,100,20); {месяц}

SetColor(green); Delay(p*10);

Line(150,460,150,400); Delay(p*10); {дерево}

Circle(170,365,25); Delay(p*10);

Circle(165,375,25); Delay(p*10);

Circle(150,375,25); Delay(p*10);

Circle(135,365,25); Delay(p*10);

Circle(155,345,25); Delay(p*10);

{задаем начальное положение нло и направление движения}

x:=xm div 2;

y:=ym div 2;

dx:=100;

dy:=100;

{основной цикл}

Repeat

PutImage(x,y,Saucer^,XorPut);

Sound(Random(2*2000));

Delay(pr*2); NoSound;

Putimage(x,y,Saucer^,XorPut);

{получаем новые координаты}

loop:x:=x+dx;

y:=y+dy;

if (x<0) or (x+width+1>xm) or (y<0) or (y+height+1>ym) then

begin

{НЛО достиг границы экрана, меняем направление его движения}

x:=x-dx; y:=y-dy;

dx:=GetMaxX div 10 - random(GetMaxX div 5);

dy:=GetMaxY div 30 - random(GetMaxY div 15);

goto loop;

end until KeyPressed;

if ReadKey=#0 then x:=ord(ReadKey);

end else CloseGraph;

end.

Список использованной и рекомендуемой литературы:

1. А.Н. Воловачев, В.С. Крисевич. Программирование на языке Паскаль для персональных ЭВМ ЕС. - Минск: "Высшая школа", 1989.

2. В.Я. Сердюченко. Розробка алгоритмів та програмування мовою TURBO PASCAL. - Харьков: "Паритет", 1995.

3. В.В. Фаронов. TURBO PASCAL 7.0 /Практика программирования/ - "Нолидж", 1997.