Практикум. Создание движущихся изображений

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

Сам «перемещаемый» объект может быть двумерным (плоским) и трехмерным (пространственным), причем движение может осуществляться по двум типам траектории: лежащей в плоскости экрана или выходящей за нее.

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

Движение плоских объектов.Любое сложное движение плоских объектов на экране складывается из базовых: перемещения, масштабирования и поворота. Формулы пересчета координат изображений для базовых видов движения следующие.

Практикум. Создание движущихся изображений - student2.ru

Рис.8.9. Элементарные изменения изображения: а - перемещение; б- масштабирование; в - поворот

Перемещение (рис. 8.9, а)

x1 = x + dx,

y1 = y + dy,

где x, у - исходные координаты точки; x1, y1 - координаты точки после перемещения; dx, dy - смещения по оси х и у соответственно.

Масштабирование относительно точки С (хc, уc) (рис. 8.9, б):

x1 =(х-xсх + xс,

y1 =(у-yсу + yс,

где Mx, My - масштабы по х и у соответственно; хc, уc - координаты точки, относительно которой ведется масштабирование.

Поворот относительно точки С с координатами (хc, уC,) (рис. 8.9, в):

x1 = (х-xс)cosα + (у-yс)sinα + хc,

y1 = (у-yс)cosα - (х-xс)sinα + yс,

где α - угол поворота.

Пример 8.7.Разработать программу, которая демонстрирует на экране движение прямоугольника: прямоугольник улетает от нас к некоторой точке горизонта, одновременно вращаясь вокруг своей оси.

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

Начало:

Установить точку отсчета координат (условное время).

Рассчитать координаты квадрата.

Цикл-покане истекло время или не нажата любая клавиша

Установить цвет рисования.

Изобразить квадрат.

Приостановить выполнение программы на время просмотра кадра.

Установить в качестве цвета рисования цвет фона.

Изобразить квадрат цветом фона - стереть.

Изменить точку отсчета (условное время).

Пересчитать координаты квадрата.

Все-цикл

Конец.

В а р и а н т 1. Координаты вершин квадрата будем хранить в специальных массивах х, у, а квадрат рисовать линиями, проводя их из одной вершины в другую. Изображение квадрата будет осуществлять специальная процедура Square.

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

Практикум. Создание движущихся изображений - student2.ru

Рис. 8.10.Разложение движения

Вначале определим координаты вершин и центра квадрата после масштабирования, а затем координаты вершин после поворота вокруг центра

квадрата. Ниже приведена соответствующая программа:

Program ex;

Uses Crt,Graph;

Const

r=100;

Type

mas=array[1.. 4] of integer;

Var

x, y, x1, y1:mas;

gd,gm,xn,yn,xc,yc,i,j,k1: integer;

t,k:real;

{изображение квадрата по координатам его вершин}

Procedure Square(х,у:mas);

Begin

Line(x[1],y[1],x[2],y[2]);

Line(x[2],y[2],x[3],y[3]);

Line(x[3],y[3],x[4],y[4]);

Line(x[4],y[4],x[1],y[1]);

End;

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

Procedure Pow(xc,yc,x,y:integer;t:real;var xl,yl:integer);

Begin

x1:=xc+round((x-xc)*cos(t))+round(y-yc)*sin(t));

y1:=yc+round((y-yc)*cos(t))-round((x-xc)*sin(t));

End;

{определение координат точки после масштабирования}

Procedure Massch(xc,yc,x,y:integer; k:real; var x1,y1:integer);

Begin

x1:=round(x*k+(1-k)*xc);

y1:=round(y*k+(1-k)*yc);

End;

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

Begin

gd:=detect;

InitGraph(gd,gm, 'd:\bp\bgi');

SetColor(2);

xn:=GetMaxX div 4;

yn:=GetMaxY div 3*2;

xc:=GetMaxX-xn;

yc:=GetMaxY-yn;

{расчет начальных координат вершин квадрата}

x[1]:=xn-r; y[1]:=уn-r;

x[2]:=xn+r; у[2]:=yn-r;

x[3]:=xn+r; y[3]:=yn+r;

x[4]:=xn-r; у[4]:=yn+r;

k:=0.99;

t:=0;

{покадровый вывод на экран}

while (t<1) and not KeyPressed do

begin

SetColor(2); {установим цвет рисования}

Square(x,y); {нарисуем квадрат}

t:=t+0.001; {увеличим угол поворота}

{масштабирование}

for j:=1 to 4 do {определим координаты вершин}

Massch(xc,yc,x[j],y[j],k,x1[j],y1[j]);

Massch(xc,yc,xn,yn,k,xn,yn); {определим координаты центра}

{поворот}

for j:=1 to 4 do {определим координаты вершин}

Pow(xn,yn,x1[j],y1[j],-t,x1[j],y1[j]);

for j:=1 to 1500 do Delay(1000); {или NewDelay см. параграф 8.3}

SetColor(0); {установим цвет рисования - цвет фона}

Square(x,y); {стираем квадрат}

x:=x1; {заменим координаты вершин на новые}

y:=y1;

end;

CloseGraph;

End.

Недостатком данного способа является то, что квадрат на экране через несколько кадров уже выглядит не квадратным. Это происходит вследствие накопления ошибки округления при пересчете координат вершин. Избежать этого можно двумя способами:

1) все вычисления выполнять в вещественной арифметике и координаты также хранить как вещественные числа, преобразуя их в целые непосредственно перед использованием в процедуре рисования;

2) пересчитывать координаты не всех вершин, а какой-нибудь одной и центра квадрата, восстанавливая квадрат по одной вершине и положению центра квадрата.

Способы являются взаимодополняющими, поэтому используем оба.

В а р и а н т 2. Для упрощения вычислений вместо массивов, хранящих координаты вершин квадрата, будем использовать смещения этих вершин относительно центра (рис. 8.11). Соответственно процедура рисования квадрата Square 1 должна использовать именно эти параметры. Также учтем, что при масштабировании изменяются размер диагонали и положение центра, а при повороте - смещения вершин относительно центра. Ниже представлен текст программы.

