Курсовая работа: Игра "Vertolet" 
				
				Курсовая работа: Игра "Vertolet"
Федеральное агентство по образованию 
ЧИТИНСКИЙ ГОСУДАРСТВЕННЫЙ УНИВЕРСИТЕТ 
ЭНЕРГЕТИЧЕСКИЙ ИНСТИТУТ 
Факультет экономики и информатики 
Кафедра ИВТ и ПМ 
Курсовая работа 
                                           
Чита 2007. 
Федеральное агентство по образованию 
ЧИТИНСКИЙ ГОСУДАРСТВЕННЫЙ УНИВЕРСИТЕТ 
ЭНЕРГЕТИЧЕСКИЙ ИНСТИТУТ 
Факультет экономики и информатики 
Кафедра ИВТ и ПМ 
ПОЯСНИТЕЛЬНАЯ ЗАПИСКА 
к курсовой работе 
По дисциплине «Программирование на языке высокого
уровня». 
На тему: Игра «Vertolet». 
Проект выполнил студент группы ИВТ-06-02 
                      Лазарев Михаил Андреевич 
                                                    
 
 Руководитель работы_____________________ 
Федеральное агентство по образованию 
ЧИТИНСКИЙ ГОСУДАРСТВЕННЫЙ УНИВЕРСИТЕТ 
ЭНЕРГЕТИЧЕСКИЙ ИНСТИТУТ 
Факультет экономики и информатики 
Кафедра ИВТ и ПМ 
ЗАДАНИЕ 
на курсовую работу 
по дисциплине «Программирование на языке высокого
уровня» 
студенту Лазареву М.А. 
Тема работы: Игра  «Vertolet» 
Рекомендуемая литература:
1. Фаронов В.В. Турбо Паскаль 7.0.
Начальный курс. Учебное пособие. – М.: издательство «Нолидж», 1998.  
  
Дата
выдачи задания  «      »_____________2007 г. 
Дата
представления руководителю «       » ______________ 2007 г. 
Руководитель
курсового проектирования: Малета Г.В. 
 
Утверждаю 
Зав.кафедрой 
«____»__________________2007г. 
Календарный план 
| Разделы курсовой работы | 
МЕСЯЦЫ И НЕДЕЛИ | 
 
| Февраль | 
Март | 
Апрель | 
Май | 
Июнь | 
 
| 1 | 
2 | 
1 | 
2 | 
3 | 
4 | 
5 | 
1 | 
2 | 
3 | 
4 | 
1 | 
2 | 
3 | 
4 | 
1 | 
2 | 
 
| 1. | 
Выбор темы | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 2. | 
Анализ алгоритма | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 3. | 
Разработка основного
алгоритма | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 4. | 
Разработка движения | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 5. | 
Создание графики | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 6. | 
Тестирование программы | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 7. | 
Исправление программы | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 8. | 
Защита | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 | 
 
| 
 | 
 
 
План выполнен: Руководитель
проекта_______________«____»______________ 2007г. 
 
РЕФЕРАТ 
Пояснительная записка – 30
с., 0 рис., 0 табл., 2 источника, 1 прил. 
Turbo Pascal, алгоритм, игрок, защитное поле, компьютерная игра, модуль,
программа, процедура, барьер, бонус, функция. 
В своей работе я
реализовал вариант телефонной игры – Вертолет. Она написана на языке Turbo Pascal. Исходные коды прилагаются. 
 
СОДЕРЖАНИЕ 
Введение………………………………………………………………..7 
1. Алгоритм
работы……………………………………………………8 
2. Руководство пользователя………………………………………...10 
Заключение……………………………………………………………11 
Приложение…………………………………………………………...13 
Исходные коды
модулей…………………………………………......17   
Список
литературы…………………………………………………...30 
 
ВВЕДЕНИЕ 
Данная программа
представляет собой реализацию известной игры «Вертолет», а точнее – ее
распространенного режима под названием «Battle mode».  
Vertolet - одна из самых простых и
увлекательных игр. Эта игра сочетает в себе простоту, оригинальность. В неё
будет интересно играть и школьнику, и пенсионеру. Элементарные правила делают
игру интересной и непринуждённой. 
 
1. АЛГОРИТМ РАБОТЫ 
Программа состоит из
следующих частей: 
  
Рис.1. Связь составных
частей. 
Exe.pas-программа вызывающая модуль menu 
1. menu.pas – основная часть программы.  
В программе происходит
вызов следующих процедур: 
·                  
procedure key1– процедура отвечающая за перемещение указателя в меню
игры.
·                  
procedure cartinka – Прорисовка фонового изображения. 
·                  
procedure menu– вызов одного из трех модулей или выход из программы
взависимости от выбора пункта в меню. Очистка динамической памяти. 
2. game.pas – модуль, в котором реализованы основные алгоритмы.  
  * Ввод имени игрока 
  * Прорисовка игрового
поля 
  * Создание «Вертолета»
, двух видов «Барьера» и  «Бонуса» 
  * Запись в динамическую
память изображений изменяющих свое положение на экране 
  * Перемещение вертолета
по игровому полю, не зависимо от других объектов и взрыв при сталкновении 
  * Начисление бонусных
очков и их использование 
  * Начисление игровых
