Исходный текст

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, C

Изм.

Лист

№ докум.

Подпись

Дата

Лист

КП ПО21.1206.081 ПЗ

Разраб.

Брилевский В.А

Провер.

Клыбик С.Л

Реценз.

Н. Контр.

Утверд.

Приложение А

Лит.

Листов

НГАЭК,2015

lasses, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Menus, XPMan;

type

TForm1 = class(TForm)

Panel1: TPanel;

Image1: TImage;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

Label25: TLabel;

Panel2: TPanel;

Image2: TImage;

Label13: TLabel;

Label14: TLabel;

Label15: TLabel;

Label16: TLabel;

Label17: TLabel;

Label18: TLabel;

Label19: TLabel;

Label20: TLabel;

Label21: TLabel;

Label22: TLabel;

Label23: TLabel;

Label26: TLabel;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N6: TMenuItem;

N5: TMenuItem;

Label12: TLabel;

Label24: TLabel;

Label27: TLabel;

Label28: TLabel;

Label29: TLabel;

procedure FormCreate(Sender: TObject);

procedure rastkor(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure nash(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure N2Click(Sender: TObject);

procedure vistrel(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure N3Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

i,j,g,x1,y1,k11,k21,

k33,k32,k31,m3,m2,m1, //кол-во 3х 2х 1х кораблей

m,n,z:integer;

rot, //ротация кораблей

riad,rnd, //для того что бы рядом не ставились,нужна для рандомирования

win,lose, //проверка на победу или поражение

bum, //проверка выстрела компьютера

kon, //проверка конца игры

cokil: boolean; //попал ли комрьютер

b1,b2:Array[1..14,1..14] of integer;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

rot:=false; //заполнение переменных

kon:=false;

k11:=3;

k33:=2;

k32:=5;

k31:=9;

m3:=0;

m2:=0;

m1:=0;

label13.Height:=0;

label14.Height:=0;

label15.Height:=0;

label16.Height:=0;

label17.Height:=0;

label18.Height:=0;

label19.Height:=0;

label20.Height:=0;

label21.Height:=0;

label22.Height:=0;

label23.Height:=0;

label26.Height:=0;

label12.Caption:='Расставьте корабли';

For i:=1 to 10 do //рисует сетку поля игрока

for j:=1 to 10 do

begin

b1[i,j]:=0;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

end;

randomize;

m:=random(10)+1;

n:=random(10)+1;

z:=(random(100) mod 2);

case n of

1..7:

case m of

1..7: for i:=0 to 3 do

if z=0 then

b2[m+i,n]:=2

else

b2[m,n+i]:=2;

8..10: for i:=0 to 3 do

if z=0 then

b2[m-i,n]:=2

else

b2[m,n+i]:=2;

end;

8..10:

case m of

1..7: for i:=0 to 3 do

if z=0 then

b2[m+i,n]:=2

else

b2[m,n-i]:=2;

8..10: for i:=0 to 3 do

if z=0 then

b2[m-i,n]:=2

else

b2[m,n-i]:=2;

end;

end;

while m3<2 do begin

m:=random(10)+1;

n:=random(10)+1;

z:=(random(100) mod 2);

case n of

1..7:

case m of

1..7: case z of

0: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m,n+1]<>2) and

(b2[m+1,n+2]<>2) and

(b2[m-1,n+2]<>2) and

(b2[m,n+2]<>2) and

(b2[m+1,n+3]<>2) and

(b2[m-1,n+3]<>2) and

(b2[m,n+3]<>2) and

(b2[m,n+3]<>2) then

begin

for i:=0 to 2 do

b2[m,n+i]:=2;

m3:=m3+1

end;

1: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n]<>2) and

(b2[m+2,n-1]<>2) and

(b2[m+2,n+1]<>2) and

(b2[m+2,n]<>2) and

(b2[m+3,n-1]<>2) and

(b2[m+3,n+1]<>2) and

(b2[m+3,n]<>2) and

(b2[m+3,n]<>2) then begin

for i:=0 to 2 do

b2[m+i,n]:=2;

m3:=m3+1

end

end;

8..10: case z of