Практикум. Создание движущихся изображений - student2.ru

Рис. 8.11. Два соседних кадра при повороте

Program ex;

Uses Crt,Graph;

Const r:real=100; {размер половины стороны квадрата}

Var

x, у, dx, dy, dx1, dy1, xn, yn, xc, yc, xn1, yn1:real;

gd,gm,i,j:integer;

t,k:real; {угол поворота и масштаб}

{изображение квадрата}

Procedure Square1(x,y,dx,dy:integer);

Begin

Line(x+dx,y+dy,x-dy,y+dx);

Line(x-dy,y+dx,x-dx,y-dy);

Line(x-dx,y-dy,x+dy,y-dx);

Line(x+dy,y-dx,x+dx,y+dy);

End;

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

Begin

gd:=detect;

InitGraph(gd,gm, 'd:\bp\bgi');

{устанавливаем начальную и конечную точки}

хп:=GetMaxX div 4;

yn:=GetMaxY div 3*2;

xc:=GetMaxX-xn;

yc:=GetMaxY-yn;

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

dx:=r;

dy:=0;

k:=0.95;

t:=0;

{покадровый вывод на экран}

while (t<100) and not Key Pressed do

begin

SetColor(2); {выводимкадр}

Square1(round(xn), round(yn), round(dx), round(dy));

{масштабирование}

xn1:=xn*k+(1-k)*xc;

yn1:=yn*k+(1-k)*yc;

r:=k*r;

{поворот}

t:=t+1; {увеличиваем угол поворота}

dx1:=r*cos(t);

dy1:=r*sin(t);

for j:=1 to 5000 do Delay(1000); {приостановка}

SetColor(0); {стираемкадр}

Square1(round(xn), round(yn), round(dx), round(dy));

dx:=dx1; {заменяем параметры квадрата}

dy: =dy1

xn:=xn1

yn:=yn1

end;

CloseGraph;

end.

Прямая запись в видеобуфер.При программировании на экране движения объектов критичным является время перезаписи изображения: именно из-за большого времени перезаписи движение получается прерывистым.

Для уменьшения этого времени при программировании в MS DOS часто используют прямую запись информации в видеобуфер.

Как указывалось в параграфе 8.4, формат информации в видеобуфере зависит от используемого графического режима. При использовании младших режимов VGA, на которые рассчитан Borland Pascal, видеобуфер содержит 4 бита на каждую точку, причем биты расположены в параллельных битовых плоскостях и доступ к ним напрямую существенно затруднен (программирование таких операций обычно выполняется на ассемблере). Однако существует режим VGA (режим 19: 200*320 точек 256 цветов из палитры 262144 цвета), при котором каждой точке соответствует байт (8 бит) в видеобуфере.

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

Пример 8.8.Разработать программу, обеспечивающую вывод «бегущей» строки. Направление движения строки по экрану - вверх-вниз.

Для создания изображения используем возможности модуля Graph, затем перепишем изображение из видеопамяти в буфер, расположенный в динамической памяти, и перейдя в режим 200*320, организуем циклический вывод изображения напрямую в видеобуфер. Стирание старого изображения будем выполнять чистой кромкой образа (образ «не прозрачный»).

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

Program ex;

Uses Graph, Crt, Dos;

Type

ScreenType=array[0..199,0..319] of byte; {массив для хранения образа экрана - формат видеобуфера}

ImageType=array[0..999] of byte; {развертка изображения}

ScrTypePtr=^ScreenType; {указатель на массив образа экрана}

ImageTypePtr=^ImageType; {указатель на развертку изображения}

{процедура установки режима с номером mode}

Procedure SetBIOSMode(mode:byte);

Var r:registers;

Begin

r.AL:=mode; {запись номера режима в регистр AL}

r.АН:=0; {запись номера функции в регистр АН}

intr($10,r); {вызов 0-й функции 10-го прерывания}

End;

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

Var

Driver, Mode:integer;

s:string;

i, j, n, m, l, y, dy:integer;

Active_Ptr:ScrTypePtr; {указатель на тип "образ экрана"}

Image:ImageTypePtr; {указатель на развертку изображения}

Begin

{формирование изображения и сохранение его в памяти}