очков   и запись в таблицу рекордов. 
Также в данном модуле определены
следующие процедуры и  функции: 
function 
game(sd:boolean):word; 
function
og(a,d:integer):word; 
procedure GET; 
procedure ni; 
procedure
start; 
procedure tex; 
procedure
lev(text,text1:string); 
procedure
vert(a,d:integer;s:byte); 
procedure
score(kol:integer; nik:string); 
procedure
ogon(a,d:integer; s:byte); 
3. Option.pas- модуль с помшью которого можно включить или
выключить звуковое сопровождение 
4. Help.pas – модуль, содержащий правила игры.  
5. score.dat – файл, содержащий 10 лучших результатов. 
 
2. РУКОВОДСТВО ПОЛЬЗОВАТЕЛЯ 
ПРАВИЛА ИГРЫ 
 Правила этой игры настолько просты,
что не потребуют от игрока ни малейшего напряжения при запоминании. Однако это
не делает игру скучной. 
Игрок управляет
вертолетом "А-308"
на  борту которого находятся  взрывчатые вещества . 
Цель игры – проити
наибольшее количество уровней,  при этом пролетев максимально возможное расстояние. 
Игрок появляется в средине
игрового поля. В верхнем левом углу указывается количество не использованных
бонусов. Правее указывается имя игрока, уровень и количество очков (считается
что при наборе одного очка игрок пролетел один метр ). 
При наличии бонуса игрок
может активировать защитное поле с помощью которого он сможет пролететь сквозь
препятствия, однако с активированным защитным полем нельзя собрать дополнительные
очки-«кубики» и за каждый пройденный метр будет убираться одно бонусное очко.  
При столкновении с
препятствием вертолет взрывается и игра заканчивается. 
Постепенно скорость
вертолета увеличивается, пока не достигнет максимальной скорости, с которой сможет
лететь вертолет.  
За каждый пролет 500
метров игрок получает 35 бонусов. 
За нахождение кубика
игрок получает 500 очков. 
Информацию о текущем
количестве очков вы можете найти в правой части экрана 
 
УПРАВЛЕНИЕ В ИГРЕ 
Для движения вертолета по
игровому полю используются клавиши  ’↑’ , ’←’,  ’↓’, ‘→’.
Для активации зашитного поля  клавиша ‘Пробел’.  Защитное поле отключается при
нулевом количистве бонуса или при нажатии любой клавиши . Также вертолет может резко набрать высоту клавиша ’w’  и
снизиться клавиша ’s’.    
 
ЗАКЛЮЧЕНИЕ 
Задача, изначально
поставленная мной, выполнена. Но всегда есть пути к совершенствованию. Для
этого я наметил комплекс целей, которые в будущем постараюсь воплотить в своей
программе. Вот они: 
·                  
Создание противников. 
·                  
создание
нескольких (трех) уровней игры компьютера. 
·                  
создание
загрузочного ролика. 
·                  
переход от Dos’а к Windows’у. 
·                  
переход в 3-d.   
Очень надеюсь, что
написанием данной я увеличил круг поклонников этой замечательной игры и привнес
небольшую лепту в ее развитие. 
 
ПРИЛОЖЕНИЯ 
ИСХОДНЫЕ КОДЫ ПРОЦЕДУР
И ФУНКЦИЙ, ПРЕДСТАВЛЯЮЩИЕ НАИБОЛЬШИЙ ИНТЕРЕС 
function
game(sd:boolean):word; 
const
left=#75; 
right=#77; 
up=#72; 
down=#80; 
begin 
ni; 
fon:=0; 
plus:=0; 
yr:=3; 
schet:=0; 
a:=120;
d:=240; 
verx:=460;niz:=125; 
kk:=300;ll:=350;z:=580;v:=880;
l:=680; k:=780; 
i:=980; 
ii:=400; 
vv:=200;zz:=150; 
p:=0;pp:=640; 
level:=1; 
vert(a,d,4); 
randomize; 
get; 
och:='70'; 
begin 
tex; 
start; 
bonn:=random(150)+300; 
end; 
repeat 
setcolor(0); 
if
(plus<70) and (ord(t)=32) then begin 
setcolor(12); 
outtextxy(50,35,
och); 
setcolor(red); 
str(pl,och); 
outtextxy(50,35, och); 
  og(a-3,d-9);
plus:=plus+1;  end; 
pl:=70-plus; 
if
((getpixel(a-2,d)=0) or (getpixel(a-2,d)=1))  and  ((getpixel(a+43,d+7)=0) or
(getpixel(a+43,d+7)=1)) 
 and ((getpixel(a+26,d+20)=0)
or (getpixel(a+26,d+20)=1))  and 
((getpixel(a+36,d+20)=0)
or (getpixel(a+36,d+20)=1)) and  ((getpixel(a+42,d-7)=0) or
(getpixel(a+42,d-7)=1)) 
and 
((getpixel(a+18,d-7)=0) or (getpixel(a+18,d-7)=1)) and 
 
((getpixel(a-1,d-5)=0) or (getpixel(a-1,d-5)=1)) 
then 
begin 
if
(getpixel(a+43,d+7)=1) or (getpixel(a-1,d-5)=1) or (getpixel(a+36,d+20)=1) 
or
(getpixel(a+42,d-7)=1) or (getpixel(a-2,d)=1) then 
 begin