0: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m-2,n-1]<>2) and

(b2[m-2,n+1]<>2) and

(b2[m-2,n]<>2) and

(b2[m-3,n-1]<>2) and

(b2[m-3,n+1]<>2) and

(b2[m-3,n]<>2) then

begin

for i:=0 to 2 do

b2[m-i,n]:=2;

m3:=m3+1

end;

1: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m,n+1]<>2) and

(b2[m+1,n+2]<>2) and

(b2[m-1,n+2]<>2) and

(b2[m,n+2]<>2) and

(b2[m+1,n+3]<>2) and

(b2[m-1,n+3]<>2) and

(b2[m,n+3]<>2) and

(b2[m,n+3]<>2) then

begin

for i:=0 to 2 do

b2[m,n+i]:=2;

m3:=m3+1

end;

end

end;

8..10:

case m of

1..7: case z of

0: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+2,n-1]<>2) and

(b2[m+2,n+1]<>2) and

(b2[m+2,n]<>2) and

(b2[m+3,n-1]<>2) and

(b2[m+3,n+1]<>2) and

(b2[m+3,n]<>2) then begin

for i:=0 to 2 do

b2[m+i,n]:=2;

m3:=m3+1

end;

1: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n-2]<>2) and

(b2[m-1,n-2]<>2) and

(b2[m,n-2]<>2) and

(b2[m+1,n-3]<>2) and

(b2[m-1,n-3]<>2) and

(b2[m,n-3]<>2) then

begin

for i:=0 to 2 do

b2[m,n-i]:=2;

m3:=m3+1

end

end;

8..10: case z of

0: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n-2]<>2) and

(b2[m-1,n-2]<>2) and

(b2[m,n-2]<>2) and

(b2[m+1,n-3]<>2) and

(b2[m-1,n-3]<>2) and

(b2[m,n-3]<>2) then

begin

for i:=0 to 2 do

b2[m,n-i]:=2;

m3:=m3+1

end;

1: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m-2,n-1]<>2) and

(b2[m-2,n+1]<>2) and

(b2[m-2,n]<>2) and

(b2[m-3,n-1]<>2) and

(b2[m-3,n+1]<>2) and

(b2[m-3,n]<>2) then

begin

for i:=0 to 2 do

b2[m-i,n]:=2;

m3:=m3+1

end

end

end

end

end;

while m2<3 do begin

m:=random(10)+1;

n:=random(10)+1;

z:=(random(100) mod 2);

case n of

1..8:

case m of

1..8: case z of

0: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m,n+1]<>2) and

(b2[m+1,n+2]<>2) and

(b2[m-1,n+2]<>2) and

(b2[m,n+2]<>2) then

begin

for i:=0 to 1 do

b2[m,n+i]:=2;

m2:=m2+1

end;

1: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n]<>2) and

(b2[m+2,n-1]<>2) and

(b2[m+2,n+1]<>2) and

(b2[m+2,n]<>2) then begin

for i:=0 to 1 do

b2[m+i,n]:=2;

m2:=m2+1

end

end;

9..10: case z of

0: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m-2,n-1]<>2) and

(b2[m-2,n+1]<>2) and

(b2[m-2,n]<>2) then

begin

for i:=0 to 1 do

b2[m-i,n]:=2;

m2:=m2+1

end;

1: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m,n+1]<>2) and

(b2[m+1,n+2]<>2) and

(b2[m-1,n+2]<>2) and

(b2[m,n+2]<>2) then

begin

for i:=0 to 1 do

b2[m,n+i]:=2;

m2:=m2+1

end;

end

end;

9..10:

case m of

1..8: case z of

0: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+2,n-1]<>2) and

(b2[m+2,n+1]<>2) and

(b2[m+2,n]<>2) then begin

for i:=0 to 1 do

b2[m+i,n]:=2;

m2:=m2+1

end;

1: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n-2]<>2) and

(b2[m-1,n-2]<>2) and

(b2[m,n-2]<>2) then

begin

for i:=0 to 1 do

b2[m,n-i]:=2;

m2:=m2+1

end

end;

9..10: case z of

0: if (b2[m,n]<>2) and

