Практикум. Создание движущихся изображений
Движение на экране создается по принципу мультипликации: на экран с соответствующей задержкой выводят последовательность кадров с небольшими изменениями положения «движущихся» объектов или объектов «фона», если эффект движения достигается изменением фона.
Сам «перемещаемый» объект может быть двумерным (плоским) и трехмерным (пространственным), причем движение может осуществляться по двум типам траектории: лежащей в плоскости экрана или выходящей за нее.
Из аналитической геометрии известны формулы, по которым можно, зная закон движения, определить изменения положения каждой точки изображения движущегося объекта на экране.
Движение плоских объектов.Любое сложное движение плоских объектов на экране складывается из базовых: перемещения, масштабирования и поворота. Формулы пересчета координат изображений для базовых видов движения следующие.
Рис.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): эффект удаления от зрителя получим, используя масштабирование относительно точки горизонта, эффект вращения - за счет поворота вокруг геометрического центра.
Рис. 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 должна использовать именно эти параметры. Также учтем, что при масштабировании изменяются размер диагонали и положение центра, а при повороте - смещения вершин относительно центра. Ниже представлен текст программы.
Рис. 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. Программа рисует человечка, делающего утреннюю зарядку.
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. Программа изображает планету, вращающуюся вокруг Солнца на фоне мерцающих звезд и расходящейся галактики.
Перемещение и изменение размеров изображений на экране можно организовать по разному. Так, в примере 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.