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 b 2[ x 1, y 1] of

0: b 2[ x 1, y 1]:=3;     //если попал в пустую клетка становится - просреленной пустой

2: b 2[ x 1, y 1]:=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 ((b 2[ 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 b 2[ x 1, y 1]=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

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

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

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

end;

procedure TForm2.Button1Click(Sender: TObject);

Begin

Close

end;

End.