(b2[m-1,n-1]<>2) and

(b2[m-1,n]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m,n-1]<>2)and

(b2[m+1,n+1]<>2)and

(b2[m+1,n]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n-2]<>2) and

(b2[m-1,n-2]<>2) and

(b2[m,n-2]<>2) then

begin

for i:=0 to 1 do

b2[m,n-i]:=2;

m2:=m2+1

end;

1: if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m-2,n-1]<>2) and

(b2[m-2,n+1]<>2) and

(b2[m-2,n]<>2) then

begin

for i:=0 to 1 do

b2[m-i,n]:=2;

m2:=m2+1

end

end

end

end

end;

while m1<4 do begin

m:=random(10)+1;

n:=random(10)+1;

while m1<4 do begin

m:=random(10)+1;

n:=random(10)+1;

if (b2[m,n]<>2) and

(b2[m+1,n+1]<>2) and

(b2[m,n+1]<>2) and

(b2[m-1,n+1]<>2) and

(b2[m-1,n]<>2)and

(b2[m-1,n-1]<>2)and

(b2[m,n-1]<>2) and

(b2[m+1,n-1]<>2) and

(b2[m+1,n]<>2) then begin

b2[m,n]:=2;

m1:=m1+1;

end

end;

end;

end;

procedure TForm1.rastkor(Sender: TObject; Shift: TShiftState; X,

Y: Integer); //расстановка кораблей на поле игрока

begin

image1.Canvas.Brush.Color:=clwhite;

y1:=(Y div 20)+1;

x1:=(X div 20)+1;

For i:=1 to 10 do

for j:=1 to 10 do

begin

if (b1[i,j]<>2) and (b1[i,j]<>3) and (b1[i,j]<>4) then

begin

b1[i,j]:=0;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

end;

end;

if rot=false then begin //ротация кораблей по горизонтали

case k11 of //смотрит какой корабль надо располагать

0: begin if (b1[x1,y1]<>2) then

for i:=0 to 0 do

b1[x1+i,y1]:=1; end;

1: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2)then

for i:=0 to 1 do begin

b1[x1+i,y1]:=1 end; end;

2: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2) and (b1[x1+2,y1]<>2) then

for i:=0 to 2 do

b1[x1+i,y1]:=1; end;

3: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2) and (b1[x1+2,y1]<>2) and (b1[x1+3,y1]<>2) then

for i:=0 to 3 do

b1[x1+i,y1]:=1; end;

end;

For i:=1 to 10 do //рисует желтым цветом текущее положение корабля

for j:=1 to 10 do

begin

if (b1[i,j]=1) then

begin

image1.Canvas.Brush.Color:=clyellow;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*(i),20*(j));

end;

end;

end

else //ротация кораблей по вертикали

begin

case k11 of

0: begin if (b1[x1,y1]<>2) then

for i:=0 to 0 do

b1[x1,y1+i]:=1; end;

1: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2)then

for i:=0 to 1 do begin

b1[x1,y1+i]:=1 end; end;

2: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2) and (b1[x1,y1+2]<>2) then

for i:=0 to 2 do

b1[x1,y1+i]:=1; end;

3: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2) and (b1[x1,y1+2]<>2) and (b1[x1,y1+3]<>2) then

for i:=0 to 3 do

b1[x1,y1+i]:=1; end;

end;

For i:=1 to 10 do

for j:=1 to 10 do

begin

if (b1[i,j]=1) then

begin

image1.Canvas.Brush.Color:=clyellow;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*(i),20*(j));

end;

end;

end;

end;

procedure TForm1.nash(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer); //процедура постановки корабля

begin

x1:=(X div 20)+1;

y1:=(Y div 20)+1;

if k11>=0 then begin //смотрит поставлены все корабли или нет

if button=mbright then begin //производит ротацию корабля по нажатии правой кн мыши

if rot=true then

rot:=false

else

rot:=true;

begin

image1.Canvas.Brush.Color:=clwhite;

For i:=1 to 10 do //рисует в пустых клетках белые квадрвты

for j:=1 to 10 do

begin

if b1[i,j]<>2 then

begin

