РЕФЕРАТ
Пояснительная записка – 30 с., 0 рис., 0 табл., 2 источника, 1 прил.
Turbo Pascal, алгоритм, игрок, защитное поле, компьютерная игра, модуль, программа, процедура, барьер, бонус, функция.
В своей работе я реализовал вариант телефонной игры – Вертолет. Она написана на языке Turbo Pascal. Исходные коды прилагаются.
СОДЕРЖАНИЕ
Введение………………………………………………………………..7
1. Алгоритм работы……………………………………………………8
2. Руководство пользователя…………………………………………10
Заключение……………………………………………………………11
Приложение……………………………………………………………13
Исходные коды модулей………………………………………………17
Список литературы……………………………………………………30
ВВЕДЕНИЕ
Нужна помощь в написании курсовой?
Мы - биржа профессиональных авторов (преподавателей и доцентов вузов). Наша система гарантирует сдачу работы к сроку без плагиата. Правки вносим бесплатно.
Данная программа представляет собой реализацию известной игры «Вертолет», а точнее – ее распространенного режима под названием «Battle mode».
Vertolet — одна из самых простых и увлекательных игр. Эта игра сочетает в себе простоту, оригинальность. В неё будет интересно играть и школьнику, и пенсионеру. Элементарные правила делают игру интересной и непринуждённой.
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.