Разработка приложения для Windows, представ-ляющего собой компьютерную игру “Морской бой”

    2.3 Текст программы

 

unit Unit1; 

interface 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids,

  Menus, StdCtrls, ExtCtrls; 

type

 Arr= Array [1..10,1..10] of byte;

// Массив поля, в  который записываются  координаты кораблей

 TMainform = class(TForm)

  Comppole: TDrawGrid;

  MainMenu1: TMainMenu;

  Menu1: TMenuItem;

  Menu2: TMenuItem;

  Menu3: TMenuItem;

  Manpole: TDrawGrid;

  Label1: TLabel;

  Label2: TLabel;

  procedure Menu3Click(Sender: TObject);

  procedure ManpoleClick(Sender: TObject);

  procedure Menu2Click(Sender: TObject);

  function Proverka(XStart,YStart:Byte;Target_obj:TDrawGrid;var Ar:Arr):Boolean;

  procedure Generate;

  procedure ComppoleMouseDown(Sender: TObject; Button: TMouseButton;

   Shift: TShiftState; X, Y: Integer);

  procedure ComppoleMouseUp(Sender: TObject; Button: TMouseButton;

   Shift: TShiftState; X, Y: Integer);

  procedure CompRun;

  procedure FormCreate(Sender: TObject);

  procedure FormPaint(Sender: TObject);

  function Win:Boolean;

  function ArRound(Ar:Arr; var Xn,Yn,Xe,Ye:Integer):Boolean;

private

  { Private declarations }

 public

  { Public declarations }

end; 
 

var

  Mainform: TMainform;

  x, y, mx, my, vx, vy: integer;

  // X, Y - текущие координаты "удара" компьютера

  // mX, mY - случайное направление   продолжения удара  компьютера

  // vX, vY - вспомогательные  переменные 

  Size: byte;

  // Size - для определения  количества ещё  не расставленных  кораблей в начале  игры

  Man, Comp: Arr;

  // Массивы полей компьютера и игрока

  Boat: array[1..10] of byte;

  // Вспомогательный массив, используется компьютером при расстановке кораблей 

implementation 

{$R *.DFM} 

procedure TMainform.Menu3Click(Sender: TObject);

// Закрытие главного окна, при выборе в главном меню пункта "Выход"

begin

 Mainform.Close;

end; 

Procedure Draw(X,Y:Byte;Tr:Boolean;Obj:TDrawGrid;var Ar:Arr);

// Вывод на компонент  DrawGrid состояния ячейки  массива Ar

Begin

If (Tr)and(Ar[X,Y]=1) Then

  Begin

   With Mainform do

    If Obj.Name='Comppole' Then Comppole.Tag:=Comppole.Tag-1

                           Else Manpole.Tag:=Manpole.Tag-1;

  End;

If (Tr)And(Ar[X,Y]<2) Then Ar[X,Y]:=Ar[X,Y]+2;

 Case Ar[x,y] of

1:If Obj.Name='Comppole' then

    Begin

     Obj.Canvas.Brush.Color:=ClAqua;

     Obj.Canvas.FillRect(Rect(21*(x-1),21*(y-1),21*(x-1)+20,21*(y-1)+20));

    End;

2:Begin

    Obj.Canvas.Pen.Color:=ClFuchsia;

    Obj.Canvas.Pen.Width:=2;

    Obj.Canvas.MoveTo(21*(x-1)+2,21*(y-1)+2);

    Obj.Canvas.LineTo(21*(x-1)+18,21*(y-1)+18);

    Obj.Canvas.MoveTo(21*(x-1)+18,21*(y-1)+2);

    Obj.Canvas.LineTo(21*(x-1)+2,21*(y-1)+18);

   End;

3:Begin

    Obj.Canvas.Brush.Color:=ClRed;

    Obj.Canvas.FillRect(Rect(21*(x-1),21*(y-1),21*(x-1)+20,21*(y-1)+20));

   End;

 End;

End; 

function TMainForm.Proverka(XStart,YStart:Byte;Target_obj:TDrawGrid; var Ar:Arr):Boolean;

// Проверка полного  уничтожения корабля  и вывод его  состояния

var Vx,Vy:byte;

Begin

Vx:=0; Vy:=0;

Proverka:=False;

If (Ar[XStart,YStart] in [0,2]) then exit;

If (XStart>1)And(Ar[XStart-1,YStart] in [1,3]) or

    (XStart<10)And(Ar[XStart+1,YStart] in [1,3]) Then Vx:=1;

If (YStart>1)And(Ar[XStart,YStart-1] in [1,3]) or

    (YStart<10)And(Ar[XStart,YStart+1] in [1,3]) Then Vy:=1;

// Проверка по оси  X

 If Vx=1 then

  Begin

   Vx:=XStart;

   While Ar[Vx,YStart]=3 Do

   If Vx<10 Then inc(Vx)

            Else break;

   If Ar[Vx,YStart]=1 Then Exit;

   Vx:=XStart;

   While Ar[Vx,YStart]=3 Do

    If Vx>1 Then dec(Vx)

            Else Break;

   If Ar[Vx,YStart]=1 Then Exit;

   Vx:=1;

  End;