b1[i,j]:=0;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

end;

end;

if rot=false then begin //ротация кораблей по горизонтали

case k11 of //смотрит какой корабль сейчас надо расстанавливать

0: begin if (b1[x1,y1]<>2) then

b1[x1,y1]:=1; end;

1: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2)then

for i:=0 to 1 do begin

b1[x1+i,y1]:=1 end; end;

2: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2) and (b1[x1+2,y1]<>2) then

for i:=0 to 2 do

b1[x1+i,y1]:=1; end;

3: begin if (b1[x1,y1]<>2) and (b1[x1+1,y1]<>2) and (b1[x1+2,y1]<>2) and (b1[x1+3,y1]<>2) then

for i:=0 to 3 do

b1[x1+i,y1]:=1; end;

end;

For i:=1 to 10 do //рисует желтым цветом корабль(ещё не поставленный)

for j:=1 to 10 do

begin

if (b1[i,j]=1) then

begin

image1.Canvas.Brush.Color:=clyellow;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*(i),20*(j));

end;

end;

end

else //ротация кораблей по вертикали

begin

case k11 of //смотрит какой корабль сейчас надо расстанавливать

0: begin if (b1[x1,y1]<>2) then

b1[x1,y1]:=1; end;

1: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2)then

for i:=0 to 1 do begin

b1[x1,y1+i]:=1 end; end;

2: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2) and (b1[x1,y1+2]<>2) then

for i:=0 to 2 do

b1[x1,y1+i]:=1; end;

3: begin if (b1[x1,y1]<>2) and (b1[x1,y1+1]<>2) and (b1[x1,y1+2]<>2) and (b1[x1,y1+3]<>2) then

for i:=0 to 3 do

b1[x1,y1+i]:=1; end;

end;

For i:=1 to 10 do //рисует желтым цветом корабль(ещё не поставленный)

for j:=1 to 10 do

begin

if (b1[i,j]=1) then

begin

image1.Canvas.Brush.Color:=clyellow;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*(i),20*(j));

end;

end;

end;

end;

end

else

if rot=false then begin //ставит корабль по горизонтали

case k11 of //смотрит какой корабль ставить

0: case x1 of //смотрит есть ли рядом с однопалубным кораблём другие корабли

1: if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1]<>2) then

begin

b1[x1,y1]:=2;

riad:=true

end

else

riad:=false;

2..10: if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1-1,y1]<>2)and

(b1[x1-1,y1-1]<>2)and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1]<>2) then begin

b1[x1,y1]:=2;

riad:=true

end

else

riad:=false;

end;

1: case x1 of //смотрит есть ли рядом с двупалубным кораблём другие корабли

1:if(b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+2,y1-1]<>2) and

(b1[x1+2,y1+1]<>2) and

(b1[x1+2,y1]<>2) and (x1+1<11)

then

for i:=0 to k11 do

begin

b1[x1+i,y1]:=2;

riad:=true

end

else

riad:=false;

2..10: if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1-1,y1]<>2)and

(b1[x1-1,y1-1]<>2)and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+2,y1-1]<>2) and

(b1[x1+2,y1+1]<>2) and

(b1[x1+2,y1]<>2) and (x1+1<11) then

for i:=0 to k11 do begin

b1[x1+i,y1]:=2;

riad:=true

end

else

riad:=false;

end;

2: case x1 of //смотрит есть ли рядом с трехпалубным кораблём другие корабли

1: if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+2,y1-1]<>2) and

(b1[x1+2,y1+1]<>2) and

(b1[x1+3,y1-1]<>2) and

(b1[x1+3,y1+1]<>2) and

(b1[x1+3,y1]<>2) and (x1+2<11) then

for i:=0 to k11 do begin

b1[x1+i,y1]:=2;

riad:=true

end

else

riad:=false;

2..10:

if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1-1,y1]<>2)and

(b1[x1-1,y1-1]<>2)and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+2,y1-1]<>2) and

(b1[x1+2,y1+1]<>2) and

(b1[x1+3,y1-1]<>2) and

(b1[x1+3,y1+1]<>2) and

(b1[x1+3,y1]<>2) and (x1+2<11) then