Driver: =Detect; InitGraph(Driver,Mode, ");

s:='ABCDEF';

SetColor(4); SetTextStyle(GothicFont, HorizDir, 3);

OutTextXY(2,2,s);

n:=TextHeight(s)+3;

m:=TextWidth(s)+3;

GetMem(Image,(n+1)*(m+1)); {получение памяти для записи изображения}

l:=0;

for i:=0 to n do

for j:=0 to m do

begin

image^[l]:=Lo(GetPixel(j,i)); {запись изображения в буфер}

l:=l+1;

end;

CloseGraph;

{запись изображения «напрямую» в видеобуфер}

SetBIOSMode($13); {установка 19-го графического режима}

Active_Ptr:=Ptr($A000,0); {стандартный адрес видеобуфера}

у:=0;

dy:=1;

{покадровый вывод изображения}

repeat

{побайтная запись изображения в видеобуфер}

l:=0;

for i:=0 to п do

for j:=0 to т do

begin

Active_Ptr^[y+i+10,j+20]:=image^[l];

l:=l+1;

end;

for i:=1 to 1000 do Delay(3000); {задержка}

Inc(y,dy); {смещение изображения}

if (y>120) or (y<0) then dy:=-dy; {организация колебательного движения}

until KeyPressed;

SetBIOSMode(3); {возврат к стандартному текстовому режиму}

End.

ПРИМЕРЫ

Пример 8.7. Программа рисует человечка, делающего утреннюю зарядку.

Практикум. Создание движущихся изображений - student2.ru

Program Animation; Uses Crt, Graph; {подключение к программе библиотек Crt и Graph} Const {вертикальные и горизонтальные координаты положения рук} Vert : Array[1..3] of Integer = (190, 157, 120); Horizont : Array[1..3] of Integer = (200, 190, 200); Var GrDriver, GrMode, GrError, i, j : Integer; BEGIN GrDriver := Detect; InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); GrError := GraphResult; If GrError <> GrOk then Halt; SetColor(LightGray); { установка светлосерого цвета для рамки} Rectangle(20, 20, 480, 400); {рисование рамки} SetColor(LightCyan); {установка яркоголубого цвета для текста} OutTextXY(200, 40, 'П Р И В Е Т !'); SetColor(LightGray); Circle (250, 130, 20); {голова} SetColor(Yellow); Arc(250, 130, 0, 180, 26); {волосы} Arc(250, 130, 0, 180, 24); Arc(250, 130, 0, 180, 22); Line(250, 105, 244, 115); Line(250, 105, 250, 116); {чубчик} Line(250, 105, 256, 115); SetColor(LightCyan); Circle(241, 125, 4); {левый глаз } Circle(259, 125, 4); {правый глаз} SetColor(LightRed); SetFillStyle(SolidFill, LightRed); FillEllipse(250, 140, 6, 3); {рот } Setcolor(Green); Line(250, 152, 250, 220); {туловище } Line(250, 220, 210, 290); {левая нога } Line(250, 220, 290, 290); {правая нога} Repeat {цикл прерывается нажатием любой клавиши} For i := 1 to 3 do {Последовательный вывод трех положений рук:} begin { вниз, на уровне плеч, вверх } SetColor(LightCyan); Sound(200*i); Line(250, 157, Horizont[i], Vert[i]); {левая рука} Line(250, 157, 500-Horizont[i], Vert[i]); {правая рука} Delay(300); {задержка} SetColor(Black); {смена цвета на черный для повторного pисования рук в том же положении ("стирания" их с экрана) } Line(250, 157, Horizont[i], Vert[i]); {левая рука } Line(250, 157, 500-Horizont[i], Vert[i]); {правая рука} end until Keypressed; SetColor(LightCyan); Line(250, 157, Horizont[3], Vert[3]); {левая рука поднята } Line(250, 157, 500-Horizont[3], Vert[3]); {правая рука поднята} For i := 1 to 10 do { звуковая трель } begin Sound(1000); Delay(50); Sound(1500); Delay(50) end; NoSound; { выключение звука } CloseGraph;END.

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

Практикум. Создание движущихся изображений - student2.ru Перемещение и изменение размеров изображений на экране можно организовать по разному. Так, в примере 8.6 эффект движения изображения достигается следующим образом: выводится изображение, затем оно стирается с экрана с помощью процедуры ClearViewPort, повторно выводится с некоторым перемещением и т.д.

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

Оба способа имеют одинаковый недостаток —
движение изображения является прерывистым и вызывает мелькание экрана.

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

Изображение сначала создается на странице с нулевым номером, видимой по умолчанию, а на невидимой странице с номером 1 формируется изображение с небольшим перемещением. Затем страница с номером 1 делается видимой, а новое изображение формируется на ставшей невидимой странице с нулевым номером и т.д.

Демонстрация

Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.

Program Space; {составил студент Тетуев Р., мат.фак. КБГУ} Uses Graph, Crt; Const RadOrb = 250 {радиус орбиты Земли}; RadSun = 70 {радиус Солнца}; RadGal = 100 {радиус галактики }; RadZem = 18 {радиус Земли }; Naklon = 0.2 {коэффициент наклона плоскости орбиты Земли}; PressZem = 0.65 {коэффициент сплющенности полюсов Земли}; Compress = 0.8 {коэффициент сжатия при переходе из }; {расширения режима VGA в режим CGA } Var ZemX, ZemY, UgMer, PixelY, DUgZem , UpDown, XRad, Grad, UgZem, PixelX, StAngle, Ua, Ub, ParallelY , Color, ZemPix, EndAngle, VisualPage, GrMode, GrError, GrDriver, i : Integer; Ugol, CompressZem, Expansion, DUgol, Projection, PolUgol : Real;BEGIN {установка графического режима и проверка возможных ошибок} GrDriver := EGA; GrMode := EGAHi; InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); GrError := GraphResult; If GrError<>GrOk then Halt; SetBkColor(Black); SetFillStyle(1, Yellow); {установка стиля заполнения и цвета Cолнцa} Ugol := 0; DUgol := 2*Pi/180; {орбитальное угловое смещение Земли} UgZem := 0; DUgZem := 14; {осевое угловое смещение Земли} {------------------------------------------------------------------} VisualPage := 1; Repeat {цикл прерывается нажатием любой клавиши} SetVisualPage(1- (VisualPage mod 2)); {установка номера видимой видеостраницы} VisualPage := VisualPage+1; {листание видеостраниц} SetActivePage(1 - (VisualPage mod 2)); {установка номера невидимой (активной) видеостраницы,} {используемой для построения смещенного изображения } ClearDevice; {очистка графического экрана} {--------------------------------------------------------------} {Рисование "расходящейся" галактики} RandSeed:=1; {исходное значение датчика случайных чисел} Expansion:=VisualPage/100; {cкорость расширения галактики} For i:= 1 to VisualPage do begin XRad := Trunc(Expansion*RadGal*Random); {текущее расстояние от звезды до центра галактики} PolUgol:= 2*Pi*Random-VisualPage/30; {текущий центральный угол положения звезды галактики} PixelX := 370+Trunc(XRad*cos(PolUgol+1.8)); {координаты} PixelY := 250+Trunc(XRad*0.5*sin(PolUgol)); { звезды } PutPixel(PixelX, PixelY, White) {рисование звезды} end; {--------------------------------------------------------------} {Рисование мерцающих звезд} Randomize; {инициализация датчика случайных чисел} For i:=1 to 70 do PutPixel(Random(640),Random (350),White); {вспыхивающие звезды} {--------------------------------------------------------------} For i := 1 to 100 do {Рисование орбиты} PutPixel(320+Round(RadOrb * cos((i+VisualPage/5)*Pi/50+0.3)), 160+Round(RadOrb*Naklon*sin((i+VisualPage/5)*Pi/50-Pi/2)),15); {--------------------------------------------------------------} PieSlice(310, 160, 0, 360, RadSun); {Рисование Солнца} {--------------------------------------------------------------} {Рисование Земли (ее параллелей и меридианов)} Ugol := Ugol+DUgol ; {угол поворота Земли относительно Солнца} Grad := Round(180*Ugol/Pi) mod 360; {в рад.(Ugol) и в град.(Grad)} ZemX := 320+Round(RadOrb*cos((Ugol+Pi/2+0.3))); { координаты } ZemY:=160+Round(RadOrb*Naklon*sin(Ugol)); {центра Земли} CompressZem := 2.5-cos(Ugol+0.3); {коэффициент учета удаленности Земли от наблюдателя} ZemPix := Round(RadZem*CompressZem); {текущий радиус Земли} UgZem := UgZem+DUgZem; {угол поворота Земли относительно своей оси} For i := 0 to 11 do { рисование меридианов } begin UgMer := (UgZem+i*30) mod 360; If (90<UgMer) and (UgMer<270) {установка начального и конечного} then begin StAngle := 90; EndAngle := 270 end { углов дуги } else begin StAngle := 270; EndAngle := 90 end; {эллипса меридиана} Ua := (Grad+220) mod 360; Ub := (Grad+400) mod 360; {установка цветов рисования затененной и освещенной частей меридиана} Color := LightBlue; If Ua<=Ub then if (Ua<UgMer) and (UgMer<Ub) then Color := White; If Ua >Ub then if (Ua<UgMer) or (UgMer<Ub) then Color := White; SetColor(Color); XRad := round((ZemPix*cos(UgMer*Pi/180))); Ellipse(ZemX,ZemY,StAngle,EndAngle,abs(XRad),round(PressZem*ZemPix)); end; For i := 2 to 7 do {рисование параллелей} begin XRad := abs(Round(ZemPix*sin(i*Pi/9))); {большая полуось эллипса параллели} UpDown := Round(ZemPix*PressZem*cos(i*Pi/9)); {высота параллели над плоскостью экватора} ParallelY := ZemY+UpDown; {координата Y центра эллипса параллели} SetColor(LightBlue); Ellipse(ZemX, ParallelY, 0, 360, XRad, Round(Naklon*XRad)); {затененная часть параллели} SetColor(White); Ellipse(ZemX,ParallelY,Grad+220,Grad+400,XRad,Round(Naklon*XRad)); {освещенная часть параллели} end; {------------------------------------------------------------------} {Повторное рисование Cолнца, если оно ближе к наблюдателю, чем Земля} If CompressZem<2 then PieSlice(310, 160, 0, 360, RadSun); {------------------------------------------------------------------} RandSeed := VisualPage mod 12; For i := 1 to 250 do {Рисование протуберанцев} begin Projection := (1-sqr(Random))*Pi/2; XRad := RadSun+Round((20)*sin(Projection))-15; PolUgol := 2 * Pi * Random+VisualPage/20; {PolUgol, XRad - полярные координаты протуберанца} PixelX := 310 + Round( XRad * cos(PolUgol)); PixelY := 160 + Round( Compress * XRad * sin(PolUgol)); PutPixel(PixelX, PixelY, LightRed) end; until KeyPressed END.