// Проверка по оси  Y

 If Vy=1 then

  Begin

   Vy:=YStart;

   While Ar[XStart,Vy]=3 Do

    If Vy<10 Then inc(Vy)

             Else break;

   If Ar[XStart,Vy]=1 Then Exit;

   Vy:=YStart; 
 

   While Ar[XStart,Vy]=3 Do

    If Vy>1 Then dec(Vy)

            Else Break;

   If Ar[XStart,Vy]=1 Then Exit;

   Vy:=1;

  End;

Proverka:=True;

If (Vx=0)And(Vy=0) Then

  Begin

   Vx:=1;

   Vy:=1;

  End;

// Прорисовка корабля  по оси X

 If Vx=1 then

  Begin

  Vx:=XStart+1;

   Repeat

    dec(Vx);

    If YStart>1 Then Draw(Vx,YStart-1,True,Target_obj,Ar);

    If YStart<10 Then Draw(Vx,YStart+1,True,Target_obj,Ar);

   Until (Ar[Vx,YStart]<>3)or(Vx<2);

   If Vx>0 then Draw(Vx,YStart,True,Target_obj,Ar);

   Vx:=XStart-1;

   Repeat

    inc(Vx);

    If YStart>1 Then Draw(Vx,YStart-1,True,Target_obj,Ar);

    If YStart<10 Then Draw(Vx,YStart+1,True,Target_obj,Ar);

   Until (Ar[Vx,YStart]<>3)or(Vx>9);

   If Vx<11 then Draw(Vx,YStart,True,Target_obj,Ar);

  End;

// Прорисовка корабля  по оси Y

 If Vy=1 then

  Begin

   Vy:=YStart+1;

   Repeat

    dec(Vy);

    If XStart>1 then Draw(XStart-1,Vy,True,Target_obj,Ar);

    If XStart<10 then Draw(XStart+1,Vy,True,Target_obj,Ar);

   Until (Ar[XStart,Vy]<>3)or(Vy<2);

  If Vy>0 then Draw(XStart,Vy,True,Target_obj,Ar);

   Vy:=YStart-1;

   Repeat

    inc(Vy);

    If XStart>1 then Draw(XStart-1,Vy,True,Target_obj,Ar);

    If XStart<10 then Draw(XStart+1,Vy,True,Target_obj,Ar);

   Until (Ar[XStart,Vy]<>3)or(Vy>9);

   If Vy<11 then Draw(XStart,Vy,True,Target_obj,Ar);

  End;

End; 

function TMainform.Win:Boolean;

// Проверка победы компьютера или игрока

// Возвращает значение True, если значение Tag равно нулю

Begin

Win:=False;

// Проверка победы игрока

If Manpole.Tag=0 then

  Begin

   Manpole.Enabled:=False;

   Win:=True;

   if MessageDlg('Вы выиграли!'+#13+#10+'Переиграть?',mtConfirmation,[MbOk,

      MbCancel],0)=1 Then Menu2.Click

                   Else Mainform.Close;

  End; 

// Проверка победы компьютера

 If Comppole.Tag=0 then

  Begin

   Manpole.Enabled:=False;

   Win:=True;

  If MessageDlg('Вы проиграли!'+#13+#10+'Переиграть?',mtConfirmation,[MbOk,

      MbCancel],0)=1 Then Menu2.Click

                     Else Mainform.Close;

  End;

End; 

function TMainForm.ArRound(Ar:Arr; var Xn,Yn,Xe,Ye:Integer):Boolean;

// Защита от расстановки  кораблей друг  на друга

var t1,t2:integer;

    // Вспомогательные переменные

    cu,cd,cr,cl:byte;

    // Направление проверки: cu - вверх, cd - вниз, cr - вправо, cl - влево

Begin

ArRound:=True;

If Xn>Xe Then

  Begin

   t1:=Xn;

   Xn:=Xe;

   Xe:=t1;

  End;

If Yn>Ye Then

  Begin

   t1:=Yn;

   Yn:=Ye;

   Ye:=t1;

  End;

cu:=1; cd:=1; cl:=1; cr:=1;

If Yn=1 Then cu:=0;

If Ye=10 Then cd:=0;

If Xn=1 Then cl:=0;

If Xe=10 Then cr:=0;

For t1:=Xn-cl to Xe+cr do

  For t2:=Yn-cu to Ye+cd do

   If Ar[t1,t2]=1 Then

    Begin

     ArRound:=False;

     Exit;

    End;

end; 

procedure TMainform.CompRun;

// Процедура хода  компьютера

Label 1;

Begin

// Выбор случайной  координаты, если  они не равны  нулю

1:If (mX=0)and(mY=0) then repeat

                           mX:=random(10)+1;

                           mY:=random(10)+1;

                           If Win Then Exit;

                          until Comp[mX,mY]<2;

Draw(mX,mY,True,Comppole,Comp);