for i:=0 to k11 do begin

b1[x1+i,y1]:=2;

riad:=true

end

else

riad:=false

end;

3: if x1+3<11 then //ставит четырехпалубный корабль

begin

for i:=0 to k11 do

b1[x1+i,y1]:=2;

riad:=true

end

else

riad:=false;

end;

if riad=true then begin //смотрит если корабль поставлен то уменьшает счетчик

if (k11=3) then

begin;

k11:=k11-1;

end;

if (k11=2) and (k33=0) then

begin

k11:k11-1;

k33:=k33-1

end

else

k33:=k33-1;

if (k11=1) and (k32=0) then

begin

k1:=k11-1;

k32:=k32-1

end

else

k32:=k32-1;

if (k11=0) and (k31=0) then

begin

k11:=k11-1;

k31:=k31-1

end

else

k31:=k31-1;

end;

end

else //ставит корабль по горизонтали

begin

case k11 of //смотрит какой корабль ставить

0: case x1 of //смотрит есть ли рядом с однопалубным кораблём другие корабли

1: if (b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1]<>2) then

begin

b1[x1,y1]:=2;

riad:=true

end

else

riad:=false;

2..10: if

(b1[x1,y1]<>2) and

(b1[x1+1,y1+1]<>2) and

(b1[x1,y1+1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1-1,y1]<>2)and

(b1[x1-1,y1-1]<>2)and

(b1[x1,y1-1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1]<>2) then begin

b1[x1,y1]:=2;

riad:=true

end

else

riad:=false;

end;

1: case x1 of //смотрит есть ли рядом с двупалубным кораблём другие корабли

1: if (b1[x1,y1]<>2) and

(b1[x1,y1-1]<>2)and

(b1[x1+1,y1+1]<>2)and

(b1[x1+1,y1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1+2]<>2) and

(b1[x1,y1+2]<>2) and (y1+1<11) then

for i:=0 to k11 do begin

b1[x1,y1+i]:=2;

riad:=true

end

else

riad:=false;

2..10:

if (b1[x1,y1]<>2) and

(b1[x1-1,y1-1]<>2) and

(b1[x1-1,y1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1,y1-1]<>2)and

(b1[x1+1,y1+1]<>2)and

(b1[x1+1,y1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1+2]<>2) and

(b1[x1-1,y1+2]<>2) and

(b1[x1,y1+2]<>2) and (y1+1<11) then

for i:=0 to k11 do begin

b1[x1,y1+i]:=2;

riad:=true

end

else

riad:=false

end;

2: case x1 of //смотрит есть ли рядом с двупалубным кораблём другие корабли

1:if (b1[x1,y1]<>2) and

(b1[x1,y1-1]<>2)and

(b1[x1+1,y1+1]<>2)and

(b1[x1+1,y1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1+2]<>2) and

(b1[x1+1,y1+3]<>2) and

(b1[x1,y1+3]<>2) and (y1+2<11) then

for i:=0 to k11 do begin

b1[x1,y1+i]:=2;

riad:=true

end

else

riad:=false;

2..10:

if (b1[x1,y1]<>2) and

(b1[x1-1,y1-1]<>2) and

(b1[x1-1,y1]<>2) and

(b1[x1-1,y1+1]<>2) and

(b1[x1,y1-1]<>2)and

(b1[x1+1,y1+1]<>2)and

(b1[x1+1,y1]<>2) and

(b1[x1+1,y1-1]<>2) and

(b1[x1+1,y1+2]<>2) and

(b1[x1-1,y1+2]<>2) and

(b1[x1+1,y1+3]<>2) and

(b1[x1-1,y1+3]<>2) and

(b1[x1,y1+3]<>2) and (y1+2<11) then

for i:=0 to k11 do begin

b1[x1,y1+i]:=2;

riad:=true

end

else

riad:=false

end; //ставит 4палубный корабль

3: if y1+3<11 then

begin

for i:=0 to k11 do

b1[x1,y1+i]:=2;

riad:=true

end

else

riad:=false

end;

if riad=true then begin //смотрит если корабль поставлен то уменьшает счетчик