Создание иллюзии движения

Создать видимость движения изображения на экране можно несколькими способами. Рассмотрим два из них.

I способ. Имитация движения объекта на экране за счет многократного выполнения программой набора действий: нарисовать – пауза – стереть (нарисовать в том же месте цветом фона) – изменить координаты положения рисунка.
Перед началом составления программы надо продумать описание «двигающегося» объекта, характер изменения координат, определяющих текущее положение объекта, диапазон изменения и шаг.
Упражнение 1. Изучить текст программы, которая рисует модель атома.

program Model_At;
uses Crt, Graph;
const Ra=100; {радиус атома}
Rc=10; {радиус ядра}
Re=4; {радиус электрона}
k=0.5; {коэффициент сжатия орбит электронов}
Dr=30; {параметр изменения координат электрона}
Step1=0.2; {шаг изменения положения электрона}
Step=100; {время задержки – скорость движения электронов}
var cx, cy, y, y1, y2, x, x1, x2, x3,y3:integer;
I, I1, I2, I3: real; gd, gm: integer;
begin
clrscr;
gd:=detect;
initgraph(gd, gm, ‘путь к драйверу’);
SetTextStyle(0, 0, 2);
OutTextXY(200, 30, ‘Модель атома’);
cx:=GetMaxX div 2; {определить центр экрана- положение ядра}
cy:=GetMaxY div 2;
PieSlice(cx, cy, 0, 360, Rc);{нарисовать ядро атома}
SetColor(Red);
SetLineStyle(0, 0, 3);
Line(cx-7, cy, cx+7, cy);
Line(cx, cy-5, cx, cy+5);
SetLineStyle(0,0,1);
SetFillStyle(1,1);
I:=Pi/4; {задать начальное положение 4 электронов}
I1:= - Pi/4;
I2:= - Pi/2;
I3:= Pi/2;
SetTextStyle(0, 0, 1);
SetColor(jellow);
OutTextXY (180, 420,’Для отмены нажмите любую клавишу’);
While not KeyPressed do {повторять, пока не нажата любая клавиша }
begin {определить координаты электронов}
x:=Round (Ra*cos(I)) +cx; Y:= Round(k+Ra*sin(I)) +cy;
x1:= Round((Ra+Dr)*cos(I1)) +cx; y1:= Round (k*(Ra+Dr)*sin(I1)) +cy;
x2:= Round((Ra-Dr)*cos(I2)) +cx; y2:= Round (k*(Ra-Dr)*sin(I2)) +cy;
x3:= Round((Ra-Dr)*cos(I3)*2.3) +cx; y3:= Round (k*(Ra-Dr)*sin(I3)*2.3) +cy;{установить синий цвет и нарисовать электроны}
SetColor(1);
Circle(x, y, Re);
PutPixel(x, y, 2);
Circle(x1, y1, Re);
PutPixel(x1, y1, 2);
Circle(x2, y2, Re);
PutPixel(x2, y2, 2);
Circle(x3, y3, Re);
PutPixel(x3, y3, 2);
Delay(Step); {нарисовать электроны цветом фона}
SetColor(0);
Circle(x, y, Re);
PutPixel(x, y, 2);
Circle(x1, y1, Re);
PutPixel(x1, y1, 2);
Circle(x2, y2, Re);
PutPixel(x2, y2, 2);
Circle(x3, y3, Re);
PutPixel(x3, y3, 2); {задать изменение положения электронов}
I:=I + Step1;
I1:=I1 – Step1;
I2:=I2 + Step1;
I3:=I3 + Step1;
end; {конец цикла}
CloseGraph;
end.

