зы в игре нехватает 3 танков-ботов их стрельбы и наличие места реса
program TW;
uses graph,wincrt;
var
grd,grm,nom:integer;
water:pointer;
key:char;
const
Esc=#27; Left=#75; Right=#77; up=#72; down=#80; enter=#13; space=#32;
stepy=200;
{___________________getpict________________________}
procedure getpicture(name:string; var p:pointer);
var
f:file; size:word;
begin
assign(f,name);
reset(f,1);
size:=filesize(f);
getmem(p,size);
blockread(f,p^,size);
close(f);
end;
{_________________Zastavka__________________}
Procedure zastavka;
var c,n:integer;
begin
cleardevice;
repeat
{_________________Music________________________}
c:=random(15)+1;
n:=random(250)+1000;
Sound(n);
Setcolor©;
Settextstyle(0,0,4);
Outtextxy(250,10,'Shooter');
Outtextxy(250,40,'Tank Wars');
Settextstyle(0,0,3);
Outtextxy(100,100,'Avtor:Oderkov Alexandr');
Outtextxy(250,300,'Good Luck');
Outtextxy(250,350,'please key pressed');
delay(500);
nosound;
Until keypressed;
while keypressed do readkey;
cleardevice;
end;
{_______________Proc Menu____________________}
procedure menu(var n:integer);
var
tank:pointer;
x,y,x1,y1:integer;
p:pointer;
s:word;
ch:char;
begin
getpicture('pne242/tankm',tank);
{______________Okoshki__________________}
setfillstyle(1,2);
bar(0,0,getmaxx,getmaxy);
setfillstyle(1,7);
bar(573,103,873,153);
bar(573,303,873,353);
bar(573,503,873,553);
bar(573,703,873,753);
setfillstyle(1,15);
bar(570,100,870,150);
bar(570,300,870,350);
bar(570,500,870,550);
bar(570,700,870,750);
{_________________________Text___________________}
settextstyle(4,0,3);
setcolor(4);
outtextxy(662,117,'New game');
outtextxy(682,317,'Options');
outtextxy(702,517,'Help');
outtextxy(712,722,'Exit');
setcolor(12);
outtextxy(660,115,'New game');
outtextxy(680,315,'Options');
outtextxy(700,515,'Help');
outtextxy(710,720,'Exit');
{___________________Dublik text______________}
setcolor(5);
settextstyle(1,0,10);
outtextxy(100,350,'Tank');
outtextxy(1000,350,'Wars');
{______________________Ykazatel`___________________}
x:=500;
y:=110;
putimage(x,y,tank^,1); {+}
repeat
y1:=y;
ch:=readkey;
if (ch=down) and (y<getmaxy-stepy) then y:=y+stepy;
if (ch=up) and (y>stepy) then y:=y-stepy;
if (y<>y1) then
begin
putimage(x,y1,tank^,1); {-}
putimage(x,y,tank^,1); {+}
end;
until (ch=esc) or(ch=enter);
if ch=esc then n:=4
else
n:=y div 200+1;
cleardevice;
end;
{_______________________Massiv_________________}
procedure game;
const
kx=36; ky=25; {razmer pol9l}
xs=33; ys=33; {razmer kvadrata}
lab:array[-1..kx,-1..ky] of integer=
((1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,2,2,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,2,2,0,1,0,1,0,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,1),
(1,0,0,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,0,1,1,1,0,1,0,0,0,0,0,1,1,0,1,1,1,1,0,1,1,1,1,0,1,1),
(1,0,0,0,0,0,1,0,1,1,1,1,1,0,0,1,0,0,1,0,1,0,0,0,0,0,1),
(1,1,0,1,1,0,1,0,0,0,0,0,1,0,1,1,0,0,1,1,1,0,1,1,1,1,1),
(1,0,0,0,1,0,0,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,1),
(1,1,1,0,1,0,1,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,0,1,1,1),
(1,0,0,0,0,0,1,0,0,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0,1),
(1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,0,1,1,1,1),
(1,0,1,0,0,0,1,1,1,1,1,0,1,1,1,1,1,0,1,0,0,0,0,0,0,0,1),
(1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1),
(1,0,1,0,0,0,0,0,1,1,1,1,1,0,1,1,0,1,1,0,0,0,0,0,0,0,1),
(1,0,1,1,1,1,0,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,1),
(1,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,1),
(1,1,1,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,1,1,1,0,1,1,1,1,1),
(1,0,1,0,0,0,1,0,0,0,1,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,1),
(1,0,1,1,1,0,1,1,1,1,1,1,0,0,0,1,1,1,0,0,1,1,1,1,1,0,1),
(1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,0,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,0,1,1,1),
(1,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1),
(1,0,1,0,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1),
(1,0,1,0,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1),
(1,0,1,0,1,0,1,1,1,1,1,1,0,1,1,1,1,0,0,1,0,1,1,1,1,0,1),
(1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,1,0,1),
(1,1,1,1,1,0,1,0,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,0,1),
(1,0,0,0,0,0,1,0,1,1,0,0,0,1,0,1,1,1,1,1,0,1,0,0,0,0,1),
(1,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1),
(1,0,1,1,0,1,1,1,1,1,0,1,0,1,0,1,1,1,0,1,1,1,1,0,0,0,1),
(1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1),
(1,0,0,0,0,0,1,0,1,1,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,1),
(1,1,1,1,1,1,1,0,1,0,0,0,0,1,0,0,0,1,1,1,0,0,0,0,0,0,1),
(1,0,0,0,0,0,1,0,1,1,1,1,0,1,0,1,0,0,0,0,0,0,1,0,1,1,1),
(1,0,0,0,0,0,1,0,0,0,0,0,0,1,0,1,0,1,0,1,0,0,1,0,0,0,1),
(1,0,0,0,0,1,1,0,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0,0,1),
(1,0,0,0,0,0,0,0,1,1,1,0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1));
var
wall,b1,b2,tnk,tnk0,tnkn,tnkv,tnkl,tnkp,pula,bazach:pointer;
x,y,xp,yp,x2,x1,y2,y1,xpu,ypu,dx,dy:integer;
pulya:boolean;
i,num:integer;
const
stx:integer=xs;
sty:integer=ys;
{__________________Budimost` stenbl______________________}
begin
rectangle(0,0,kx*xs,ky*ys);
getpicture('pne242/wall',wall);
for x:=0 to kx-1 do
for y:=0 to ky-1 do
if lab[x,y]=1 then putimage(xs*x,ys*y,wall^,1);
getpicture('pne242/baza1',b1);
putimage(0,0,b1^,1);
getpicture('pne242/baza2',b2);
putimage(xs*kx-xs*2,ys*ky-ys*2,b1^,1);
{______________________Dvijenie ypr______________________}
getpicture('pne242/tank image/tankniz',tnkn);
getpicture('pne242/tank image/tankverh',tnkv);
getpicture('pne242/tank image/tanklevo',tnkl);
getpicture('pne242/tank image/tankprav',tnkp);
getpicture('pne242/tank image/pulka',pula);
xp:=0;
yp:=2;
tnk:=tnkn;
{tnk0-бв ал©,tnk-noviy}
putimage(xp*xs,yp*ys,tnk^,1);
pulya:=false;
{povorot tanka po najatii klavish ypravleni9l}
repeat
if keypressed then
begin
key:=readkey;
if key=#0 then key:=readkey;
x:=xp; y:=yp; tnk0:=tnk;
case key of
down: begin if lab[xp,yp+1]<>1 then yp:=yp+1; tnk:=tnkn; end;
up: begin if lab[xp,yp-1]<>1 then yp:=yp-1; tnk:=tnkv; end;
left: begin if lab[xp-1,yp]<>1 then xp:=xp-1; tnk:=tnkl; end;
right: begin if lab[xp+1,yp]<>1 then xp:=xp+1; tnk:=tnkp; end;
{_________________________________PYLIA_______________________________}
{___xpu,ypu-x,y puli; xp,yp-na4alna9 x,y puli___}
space: if not pulya then
begin
xpu:=xp; ypu:=yp;
pulya:=true;
putimage(xpu*xs+15,ypu*ys+15,pula^,1);
dx:=0;
dy:=0;
if tnk=tnkl then dx:=-1 else
if tnk=tnkp then dx:=1 else
if tnk=tnkn then dy:=1 else dy:=-1;
end;
end;
if (x<>xp) or (y<>yp) or(tnk<>tnk0)then
begin
putimage(x*xs,y*ys,tnk0^,1);
putimage(xp*xs,yp*xs,tnk^,1);
end;
end;
if pulya then
begin
putimage(xpu*xs+15,ypu*ys+15,pula^,1);
xpu:=xpu+dx;
ypu:=ypu+dy;
if (xpu<0) or (xpu>kx-1)or (ypu<0) or( ypu>ky-1) then pulya:=false
else if lab[xpu,ypu]=1 then
begin
pulya:=false;
putimage(xpu*xs,ypu*ys,wall^,1);
lab[xpu,ypu]:=0;
end ;
if pulya then putimage(xpu*xs+15,ypu*ys+15,pula^,1);
end;
until key=esc;
{___________________Neupr dvijenie_________}
{_________________Granica pol9l_________________________}
readkey;
cleardevice;
end;
{_________________________Procedure Options_________________}
procedure option;
begin
outtextxy(500,350,'Option');
cleardevice;
end;
{_________________________Procedure Help_________________}
procedure help(name:string);
var
t:text;
s:string;
ir:integer;
begin
assign(t,name);
reset(t);
ir:=0;
while not(eof(t)) do
begin
readln(t,s);
settextstyle(1,0,3);
outtextxy(0,ir,s);
ir:=ir+textheight(s);
end;
close(t);
readkey;
cleardevice;
end;
{_______________________Glavna9l 4ast`__________}
begin
grd:=detect;
InitGraph(grd,grm,'');
zastavka;
repeat
menu(nom);
case nom of
1:game;
2:option;
3:help;
end;
until nom=4;
closegraph;
writeln(nom);
end.
М | При публикации программного кода используй теги (меню CODE) Lapp |