schet:=schet+500; inc(aw); putimage(v-50,vv+80,barer3^,0); end; 
text:=nik; 
 end 
else 
begin 
text:='GAME
OVER'; 
settextstyle(1,0,9); 
if sd=true
then begin sound(100); delay(6000); nosound;  end; 
vert(a,d,fon); 
delay(200); 
ogon(a,d,1); 
if sd=true
then begin sound(50); delay(6000); nosound;  end; 
delay(1000); 
outtextxy(60,140,text); 
outtextxy(62,142,text); 
outtextxy(68,138,text); 
delay(15000); 
break; 
closegraph; 
Score(schet,nik); 
end; 
b:=keypressed; 
if b=true then
t:=readkey; 
settextstyle(1,0,3); 
setcolor(white); 
setbkcolor(fon); 
setfillstyle(9,7); 
case t of 
right :
a:=a+5; 
left : a:=a-5; 
up : d:=d-5; 
down : d:=d+5; 
's' : begin 
d:=d+15; a:=a; end; 
'w' : begin 
d:=d-15; a:=a; end; 
'`' : begin
read(cod);   if cod='money' then begin  schet:=schet+2000; cod:=''; t:='y';
end;   end; 
']' : begin
read(cod1);   if cod1='bonus' then begin  plus:=plus-1000; cod1:=''; 
t:='y';end;   end; 
end; 
if z>(yr*2)
then z:=z-yr else begin z:=640;zz:=(460-random(355)) end; 
if v>(yr*2)
then v:=v-yr else begin v:=640;vv:=(460-random(355)) end; 
if k>(yr*2)
then k:=k-yr else begin k:=640;kk:=(460-random(355)) end; 
if l>(yr*2)
then l:=l-yr else begin l:=640;ll:=(460-random(355)) end; 
if i>(yr*2)
then i:=i-yr else begin i:=640;ii:=(460-random(355)) end; 
 if a<6
then a:=6   ; 
 if d<niz+1
then d:=niz+1  ; 
 if a>594
then a:=594   ; 
 if d>verx-1
then d:=verx-1   ; 
if sd=true
then begin sound(500); delay(100); nosound;  end; 
inc(schet); 
if ((schet mod
200)=0) and (yr<20) then begin 
setcolor(0); 
line(25+yr*2,101,25+yr*2,480); 
yr:=yr+1;  
end; 
if (schet mod
500)=0 then begin 
 plus:=plus-35;
pl:=70-plus; setcolor(12); 
outtextxy(50,35,
och); 
setcolor(red); 
str(pl,och); 
outtextxy(50,35, och); 
  end; 
setlinestyle(0,0,1); 
if (schet mod
10)=0 then begin 
setcolor(12); 
outtextxy(560,35,
och1); 
setcolor(red); 
 