if (k11=3) then

begin;

k11:=k11-1;

end;

if (k11=2) and (k33=0) then

begin

k11:=k11-1;

k33:=k33-1

end

else

k33:=k33-1;

if (k11=1) and (k32=0) then

begin

k11:=k11-1;

k32:=k32-1

end

else

k32:=k32-1;

if (k11=0) and (k31=0) then

begin

k11:=k11-1;

k31:=k31-1

end

else

k31:=k31-1;

end;

end;

For i:=1 to 10 do //закрашивает поставленные корабли Серым

for j:=1 to 10 do

begin

if b1[i,j]=2 then

begin

image1.Canvas.Brush.Color:=clgray;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

end;

end;

if k11<0 then begin //проверяет поставлены ли все корабли, если "да" то начинает игру с компьютером

label12.Height:=0;

label13.Height:=13;

label14.Height:=13;

label15.Height:=13;

label16.Height:=13;

label17.Height:=13;

label18.Height:=13;

label19.Height:=13;

label20.Height:=13;

label21.Height:=13;

label22.Height:=13;

label23.Height:=13;

label26.Height:=13;

image2.Height:=200;

image2.Width:=200;

for i:=1 to 10 do //ресует белую сетку поля компьютера

for j:=1 to 10 do begin

image2.Canvas.Brush.Color:=clwhite;

image2.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j) end

end

end;

end;

procedure TForm1.N2Click(Sender: TObject); //начинает новыю игру

begin

image1.Canvas.Brush.Color:=clwhite;

rot:=false;

k11:=3;

k33:=2;

k32:=5;

k31:=9;

label12.Height:=62;

image2.Height:=0;

For i:=1 to 10 do //обнуляет массивы

for j:=1 to 10 do

begin

b1[i,j]:=0;

b2[i,j]:=0;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

end;

FormCreate(self); //использует процедуру создания формы

end;

procedure TForm1.vistrel(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer); //процедура обмена выстрелов

begin

x1:=(X div 20)+1;

y1:=(Y div 20)+1;

if kon=false then begin //проверка закончилась игра или нет

case b2[x1,y1] of

0: b2[x1,y1]:=3; //если попал в пустую клетка становится - просреленной пустой

2: b2[x1,y1]:=4; //если попал в клетку с кораблем то она становится- подбитой

3,4: exit; //если попал в клетку в которую уже стрелял то ничего не происходит

end;

for i:=1 to 10 do //рисуется графическое поле компютера

for j:=1 to 10 do

begin

case b2[i,j] of

4: begin //клетка в котрой стоит подбитый или не доконца подбитый корабль

if ((b2[i+1,j]=2) //не доконца подбитый корабль

or(b2[i,j+1]=2)

or(b2[i-1,j]=2)

or(b2[i,j-1]=2))

or (((b2[i+1,j]=4)and(b2[i+2,j]=2))

or((b2[i,j+1]=4)and(b2[i,j+2]=2))

or((b2[i-1,j]=4)and(b2[i-2,j]=2))

or((b2[i,j-1]=4)and(b2[i,j-2]=2)))

or(((b2[i+1,j]=4)and(b2[i+2,j]=4) and (b2[i+3,j]=2))

or((b2[i,j+1]=4)and(b2[i,j+2]=4)and(b2[i,j+3]=2))

or((b2[i-1,j]=4)and(b2[i-2,j]=4)and(b2[i-3,j]=2))

or((b2[i,j-1]=4)and(b2[i,j-2]=4)and(b2[i,j-3]=2)))

then

begin

image2.Canvas.Brush.Color:=clgray;

image2.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j);

image2.Canvas.pen.Color:=clred;

image2.Canvas.MoveTo(20*i-19,20*j-19);

image2.Canvas.LineTo(20*i-1,20*j-1);

image2.Canvas.MoveTo(20*i-1,20*j-19);

image2.Canvas.LineTo(20*i-19,20*j-1);

image2.Canvas.pen.Color:=clblack;

end

else //подбитый корабль

begin

image2.Canvas.Brush.Color:=clred;

image2.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j)

end;

end;

3: begin //простреленная пустая клетка

