Федеральне агентство з освіти
Читинської ДЕРЖАВНИЙ УНІВЕРСИТЕТ
Енергетичний інститут
Факультет економіки та інформатики
Кафедра ІХТ і ПМ
Курсова робота

Чита 2007.
Федеральне агентство з освіти
Читинської ДЕРЖАВНИЙ УНІВЕРСИТЕТ
Енергетичний інститут
Факультет економіки та інформатики
Кафедра ІХТ і ПМ
ПОЯСНЮВАЛЬНА ЗАПИСКА
до курсової роботи
З дисципліни «Програмування на мові високого рівня».
На тему: Гра «Vertolet».
Проект виконав студент групи ІХТ-06-02
Лазарєв Михайло Андрійович

Керівник работи_____________________
Федеральне агентство з освіти
Читинської ДЕРЖАВНИЙ УНІВЕРСИТЕТ
Енергетичний інститут
Факультет економіки та інформатики
Кафедра ІХТ і ПМ
ЗАВДАННЯ
на курсову роботу
з дисципліни «Програмування на мові високого рівня»
студенту Лазареву М.А.
Тема роботи: Гра «Vertolet»

· 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: = keydivssed;
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: = keydivssed;
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 oun 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.

Гра Vertolet

Рекомендована література:

· Procedure key1-процедура відповідає за переміщення покажчика в меню гри.