07/04 back

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;
    HLongShip: TImage;
    HMiddleShip: TImage;
    HSmallShip: TImage;
    HShortShip: TImage;
    VLongShip: TImage;
    VMiddleShip: TImage;
    VSmallShip: TImage;
    VShortShip: TImage;
    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);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ConstructorForm: TConstructorForm;

implementation

uses
    GridUnit, FieldGeneratorUnit;

const
    CELL_WIDTH = 30;
var
    Field, TempField, NewField: TField;
    IsDrag, IsMovingShipHorizontal: Boolean;
    MovingShipType: TShip;
    ImpossibleCellsMatrix, TempMatrix: TImpossibleCellsMatrix;
    ShipCol, ShipRow: Byte;
    CanPlaceShip: Boolean;
    MovingShip: TImage;

{$R *.dfm}

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

procedure DrawShips();
begin
    with ConstructorForm do
    begin
        DrawShip(HLongShip, 4, 1);
        DrawShip(HMiddleShip, 3, 1);
        DrawShip(HSmallShip, 2, 1);
        DrawShip(HShortShip, 1, 1);
        DrawShip(VLongShip, 1, 4);
        DrawShip(VMiddleShip, 1, 3);
        DrawShip(VSmallShip, 1, 2);
        DrawShip(VShortShip, 1, 1);
    end;
end;

procedure TConstructorForm.FormShow(Sender: TObject);
begin
    Field := CreateField();
    ImpossibleCellsMatrix := CreateImpossibleCellsMatrix();
    DrawField(UserFieldImage, Field);
    DrawShips;
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;

function IsShipFromFormHorizontal(MovingShip: TImage): Boolean;
var
    IsHorizontal: Boolean;
begin
    if MovingShip.Width Div CELL_WIDTH  = 1 then
        IsHorizontal := False
    else
        IsHorizontal := True;

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

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

    ConvertImageToShipType := TempArr[DeckCount];
end;

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

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

    Accept := CanPlaceShipHere(Field, MovingShipType, Col, Row, IsMovingShipHorizontal);
    if Accept then
    begin
        TempField := Field;
        PlaceShip(TempField, MovingShipType, Col, Row, IsMovingShipHorizontal);
        DrawField(UserFieldImage, TempField);
    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;

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

    DrawField(UserFieldImage, Field);
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;

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
        IsDrag := True;

        TempField := Field;
        TempMatrix := ImpossibleCellsMatrix;

        MovingShipType := ConvertFieldStateToShip(TempField[Col, Row]);
        IsMovingShipHorizontal := IsShipInFieldHorizontal(TempField, MovingShipType, Col, Row);

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

        DeleteShip(TempField, TempMatrix, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal);
    end;
end;

procedure TConstructorForm.UserFieldImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
    if IsDrag then
    begin
        ShipCol := X div CELL_WIDTH;
        ShipRow := Y div CELL_WIDTH;
        NewField := TempField;

        CanPlaceShip := CanPlaceShipHere(NewField, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);

        if CanPlaceShip then
        begin
            PlaceShip(NewField, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);
            DrawField(UserFieldImage, NewField);
        end;
    end;
end;

procedure TConstructorForm.UserFieldImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if IsDrag and CanPlaceShip then
    begin
        Field := NewField;
        FillImpossibleCellsMatrix(TempMatrix, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);
        ImpossibleCellsMatrix := TempMatrix;
    end;
    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;

    TReturnCellStateFunction = function (ShipField: TField; Col, Row, 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;
    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 ConvertShipToFieldState(Ship: TShip): TFieldCellState;
    function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
    function ReturnRowElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
    function ReturnColElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
    procedure PlaceShip(var Field: TField; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
    function CreateImpossibleCellsMatrix(): TImpossibleCellsMatrix;
    procedure FillImpossibleCellsMatrix(var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
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 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;

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;

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;

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 FillImpossibleCellsHorizontal (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 FillImpossibleCellsVertical (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
        FillImpossibleCellsHorizontal(Matrix, Ship, X, Y)
    else
        FillImpossibleCellsVertical(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 PlaceShip(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;

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;
begin
    with Image do
    begin
        Height := RowCount * CELL_WIDTH;
        Width := ColCount * CELL_WIDTH;

        Picture := nil;

        Canvas.Pen.Color:= clDkGray;
        for I := 0 to RowCount-1 do
        begin
            Y :=  I*CELL_WIDTH;
            for J := 0 to ColCount-1 do
            begin
                X := J*CELL_WIDTH;
                CurrRect := Rect(X, Y, X + CELL_WIDTH, Y + CELL_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.










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.