image2.Canvas.Brush.Color:=clwhite;

image2.Canvas.Rectangle(20*i-15,20*j-15,20*i-5,20*j-5)

end;

end;

end;

win:=true;

For i:=1 to 10 do //если находится хотябы один неподбитый корабль то победы нет

for j:=1 to 10 do

if b2[i,j]=2 then

win:=false;

if win=true then //вывод сообщения при победе

begin

showmessage ('Поздравляю!'+#13+'Вы победили.');

kon:=true;

exit

end;

if b2[x1,y1]=4 then //если игрок попал то компьютер не ходит

exit;

bum:=false;

cokil:=true;

while (bum=false) or (cokil=true) do //стрел-ть до тех пор пока не попал в клетку в которую не стрылял и если она пустая

begin

m:=random(10)+1;

n:=random(10)+1;

case b1[m,n] of

0: begin

b1[m,n]:=3;

bum:=true;

cokil:=false

end;

2: begin

b1[m,n]:=4;

bum:=true;

cokil:=true

end

end;

For i:=1 to 10 do //рисуется графическое поле игрока

for j:=1 to 10 do

begin

case b1[i,j] of

3: begin //простреленая пустая клетка

image1.Canvas.Brush.Color:=clwhite;

image1.Canvas.Rectangle(20*i-15,20*j-15,20*i-5,20*j-5)

end;

4:begin //клетка в котрой стоит подбитый или не доконца подбитый корабль

if ((b1[i+1,j]=2)

or(b1[i,j+1]=2)

or(b1[i-1,j]=2)

or(b1[i,j-1]=2))

or(((b1[i+1,j]=4)and(b1[i+2,j]=2))

or((b1[i,j+1]=4)and(b1[i,j+2]=2))

or((b1[i-1,j]=4)and(b1[i-2,j]=2))

or((b1[i,j-1]=4)and(b1[i,j-2]=2)))

or(((b1[i+1,j]=4)and(b1[i+2,j]=4)and(b1[i+3,j]=2))

or((b1[i,j+1]=4)and(b1[i,j+2]=4)and(b1[i,j+3]=2))

or((b1[i-1,j]=4)and(b1[i-2,j]=4)and(b1[i-3,j]=2))

or((b1[i,j-1]=4)and(b1[i,j-2]=4)and(b1[i,j-3]=2)))

then begin //не доконца подбитый корабль

image1.Canvas.pen.Color:=clred;

image1.Canvas.MoveTo(20*i-19,20*j-19);

image1.Canvas.LineTo(20*i-1,20*j-1);

image1.Canvas.MoveTo(20*i-1,20*j-19);

image1.Canvas.LineTo(20*i-19,20*j-1);

image1.Canvas.pen.Color:=clblack;

end

else //подбитый корабль

begin

image1.Canvas.Brush.Color:=clred;

image1.Canvas.Rectangle(20*i-20,20*j-20,20*i,20*j)

end;

end;

end;

end;

end;

lose:=true;

For i:=1 to 10 do //если находится хотябы один неподбитый корабль то проигрыша нет

for j:=1 to 10 do

if b1[i,j]=2 then

lose:=false;

if lose=true then

begin

kon:=true;

showmessage ('Вы проиграли.'+#13+'Попробуйте ещё раз!');

exit

end;

end;

end;

procedure TForm1.N3Click(Sender: TObject); //процедура нажатия на кнопку "выход"

begin

close

end;

procedure TForm1.N5Click(Sender: TObject); //процедура нажатия на кнопку "О программе..."

begin

form2.ShowModal

end;

procedure TForm1.N6Click(Sender: TObject);

begin

winhelp(Form1.Handle,'morb.hlp',HELP_CONTEXT,1);

end;

end.

Приложение Б

Изм.

Лист

№ докум.

Подпись

Дата

Лист

КП ПО21.1206.081 ПЗ

Разраб.

Брилевский В.А

Провер.

Клыбик С.Л

Реценз.

Н. Контр.

Утверд.

Приложение Б

Лит.

Листов

НГАЭК,2015

Руководство пользователя

Дата добавления: 2015-08-31