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

Font – синий, размер 10;

Caption – “Поле компьютера:”.

6 – компонент Manpole.

Свойства:

ColCount – 10;

DefaultColWidth – 20;

DefaultRowHeight – 20;

RowCount – 10;

События:

ManpoleClick – происходит при выборе игроком координаты удара. 
 
 
 

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

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:=ClYellow;

     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:=ClBlue;

    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;