back 10/04

unit StartUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.StdCtrls, ConstructorUnit;

type
  TStartForm = class(TForm)
    BackgroundImage: TImage;
    StartLabel: TLabel;
    SettingsLabel: TLabel;
    AboutDeveloperLabel: TLabel;
    ManualLabel: TLabel;
    ExitLabel: TLabel;
    procedure LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LabelMouseLeave(Sender: TObject);
    procedure LabelMouseEnter(Sender: TObject);
    procedure ExitLabelClick(Sender: TObject);
    procedure StartLabelClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  StartForm: TStartForm;

implementation

{$R *.dfm}

procedure TStartForm.ExitLabelClick(Sender: TObject);
begin
    StartForm.Close;
end;

procedure TStartForm.LabelMouseEnter(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clBlack;
    end;
end;

procedure TStartForm.LabelMouseLeave(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clGrayText;
    end;
end;

procedure TStartForm.LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    with Sender as TLabel do
    begin
        Font.Color := clBlack;
    end;
end;

procedure TStartForm.StartLabelClick(Sender: TObject);
begin
    StartForm.Hide;
    ConstructorForm.ShowModal;
    StartForm.Show;
end;

end.















unit ConstructorUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TConstructorForm = class(TForm)
    MainMenu: TMainMenu;
    FileMenuItem: TMenuItem;
    ManualMenuItem: TMenuItem;
    AboutDeveloperMenuItem: TMenuItem;
    LoadTemplateMenuItem: TMenuItem;
    SaveTemplateMenuItem: TMenuItem;
    BackLabel: TLabel;
    StartLabel: TLabel;
    UserFieldImage: TImage;
    LongShip: TImage;
    MiddleShip: TImage;
    SmallShip: TImage;
    ShortShip: TImage;
    PopupMenu: TPopupMenu;
    DeleteShipButton: TMenuItem;
    TurnButton: TMenuItem;
    GenerateFieldButton: TLabel;
    procedure LabelMouseEnter(Sender: TObject);
    procedure LabelMouseLeave(Sender: TObject);
    procedure BackLabelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure UserFieldImageDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure UserFieldImageDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure UserFieldImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UserFieldImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure UserFieldImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShipStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure DeleteShipButtonClick(Sender: TObject);
    procedure TurnButtonClick(Sender: TObject);
    procedure GenerateFieldButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ConstructorForm: TConstructorForm;

implementation

uses
    GridUnit, FieldGeneratorUnit;

const
    CELL_WIDTH = 30;
var
    Field, BufField, NewField: TField;
    ImpossibleCellsMatrix, BufMatrix: TImpossibleCellsMatrix;
    ShipsCountArr: TShipsCountArray;
    IsDrag, IsMovingShipHorizontal, IsShipPlaced: Boolean;

    MovingShipType: TShip;
    MovingShipCol, MovingShipRow: ShortInt;

{$R *.dfm}

procedure TConstructorForm.BackLabelClick(Sender: TObject);
begin
    ConstructorForm.Close;
end;

procedure TConstructorForm.LabelMouseEnter(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clBlack;
    end;
end;

procedure TConstructorForm.LabelMouseLeave(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clGrayText;
    end;
end;

procedure HideShipImage(Ship: TShip);
begin
    with ConstructorForm do
        case Ship of
            tShortShip:
                ShortShip.Visible := False;
            tSmallShip:
                SmallShip.Visible := False;
            tMiddleShip:
                MiddleShip.Visible := False;
            tLongShip:
                LongShip.Visible := False;
        end;
end;

procedure ShowShipImage(Ship: TShip);
begin
    with ConstructorForm do
        case Ship of
            tShortShip:
                ShortShip.Visible := True;
            tSmallShip:
                SmallShip.Visible := True;
            tMiddleShip:
                MiddleShip.Visible := True;
            tLongShip:
                LongShip.Visible := True;
        end;
end;

procedure DrawShips();
begin
    with ConstructorForm do
    begin
        DrawShip(LongShip, 4, 1);
        LongShip.Visible := True;

        DrawShip(MiddleShip, 3, 1);
        MiddleShip.Visible := True;

        DrawShip(SmallShip, 2, 1);
        SmallShip.Visible := True;

        DrawShip(ShortShip, 1, 1);
        ShortShip.Visible := True;
    end;
end;

procedure HideShips();
begin
    with ConstructorForm do
    begin
        LongShip.Visible := False;
        MiddleShip.Visible := False;
        SmallShip.Visible := False;
        ShortShip.Visible := False;
    end;
end;

procedure ClearShipsCountArr(var ShipsCountArr: TShipsCountArray);
var
    I: TShip;
begin
    for I := Low(ShipsCountArr) to High(ShipsCountArr) do
        ShipsCountArr[I] := 0;
end;

procedure TConstructorForm.FormShow(Sender: TObject);
begin
    Field := CreateField();
    ImpossibleCellsMatrix := CreateImpossibleCellsMatrix();
    DrawShips();
    ShipsCountArr := IinializeShipsCountArray();
    IsShipPlaced := False;
    DrawField(UserFieldImage, Field);
end;

procedure TConstructorForm.GenerateFieldButtonClick(Sender: TObject);
begin
    ImpossibleCellsMatrix := CreateImpossibleCellsMatrix();
    Field := GenerateField(ImpossibleCellsMatrix);
    HideShips();
    ClearShipsCountArr(ShipsCountArr);
    DrawField(UserFieldImage, Field);
end;

function ConvertImageToShipType(MovingShip: TImage): TShip;
const
    TempArr: array [1..4] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
var
    DeckCount: Byte;
begin
    DeckCount := MovingShip.Width div CELL_WIDTH;
    ConvertImageToShipType := TempArr[DeckCount];
end;

procedure TConstructorForm.ShipStartDrag(Sender: TObject;
  var DragObject: TDragObject);
var
    MovingShip: TImage;
begin
    MovingShip := TImage(Sender);
    IsMovingShipHorizontal := True;
    MovingShipType := ConvertImageToShipType(MovingShip);
end;

procedure TConstructorForm.UserFieldImageDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
    Col, Row: ShortInt;
begin
    Col := X div CELL_WIDTH;
    Row := Y div CELL_WIDTH;

    Accept := CanPlaceShipHere(Field, MovingShipType, Col, Row, IsMovingShipHorizontal);
    if Accept then
    begin
        BufField := Field;
        PlaceShipHere(BufField, MovingShipType, Col, Row, IsMovingShipHorizontal);
        DrawField(UserFieldImage, BufField);
    end;

    if State = dsDragLeave then
        DrawField(UserFieldImage, Field);
end;

procedure TConstructorForm.UserFieldImageDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
    Col, Row: Byte;
begin
    Col := X div CELL_WIDTH;
    Row := Y div CELL_WIDTH;

    Dec(ShipsCountArr[MovingShipType]);
    if ShipsCountArr[MovingShipType] = 0 then
        HideShipImage(MovingShipType);

    Field := BufField;
    FillImpossibleCellsMatrix(ImpossibleCellsMatrix, MovingShipType, Col, Row, IsMovingShipHorizontal);

    DrawField(UserFieldImage, Field);
end;

procedure TConstructorForm.TurnButtonClick(Sender: TObject);
var
   FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, I: ShortInt;
   CanPlace: Boolean;
begin
    BufField := Field;
    FindSideOfShip(BufField, MovingShipType, MovingShipCol, MovingShipRow, FirstSideCol, FirstSideRow, IsMovingShipHorizontal, -1);
    FindSideOfShip(BufField, MovingShipType, MovingShipCol, MovingShipRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal, 1);

    DeleteShip(BufField, ImpossibleCellsMatrix, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal);

    if CanPlaceShipHere(BufField, MovingShipType, MovingShipCol, MovingShipRow, not IsMovingShipHorizontal) then
    begin
        PlaceShipHere(BufField, MovingShipType, MovingShipCol, MovingShipRow, not IsMovingShipHorizontal);
        Field := BufField;
        FillImpossibleCellsMatrix(ImpossibleCellsMatrix, MovingShipType, MovingShipCol, MovingShipRow, not IsMovingShipHorizontal);
    end
    else
    begin
        I := -1;
        repeat
            Inc(I);
            CanPlace := CanPlaceShipInLine(BufField, MovingShipType, I, not IsMovingShipHorizontal);
        until CanPlace or (I = High(Field));

        if CanPlace then
        begin
            PlaceShipInLine(BufField, ImpossibleCellsMatrix, MovingShipType, I, not IsMovingShipHorizontal);
            Field := BufField;
        end;
    end;
    DrawField(UserFieldImage, Field);
end;

procedure TConstructorForm.DeleteShipButtonClick(Sender: TObject);
var
    FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow: ShortInt;
begin
    FindSideOfShip(Field, MovingShipType, MovingShipCol, MovingShipRow, FirstSideCol, FirstSideRow, IsMovingShipHorizontal, -1);
    FindSideOfShip(Field, MovingShipType, MovingShipCol, MovingShipRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal, 1);

    DeleteShip(Field, ImpossibleCellsMatrix, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal);
    DrawField(UserFieldImage, Field);

    Inc(ShipsCountArr[MovingShipType]);
    if ShipsCountArr[MovingShipType] = 1 then
        ShowShipImage(MovingShipType);
end;

procedure TConstructorForm.UserFieldImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    Col, Row, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow: ShortInt;
    IsShip: Boolean;
begin
    Col := X div CELL_WIDTH;
    Row := Y div CELL_WIDTH;

    IsShip := Ord(Field[Col, Row]) > 0;
    if IsShip then
    begin
        MovingShipType := ConvertFieldStateToShip(Field[Col, Row]);
        IsMovingShipHorizontal := IsShipInFieldHorizontal(Field, MovingShipType, Col, Row);

        case Button of
            mbLeft:
            begin
                IsDrag := True;

                BufField := Field;
                BufMatrix := ImpossibleCellsMatrix;

                FindSideOfShip(BufField, MovingShipType, Col, Row, FirstSideCol, FirstSideRow, IsMovingShipHorizontal, -1);
                FindSideOfShip(BufField, MovingShipType, Col, Row, SecondSideCol, SecondSideRow, IsMovingShipHorizontal, 1);

                DeleteShip(BufField, BufMatrix, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal);
            end;
            mbRight:
            begin
                MovingShipCol := Col;
                MovingShipRow := Row;

                X := X + Left + UserFieldImage.Left+15;
                Y :=  Y + Top + UserFieldImage.Top + 30;
                PopupMenu.Popup(X, Y);
            end;
            mbMiddle: ;
        end;
    end;
end;

procedure TConstructorForm.UserFieldImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
    Col, Row: ShortInt;
    CanPlaceShip, IsCursorOnField: Boolean;
begin
    if IsDrag then
    begin
        Col := X div CELL_WIDTH;
        Row := Y div CELL_WIDTH;

        IsCursorOnField := (Col > -1) and (Col < 10)  and (Row > -1) and (Row < 10);
        if IsCursorOnField then
        begin
            NewField := BufField;

            CanPlaceShip := CanPlaceShipHere(NewField, MovingShipType, Col, Row, IsMovingShipHorizontal);
            if CanPlaceShip then
            begin
                PlaceShipHere(NewField, MovingShipType, Col, Row, IsMovingShipHorizontal);
                DrawField(UserFieldImage, NewField);

                MovingShipCol := Col;
                MovingShipRow := Row;

                Field := NewField;
                IsShipPlaced := True;
            end;
        end;
    end;
end;

procedure TConstructorForm.UserFieldImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if IsDrag and IsShipPlaced then
    begin
        FillImpossibleCellsMatrix(BufMatrix, MovingShipType, MovingShipCol, MovingShipRow, IsMovingShipHorizontal);
        ImpossibleCellsMatrix := BufMatrix;
    end;
    IsShipPlaced := False;
    IsDrag := False;
    DrawField(UserFieldImage, Field);
end;
end.























unit FieldGeneratorUnit;

interface
type
    TFieldCellState = (stImpossible = -1, stFree, stShortShip, stSmallShip, stMiddleShip, stLongShip);
    TField = array [-1..10, -1..10] of TFieldCellState;
    TImpossibleCellsMatrix = array [-1..10, -1..10] of ShortInt;

    TShip = (tShortShip = 1, tSmallShip, tMiddleShip, tLongShip);
    TShipsArray = array [0..9] of TShip;
    TShipsCountArray = array [TShip] of Byte;

    TReturnCellStateFunction = function (ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
    TReturnLineCellStateFunction = function (ShipField: TField; J, I: ShortInt): TFieldCellState;
    TPlaceShipProcedure = procedure (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
    TCompareFunction = function(ShootField: TField; Ship: TShip; Col, Row, I: ShortInt): Boolean;

    TCellsArray = array [0..99] of Byte;

    function CreateField(): TField;
    function CreateImpossibleCellsMatrix(): TImpossibleCellsMatrix;
    function IinializeShipsCountArray(): TShipsCountArray;
    function GenerateField(var ImpossibleCellsMatrix: TImpossibleCellsMatrix): TField;
    procedure FillImpossibleCellsMatrix(var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);

    procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var SideCol: ShortInt; var SideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
    procedure DeleteShip (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col1, Row1, Col2, Row2: ShortInt; IsHorizontal: Boolean);

    function CanPlaceShipHere(Field: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean): Boolean;
    procedure PlaceShipHere(var Field: TField; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
    function CanPlaceShipInLine(Field: TField; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): Boolean;
    procedure PlaceShipInLine(var Field: TField; var ImpossibleCellsMatrix: TImpossibleCellsMatrix; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean);
    function IsShipInFieldHorizontal(Field: TField; Ship: TShip; Col, Row: ShortInt): Boolean;

    function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
    function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
implementation

function CreateField(): TField;
var
    I, J: ShortInt;
    NewField: TField;
begin
    for J := Low(NewField) to High(NewField) do
        NewField[-1, J] := stImpossible;

    for I := Low(NewField)+1 to High(NewField)-1 do
    begin
        for J := Low(NewField)+1 to High(NewField)-1 do
            NewField[I, J] := stFree;
        NewField[I, Low(NewField)] := stImpossible;
        NewField[I, High(NewField)] := stImpossible;
    end;

    for J := Low(NewField) to High(NewField) do
        NewField[High(NewField), J] := stImpossible;

    CreateField := NewField;
end;

function CreateImpossibleCellsMatrix(): TImpossibleCellsMatrix;
var
    I, J: ShortInt;
    NewField: TImpossibleCellsMatrix;
begin
    for J := Low(NewField) to High(NewField) do
        NewField[-1, J] := 1;

    for I := Low(NewField)+1 to High(NewField)-1 do
    begin
        for J := Low(NewField)+1 to High(NewField)-1 do
            NewField[I, J] := 0;
        NewField[I, Low(NewField)] := 1;
        NewField[I, High(NewField)] := 1;
    end;

    for J := Low(NewField) to High(NewField) do
        NewField[High(NewField), J] := 1;

    CreateImpossibleCellsMatrix := NewField;
end;

function IinializeShipsCountArray(): TShipsCountArray;
var
    Arr: TShipsCountArray;
    I: TShip;
begin
    for I := tShortShip to tLongShip do
        Arr[I] := 5-Ord(I);

    IinializeShipsCountArray := Arr;
end;

procedure InitializeShips(var ShipsArray: TShipsArray);
var
    CurrShip: TShip;
    I, J: Byte;
begin
    J := Low(ShipsArray);
    for CurrShip := Low(TShip) to High(TShip) do
        for I := 5 - Ord(CurrShip) DownTo 1 do
        begin
            ShipsArray[J] := CurrShip;
            Inc(J);
        end;
end;

function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
const
    TempArr: array [TShip] of TFieldCellState = (stShortShip, stSmallShip, stMiddleShip, stLongShip);
begin
    ConvertShipToFieldState := TempArr[Ship];
end;

function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
const
    TempArr: array [stShortShip..stLongShip] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
begin
    ConvertFieldStateToShip := TempArr[FieldState];
end;

function CompareCellsVertically(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
begin
    CompareCellsVertically := ShootField[Col, Row+I] = ConvertShipToFieldState(Ship);
end;

function CompareCellsHorizontally(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
begin
    CompareCellsHorizontally := ShootField[Col+I, Row] = ConvertShipToFieldState(Ship);
end;

function ReturnRowElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
begin
    ReturnRowElemState := ShipField[Col+I, Row];
end;

function ReturnColElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
begin
    ReturnColElemState := ShipField[Col, Row+I];
end;

procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var SideCol: ShortInt; var SideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
var
    I: ShortInt;
    HasPartOfShip: Boolean;
begin
    if IsHorizontal then
    begin
        I := 0;
        Repeat
            Inc(I);
            HasPartOfShip := CompareCellsHorizontally(ShootField, Ship, Col, Row, DirectionCoef*I);
        Until not HasPartOfShip;

        SideRow := Row;
        SideCol := Col + DirectionCoef * I;
    end
    else
    begin
        I := 0;
        Repeat
            Inc(I);
            HasPartOfShip := CompareCellsVertically(ShootField, Ship, Col, Row, DirectionCoef*I);
        Until not HasPartOfShip;
        SideCol := Col;
        SideRow := Row + DirectionCoef * I;
    end;
end;

function IsShipInFieldHorizontal(Field: TField; Ship: TShip; Col, Row: ShortInt): Boolean;
var
    IsHorizontal: Boolean;
begin
    if Ship = tShortShip then
        IsHorizontal := True
    else
    begin
        if (Field[Col-1, Row] <> stImpossible) or (Field[Col+1, Row] <> stImpossible) then
             IsHorizontal := True
        else
            IsHorizontal := False;
    end;
    IsShipInFieldHorizontal := IsHorizontal;
end;

function CanPlaceShipHere(Field: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean): Boolean;
var
    I: ShortInt;
    CanPlace: Boolean;
    ReturnCellStateFunction: TReturnCellStateFunction;
begin
    I := 0;
    CanPlace := True;
    if IsHorizontal then
        ReturnCellStateFunction := ReturnRowElemState
    else
        ReturnCellStateFunction := ReturnColElemState;

    while (I < Ord(Ship)) and CanPlace do
    begin
       CanPlace := ReturnCellStateFunction(Field, Col, Row, I) = stFree;
       Inc(I);
    end;

    CanPlaceShipHere := CanPlace;
end;

procedure DeleteShipPart (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col, Row: ShortInt);
begin
    Dec(Matrix[Col, Row]);
    if (Matrix[Col, Row] = 0) then
        Field[Col, Row] := stFree;
end;

procedure DeleteShip (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col1, Row1, Col2, Row2: ShortInt; IsHorizontal: Boolean);
var
    I: ShortInt;
begin
    if IsHorizontal then
        for I := Col1 to Col2 do
        begin
            DeleteShipPart(Field, Matrix, I, Row1-1);
            DeleteShipPart(Field, Matrix, I, Row1);
            DeleteShipPart(Field, Matrix, I, Row1+1);
        end
    else
        for I := Row1 to Row2 do
        begin
            DeleteShipPart(Field, Matrix, Col1-1, I);
            DeleteShipPart(Field, Matrix, Col1, I);
            DeleteShipPart(Field, Matrix, Col1+1, I);
        end;
end;

procedure FillImpossibleCellsHorizontaly (var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        Inc(Matrix[X+I, Y-1]);
        Inc(Matrix[X+I, Y]);
        Inc(Matrix[X+I, Y+1]);
    end;
end;

procedure FillImpossibleCellsVerticaly (var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        Inc(Matrix[X-1, Y+I]);
        Inc(Matrix[X, Y+I]);
        Inc(Matrix[X+1, Y+I]);
    end;
end;

procedure FillImpossibleCellsMatrix(var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
begin
    if IsHorizontal then
        FillImpossibleCellsHorizontaly(Matrix, Ship, X, Y)
    else
        FillImpossibleCellsVerticaly(Matrix, Ship, X, Y);
end;

procedure PlaceShipHorizontal (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        ShipsField[X+I, Y-1] := stImpossible;
        ShipsField[X+I, Y] := ConvertShipToFieldState(Ship);
        ShipsField[X+I, Y+1] := stImpossible;
    end;
    ShipsField[X-1, Y] := stImpossible;
    ShipsField[X+Ord(Ship), Y] := stImpossible;
end;

procedure PlaceShipVertical (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        ShipsField[X-1, Y+I] := stImpossible;
        ShipsField[X, Y+I] := ConvertShipToFieldState(Ship);
        ShipsField[X+1, Y+I] := stImpossible;
    end;
    ShipsField[X, Y-1] := stImpossible;
    ShipsField[X, Y+Ord(Ship)] := stImpossible;
end;

procedure PlaceShipHere(var Field: TField; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
begin
    if IsHorizontal then
        PlaceShipHorizontal (Field, Ship, X, Y)
    else
        PlaceShipVertical (Field, Ship, X, Y);
end;

function ReturnHorizontalLineCellState(ShipField: TField; Row, I: ShortInt): TFieldCellState;
begin
    ReturnHorizontalLineCellState := ShipField[I, Row];
end;

function ReturnVerticalLineCellState(ShipField: TField; Col, I: ShortInt): TFieldCellState;
begin
    ReturnVerticalLineCellState := ShipField[Col, I];
end;

function CanPlaceShipInLine(Field: TField; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): Boolean;
var
    I, Counter: ShortInt;
    HasFreePlace: Boolean;
    ReturnCellState: TReturnLineCellStateFunction;
begin
    Counter := 0;
    HasFreePlace := False;
    I := Low(Field)+1;

    if IsHorizontal then
        ReturnCellState := ReturnHorizontalLineCellState
    else
        ReturnCellState := ReturnVerticalLineCellState;

    while not HasFreePlace and (I < High(Field)) do
    begin
        if Ord(ReturnCellState(Field, Coord, I)) = 0 then
            Inc(Counter)
        else
            Counter := 0;

        if Counter = Ord(Ship) then
            HasFreePlace := True;
        Inc(I);
    end;

    CanPlaceShipInLine := HasFreePlace;
end;

function GetSecondCoord(var Field: TField; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): ShortInt;
var
    I, Counter, StartCell, PossibleCellCount: ShortInt;
    ReturnCellState: TReturnLineCellStateFunction;
begin
    Counter := 0;
    PossibleCellCount := 0;
    I := Low(Field)+1;

    if IsHorizontal then
        ReturnCellState := ReturnHorizontalLineCellState
    else
        ReturnCellState := ReturnVerticalLineCellState;

    while I < High(Field) do
    begin
        if Ord(ReturnCellState(Field, Coord, I)) = 0 then
            Inc(Counter)
        else
        begin
            Counter := 0;
            PossibleCellCount := 0;
        end;

        if Counter = Ord(Ship) then
            StartCell :=  I - Ord(Ship)+1;

        if (Counter - Ord(Ship)) > PossibleCellCount then
            PossibleCellCount := Counter - Ord(Ship);

        Inc(I);
    end;

    GetSecondCoord := StartCell + Random(PossibleCellCount + 1);
end;

function PullShip(var ShipsArray: TShipsArray; CommonShipsCount: Byte): TShip;
var
    Ship: TShip;
begin
    Ship := ShipsArray[CommonShipsCount-1];
    PullShip := Ship;
end;

function GetRandomDirection(): Boolean;
var
    IsHorizontal: Boolean;
begin
    IsHorizontal := Random(2) = 0;
    GetRandomDirection := isHorizontal;
end;

procedure PlaceShipInLine(var Field: TField; var ImpossibleCellsMatrix: TImpossibleCellsMatrix; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean);
var
    SecondCoord: ShortInt;
begin
    SecondCoord := GetSecondCoord(Field, Ship, Coord, IsHorizontal);

    if IsHorizontal then
    begin
        PlaceShipHorizontal(Field, Ship, SecondCoord, Coord);
        FillImpossibleCellsHorizontaly(ImpossibleCellsMatrix, Ship, SecondCoord, Coord);
    end
    else
    begin
        PlaceShipVertical(Field, Ship, Coord, SecondCoord);
        FillImpossibleCellsVerticaly(ImpossibleCellsMatrix, Ship, Coord, SecondCoord);
    end;
end;

procedure PutShipToField(var Field: TField; var ImpossibleCellsMatrix: TImpossibleCellsMatrix; Ship: TShip);
var
    Coord, SecondCoord: ShortInt;
    IsHorizontal: Boolean;
begin
    repeat
        IsHorizontal := GetRandomDirection();
        Coord := Random(10);
    until CanPlaceShipInLine(Field, Ship, Coord, IsHorizontal);

    PlaceShipInLine(Field, ImpossibleCellsMatrix, Ship, Coord, IsHorizontal);
end;

procedure FillGameField(var Field: TField; var ImpossibleCellsMatrix: TImpossibleCellsMatrix; var ShipsArray: TShipsArray; var CommonShipsCount: Byte);
var
    Ship: TShip;
    I: ShortInt;
begin
    for I := 1 to 10 do
    begin
        Ship := PullShip(ShipsArray, CommonShipsCount);
        Dec(CommonShipsCount);
        PutShipToField(Field, ImpossibleCellsMatrix, Ship);
    end;
end;

function GenerateField(var ImpossibleCellsMatrix: TImpossibleCellsMatrix): TField;
var
    NewField: TField;
    ShipsArray: TShipsArray;
    CommonShipsCount: Byte;
begin
    CommonShipsCount := 10;
    NewField := CreateField();
    InitializeShips(ShipsArray);
    FillGameField(NewField, ImpossibleCellsMatrix, ShipsArray, CommonShipsCount);

    GenerateField := NewField;
end;












end.









unit GridUnit;

interface
uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ExtCtrls, FieldGeneratorUnit;


    procedure DrawField(var Image: TImage; StateMatrix: TField);
    procedure DrawShip(var Image: TImage; ColCount, RowCount: Byte);

implementation
const
    CELL_WIDTH = 30;

procedure DrawShip(var Image: TImage; ColCount, RowCount: Byte);
var
    I, J, X, Y: Byte;
    CurrRect: TRect;
const
    DECK_WIDTH = 30;
begin
    with Image do
    begin
        Height := RowCount * DECK_WIDTH;
        Width := ColCount * DECK_WIDTH;

        Picture := nil;

        Canvas.Pen.Color:= clDkGray;
        for I := 0 to RowCount-1 do
        begin
            Y :=  I*DECK_WIDTH;
            for J := 0 to ColCount-1 do
            begin
                X := J*DECK_WIDTH;
                CurrRect := Rect(X, Y, X + DECK_WIDTH, Y + DECK_WIDTH);

                Canvas.Brush.Color:=clNavy;
                Canvas.FillRect(CurrRect);

                Canvas.Rectangle(CurrRect);
            end;
        end;
    end;
end;

procedure DrawField(var Image: TImage; StateMatrix: TField);
const
    SIZE = 10;
var
    I, J: ShortInt;
    X, Y: Word;
    CurrRect: TRect;
    CellColor: TColor;
begin
    with Image do
    begin
        Height := SIZE * CELL_WIDTH;
        Width := SIZE * CELL_WIDTH;

        Canvas.Pen.Color:=clSkyBlue;
        for I := Low(StateMatrix)+1 to High(StateMatrix)-1 do
        begin
            Y :=  I*CELL_WIDTH;
            for J := Low(StateMatrix)+1 to High(StateMatrix)-1 do
            begin
                X := J*CELL_WIDTH;
                CurrRect := Rect(X, Y, X + CELL_WIDTH, Y + CELL_WIDTH);

                case StateMatrix[J, I] of
                    stImpossible: CellColor := clGrayText;
                    stFree: CellColor := clWhite;
                else
                    CellColor := clBlue;
                end;

                Canvas.Brush.Color:=CellColor;
                Canvas.FillRect(CurrRect);

                Canvas.Rectangle(CurrRect);
            end;
        end;
    end;
end;

end.