II способ. Иллюзия движения создается при помощи специальных процедур и функций.
Функция ImageSize (x1,y1,x2,y2:integer):word возвращает размер памяти в байтах, необходимый для размещения прямоугольного фрагмента изображения, где x1,y1 – координаты левого верхнего и x2,y2 – правого нижнего углов фрагмента изображения.
Процедура GetImage (x1,y1,x2,y2:integer,var Buf) помещает в память копию прямоугольного фрагмента изображения, где x1,..,y2 – координаты углов фрагмента изображения, Buf - специальная переменная, куда будет помещена копия видеопамяти с фрагментом изображения. Buf должна быть не меньше значения, возвращаемого функцией ImageSize с теми же координатами.
Процедура PutImage (x1,y1,x2,y2:integer,var Buf, Mode:word) выводит в заданное место экрана копию фрагмента изображения, ранее помещенную в память процедурой GetImage. X,Y – координаты левого верхнего угла того места на экране, куда будет скопирован фрагмент изображения; Buf - специальная переменная, откуда берется изображение, Mode – способ копирования. Координаты правого нижнего угла не указываются, так как они полностью определяются размерами выводимой на экран копии изображения. Координаты левого верхнего угла могут быть любыми, лишь бы только копия уместилась в пределах экрана (если копия не размещается на экране, то она не выводится , и экран остается без изменений). Параметр Mode определяет способ взаимодействия размещаемой с уже имеющимся на экране изображением ( табл. 7)

Константа Значение Операция Пояснения
NormalPut Замена существующего на копию Стирает часть экрана и на это место помещает копию
XorPut Исключительное или Рисует сохраненный образ или стирает ранее нарисованный, сохраняя фон
OrPut Объединительное или Накладывает сохраненный образ на существующий
AndPut Логическое и Объединяет сохраненный образ и уже существующий на экране
NotPut Инверсия изображения То же самое, что и 0, только копия выводится в инверсном виде

Упражнение 2. Изучить программу, которая рисует звездное небо и перемещает на его фоне рисунок НЛО.

program NLO;
uses crt, graph;
const k=20;
Pause=50;
var gd, gm, xmin, xm, ymin, ym, x, y, tx, ty, rx, ry, size, i, dx, dy, width, height: integer;
sauser:Pointer;
begin
Randomize;
gd:= detect;
initgraph (gd, gm, ‘путь к драйверу’);
SetTextStyle (0, 0, 2);
OutTextXY (50, 10, ‘Демонстрация движения НЛО’); {Рисуем НЛО}
x:=R*5;
y:=R*2;
xm:=GetmaxX-5;
ym:=GetmaxY-25;
Ellipse(x, y, 0, 360, R, R div 3+2);
Ellipse(x, y-4, 190, 357, R, R div 3);
Line(x + 7, y - 6, x + 10, y - 12);
Line(x - 7, y - 6, x + 10, y - 12);
Circle(x + 10, y - 10, 2);
Circle(x - 10, y - 10, 2);
FloodFill(x+1, y+4, White); {определяем габариты НЛО и помещаем в специальную динамическую переменную}
Tx:= x-R;
Ty:=y-14;
Rx:=x+R;
Ry:=y+R div3 +3;
Width:=Rx-Tx+1;
Size:=ImageSize(Tx, Ty, Rx, Ry);
GetMem(sauser, Size);
GetImage(Tx, Ty, Rx, Ry, sauser^); {стираем построенное изображение}
PutImage(Tx, Ty, sauser^, XorPut); {рисуем звездное небо}
SetStyle (1, blue); {установить стиль и цвет закраски голубое небо}
SetColor (White); {начертить прямоугольник и открыть окно}
Rectangle (xmin, ymin, GetmaxX, GetmaxY);
SetViewPort (xmin, ymin, GetmaxX, GetmaxY, ClipOn);
FloodFill (xmin+1, ymin+1, White);
For i:=1 to 500 do {нарисовать 500 звезд белого цвета}
PutPixel(Random(GetmaxX),
Random(GetmaxY- ymin), 15); {задаем начальное положение НЛО}
x:=xm div 3 – xmin;
y:=ym div 3 – ymin;
dx:=6;
dy:=6;
Repeat {цикл: повторять, пока не нажата любая клавиша}
PutImage (x, y, sauser^, XorPut); {изображаем объект}
Delay (Pause);{задержка}
PutImage(x, y, sauser^, XorPut); {после паузы стираем объект} {перемещаем объект}
If (x<xmin) Or (y<ymin) Or (x+Width +1> xm) Or (y+Height +1> ym) Then
begin {если объект смещается влево-вверх за границы окна, изменить координаты так, чтобы он оставался в окне}
If (x- Dx< xmin) then x:= xmin else x := x- Dx;
If (y- Dy< ymin) then y:= ymin else y := y- Dy;
Dx:= GetmaxX div 10 - Random(GetmaxX div 4);
Dy:= GetmaxY div 10 - Random(GetmaxY div 4);
end
else
begin {если объект смещается вправо-вниз за границы окна, изменить координаты так, чтобы он оставался в окне}
If (x + Dx< xm) then x:= x + Dx else x:= Random(GetmaxX) - Random(GetmaxX div 4);
If (y + Dy< ym) then y:= y + Dy else y:= Random(GetmaxY) - Random(GetmaxY div 3);
end;
until KeyPressed; {завершить, как только будет нажата клавиша}
FreeMem (sauser, Size);
Closegraph;
end;
end.

Пример. Рисование сердца на экране:

