скачать рефераты

скачать рефераты
Рус Укр Eng
 
 
скачать рефераты скачать рефераты

Меню

Игра "Vertolet" скачать рефераты

etcolor(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.

Страницы: 1, 2