Previous Entry Share Next Entry
Морской бой (FP)
Аватар
eolegv
Я думаю это мою программу уже можно назвать полноценной игрой. А идея как всегда свалилась наголову почти неоткуда. Показывал я своей сестренке, программу шахматы, ну критики я скажу было масса. Ну так вот я уже давно ничего не писал, и у меня возникла потребность я и спросил у нее, она и предложила мне написать морской бой. Написать основную часть программы было не сложно, сложнее было заставить компьютер совершать ходы ну об этом позже. Помню поля для боя и фигурки кораблей я написал прям при ней, ну а полностью я завершил ее через пару дней, и еще что мне хорошо запомнилось в этой программе я здесь впервые использовал кубические матрицы.
Вот текст этой программы

program seawar;
uses graph,crt;
var x,y:array[1..10] of integer;
a,b,c,i,j,k,dx,dy:integer; v,mm,difficult:boolean;kes:char;fil:text;
player,comp:array[1..10,1..10] of byte;bufp,bufc:array[1..10,1..10,1..10] of byte;
procedure desk;
begin cleardevice;
setlinestyle(0,0,1);setcolor(white);
for i:=0 to 9 do x[i+1]:=75+50*i;
for i:=0 to 9 do y[i+1]:=125+50*i;
for i:=1 to 10 do
for j:=1 to 10 do rectangle(x[i]-25,y[j]-25,x[i]+25,y[j]+25);

for i:=1 to 10 do
for j:=1 to 10 do rectangle(x[i]+650,y[j]-25,x[i]+700,y[j]+25);
settextstyle(0,0,2);
for i:=1 to 10 do if i<>10 then outtextxy(x[1]-60,y[i]-5,chr(ord('0')+i))
else outtextxy(x[1]-70,y[i]-5,'10');
for i:=1 to 10 do if i<>10 then outtextxy(x[1]+610,y[i]-5,chr(ord('0')+i))
else outtextxy(x[1]+600,y[i]-5,'10');
for i:=0 to 9 do outtextxy(x[i+1]-5,y[1]-60,chr(ord('A')+i));
for i:=0 to 9 do outtextxy(x[i+1]+670,y[1]-60,chr(ord('A')+i));
end;
procedure kor(xk,yk,xl,yl,pp:integer);
var ff:integer;
begin
setfillstyle(1,blue);setcolor(blue);
if xk=xl then bar(x[xk]-20,y[yk],x[xl]+20,y[yl]);
if yk=yl then bar(x[xk],y[yk]-20,x[xl],y[yl]+20);
fillellipse(x[xk],y[yk],20,20);
fillellipse(x[xl],y[yl],20,20);
setfillstyle(7,green);
for ff:=0 to abs(xk-xl) do fillellipse(x[xk+ff],y[yk],10,10);
for ff:=0 to abs(yk-yl) do fillellipse(x[xk],y[yk+ff],10,10);
if yk=yl then
for ff:=xk to xl do player[yk,ff]:=pp;
if xk=xl then
for ff:=yk to yl do player[ff,xk]:=pp;
end;
procedure readpos(t,jjj,pp:integer);
var key:char;l,h:boolean;x1,y1,x2,y2:integer;o,buf:integer;
begin
l:=false;x1:=1;y1:=1;y2:=1+t;x2:=1;
repeat
h:=true;for o:=y1 to y2 do
if (player[o,x1]=1)or(player[o,x1]=2)or(player[o,x1]=3)or(player[o,x1]=4)or
(player[o,x1]=5)or(player[o,x1]=6)or(player[o,x1]=7)or(player[o,x1]=8)or
(player[o,x1]=9)or(player[o,x1]=10)
then if x1+2<11 then
begin x1:=x1+2;x2:=x2+2;h:=false;end else begin x1:=1;x2:=1;y1:=y1+5;y2:=y2+5;h:=false; end;
until h; kor(x1,y1,x2,y2,pp);
repeat
key:=readkey;h:=true;setfillstyle(1,black);setcolor(white);
case key of
#72:begin if (x1>1)and(x2<10) then begin
for o:=x1-1 to x2+1 do if y1>2 then
if (player[y1-2,o]<>0)or(player[y1-1,o]<>0)