program gr;
uses crt,graph;
var driver,mode,error:integer;
l,n,m,x,y,r:integer;
begin
driver:=detect;
initgraph(driver,mode,”);
error:=graphresult;
if error<>grOk then
begin
writeln(’Ошибка графики: ‘,graphErrorMsg(error));
writeln(’Программа аварийно завершила работу…’);
halt(1);
end;
m:=1;l:=1;x:=1;y:=1;r:=1;n:=1;
repeat
x:=1;y:=1;r:=1;l:=1;
repeat
begin
setcolor(cyan);
arc(170-x,150,0,180,20+r);
arc(210+x,150,0,180,20+r);
line(150-2*x,150,190,200+y);
line(230+2*x,150,190,200+y);
floodfill(149,150,cyan);
x:=x+1;y:=y+1;r:=r+1;
delay(20);
clearviewport;
l:=l+1;
end;
until l=20;
x:=1;y:=1;r:=1;m:=1;
repeat
setcolor(cyan);
arc(150+x,150,0,180,40-r);
arc(230-x,150,0,180,40-r);
line(110+2*x,150,190,220-y);
line(270-2*x,150,190,220-y);
floodfill(149,150,cyan);
x:=x+1;y:=y+1;r:=r+1;m:=m+1;
delay(20);
clearviewport;
until m=20;
n:=n+1;
until n=20;
closegraph;
end.

Пример. НЛО.

Program nlo;

uses crt, graph;

label loop;

const

r=20;

pause=10000;

col=white;

var driver,regim,error:integer;

i:integer;

sauser:pointer;

size:integer;

xm,ym,x,y,lx,ly,rx,ry,dx,dy,width,height:integer;

begin

clrscr;

driver:=detect;

InitGraph(driver,regim,'');

setgraphmode(0);

x:=r*5; y:=r*2;

xm:=getmaxx; ym:=getmaxy;

ellipse(x,y,0,360,r,r div 3 +2);

ellipse(x,y-4,190,357,r,r div 3);

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);

setfillstyle(solidfill,col);

floodfill(x+1,y+4,col);

lx:=x-r-1; ly:=y-14;

rx:=x+r+1; ry:=y+r div 3 +3;

width:=rx-lx+1;

height:=ry-ly+1;

size:=imagesize(lx,ly,rx,ry);

getmem(sauser,size);

getimage(lx,ly,rx,ry,sauser^);

putimage(lx,ly,sauser^,xorput);

for i:=1 to 1000 do

putpixel(random(xm),random(ym),random(succ(getmaxcolor)));

x:=xm div 2; y:=ym div 2;

dx:=getmaxx div 100 -random(getmaxx div 50);

dy:=getmaxy div 40 -random(getmaxy div 20);

repeat

putimage(x,y,sauser^,xorput);

delay(pause);

putimage(x,y,sauser^,xorput);

loop: x:=x+dx; y:=y+dy;

delay(pause);

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

begin

x:=x-dx;

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

y:=y-dy;

dy:=getmaxy div 40 -random(getmaxy div 20);

goto loop;

end;

until keypressed;

{readln;}

CloseGraph;

end.

Пример. Летящее красное ядро.

Program yadro;

uses crt, graph;

var driver,regim,error:integer;

i:integer;

p:pointer;

size:word;

begin

clrscr;

driver:=detect;

InitGraph(driver,regim,'');

setcolor(4);

for i:=1 to 10 do

begin

circle(40,50,i);

end;

size:=imagesize(29,39,51,61);

getmem(p,size);

getimage(29,39,51,61,p^);

readln;

cleardevice;

for i:=1 to 400 do

begin

putimage(29+i,39+i,p^,normalput);

delay(1000);

end;

readln;

CloseGraph;

end.

Пример. Бьющееся сердце.

Program heart;

uses crt, graph;

const

sx=1.6; (* коэффициент сжатия по х *)

sy=1.3; (* по y *)

dx=250; (* смещение по х *)

dy=100; (* смещение по y *)

n1=79; (* кол-во точек, описывающих несжатое сердце *)

a1:array[1..n1*2] of word=(22,38, 20,40, 19,44, 17,48, 16,52,

17,55, 18,60, 20,64, 21,67, 23,70,

27,74, 30,77, 34,80, 37,83, 42,87,

48,90, 50,91, 52,92, 56,93, 59,94,

62,93, 65,92, 66,92, 68,90, 70,88,

71,86, 72,84, 73,81, 74,78, 75,75,

75,72, 76,68, 76,65, 76,61, 76,57,

75,53, 73,49, 75,49, 74,42, 71,38,

70,35, 69,32, 65,28, 67,25, 70,24,

73,23, 74,21, 77,20, 80,19, 83,19,

85,19, 87,20, 88,20, 91,21, 94,23,

96,25, 98,18, 94,15, 86,12, 87,11,

75,12, 71,14, 65,16, 60,20, 56,25,

50,27, 44,29, 40,30, 34,27, 30,25,

25,24, 20,24, 15,25, 8,27, 3,29,

5,40, 10,38, 14,37, 22,38);

n2=64; (* кол-во точек, описывающих сжатое сердце *)

a2:array[1..n2*2] of word=(22,38, 22,41, 23,47, 25,54, 26,59,

28,63, 30,67, 34,72, 36,76, 40,80,

44,84, 50,88, 55,91, 59,92, 64,91,

67,89, 69,87, 71,83, 72,79, 72,75,

72,70, 72,65, 72,60, 70,52, 69,45,

66,36, 64,30, 65,28, 67,25, 70,24,

73,23, 74,21, 77,20, 80,19, 83,19,

85,19, 87,20, 88,20, 91,21, 94,23,

96,25, 98,18, 94,15, 86,12, 87,11,

75,12, 71,14, 65,16, 60,20, 56,25,

50,27, 44,29, 40,30, 34,27, 30,25,

25,24, 20,24, 15,25, 8,27, 3,29,

5,40, 10,38, 14,37, 22,38);

n3=5; (* координаты пузырьков крови *)

a3:array[1..n3*2] of word=(65,23, 71,17, 77,17, 85,17, 95,20);

var driver,regim,error:integer;

i,k:word;

procedure bum; (* имитация стука сердца *)

begin