str(schet,och1); 
  outtextxy(560,35,
och1); end; 
if
(schet>500) and (level=1) then 
begin 
ll:=350;
l:=680; 
lev('Level
2','2'); 
level:=2; 
end; 
if
(schet>1500) and (level=2) then 
begin 
kk:=300;
k:=780; 
lev('Level
3','3'); 
level:=3; 
end; 
if
(schet>3000) and (level=3) then 
begin 
i:=980; 
ii:=400; 
lev('Level
4','4'); 
level:=4; 
end; 
if
(schet>5000) and (level=4) then 
begin 
lev('Level
5','5'); 
level:=5; 
end; 
if
(schet>7000) and (level=5) then 
begin 
lev('Level
6','6'); 
level:=6; 
end; 
if
(schet>10000) and (level=6) then 
begin 
lev('Level
7','7'); 
level:=7; 
end; 
if sd=false
then delay(50); 
setfillstyle(1,0); 
 if sd=false
then delay(10); 
putimage(a-10,d-25,ver^,0); 
{Level 1} 
 if sd=false
then delay(10); 
putimage(v,vv,barer1^,0); 
if (schet mod
bonn)=0 then inc(aw); 
if (aw mod
2)=0 then 
putimage(v-50,vv+80,barer2^,0); 
if sd=false
then delay(10); 
putimage(z,zz,barer^,0); 
{Level 2} 
 if sd=false
then delay(10); 
if level>1
then putimage(l,ll,barer1^,0); 
{Level 3} 
 if sd=false
then delay(10); 
if level>2
then putimage(k,kk,barer^,0); 
setcolor(12); 
line(25+yr*2,101,25+yr*2,480); 
until
Ord(t)=258; 
freemem(ver,imagesize(a-10,d-25,a+53,d+40)); 
freemem(barer,imagesize(300,300,340,350)); 
freemem(barer1,imagesize(400,300,440,350)); 
closegraph; 
Score(schet,nik); 
end; 
 
ИСХОДНЫЕ КОДЫ МОДУЛЕЙ 
Модуль Game 
unit games; 
interface 
USES CRT,GRAPH; 
function 
game(sd:boolean):word; 
function
og(a,d:integer):word; 
procedure GET; 
procedure ni; 
procedure start; 
procedure tex; 
procedure
lev(text,text1:string); 
procedure
vert(a,d:integer;s:byte); 
procedure
score(kol:integer; nik:string); 
procedure
ogon(a,d:integer; s:byte); 
implementation 
type mass=array[1..100]
of word; 
Var 
sche: array[1..100] of
integer ; 
nam: array[1..100] of
string ; 
q,e,r,a,d,w,n,k,kk,l,ll,verx,niz,ste,z,zz,v,vv,p,pp,schet,yr,fon,plus,pl:integer; 
aw,bonn,xxx,xx,sss,ss,aa,zs,vs,ff,gg,fff,ggg,i,ii,level:integer; 
t:char;
text,text1,cod,cod1:string[15]; nik,och,och1:string[7]; 
astn1:mass; 
b:boolean; 
ver,barer,barer1,barer2,barer3:pointer; 
procedure
ogon(a,d:integer; s:byte); 
var 
k:array[1..200] of word; 
n,i:integer; 
begin 
for i:=1 to 5 do begin 
k[1]:=a;k[2]:=d;
k[3]:=a+8;k[4]:=d-15;k[5]:=a+14;k[6]:=d-12; 
k[7]:=a+18;k[8]:=d-18;k[9]:=a+20;k[10]:=d-13;k[11]:=a+25;k[12]:=d-25; 
k[13]:=a+27;k[14]:=d-19;k[15]:=a+30;
k[16]:=d-21;k[17]:=a+34;k[18]:=d-17; 
k[19]:=a+36;k[20]:=d-19;k[21]:=a+37;k[22]:=d-5;k[23]:=a+40;k[24]:=d-10; 
k[25]:=a+38;k[26]:=d+3;k[27]:=a+33;k[28]:=d+10;k[29]:=a+27;k[30]:=d+4; 
k[31]:=a+25;k[32]:=d+11;k[33]:=a+19;k[34]:=d+6;k[35]:=a+9;k[36]:=d+13; 
k[37]:=a;k[38]:=d; 
n:=19; 
setfillstyle(1,s); 
setcolor(s); 
fillpoly(n,k); 
delay(1500); 
setfillstyle(1,s+3); 
setcolor(s+3); 
fillpoly(n,k); 
delay(3000); 
setfillstyle(1,s+4); 
setcolor(s+4); 
fillpoly(n,k); 
delay(1500); 
setfillstyle(1,s+3); 
setcolor(s+3); 
fillpoly(n,k); 
end; 
end; 
procedure
vert(a,d:integer;s:byte); 
var 
k:array[1..100] of word; 
n:integer; 
begin 
k[1]:=a;k[2]:=d;k[3]:=a+5;k[4]:=d;k[5]:=a+5;k[6]:=d-5;k[7]:=a;k[8]:=d-5;k[9]:=a+10;k[10]:=d-5; 
k[11]:=a+5;k[12]:=d-5;k[13]:=a+5;k[14]:=d;k[15]:=a+10;
k[16]:=d;k[17]:=a+15;k[18]:=d+5; 
k[19]:=a+20;k[20]:=d+5;k[21]:=a+23;k[22]:=d+2;k[23]:=a+27;k[24]:=d;k[25]:=a+30;k[26]:=d; 
k[27]:=a+30;k[28]:=d-7;k[29]:=a+20;k[30]:=d-7;k[31]:=a+20;k[32]:=d-8;k[33]:=a+40;k[34]:=d-8; 
k[35]:=a+40;k[36]:=d-7;k[37]:=a+30;k[38]:=d-7;k[39]:=a+30;k[40]:=d;k[41]:=a+33;k[42]:=d+2; 
k[43]:=a+30;k[44]:=d;k[45]:=a+30;k[46]:=d+9;k[47]:=a+41;k[48]:=d+9;k[49]:=a+27;k[50]:=d+9; 
k[51]:=a+19;k[52]:=d+6;k[53]:=a-1;k[54]:=d;k[55]:=a;k[56]:=d+5;k[57]:=a+5;k[58]:=d+6; 
k[59]:=a+11;k[60]:=d+7;k[61]:=a+17;k[62]:=d+8;k[63]:=a+19;k[64]:=d+9;k[65]:=a+24;k[66]:=d+17; 
k[67]:=a+26;k[68]:=d+18;k[69]:=a+36;k[70]:=d+18;k[71]:=a+40;k[72]:=d+12;k[73]:=a+42;k[74]:=d+8; 
k[75]:=a+40;k[76]:=d+5;k[77]:=a+38;k[78]:=d+1;k[79]:=a+33;k[80]:=d; 
n:=40; 
setfillstyle(1,s); 
setcolor(s); 
fillpoly(n,k); 
k[1]:=a+28;k[2]:=d+16;k[3]:=a+32;k[4]:=d+6;k[5]:=a+36;k[6]:=d+16;k[7]:=a+26;k[8]:=d+10; 
k[9]:=a+37;k[10]:=d+10;k[11]:=a+28;k[12]:=d+16; 
n:=6; 
setfillstyle(1,1); 
setcolor(1); 
fillpoly(n,k); 
end; 
function
og(a,d:integer):word; 
begin 
setcolor(fon); 
setfillstyle(1,0); 
bar(a,d,a+48,d+30); 
end; 
procedure
score(kol:integer; nik:string); 
type  pass=record 
name:string[10]; 
schet:integer; 
end; 
var t:char;  f:file of
pass;  rec:pass; 
e:boolean;
address,klon:string;  mes,k,p,fop,kolop,sch:integer; 
begin 
clrscr; 
address:='FILEOFRE'; 
assign(f,address); 
 begin 
  kolop:=kol; 
  e:=false; 
  p:=0; 
  fop:=1; 
  mes:=1; 
  {rewrite(f); 
  repeat 
  with rec do begin 
  write ('name: '); 
  readln(name); 
  write ('schet: '); 
  readln(schet); 
  write(f,rec); 
  end; 
  inc(p); 
  until p=11; 
procedure
score(kol:integer; nik:string); 
type  pass=record 
name:string[10]; 
schet:integer; 
end; 
var t:char;  f:file of
pass;  rec:pass; 
e:boolean;
address,klon:string;  mes,k,p,fop,kolop,sch:integer; 
begin 
clrscr; 
address:='FILEOFRE'; 
assign(f,address); 
 begin 
  kolop:=kol; 
  e:=false; 
  p:=0; 
  fop:=1; 
  mes:=1; 
  {rewrite(f); 
  repeat 
  with rec do begin 
  write ('name: '); 
  readln(name); 
  write ('schet: '); 
  readln(schet); 
  write(f,rec); 
  end; 
  inc(p); 
  until p=11; 
  close(f); } 
  reset(f); 
  writeln;    
writeln('                                 Pekopd      '); 
 
writeln;writeln;writeln; 
  repeat 
  read(f,rec); 
  writeln; 
  with rec do begin 
  write('               
',mes); 
  write('   ',name); 
  write(' :  ',schet); 
  end; 
  inc(mes); 
  until mes=7; 
  close(f); 
  writeln; 
  if fop<>1 then
begin 
 
writeln('                            .................        '); 
   end; 
 end; 
delay(5000); 
writeln;  
writeln;writeln; 
writeln('                  
                                            Press Enter      '); 
repeat 
begin 
t:=readkey; 
end; 
until Ord(t)=13; 
clrscr; 
writeln(''); 
writeln('');writeln('');writeln('');writeln('');writeln('');writeln('');writeln(''); 
writeln('');writeln('');writeln('');writeln(''); 
writeln('                             
You had gone =', kolop,'  meters'); 
   
writeln('');writeln(''); 
writeln('');writeln('');writeln('');writeln('');writeln('');writeln('');writeln('');
delay(10000); 
writeln
('                                                                   Press
Enter'); 
repeat 
t:=readkey; 
until Ord(t)=13; 
(*begin 
clrscr; 
writeln(''); 
writeln('');writeln('');writeln('');writeln('');writeln('');writeln('');writeln(''); 
writeln('Выражаю благодарность
за помошь в тестировании игры группе ИВТ-06-2 и лично '); 
{setcolor(12);  } 
writeln('Павлу Просянникову
{Пахе старому}'); 
writeln(''); 
{setcolor(4);     } 
writeln('Выражаю
благодарность за помошь в написании сценария игры  '); 
{setcolor(12);   } 
writeln('Левону, Любе,
Михаилу') ; 
{setcolor(4);      } 
   
writeln('');writeln(''); 
writeln('');writeln('');writeln('');
delay(10000); 
delay(5000); 
writeln
('                                                               Нажмите пробел'); 
repeat 
begin 
t:=readkey; 
end; 
until Ord(t)=32; end; *) 
end; 
procedure GET; 
begin 
getmem(ver,imagesize(a-10,d-25,a+53,d+40)); 
getimage(a-10,d-25,a+53,d+40,ver^); 
setfillstyle(6,99); 
bar(300,300,320,350); 
getmem(barer,imagesize(300,300,340,350)); 
getimage(300,300,340,350,barer^); 
setfillstyle(1,1); 
bar(500,330,520,350); 
setcolor(0); 
settextstyle(2,0,4); 
outtextxy(503,333,'500'); 
getmem(barer2,imagesize(500,330,540,350)); 
getimage(500,330,540,350,barer2^); 
setfillstyle(1,0); 
bar(500,330,520,350); 
getmem(barer3,imagesize(500,330,540,350)); 
getimage(500,330,540,350,barer3^); 
setfillstyle(9,53); 
bar(400,300,420,350); 
setfillstyle(1,0); 
getmem(barer1,imagesize(400,300,440,350)); 
getimage(400,300,440,350,barer1^); 
putimage(400,300,barer^,1); 
putimage(300,300,barer1^,1); 
end; 
procedure start; 
begin 
cleardevice; 
aa:=pp; 
putimage(a-10,d-25,ver^,1); 
setfillstyle(1,12); 
bar(0,0,640,100); 
setfillstyle(1,0); 
setcolor(5); 
settextstyle(4,0,5); 
 outtextxy(150,15, nik); 
 text:='Level 1'; 
 outtextxy(400,15,
text); 
 setcolor(red); 
 settextstyle(1,0,3); 
outtextxy(50,35,och); 
settextstyle(0,0,0); 
end; 
procedure tex; 
begin 
cleardevice; 
settextstyle(1,0,9); 
setcolor(4); 
text:='Level 1'; 
outtextxy(150,140,text); 
outtextxy(152,142,text); 
outtextxy(158,138,text); 
delay(30000); 
end; 
procedure ni; 
var cc:char; 
bb:integer; 
s:string[8]; 
begin 
cleardevice; 
setcolor(6); 
bb:=220; 
s:=''; 
setfillstyle(1,1); 
outtextxy(100,60,'Will
enter your name:'); 
bar(200,220,400,280); 
settextstyle(1,0,5); 
repeat 
cc:=readkey; 
if (ord(cc)<>75)
and (ord(cc)<>72) {and (ord(cc)<>77)} and (ord(cc)<>80) then 
s:=s+cc; 
nik:=s; 
outtextxy(bb,230,nik); 
outtextxy(bb+2,230,nik); 
until ord(cc)=13; 
setfillstyle(1,0); 
cleardevice; 
 end; 
procedure
lev(text,text1:string); 
begin 
settextstyle(1,0,9); 
setcolor(4); 
outtextxy(150,140,text); 
outtextxy(152,142,text); 
outtextxy(158,138,text); 
delay(10000); 
setcolor(0); 
outtextxy(150,140,text); 
outtextxy(152,142,text); 
outtextxy(158,138,text); 
setcolor(5); 
setfillstyle(1,12); 
bar(505,15,525,65); 
setfillstyle(1,0); 
settextstyle(4,0,5); 
outtextxy(505,15,text1); 
end; 
function
game(sd:boolean):word; 
const left=#75; 
right=#77; 
up=#72; 
down=#80; 
begin 
ni; 
fon:=0; 
plus:=0; 
yr:=3; 
schet:=0;a:=120;
d:=240;verx:=460;niz:=125;kk:=300;ll:=350;z:=580;v:=880; l:=680; k:=780; 
i:=980;ii:=400;vv:=200;zz:=150;p:=0;pp:=640;level:=1;vert(a,d,4); 
randomize; 
get; 
och:='70'; 
begin 
tex; 
start; 
bonn:=random(150)+300; 
end; 
repeat 
setcolor(0); 
if (plus<70) and
(ord(t)=32) then begin 
setcolor(12); 
outtextxy(50,35, och); 
setcolor(red); 
str(pl,och); 
outtextxy(50,35, och); 
  og(a-3,d-9);
plus:=plus+1;  end; 
pl:=70-plus; 
if ((getpixel(a-2,d)=0)
or (getpixel(a-2,d)=1))  and  ((getpixel(a+43,d+7)=0) or
(getpixel(a+43,d+7)=1)) 
 and
((getpixel(a+26,d+20)=0) or (getpixel(a+26,d+20)=1))  and 
((getpixel(a+36,d+20)=0)
or (getpixel(a+36,d+20)=1)) and  ((getpixel(a+42,d-7)=0) or
(getpixel(a+42,d-7)=1)) 
and 
((getpixel(a+18,d-7)=0) or (getpixel(a+18,d-7)=1)) and 
  ((getpixel(a-1,d-5)=0)
or (getpixel(a-1,d-5)=1)) 
then 
begin 
if (getpixel(a+43,d+7)=1)
or (getpixel(a-1,d-5)=1) or (getpixel(a+36,d+20)=1) 
or
(getpixel(a+42,d-7)=1) or (getpixel(a-2,d)=1) then 
 begin schet:=schet+500;
inc(aw); putimage(v-50,vv+80,barer3^,0); end; 
text:=nik; 
 end 
else 
begin 
text:='GAME OVER'; 
settextstyle(1,0,9); 
if sd=true then begin
sound(100); delay(6000); nosound;  end; 
vert(a,d,fon); 
delay(200); 
ogon(a,d,1); 
if sd=true then begin
sound(50); delay(6000); nosound;  end; 
delay(1000); 
outtextxy(60,140,text); 
outtextxy(62,142,text); 
outtextxy(68,138,text); 
delay(15000); 
break; 
closegraph; 
Score(schet,nik); 
end; 
b:=keypressed; 
if b=true then
t:=readkey; 
settextstyle(1,0,3); 
setcolor(white); 
setbkcolor(fon); 
setfillstyle(9,7); 
case t of 
right : a:=a+5;left :
a:=a-5;up : d:=d-5;down : d:=d+5; 
's' : begin  d:=d+15;
a:=a; end; 
'w' : begin  d:=d-15;
a:=a; end; 
'`' : begin read(cod);  
if cod='money' then begin  schet:=schet+2000; cod:=''; t:='y'; end;   end; 
']' : begin
read(cod1);   if cod1='bonus' then begin  plus:=plus-1000; cod1:='';  t:='y';end;  
end; 
end; 
if z>(yr*2) then
z:=z-yr else begin z:=640;zz:=(460-random(355)) end; 
if v>(yr*2) then
v:=v-yr else begin v:=640;vv:=(460-random(355)) end; 
if k>(yr*2) then
k:=k-yr else begin k:=640;kk:=(460-random(355)) end; 
if l>(yr*2) then
l:=l-yr else begin l:=640;ll:=(460-random(355)) end; 
if i>(yr*2) then
i:=i-yr else begin i:=640;ii:=(460-random(355)) end; 
 if a<6 then a:=6   ; 
 if d<niz+1 then
d:=niz+1  ; 
 if a>594 then
a:=594   ; 
 if d>verx-1 then
d:=verx-1   ; 
if sd=true then begin
sound(500); delay(100); nosound;  end; 
inc(schet); 
if ((schet mod 200)=0)
and (yr<20) then begin 
setcolor(0); 
line(25+yr*2,101,25+yr*2,480); 
yr:=yr+1;   end; 
if (schet mod 500)=0
then begin 
 plus:=plus-35;
pl:=70-plus; setcolor(12); 
outtextxy(50,35, och); 
setcolor(red); 
str(pl,och); 
outtextxy(50,35, och); 
  end; 
setlinestyle(0,0,1); 
if (schet mod 10)=0 then
begin 
setcolor(12); 
outtextxy(560,35, och1); 
setcolor(red); 
  str(schet,och1); 
  outtextxy(560,35,
och1); end; 
if (schet>500) and
(level=1) then 
begin 
ll:=350; l:=680;lev('Level
2','2');level:=2;end; 
if (schet>1500) and
(level=2) then 
begin  
kk:=300;
k:=780;lev('Level 3','3');level:=3;end; 
if (schet>3000) and
(level=3) then 
begin 
i:=980;ii:=400;lev('Level
4','4');level:=4;end; 
if (schet>5000) and
(level=4) then 
begin 
lev('Level
5','5');level:=5;end; 
if (schet>7000) and
(level=5) then 
begin 
lev('Level 6','6'); 
level:=6;end; 
if (schet>10000) and
(level=6) then 
begin 
lev('Level
7','7');level:=7;end; 
if sd=false then
delay(50); 
setfillstyle(1,0); 
 if sd=false then
delay(10); 
putimage(a-10,d-25,ver^,0); 
{Level 1} 
 if sd=false then
delay(10); 
putimage(v,vv,barer1^,0); 
if (schet mod bonn)=0
then inc(aw); 
if (aw mod 2)=0 then 
putimage(v-50,vv+80,barer2^,0); 
if sd=false then
delay(10); 
putimage(z,zz,barer^,0); 
{Level 2} 
 if sd=false then
delay(10); 
if level>1 then
putimage(l,ll,barer1^,0); 
{Level 3} 
 if sd=false then
delay(10); 
if level>2 then
putimage(k,kk,barer^,0); 
setcolor(12); 
line(25+yr*2,101,25+yr*2,480); 
until Ord(t)=258; 
freemem(ver,imagesize(a-10,d-25,a+53,d+40)); 
freemem(barer,imagesize(300,300,340,350)); 
freemem(barer1,imagesize(400,300,440,350)); 
closegraph; 
Score(schet,nik); 
end; 
begin 
end. 
Модуль Menu 
unit menus; 
interface 
uses
crt,graph,games,options,help; 
const left=#75; 
right=#77; 
down=#72; 
up=#80; 
procedure cartinka; 
procedure  menu; 
procedure key1(ch:char); 
implementation 
var ch:char; 
   
ka,kd,n,a,d,q,r,e,s:integer; 
    text:string; 
    sd:boolean; 
   
bor,men0,men1,men2:pointer; 
procedure key1(ch:char); 
begin 
    if ord(ch)=80 then
begin  if d=380 then 
begin 
 begin 
 setcolor(red); 
 rectangle(a+2,d+2,a+398,d+48); 
 setcolor(3); 
 end; 
 d:=100; 
 end; 
   d:=d+70; 
 if d<>170 then
begin 
 setcolor(red); 
 rectangle(a+2,d+2-70,a+398,d+48-70); 
 setcolor(3); 
 end; 
  end; 
if ord(ch)=72 then
begin  if d<240 then 
begin 
 begin 
 setcolor(red); 
 rectangle(a+2,d+2,a+398,d+48); 
 setcolor(3); 
 end; 
 d:=450; 
 end; 
 d:=d-70; 
 if d<>380 then
begin 
 setcolor(red); 
 rectangle(a+2,d+2+70,a+398,d+48+70); 
 setcolor(3); end; 
 end; 
setlinestyle(0,0,1); 
end; 
procedure cartinka; 
begin 
q:=detect;
initgraph(q,r,''); 
e:=GraphResult; 
If e<>grok then 
writeln(GraphErrorMsg(e)) 
else 
begin 
sd:=true; 
a:=100; 
d:=170; 
setfillstyle(1,4); 
bar(100,170,500,220); 
getmem(bor,imagesize(100,170,500,220)); 
getimage(100,170,500,220,bor^); 
setfillstyle(1,0); 
setcolor(13); 
settextstyle(1,0,9); 
text:='VERTOLET'; 
cleardevice; 
vert(30,20,4); 
vert(550,20,4); 
setcolor(13); 
settextstyle(1,0,9); 
outtextxy(100,5, text); 
outtextxy(102,5, text); 
outtextxy(104,5, text); 
setbkcolor(0); 
setcolor(7); 
setfillstyle(1,red); 
settextstyle(1,0,5); 
putimage(100,170,bor^,xorput); 
text:=' Play game '; 
outtextxy(200,165,
text); 
outtextxy(202,165,
text); 
putimage(100,240,bor^,xorput); 
text:=' Options '; 
outtextxy(220,235,
text); 
outtextxy(222,235,
text); 
putimage(100,310,bor^,xorput); 
text:=' Help '; 
outtextxy(240,305,
text); 
outtextxy(242,3055,
text); 
putimage(100,380,bor^,xorput); 
text:=' Exit '; 
outtextxy(240,375,
text); 
outtextxy(242,375,
text); 
end; 
end; 
procedure menu; 
var ch:char; 
begin 
repeat 
cartinka; 
getmem(men0,imagesize(10,10,620,170)); 
getimage(10,10,620,170,men0^); 
getmem(men1,imagesize(10,170,550,230)); 
getimage(10,170,550,230,men1^); 
getmem(men2,imagesize(10,230,550,460)); 
getimage(10,230,550,460,men2^); 
repeat 
cleardevice; 
putimage(10,10,men0^,0); 
putimage(10,170,men1^,0); 
putimage(10,230,men2^,0); 
repeat 
setlinestyle(0,0,3); 
setcolor(3); 
rectangle(a+2,d+2,a+398,d+48); 
setlinestyle(0,0,3); 
setlinestyle(0,0,3); 
setcolor(3); 
ch:=readkey; 
key1(ch); 
until ord(ch)=13; 
if d=240 then
sd:=option; 
if d=310 then begin
closegraph; pravila; 
begin 
q:=detect;
initgraph(q,r,''); 
e:=GraphResult; 
If e<>grok then 
writeln(GraphErrorMsg(e)) 
else 
begin 
end; 
end; 
 end; 
until (d=170) or
(d=380); 
freemem(men0,imagesize(10,10,620,170));freemem(men1,imagesize(10,170,550,230)); 
freemem(men2,imagesize(10,230,550,460)); 
if d =170 then begin if
sd=false then game(false) else game(true); 
end; 
until d=380 ; 
closegraph; 
end; 
begin 
end. 
Модуль Option 
unit options; 
interface 
uses crt,graph; 
function 
option:boolean; 
procedure key(ch:char); 
procedure tex; 
implementation 
var ch:char; 
    a,d:integer; 
    text:string; 
    opt:pointer; 
procedure tex; 
begin 
setcolor(13); 
settextstyle(1,0,9); 
text:='S o u n d'; 
outtextxy(100,5, text); 
outtextxy(102,5, text); 
outtextxy(104,5, text); 
setcolor(0); 
text:='on'; 
setfillstyle(1,red); 
settextstyle(1,0,5); 
bar(100,170,500,220); 
outtextxy(260,165,
text); 
text:='off'; 
setfillstyle(1,red); 
settextstyle(1,0,5); 
bar(100,240,500,290); 
outtextxy(260,235,
text); 
end; 
procedure key(ch:char); 
begin 
if ord(ch)=80 then
begin  if d=240 then 
begin 
 begin 
 setcolor(red); 
 rectangle(a+2,d+2,a+398,d+48); 
 setcolor(3); 
 end; 
 d:=100; 
 end; 
   d:=d+70; 
 if d<>170 then
begin 
 setcolor(red); 
 rectangle(a+2,d+2-70,a+398,d+48-70); 
 setcolor(3); 
 end; 
  end; 
if ord(ch)=72 then
begin  if d<240 then 
begin 
 begin 
 setcolor(red); 
 rectangle(a+2,d+2,a+398,d+48); 
 setcolor(3); 
 end; 
 d:=310; 
 end; 
 d:=d-70; 
 if d<>240 then
begin 
 setcolor(red); 
 rectangle(a+2,d+2+70,a+398,d+48+70); 
 setcolor(3); end; 
 end; 
end; 
function 
option:boolean; 
begin 
a:=100; 
d:=170; 
cleardevice; 
tex; 
option:=false; 
repeat 
setlinestyle(0,0,3); 
setcolor(3); 
rectangle(a+2,d+2,a+398,d+48); 
setlinestyle(0,0,3); 
setcolor(3); 
ch:=readkey; 
key(ch); 
setlinestyle(0,0,1); 
until ord(ch)=13; 
if d =170 then
option:=true; 
end; 
begin 
end. 
Модуль Help 
unit help; 
interface 
uses crt; 
procedure pravila; 
implementation 
procedure pravila; 
var ch:char; 
begin 
clrscr; 
textcolor(red); 
Writeln('                                    
ПРАВИЛА ИГРЫ'); 
textcolor(Green); 
Writeln('Вы управляете
вертолетом "А-308" на  борту которого находятся  взрывчатые'); 
Write('вещества. Ваша цель
перевести их в пункт назначения не врезавшись в препятствия. '); 
Write('В начале игры у вас
имеется 70 бонусов, с помощью которых вы можете пролететь'); 
Write('сквозь препятствие.
Через каждые 500 метров вам начисляется 35 бонусов'); 
textcolor(red); 
Writeln; 
Writeln;Writeln;Writeln; 
Writeln('                      
              УПРАВЛЕНИЕ'); 
textcolor(Green); 
Writeln('Управление
вертолетом осуществляется с помошью клавишь стрелок.  '); 
Write('При нажатии клавиши
пробел активируется защитное поле(бонус) и при нажатии любой другой'); 
Write('клавиши
выключается.'); 
Writeln('Также вертолет может
резко набрать высоту {клавиша w } и снизиться {клавиша s}   '); 
textcolor(Green); 
ch:=readkey; 
end; 
end. 
СПИСОК ЛИТЕРАТУРЫ 
1. Фаронов В.В Турбо
Паскаль 7.0. Начальный курс. Учебное пособие. – М: издательство «Нолидж», 1998. 
2. Меженный О.А.
Самоучитель Turbo Pascal. – М: издательство «Диалектика», 2004. 
3. Николаев А.Б. Турбо
Паскаль в примерах.- М:издательство «Просвещение», 2002. 
 |