then h:=false; end
else if x1=1 then
begin
for o:=x1 to x2+1 do if y1>2 then
if(player[y1-2,o]<>0)or(player[y1-1,o]<>0)
then h:=false; end else
begin
for o:=x1-1 to x2 do if y1>2 then
if (player[y1-2,o]<>0)or(player[y1-1,o]<>0)
then h:=false; end;

if (y1-1<>0)and h then
begin
for o:=x1 to x2 do
begin
bar(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
rectangle(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
player[y1,o]:=0;
end;
for o:=y1 to y2 do
begin
bar(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
rectangle(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
player[o,x1]:=0;
end;
y1:=y1-1;y2:=y2-1;kor(x1,y1,x2,y2,pp); end;
end;
#80:begin if (x1>1)and(x2<10) then begin
for o:=x1-1 to x2+1 do if y2<9 then
if (player[y2+2,o]<>0)or(player[y2+1,o]<>0)
then h:=false; end
else if x1=1 then
begin
for o:=x1 to x2+1 do if y2<9 then
if (player[y2+2,o]<>0)or(player[y2+1,o]<>0)
then h:=false; end else
begin
for o:=x1-1 to x2 do if y2<9 then
if (player[y2+2,o]<>0)or(player[y2+1,o]<>0)

then h:=false; end;

if (y2+1<>11)and h then
begin
for o:=x1 to x2 do
begin
bar(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
rectangle(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
player[y1,o]:=0;
end;
for o:=y1 to y2 do
begin
bar(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
rectangle(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
player[o,x1]:=0;
end;
y1:=y1+1;y2:=y2+1;kor(x1,y1,x2,y2,pp); end; end;

#77:
begin if (y1>1)and(y2<10) then begin
for o:=y1-1 to y2+1 do if x2<9 then
if (player[o,x2+2]<>0)or(player[o,x2+1]<>0)
then h:=false; end
else if y1=1 then
begin
for o:=y1 to y2+1 do if x2<9 then
if (player[o,x2+2]<>0)or(player[o,x2+1]<>0)
then h:=false; end else
begin
for o:=y1-1 to y2 do if x2<9 then
if (player[o,x2+2]<>0)or(player[o,x2+1]<>0)
then h:=false; end;

if (x2+1<>11)and h then
begin
for o:=x1 to x2 do
begin
bar(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
rectangle(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
player[y1,o]:=0;
end;
for o:=y1 to y2 do
begin
bar(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
rectangle(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
player[o,x1]:=0;
end;

x1:=x1+1;x2:=x2+1;kor(x1,y1,x2,y2,pp); end;
end;
#75:begin if (y1>1)and(y2<10) then begin
for o:=y1-1 to y2+1 do if x1>2 then
if (player[o,x1-2]<>0)or(player[o,x1-1]<>0)
then h:=false; end
else if y1=1 then
begin
for o:=y1 to y2+1 do if x1>2 then
if (player[o,x1-2]<>0)or(player[o,x1-1]<>0)
then h:=false; end else
begin
for o:=y1-1 to y2 do if x1>2 then
if (player[o,x1-2]<>0)or(player[o,x1-1]<>0)
then h:=false; end;

if (x1-1<>0)and h then
begin
for o:=x1 to x2 do
begin
bar(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
rectangle(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
player[y1,o]:=0;
end;
for o:=y1 to y2 do
begin
bar(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
rectangle(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
player[o,x1]:=0;
end;

x1:=x1-1;x2:=x2-1;kor(x1,y1,x2,y2,pp); end;

end;
#13:l:=true;
#73,#81:begin
for o:=y1 to y2 do begin
bar(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
rectangle(x[x1]-25,y[o]-25,x[x1]+25,y[o]+25);
player[o,x1]:=0;
end;
for o:=x1 to x2 do
begin
bar(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
rectangle(x[o]-25,y[y1]-25,x[o]+25,y[y1]+25);
player[y1,o]:=0;
end;
h:=true;
if (x1=x2)and(x1+y2-y1<11) then
begin
for o:=x1 to x1+y2-y1 do if (player[y1,o]=1)or
(player[y1,o]=2)or(player[y1,o]=3)or(player[y1,o]=4)or
(player[y1,o]=5)or(player[y1,o]=6)or(player[y1,o]=7)or
(player[y1,o]=8)or(player[y1,o]=9)or(player[y1,o]=10)
then h:=false;
if h then begin
x2:=x1+y2-y1;
y2:=y1;end;end else

if (y1=y2)and(y1+x2-x1<11) then
begin
for o:=y1 to y1+x2-x1 do if (player[o,x1]=1)or(player[o,x1]=2)or
(player[o,x1]=3)or(player[o,x1]=4)or
(player[o,x1]=5)or(player[o,x1]=6)or
(player[o,x1]=7)or(player[o,x1]=8)or
(player[o,x1]=9)or(player[o,x1]=10)
then h:=false;
if h then begin
y2:=y1+x2-x1;x2:=x1;end;end;
kor(x1,y1,x2,y2,pp);

end;
end;
until l;
if x1=1 then begin for o:=x1 to x2+1 do
if (y1>1)and(y2<10) then
begin bufp[pp,y1-1,o]:=(t+1)*10+jjj;bufp[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufp[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufp[pp,y1-1,o]:=(t+1)*10+jjj;
end else
if x2=10 then begin for o:=x1-1 to x2 do
if (y1>1)and(y2<10) then
begin bufp[pp,y1-1,o]:=(t+1)*10+jjj;bufp[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufp[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufp[pp,y1-1,o]:=(t+1)*10+jjj ;
end else
if (x1>1)and(x2<10) then for o:=x1-1 to x2+1 do
if (y1>1)and(y2<10) then
begin bufp[pp,y1-1,o]:=(t+1)*10+jjj;bufp[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufp[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufp[pp,y1-1,o]:=(t+1)*10+jjj;

if y1=1 then begin for o:=y1 to y2+1 do
if (x1>1)and(x2<10) then
begin bufp[pp,o,x1-1]:=(t+1)*10+jjj;bufp[pp,o,x2+1]:=(t+1)*10+jjj;end

else if x1=1 then bufp[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufp[pp,o,x1-1]:=(t+1)*10+jjj;

end else
if y2=10 then begin for o:=y1-1 to y2 do
if (x1>1)and(x2<10) then
begin bufp[pp,o,x1-1]:=(t+1)*10+jjj;bufp[pp,o,x2+1]:=(t+1)*10+jjj;end
else if x1=1 then bufp[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufp[pp,o,x1-1]:=(t+1)*10+jjj;
end else
if (y1>1)and(y2<10) then for o:=y1-1 to y2+1 do
if (x1>1)and(x2<10) then
begin bufp[pp,o,x1-1]:=(t+1)*10+jjj;bufp[pp,o,x2+1]:=(t+1)*10+jjj;end
else if x1=1 then bufp[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufp[pp,o,x1-1]:=(t+1)*10+jjj;

end;
procedure newP;
var t,r,g:integer;
begin g:=0;
for t:=1 to 4 do
case t of
1:begin g:=g+1; readpos(3,0,g);end;
2:for r:=1 to 2 do begin g:=g+1; readpos(2,r,g);end;
3:for r:=1 to 3 do begin g:=g+1; readpos(1,r,g);end;
4:for r:=1 to 4 do begin g:=g+1;readpos(0,r,g);end;
end;end;
procedure newC;
var t,r,g:integer;
procedure rand(ss,jjj,pp:integer);
var
u,o,x1,x2,y1,y2:integer;uac:boolean;
begin
repeat
uac:=true;
x1:=random(10)+1;y1:=random(10)+1;
u:=random(2);
if u=0 then begin x2:=x1;y2:=y1+ss;end else begin y2:=y1;x2:=x1+ss;end;
if y2>10 then uac:=false;
if x2>10 then uac:=false;
if uac and(u=1) then
for o:=x1 to x2 do if (comp[y1,o]=1)or(comp[y1,o]=2)or(comp[y1,o]=3)or(comp[y1,o]=4)
then uac:=false;
if uac and(u=0) then for o:=y1 to y2 do
if (comp[o,x1]=1)or(comp[o,x1]=2)or(comp[o,x1]=3)or(comp[o,x1]=4) then uac:=false;
if x1=1 then for o:=x1 to x2+1 do
if (y1-1>0)and(y2+1<11) then
begin if (comp[y1-1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y1-1=0 then begin if (comp[y1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y2+1=11 then begin if (comp[y1-1,o]<>0)or(comp[y2,o]<>0)
then uac:=false;end;
if x2=10 then for o:=x1-1 to x2 do
if (y1-1>0)and(y2+1<11) then begin if (comp[y1-1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y1-1=0 then begin if (comp[y1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y2+1=11 then begin if (comp[y1-1,o]<>0)or(comp[y2,o]<>0)

then uac:=false;end;
if (x1>1)and(x2<10) then for o:=x1-1 to x2+1 do
if (y1-1>0)and(y2+1<11) then begin if (comp[y1-1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y1-1=0 then begin if (comp[y1,o]<>0)or(comp[y2+1,o]<>0)
then uac:=false;end
else if y2+1=11 then begin if (comp[y1-1,o]<>0)or(comp[y2,o]<>0)
then uac:=false;end;
if y1=1 then for o:=y1 to y2+1 do
if (x1-1>0)and(x2+1<11) then
begin if (comp[o,x1-1]<>0)or(comp[o,x2+1]<>0)

then uac:=false;end
else if x1-1=0 then begin if (comp[o,x1]<>0)or(comp[o,x2+1]<>0)
then uac:=false;end
else if x2+1=11 then begin if (comp[o,x1-1]<>0)or(comp[o,x2]<>0)
then uac:=false;end;
if y2=10 then for o:=y1-1 to y2 do
if (x1-1>0)and(x2+1<11) then
begin if (comp[o,x1-1]<>0)or(comp[o,x2+1]<>0)
then uac:=false;end
else if x1-1=0 then begin if (comp[o,x1]<>0)or(comp[o,x2+1]<>0)

then uac:=false;end
else if x2+1=11 then begin if (comp[o,x1-1]<>0)or(comp[o,x2]<>0)

then uac:=false;end;
if (y1>1)and(y2<10) then for o:=y1-1 to y2+1 do
if (x1-1>0)and(x2+1<11) then
begin if (comp[o,x1-1]<>0)or(comp[o,x2+1]<>0)
then uac:=false;end
else if x1-1=0 then begin if (comp[o,x1]<>0)or(comp[o,x2+1]<>0)
then uac:=false;end
else if x2+1=11 then begin if (comp[o,x1-1]<>0)or(comp[o,x2]<>0)
then uac:=false;end;
until uac;
if y1=y2 then
for o:=x1 to x2 do comp[y1,o]:=pp;
if x1=x2 then
for o:=y1 to y2 do comp[o,x1]:=pp;
if x1=1 then begin for o:=x1 to x2+1 do
if (y1>1)and(y2<10) then
begin bufc[pp,y1-1,o]:=(t+1)*10+jjj;bufc[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufc[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufc[pp,y1-1,o]:=(t+1)*10+jjj;
end else
if x2=10 then begin for o:=x1-1 to x2 do
if (y1>1)and(y2<10) then
begin bufc[pp,y1-1,o]:=(t+1)*10+jjj;bufc[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufc[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufc[pp,y1-1,o]:=(t+1)*10+jjj ;
end else
if (x1>1)and(x2<10) then for o:=x1-1 to x2+1 do
if (y1>1)and(y2<10) then
begin bufc[pp,y1-1,o]:=(t+1)*10+jjj;bufc[pp,y2+1,o]:=(t+1)*10+jjj;end
else if y1=1 then bufc[pp,y2+1,o]:=(t+1)*10+jjj else
if y2=10 then bufc[pp,y1-1,o]:=(t+1)*10+jjj;

if y1=1 then begin for o:=y1 to y2+1 do
if (x1>1)and(x2<10) then
begin bufc[pp,o,x1-1]:=(t+1)*10+jjj;bufc[pp,o,x2+1]:=(t+1)*10+jjj;end

else if x1=1 then bufc[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufc[pp,o,x1-1]:=(t+1)*10+jjj;

end else
if y2=10 then begin for o:=y1-1 to y2 do
if (x1>1)and(x2<10) then
begin bufc[pp,o,x1-1]:=(t+1)*10+jjj;bufc[pp,o,x2+1]:=(t+1)*10+jjj;end
else if x1=1 then bufc[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufc[pp,o,x1-1]:=(t+1)*10+jjj;
end else
if (y1>1)and(y2<10) then for o:=y1-1 to y2+1 do
if (x1>1)and(x2<10) then
begin bufc[pp,o,x1-1]:=(t+1)*10+jjj;bufc[pp,o,x2+1]:=(t+1)*10+jjj;end
else if x1=1 then bufc[pp,o,x2+1]:=(t+1)*10+jjj else
if x2=10 then bufc[pp,o,x1-1]:=(t+1)*10+jjj;
end;
begin
randomize;g:=0;
for t:=1 to 4 do
case t of
1:begin g:=g+1;rand(3,0,g);end;
2:for r:=1 to 2 do begin g:=g+1;rand(2,r,g);end;
3:for r:=1 to 3 do begin g:=g+1;rand(1,r,g);end;
4:for r:=1 to 4 do begin g:=g+1;rand(0,r,g);end;
end;
end;
procedure readhod(var pox:boolean);
var key:char;l:boolean;
n1,n2,w,e,ll1,ll2,klk:integer;
procedure krest(xx,yy:integer);
begin
setcolor(red);setlinestyle(0,0,3);
line(xx-18,yy-18,xx+18,yy+18);
line(xx-18,yy+18,xx+18,yy-18);
end;
procedure nol(xx,yy:integer);
begin
setfillstyle(1,cyan);setcolor(cyan);
fillellipse(xx,yy,10,10);
end;
begin l:=false;n1:=655;n2:=695;pox:=false;
w:=5;e:=5;setcolor(red);
rectangle(x[w]+n1,y[e]-20,x[w]+n2,y[e]+20);
repeat
if keypressed then begin
key:=readkey;setcolor(black);setlinestyle(0,0,3);
rectangle(x[w]+n1,y[e]-20,x[w]+n2,y[e]+20);
case key of
#72:if e-1>0 then e:=e-1;
#80:if e+1<11 then e:=e+1;
#77:if w+1<11 then w:=w+1;
#75:if w-1>0 then w:=w-1;
#13:l:=true;
end;
setcolor(red);setlinestyle(0,0,3);
rectangle(x[w]+n1,y[e]-20,x[w]+n2,y[e]+20);
end;
until l;

if (comp[e,w]>0)and(comp[e,w]<11)
then begin comp[e,w]:=11;pox:=true;krest(x[w]+675,y[e]);sound(100);nosound;
klk:=0;
repeat klk:=klk+1;l:=true;
for ll1:=1 to 10 do
for ll2:=1 to 10 do
if comp[ll1,ll2]=klk then l:=false;
if l then
for ll1:=1 to 10 do for ll2:=1 to 10 do
if bufc[klk,ll1,ll2]<>0 then begin nol(x[ll2]+675,y[ll1]);comp[ll1,ll2]:=12;end;
until klk=10;
end;
if comp[e,w]=0 then begin comp[e,w]:=12;nol(x[w]+675,y[e]);end;

setcolor(black);setlinestyle(0,0,3);
rectangle(x[w]+n1,y[e]-20,x[w]+n2,y[e]+20);
end;

procedure comhod(var pox:boolean;hard:boolean);
var x1,y1,ll1,ll2,klk:integer;kik,l:boolean;
procedure krest(xx,yy:integer);
begin
setcolor(magenta);setlinestyle(0,0,3);
line(xx-18,yy-18,xx+18,yy+18);
line(xx-18,yy+18,xx+18,yy-18);
end;
procedure nol(xx,yy:integer);
begin
setfillstyle(1,green);setcolor(green);
fillellipse(xx,yy,10,10);
end;
begin
randomize;pox:=false;
repeat

kik:=true;
x1:=random(10)+1;y1:=random(10)+1;

if (player[x1,y1]=11)or(player[x1,y1]=12) then kik:=false;
until kik;

if (player[x1,y1]>0)and(player[x1,y1]<11)
then if hard then
begin
klk:=player[x1,y1];
for ll1:=1 to 10 do
for ll2:=1 to 10 do if player[ll1,ll2]=klk then
begin
player[ll1,ll2]:=11;
krest(x[ll2],y[ll1]);pox:=true;end;
end
else
begin player[x1,y1]:=11;krest(x[y1],y[x1]);pox:=true;sound(100);nosound; end;
if player[x1,y1]=0 then begin player[x1,y1]:=12;nol(x[y1],y[x1]);end;

klk:=0;
repeat klk:=klk+1;l:=true;
for ll1:=1 to 10 do
for ll2:=1 to 10 do
if player[ll1,ll2]=klk then l:=false;
if l then
for ll1:=1 to 10 do for ll2:=1 to 10 do
if bufp[klk,ll1,ll2]<>0 then begin nol(x[ll2],y[ll1]);player[ll1,ll2]:=12;end;
until klk=10;

end;
function sost:char;
var ll,cc,m,kk:integer;
begin sost:='M'; m:=0;
for ll:=1 to 10 do for cc:=1 to 10 do
if (player[ll,cc]=11)or(player[ll,cc]=12)or(player[ll,cc]=0) then m:=m+1;
if m=100 then sost:='C';
m:=0;
for ll:=1 to 10 do for cc:=1 to 10 do
if (comp[ll,cc]=11)or(comp[ll,cc]=12)or(comp[ll,cc]=0) then m:=m+1;
if m=100 then sost:='P';
end;
procedure newgame(var uu,dif:boolean);
var key:char;kl:integer;fff:boolean;
begin
settextstyle(0,0,15);setcolor(magenta);kl:=1;fff:=false;
outtextxy(370,100,'SEA WAR');settextstyle(0,0,3);outtextxy(950,150,'beta');
settextstyle(0,0,5);setcolor(blue);
outtextxy(500,300,'New Game');
outtextxy(500,400,'Quit');setcolor(red);
setfillstyle(1,yellow);fillellipse(450,210+kl*100,40,10);
repeat
key:=readkey;setfillstyle(1,black);setcolor(black);
fillellipse(450,210+kl*100,40,10);
case key of
#72:if kl=2 then kl:=1;
#80:if kl=1 then kl:=2;
#13:begin fff:=true; if kl=1 then uu:=true else uu:=false;end;
end;
setfillstyle(1,yellow);setcolor(red);
fillellipse(450,210+kl*100,40,10);
until fff;
kl:=1;fff:=false;
if uu then begin
settextstyle(0,0,5);setcolor(black);
outtextxy(500,300,'New Game');
outtextxy(500,400,'Quit');
setfillstyle(1,yellow);fillellipse(450,210+kl*100,40,10);
settextstyle(0,0,5);setcolor(red);outtextxy(475,230,'DIFFICULT');
settextstyle(0,0,5);setcolor(blue);
outtextxy(570,300,'Easy');
outtextxy(570,400,'Hard');
repeat
key:=readkey;setfillstyle(1,black);setcolor(black);
fillellipse(450,210+kl*100,40,10);
case key of
#72:if kl=2 then kl:=1;
#80:if kl=1 then kl:=2;
#13:begin fff:=true; if kl=1 then dif:=false else dif:=true;end;
end;
setfillstyle(1,yellow);setcolor(red);
fillellipse(450,210+kl*100,40,10);
until fff;
end;
end;
begin
for i:=1 to 10 do for j:=1 to 10 do begin comp[i,j]:=0;player[i,j]:=0;end;
a:=detect;
initgraph(a,b,'');
newgame(v,difficult);
if v then
begin
desk;
newp;newc;
repeat
repeat
readhod(mm);
until not mm;
begin end;
if sost='M' then
repeat
comhod(mm,difficult);
until not mm;

until sost<>'M';
if sost='C' then begin settextstyle(0,0,15);setcolor(green);
outtextxy(330,700,'YOU LOSE!');repeat until keypressed; end;
if sost='P' then begin settextstyle(0,0,15);setcolor(Red);
outtextxy(330,700,'YOU WIN!!!');repeat until keypressed; end;
end;
end.

Алгоритм этой программы я расскажу по подробнее. Итак в основной части программы первой процедурой выполняется newgame она отвечает за экран приветствие и выбор сложности. Возможны два варианта сложности тяжелый и легкий, в легком компьютер делает ходы наугад, в тяжелом же если он попадет в корабль, то считайте что этого корабля уже нет. Дальше процедура desk рисует поля, процедура newp и newc отвечают за постановку кораблей, причем по всем правилам. Затем идет цикл в котором участвуют три процедуры readhod, comhod и sost. Процедура readhod считывает ход игрока, процедура comhod совершает ход компьютера. Ну и процедура sost проверяет текущее положение дел в игре.
seawar1
seawar2
seawar3

Вот ссылки на эту программу
DepositFiles.com

ifolder.tu


  • 1
Управление у меня на Win7 не работает, но с виду игрушка приятная...чего не скажешь про код =)

Оно работает нажимать надо в основном окне. Я это писал в "Немного о Free Pascal"

  • 1
?

Log in

No account? Create an account