sound(100);

delay(4);

sound(20);

delay(7);

nosound;

end;

procedure bulbul; (* имитация движения крови *)

var i,k:word;

begin

for k:=1 downto 0 do

begin

setcolor(k);

for i:=1 to 5 do

begin

circle(round(a3[i*2-1]*sx),round(a3[i*2]*sy),3);

delay(60000);

end;

end;

end;

procedure draw1; (* рисуем несжатое сердце *)

begin

setcolor(1);

moveto(round(a1[1]*sx),round(a1[2]*sy)); (* устанавливаем указатель на первую точку сердца *)

i:=3;

while i<=(n1*2) do

begin

lineto(round(a1[i]*sx),round(a1[i+1]*sy));

inc(i,2);

end;

lineto(round(a1[1]*sx),round(a1[2]*sy));

end;

procedure draw2;

begin

setcolor(0);

moveto(round(a1[1]*sx),round(a1[2]*sy));

i:=3;

while i<=(n1*2) do

begin

lineto(round(a1[i]*sx),round(a1[i+1]*sy));

inc(i,2);

end;

setcolor(1);

moveto(round(a2[1]*sx),round(a2[2]*sy));

i:=3;

while i<=(n2*2) do

begin

lineto(round(a2[i]*sx),round(a2[i+1]*sy));

inc(i,2);

end;

bum;

bulbul;

end;

procedure draw3;

begin

setcolor(0);

moveto(round(a2[1]*sx),round(a2[2]*sy));

i:=3;

while i<=(n2*2) do

begin

lineto(round(a2[i]*sx),round(a2[i+1]*sy));

inc(i,2);

end;

setcolor(1);

moveto(round(a1[1]*sx),round(a1[2]*sy));

i:=3;

while i<=(n1*2) do

begin

lineto(round(a1[i]*sx),round(a1[i+1]*sy));

inc(i,2);

end;

end;

begin

{clrscr; }

driver:=detect;

InitGraph(driver,regim,''); (* инициализация графики *)

setviewport(dx,dy,dx+300,dy+300,true); (* устанавливаем окно просмотра *)

repeat

begin

draw1;

delay(50000);

draw2; (* рисуем сжатое сердце *)

draw3; (* стираем его и рисуем нормальное сердце *)

end;

until keypressed;

readln;

CloseGraph;

end.

Пример листинга курсовой работы.

program g1;

uses crt, graph;

const N=15000;

t: array [1..10] of integer = (480, 345, 530, 345, 530, 385, 480, 385, 480, 345);

var

driver, regim, error: integer;

i, j: integer;

p: pointer;

size: word;

l: byte;

st: string[8];

st1: string[34];

st2: string[54];

k, x1, y1, x2, y2: integer;

x, y: array[1..n] of integer;

begin

clrscr;

writeln('Tekstoyregim');

textcolor(10);

st:='ZADANIE:';

gotoXY(18,9);

for l:=1 to length(st) do

begin

write (st[l]);

sound(20);

delay(9900);

nosound;

end;

textcolor(15);

st1:='Ojivit za schet dvijenia elochky:';

gotoXY(18, 12);

for l:=1 to length(st1) do

begin

write (st1[l]);

sound(68);

delay(9999);

nosound;

end;

gotoXY(18, 14);

st2:='organizovat peremechenie vpravo s izmeneniem razmera.';

for l:=1 to length(st2) do

begin

write (st2[l]);

sound(21);

delay(9999);

nosound;

end;

readln;

driver:=detect;

Initgraph (driver, regim, 'c:\tp\bgi');

error:=graphresult;

if error <> grOk then writeln (grapherrorMSg(error))

else

begin

OuttextXY(30, 20, 'Graficheskyregim');readln;

cleardevice;

begin

x1:=0;

y1:=0;

x2:=getmaxX-2;

y2:=getmaxY-2;

rectangle(x1, y1, x2, y2);

setViewport(x1+1, y1+1, x2-1, y2-1, ClipOn);

for k:=1 to n do

begin

x[k]:=random(x2-x1);

y[k]:=random(y2-y1);

end;

for k:=1 to n do

putpixel(x[k], y[k], random(7));

setfillstyle(0, black);

bar(40, 40, 590, 438);

rectangle(40, 40, 590, 438);

BEGIN

SetColor(LightGray); Circle (390, 180, 12);

SetColor(Yellow); Arc(390, 180, 0, 180, 19);

Arc(390, 180, 0, 180, 17); Arc(390, 180, 0, 180, 15);

SetColor(LightCyan); Circle(385, 176, 2);

Circle(395, 176, 2);

SetColor(LightRed);

SetFillStyle(SolidFill, LightRed);

FillEllipse(390, 186, 5, 2);

Setcolor(lightgray);

Line(390, 192, 390, 225);

Line(390, 225, 370, 255);

Line(390, 225, 410, 255);

line(365, 200, 415, 200);

setcolor(6);

line(366, 190, 366, 210);

line(360, 190, 360, 210);

setcolor(7);

line(366, 190, 353, 190);

line(353, 190, 353, 200);

line(353, 200, 360, 195);

setcolor(6);

line(366, 210, 360, 210);

setcolor(15);

settextstyle (DefaultFont, HorizDir, 1);

OutTextXY (50, 415, 'S M A L L H E R R I N G B O N E');

setfillstyle(4, 2);

bar(80, 260, 420 , 270);

setfillstyle(4, 2);

bar(400, 420, 570 , 430);

setfillstyle (11, 14);

fillellipse(80, 120, 15, 15);

setcolor(8);

ellipse (532, 130, 0, 360, 30, 5);

ellipse (532, 170, 0, 360, 23, 4);

ellipse (532, 210, 0, 360, 18, 3);

ellipse (532, 250, 0, 360, 10, 2);

setcolor (yellow);

line(540, 300, 540, 270);

line(525, 287, 525, 270);

line(540, 270, 525, 270);

circle(80, 120, 15);

line(479, 344, 531, 344);

line(531, 344, 531, 385);

line(531, 385, 479, 385);

line(479, 385, 479, 344);

LINE(450, 320, 560, 320);

