Модуль Graph, самодельный модуль, методы анимации
Чтобы работать с графическим экраном, нужно использовать стандартный модуль Graph,
который подключается предложением uses:
uses ... , Graph;
При этом необходимо, чтобы среда могла найти файл graph.tpu. Обычно все стандартные модули (т е файлы *.tpu) помещают в папку ...\TPAS7\units\ где ...\TPAS7 - папка, содержащая среду Турбо Паскаль7, т е файлы:
turbo.exe - 402474 байта - среда
turbo.tp - файл конфигурации
turbo.tpl - основные библиотеки (System,Dos)
turbo.tph - файл справки
А в папку \units помещают остальные модули. Для доступности модулей среду настраивают: Меню | Options | Directories и здесь в окошко Unit directories записывают пути к необходимым модулям (если несколько - разделяют точкой с запятой). Описываемый проект хранится в папке
...\TPAS7\Juli_GR4\, и в эту же папку среда поместит после компиляции самодельный модуль, т е файл unit1.tpu, поэтому в окошко Unit directories вписано: units; Juli_GR4 чтобы это сохранилось - щелкните кнопку ОК. После того как Вы это сделаете и откроете файлы проекта: PRGRAF2.PAS и unit1.pas в среде, полезно сохранить конфигурацию (Меню | Options | Save Turbo.tp).Тогда для работы с проектом достаточно запустить среду (файл turbo.exe).
О методах анимации в Турбо Паскале 7
Обычно анимация выполняется по циклическому алгоритму:- где-то на экране рисуется картинка.
- выдерживается пауза, чтобы глаз мог увидеть эту картинку
- картинка удаляется
- картинка изменяется (в простейшем случае - немного изменяются ее координаты)
- переходим на п.1 алгоритма, т е рисуем измененную картинку. И далее цикл повторяется.
- можно повторно нарисовать ту же картинку в том же месте, но только цветом фона. В результате картинка исчезнет
- можно залить цветом фона прямоугольник, охватывающий картинку (может быть, это быстрее, чем повторная прорисовка)
- Можно повторно нарисовать ту же картинку в том же месте, но при установленном режиме рисования XORPut. В этом случае движущаяся картинка не портит картинки при наездах.
В случае, когда картинка не изменяется, а просто перемещается, выгодно
использовать хранение картинки в памяти с последующим выводом на экран из памяти. Это
быстрый способ.
В проекте - при нажатии клавиши s мяч перемещается используя режим XORPut, поэтому он проходит
по надписи, не повреждая ее. Если нажать клавишу S (т е Shift s), то мяч перемещается стирая
картинку цветом фона в режиме NormalPut, поэтому портит надпись. В конце полета мяч ударяет по шкафу и шкаф падает, вращаясь вокруг точки. Окончив падение, шкаф скользит по наклону.
- Имя файла, в котором хранится модуль, должно совпадать с именем модуля, т е модуль unit1 хранится в файле unit1.pas (текст), а в откомпилированном виде - в файле unit1.tpu.
- В интерфейсном разделе модуля помещают описания (любые, кроме меток) которые можно использовать в других модулях. Вместо подпрограмм помещают только их заголовки.
- В разделе реализации (implementation) помещают описания идентификаторов, которые нужны только данному модулю и описания подпрограмм (тех, заголовки которых есть в интерфесной части и тех, которые нужны только данному модулю)
- В модуле может присутствовать раздел инициализации, в котором помещают операторы, выполняющиеся при подключении модуля.
Текст главной программы
(Для использования необходимо перекодировать под DOS)
Program Proba_Graph1;
uses Graph,crt,unit1;
begin
Nacalo; {процедура устанавливает графический режим и его параметры}
TTT; { процедура выводит надписи на графический экран }
Repeat ch1:= #0;
Menu1(5,310); {рисует меню}
clearkey; {процедура очищает буфер клавиатуры}
ch1:= readkey; {читаю нажатие на клавишу}
case ch1 of {выбор в зависимости от нажатой клавиши}
#27: begin closegraph;
restorecrtmode; {востанавливаю текстовый режим экрана}
exit; {Выход из программы}
end;
'T','t','е','Е': TTT; {Выводит образцы графических шрифтов}
'C','c','с','С': begin
ClearDevice; {очистка экрана}
setcolor(gcol); setbkcolor(bcol);
{восстановление цветов фона и символов}
end;
'S','Ы': begin Osnova(240); {рисует треугольное основание}
gaubica(50,240,10,10,'N'); {бросает мячик}
pramoug(ara); {падает шкаф}
siezd(ara); {шкаф скользит}
end;
's','ы': begin Osnova(240); {рисует треугольное основание}
gaubica(50,240,10,10,'X'); {бросает мячик}
pramoug(ara); {падает шкаф}
siezd(ara); {шкаф скользит}
end;
end;
until ch1 = #27; {цикл прекратится, если нажать Esc}
end.
Текст модуля Unit1
(Для использования необходимо перекодировать под DOS)
Unit unit1;
interface uses graph;
type arpo = array [1..4] of PointType; {хранит коорд. вершин
прямоугольника}
{ Справка: PointType = Record
X, Y : Integer;
End; }
var grdriver, graphmode,errcode,maxx,maxy,ImSize: integer;
ch1,ch2: char;
bufs: string;
bcol,gcol: byte; {хранит цвет символов и фона}
alfa: double; {угол наклона основания (радиан)}
P1: Pointer; {указатель на область памяти, где будет
храниться картинка (мячик)}
ara: arpo; {хранит коорд. вершин
прямоугольника}
Procedure Nacalo; {инициирует графический режим}
Procedure Menu1(x0,y0: integer); {выводит меню в графическом режиме }
procedure TTT; {Выводит образцы графических шрифтов}
procedure Osnova(x0: integer); {рисует треугольное основание}
procedure gaubica(x0,y0: integer; beta,vel: double; typ:char);
{бросает мячик}
procedure siezd(var ara: arpo); {шкаф скользит}
procedure pramoug(var ara: arPo); {падает шкаф}
procedure clearkey;
procedure stopka;
implementation uses crt;
var hh, {высота шкафа}
ww: {ширина шкафа} integer;
beta: double; {угол наклона основания}
Procedure Menu1(x0,y0: integer); {рисует меню}
var buf1,buf2: string;
begin
SetTextStyle(2,0,6); {устанавливаю шрифт SmallFont,
горизонтальное направление, размер = 6}
str(maxx,buf1); str(maxy,buf2); {преобразую maxx,maxy в строки }
setcolor(green); {устанавливаю цвет = зеленый (для рамки меню) }
rectangle(x0+5,y0+5,x0+215,y0+160); {прямоугольник (рамка меню)}
setfillstyle(SolidFill,8); {устанавливаю тип и цвет заливки
(темносерый)}
FloodFill(x0+7,y0+7, green); {Заливает фигуру, начиная от точки
(x0+7,y0+7) и до границы цвета green}
setcolor(11); {устанавливаю цвет (светлоголубой) - для надписей меню }
OutTextXY(x0+10,y0+15, 'MaxX= '+buf1+' MaxY= '+buf2);
OutTextXY(x0+10,y0+35, ' --- Menu: --- ');
OutTextXY(x0+10,y0+55, ' Esc - Exit ');
OutTextXY(x0+10,y0+75, ' T - Шрифты ');
OutTextXY(x0+10,y0+95, ' C - CLEAR ');
OutTextXY(x0+10,y0+115, ' S - NormalPut ');
OutTextXY(x0+10,y0+135, ' s - XORPut ');
end;
Procedure Nacalo; {устанавливает графический режим и его параметры}
begin
bcol := 7; gcol := 11; {цвета по умолчанию}
grdriver:= detect; {установка для автоматического определения
графического драйвера}
graphmode := 0;
InitGraph(grdriver,graphmode,'..\');
{'..\'означает, что драйвер EGAVGA.BGI должен находиться во внешней папке
по отношению к папке этой программы}
errcode := graphresult; {проверяем успешность выполнения процедуры
InitGraph }
if errcode <> grOk then { если произошла ошибка}
begin writeln (' ошибка инит граф режима N ',errcode);
halt(1); {выход в систему с кодом возврата=1, т е аварийно}
end
else
begin
setgraphmode(graphmode);
setcolor (gcol); setbkcolor(bcol);
SetLineStyle(SolidLn, 0, 2); {устанавливаю: линия сплошная,
толщиной 2}
maxx:= getmaxx; maxy:= getmaxy; { сохраняю размеры экрана }
SetTextStyle(2,0,6); {устанавливаю шрифт SmallFont,
горизонтальное направление, размер = 6}
end;
end;
procedure TTT;
begin setcolor(blue); {цвет - синий (для вывода текста)}
OutTextXY(10,10,'- Графические шрифты -');
SetTextStyle(1,0,4);
if graphresult <> grOK then
OutTextXY(10,30,'gr - ERROR') else
OutTextXY(10,30,'Text ПРОБА');
SetTextStyle(2,0,8);
if graphresult <> grOK then
OutTextXY(10,60,'gr - ERROR') else
OutTextXY(10,60,'Text ПРОБА');
SetTextStyle(3,0,4);
if graphresult <> grOK then
OutTextXY(10,80,'gr - ERROR') else
OutTextXY(10,80,'Text ПРОБА');
SetTextStyle(4,0,4);
if graphresult <> grOK then
OutTextXY(10,110,'gr - ERROR') else
OutTextXY(10,110,'Text ПРОБА');
SetTextStyle(4,0,6);
if graphresult <> grOK then
OutTextXY(10,150,'gr - ERROR') else
OutTextXY(10,150,'Text ПРОБА');
setcolor(gcol); {восстанавливаю цвет по умоляанию}
end;
procedure moveto2(t: PointType);
begin {это процедура moveto, приспособленная для работы
с точками PointType}
moveto(t.x,t.y);
end;
procedure lineto2(t: PointType);
begin {это процедура lineto, приспособленная для работы
с точками PointType}
lineto(t.x,t.y);
end;
procedure siezd(var ara: arpo);
var ii: Integer; sdvig,sdvigX,sdvigY: double;
ar0: arpo;
begin
ar0:= ara; {запоминаю координаты прямоуг-ка в начальном положении }
sdvig:=0; {в этой переменной хранится сдвиг (вдоль склона)
скользящего шкафа относительно исходного положения }
repeat {цикл скольжения шкафа}
sdvig:=sdvig + 1; {на каждом шага перемещаю шкаф на 1 пикс}
sdvigX:= sdvig*cos(beta); {проекция сдвига на ось X }
sdvigY:= sdvig*sin(beta); {проекция сдвига на ось Y }
setcolor(green); {устанавливаю цвет границы }
setfillstyle(SolidFill,8); {устанавливаю режим заливки
(темно-серый) }
FillPoly(4, ara); {заливаю прямоугольник (шкаф) с коорд ara }
delay(3000); {задержка (мсек) - чтобы увидеть шкаф.
3000 - на IBM286, на современных компах много меньше}
setcolor(7); {готовлюсь стереть шкаф (цветом фона)}
setfillstyle(SolidFill,7); {устанавливаю режим заливки
(светло-серый, т е цвет фона) }
FillPoly(4, ara); {заливаю шкаф цветом фона, т е стираю его}
for ii:= 1 to 4 do {изменяю координаты шкафа, т е перемещаю его}
begin {для этого использую вычисленные ранее сдвиги
относительно исходного положения (т е координат ar0)}
ara[ii].x := ar0[ii].x + round(sdvigX);
ara[ii].y := ar0[ii].y + round(sdvigY);
end;
until ara[2].x > 620; {ограничиваю перемещение}
setcolor(green); {делаю видимым шкаф в последнем положении}
setfillstyle(SolidFill,8);
FillPoly(4, ara);
end;
procedure pramoug(var ara: arPo);
var alfa: double; ch: char; {эта процедура роняет шкаф поворотом вокруг
правой нижней точки на угол Pi/2
стирание осуществляется прорисовкой цветом фона }
begin
SetWriteMode(NormalPut);
alfa:= 0;
repeat {используя тригонометрию, вычмсляем координаты вершин шкафа
как функции высоты hh, ширины ww и углов:
beta (наклон основания) и alfa (угол поворота относительно
неподвижного правого-нижнего угла)}
ara[2].x := ara[1].x + round(hh*sin(alfa+beta));
ara[2].y := ara[1].y - round(hh*cos(alfa+beta));
ara[3].x := ara[2].x - round(ww*cos(alfa+beta));
ara[3].y := ara[2].y - round(ww*sin(alfa+beta));
ara[4].x := ara[1].x - round(ww*cos(alfa+beta));
ara[4].y := ara[1].y - round(ww*sin(alfa+beta));
setcolor(green);
setfillstyle(SolidFill,8);
FillPoly(4, ara); {рисую 4-угольник по координатам ara,
(заливка SolidFill цветом 8 - темносерый)}
delay(3000); {задержка (мсек) - чтобы увидеть шкаф.
3000 - на IBM286, на современных компах много меньше}
setcolor(7); {готовлюсь рисовать шкаф цветом фона, т е стирать}
setfillstyle(SolidFill,7);
FillPoly(4, ara); {стираю текущее положение шкафа}
alfa:= alfa + 0.02; {изменяю угол наклона шкафа на 0.02 рад}
until alfa > pi/2; {ограничиваю угол поворота - Pi/2 }
end;
procedure gaubica(x0,y0: integer; beta,vel: double; typ:char);
{бросает мячик}
var tt: PointType; {здесь храню коорд верхнего левого угла квадрата,
описанного относительно мячика (круга),
x0,y0 - координаты начального положения цнтра мячика.}
RR: integer; {радиус мячика}
function dy(xx: integer): integer;
{вычисляет (по законам физики) вертикальное перемещение мячика,
соответствующее заданному горизонтальному xx.
Так как горизонтальная компонента скорости постоянна, то время
движения t пропорционально xx (tt:= 0.1*xx), а вертикальное смещение
yyy за единицу времени пропррционально tt, например yyy := bb*tt + cc
коэффициенты bb,cc подобраны по картинке}
const bb= 0.3; cc=-4;
var t,yyy: double;
begin
t:= 0.1*xx;
yyy := bb*t + cc;
dy:=round(yyy);
end;
begin
RR:= 10;
tt.x:= x0-RR; tt.y:= y0-RR; {точка tt- верхний левый угол квадрата,
описанного вокруг мячика (круга)}
setbkcolor(7);
setcolor(green);
ImSize := ImageSize(x0-RR, y0-RR, x0+RR, y0+RR);
{функция ImageSize вычисляет объем памяти, необходимый для
хранения картинки, расположенной внутри этого описанного квадрата }
GetMem(P1, ImSize); {указатель P1 будет указывать на этот фрагмент
памяти}
circle(x0,y0,RR); {рисую окружноость. x0,y0 - центр}
setfillstyle(SolidFill,1); {готовлюсь залить круг цветом 1 = синий}
FloodFill(x0,y0, green); {заливаю внутренность фигуры начиная с точки
x0,y0 и до границы, заданной цветом green}
GetImage(x0-RR, y0-RR, x0+RR, y0+RR, P1^);
{сохраняю изображение, ограниченное квадратом
(x0-RR, y0-RR, x0+RR, y0+RR) в памяти, связанной с указателем P1}
while (tt.x < 296) and (tt.y < 500) and (tt.y > RR) do
begin
PutImage(tt.x, tt.y, P1^, XORPut);
{помещаю картинку из памяти (P1) в ту же позицию, но
использую тип записи XOR. В результате мячик исчезает}
inc(tt.x,2); {увеличиваю координату x на 2}
tt.y:= tt.y + dy(tt.x-x0+RR); {вычисляю соответствующую коорд y,
используя функцию dy. Аргумент =
горизонтальному перемещению
относительно исходного положения}
case typ of
'N': PutImage(tt.x, tt.y, P1^, NormalPut);
'X': PutImage(tt.x, tt.y, P1^, XORPut);
end;
{помещаю изображение в точку с новыми координатми. Сейчас оно
видимое}
delay(3000);{делаю задержкуЁ чтобы глаз успел увидеть мячик,
прежде его стирания. Далее в начале цикла мячик
стирается}
end;
PutImage(tt.x, tt.y, P1^, XORPut);
end;
procedure Osnova(x0: integer); {рисует треугольное основание}
var xx: Integer;
t1,t2,t3,t4,t5,t6,t7: PointType; alfa,dola:double;
ch2: char;
begin
setcolor(green);
t1.x:= x0; t1.y:= 300;
t2.x:= x0; t2.y:= 470;
t3.x:= 630; t3.y:= 470; {координаты вершин тр-ка}
moveto2(t1);
lineto2(t2);
lineto2(t3);
lineto2(t1);
setfillstyle(SolidFill,green); {готовлюсь залить зеленым}
FloodFill(x0+10,400, green); {заливаю до зеленой границы}
dola:= 0.1; {это доля длины гипотенузы. Определяет положение
шкафа на склоне }
t4.x:= round(t1.x + dola*(t3.x-t1.x))+1;
{Это коорд левого нижнего угла шкафа. (отрываю шкаф на 1)}
t4.y:= round(t1.y + dola*(t3.y-t1.y))-1;
hh:= 100; ww:= 40; {задаю высоту и ширину шкафа}
beta:= arctan((t3.y-t1.y)/(t3.x-t1.x)); {вычисляю угол наклона основания}
t5.x:= t4.x+round(hh*sin(beta)); {вычисляю коорд остальных углов
шкафа, используя тригонометрию}
t5.y:= t4.y-round(hh*cos(beta));
t6.x:= t5.x+round(ww*cos(beta));
t6.y:= t5.y+round(ww*sin(beta));
t7.x:= t6.x-round(hh*sin(beta));
t7.y:= t6.y+round(hh*cos(beta));
ara[1]:= t7; ara[2]:= t6; ara[3]:= t5; ara[4]:=t4;
{ помещаю эти коорд в массив, т к FillPoly использует массив }
setfillstyle(SolidFill,8); {готовлю тип заливки - темносерым}
FillPoly(4, ara); {рисую залитый 4-угольник}
end;
procedure clearkey;
var cc:char;
begin
while keypressed do cc:= readkey;
end;
procedure stopka; {останавливает программу до нажатия
любой клавиши}
var cc:char; colr: byte;
begin
clearkey;
colr:= getcolor;
outtextxy(300,20,'Press any key');
cc:= readkey;
setcolor(7);
outtextxy(300,20,'Press any key');
setcolor(colr);
end;
end.
