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));