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

PlaySound('BUM_WAV', HInstance, SND_RESOURCE or SND_ASYNC or SND_NOWAIT);

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

PlaySound('POBEDA_WAV', HInstance, SND_RESOURCE or SND_ASYNC or SND_NOWAIT);

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

PlaySound('PORAJENIE_WAV', HInstance, SND_RESOURCE or SND_ASYNC or SND_NOWAIT);

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.

         

 

Приложение 4. Исходный код модуля второй формы «Unit2.pas»

 

unit Unit2;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, jpeg, ExtCtrls;

Type

TForm2 = class(TForm)

Image1: TImage;

Label1: TLabel;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

Var

Form2: TForm2;

Implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

Begin

label1.Caption:='Курсовая работа студента 4-ого курса'+

           #13+#13+'факультета информатики'+

           #13+#13+'Круглова В.Н.'

end;

procedure TForm2.Button1Click(Sender: TObject);

Begin

Close

end;

End.