line(560, 320, 560, 410);

line(560, 410, 450, 410);

line(450, 410, 450, 320);

line(440, 328, 505, 268);

line(505, 268, 570, 328);

repeat

circle(505, 300, 10);

begin

randomize;

for i:=1 to 70 do

putpixel(random(630), random(107), random(succ(getmaxcolor)));

end;

for i:=1 to 21 do

begin

setcolor(Green);

begin

Sound(Random(2000));

Delay(Random(1000));

LINE(200+5*i, 100+5*i, 230+4*i, 130+4*i);

line(230+4*i, 130+4*i, 170+6*i, 130+4*i);

line(170+6*i, 130+4*i, 200+5*i, 100+5*i);

line(200+5*i, 130+4*i, 255+3*i, 165+3*i);

line(255+3*i, 165+3*i, 145+7*i, 165+3*i);

line(145+7*i, 165+3*i, 200+5*i, 130+4*i);

line(200+5*i, 165+3*i, 265+3*i, 220+i);

line(265+3*i, 220+i, 135+7*i, 220+i);

line(135+7*i, 220+i, 200+5*i, 165+3*i);

setcolor(6);

line(205+5*i, 220+i, 205+5*i, 250);

line(205+5*i, 250, 195+5*i, 250);

line(195+5*i, 250, 195+5*i, 220+i);

end;

DELAY(60000);

setcolor(0);

begin

LINE(200+5*i, 100+5*i, 230+4*i, 130+4*i);

line(230+4*i, 130+4*i, 170+6*i, 130+4*i);

line(170+6*i, 130+4*i, 200+5*i, 100+5*i);

line(200+5*i, 130+4*i, 255+3*i, 165+3*i);

line(255+3*i, 165+3*i, 145+7*i, 165+3*i);

line(145+7*i, 165+3*i, 200+5*i, 130+4*i);

line(200+5*i, 165+3*i, 265+3*i, 220+i);

line(265+3*i, 220+i, 135+7*i, 220+i);

line(135+7*i, 220+i, 200+5*i, 165+3*i);

setcolor (0);

line(205+5*i, 220+i, 205+5*i, 250);

line(205+5*i, 250, 195+5*i, 250);

line(195+5*i, 250, 195+5*i, 220+i);

end;

END;

j:=i mod 12;

for i:=0 to j do

begin

setfillstyle(j, random(13));

fillpoly(5, t);

inc(i);

delay(500);

end;

for i:=21 downto 1 do

begin

setcolor(Green);

begin

LINE(200+5*i, 100+5*i, 230+4*i, 130+4*i);

line(230+4*i, 130+4*i, 170+6*i, 130+4*i);

line(170+6*i, 130+4*i, 200+5*i, 100+5*i);

line(200+5*i, 130+4*i, 255+3*i, 165+3*i);

line(255+3*i, 165+3*i, 145+7*i, 165+3*i);

line(145+7*i, 165+3*i, 200+5*i, 130+4*i);

line(200+5*i, 165+3*i, 265+3*i, 220+i);

line(265+3*i, 220+i, 135+7*i, 220+i);

line(135+7*i, 220+i, 200+5*i, 165+3*i);

setcolor (6);

line(205+5*i, 220+i, 205+5*i, 250);

line(205+5*i, 250, 195+5*i, 250);

line(195+5*i, 250, 195+5*i, 220+i);

end;

DELAY(60000);

setcolor(0);

begin

LINE(200+5*i, 100+5*i, 230+4*i, 130+4*i);

line(230+4*i, 130+4*i, 170+6*i, 130+4*i);

line(170+6*i, 130+4*i, 200+5*i, 100+5*i);

line(200+5*i, 130+4*i, 255+3*i, 165+3*i);

line(255+3*i, 165+3*i, 145+7*i, 165+3*i);

line(145+7*i, 165+3*i, 200+5*i, 130+4*i);

line(200+5*i, 165+3*i, 265+3*i, 220+i);

line(265+3*i, 220+i, 135+7*i, 220+i);

line(135+7*i, 220+i, 200+5*i, 165+3*i);

setcolor(0);

line(205+5*i, 220+i, 205+5*i, 250);

line(205+5*i, 250, 195+5*i, 250);

line(195+5*i, 250, 195+5*i, 220+i);

end;

END;

j:=i mod 12;

for i:=0 to j do

begin

setfillstyle(j, random(13));

fillpoly(5, t);

inc(i);

delay(500);

end;

nosound;

until keypressed;

end;end;

readln;

closegraph;

RestoreCrtMode;

writeln('Tekstoyregim');

repeat

textbackground(9);

textcolor(10);

gotoXY (27, 7);

writeln('* * * * * * * * * * * * * * * *'); gotoXY(27, 8);

writeln('* *'); gotoXY(27, 9);

writeln('* Vipolnila: *'); gotoXY(27, 10);

writeln('* *'); gotoXY(27, 11);

writeln('* Sarafan Ekaterina *'); gotoXY(27, 12);

writeln('* *'); gotoXY(27, 13);

writeln('* Andreevna *'); gotoXY(27, 14);

writeln('* *'); gotoXY(27, 15);

writeln('* stydentka 1 kyrsa *'); gotoXY(27, 16);

writeln('* *'); gotoXY(27, 17);

writeln('* gryppi BM-71 *'); gotoXY(27, 18);

writeln('* *'); gotoXY(27, 19);

writeln('* * * * * * * * * * * * * * * *');

sound(540);delay(30000);nosound;

sound(480);delay(10000);nosound;

sound(420);delay(20000);nosound;

sound(480);delay(20000);nosound;

sound(540);delay(10000);nosound;delay(10000);

sound(540);delay(10000);nosound;delay(10000);

sound(540);delay(30000);nosound;

sound(480);delay(10000);nosound;delay(10000);

sound(480);delay(10000);nosound;delay(10000);

sound(480);delay(30000);nosound;

sound(540);delay(10000);nosound;delay(10000);

sound(660);delay(10000);nosound;delay(10000);

sound(660);delay(30000);nosound;

until keypressed;

readln;

end;

end.

Наши рекомендации