Miscellany

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    RefreshBtn: TButton;
    StartBtn: TButton;
    StopBtn: TButton;
    Memo1: TMemo;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure StartBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure RefreshBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BotInit;
    procedure XodBot;
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type btfld = record
       isSuccess: 0..2;
       o4ku : -1..2;
     end;

var playerfield, botfield, planalys : array [1..8, 1..8] of Boolean;
    btanalys : array [0..9, 0..9] of btfld;
    c4, c3, c2, c1, pc4et, bc4et :Integer; botWin :Boolean;
    seltype : 0..4; //0 - тип корабля не выбран, 1..4 - количество труб

procedure TForm1.BotInit;
label WHILE_1,WHILE_2,WHILE_3;
var x, y, st, i, c :Integer;
begin
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Бот начал расстановку.');
  Randomize;
    st :=random(1);
    if st=1 then
    begin
      x := Random(8);
      y := Random(5);
      for i:=0 to 3 do botfield[x,y+i] := True;
    end else
    begin
      x := Random(5);
      y := Random(8);
      for i:=0 to 3 do botfield[x+i,y] := True;
    end;
  c := 1;
  while c<=2 do
  begin
    WHILE_1:
    st :=random(1);
    if st=1 then
    begin
      x := Random(8);
      y := Random(6);
      for i:=0 to 2 do if botfield[x,y+i] then goto WHILE_1;
      for i:=0 to 2 do botfield[x,y+i] := True;
    end else
    begin
      x := Random(6);
      y := Random(8);
      for i:=0 to 2 do if botfield[x+i,y] then goto WHILE_1;
      for i:=0 to 2 do botfield[x+i,y] := True;
    end;
    c := c+1;
  end;
    c := 1;
  while c<=3 do
  begin
    WHILE_2:
    st :=random(1);
    if st=1 then
    begin
      x := Random(8);
      y := Random(7);
      for i:=0 to 1 do if botfield[x,y+i] then goto WHILE_2;
      for i:=0 to 1 do botfield[x,y+i] := True;
    end else
    begin
      x := Random(7);
      y := Random(8);
      for i:=0 to 1 do if botfield[x+i,y] then goto WHILE_2;
      for i:=0 to 1 do botfield[x+i,y] := True;
    end;
    c := c+1;
  end;
  c := 1;
  while c<=4 do
  begin
    WHILE_3:
    x := Random(8);
    y := Random(8);
    if botfield[x,y] then goto WHILE_3;
    botfield[x,y] := True;
    c := c+1;
  end;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Бот закончил расстановку.');
end;

function SetIndexes :TPoint;
label RETURN;
var i, j, cmax, k :Integer; max : -1..2;
begin
  Randomize;
  max := 0;
  for i:=1 to 8 do for j:=1 to 8 do
    if btanalys[i,j].isSuccess <> 0 then btanalys[i,j].o4ku := -1
    else begin
      btanalys[i,j].o4ku := 0;
      if (btanalys[i+1,j].isSuccess=2)or(btanalys[i-1,j].isSuccess=2)or(btanalys[i,j+1].isSuccess=2)or(btanalys[i,j-1].isSuccess=2) then btanalys[i,j].o4ku := 1;
      if (btanalys[i+1,j].isSuccess=2)and(btanalys[i-1,j].isSuccess=2) or (btanalys[i,j+1].isSuccess=2)and(btanalys[i,j-1].isSuccess=2) then btanalys[i,j].o4ku := 2;
      if btanalys[i,j].o4ku > max then max := btanalys[i,j].o4ku;
    end;
  cmax := 0;
  for i:=1 to 8 do for j:=1 to 8 do if btanalys[i,j].o4ku = max then cmax := cmax+1;
  k := Random(cmax)+1;
  for i:=1 to 8 do for j:=1 to 8 do
  begin
    if btanalys[i,j].o4ku=max then k:=k-1;
    if k=0 then goto RETURN;
  end;
  RETURN:
  Result.Y := i; Result.X := j;
end;

procedure TForm1.XodBot;
var CField :TPoint;
begin
  if botWin then exit;
  repeat
    CField := SetIndexes;
    if playerfield[CField.X, CField.Y] then
    begin
      btanalys[CField.Y, CField.X].isSuccess := 2;
      with Image1.Canvas do
      begin
        Pen.Color := clRed;
        Pen.Width := 5;
        Ellipse(CField.X*40-25, CField.Y*40-25, CField.X*40+3, CField.Y*40+3);
        Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Ходит бот...');
        Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': '+IntToStr(CField.X)+','+IntToStr(CField.Y)+' Попал!');
        bc4et := bc4et+1;
        if bc4et = 20 then
        begin
          ShowMessage('YOU LOSE!!!');
          Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Игрок проиграл.');
          pc4et := -20;
          botWin := True;
          exit;
        end;
      end;
    end else
    begin
      btanalys[CField.Y, CField.X].isSuccess := 1;
      with Image1.Canvas do
      begin
        Pen.Color := clGray;
        Pen.Width := 5;
        MoveTo(CField.X*40-27, CField.Y*40-27);
        LineTo(CField.X*40+5, CField.Y*40+5);
        MoveTo(CField.X*40+5, CField.Y*40-27);
        LineTo(CField.X*40-27, CField.Y*40+5);
        Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Ходит бот...');
        Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': '+IntToStr(CField.X)+','+IntToStr(CField.Y)+' Мимо!');
        exit;
      end;
    end;
  until not playerfield[CField.X, CField.Y];
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j :Integer; frect :TRect;
begin
  frect.Left := 0; frect.Top := 0;
  c4 := 1; c3 := 2; c2 := 3; c1 := 4; pc4et := 0; bc4et := 0; botWin := False;
  seltype := 0;
  Button1.Enabled := True;
  Button2.Enabled := True;
  Button3.Enabled := True;
  Button4.Enabled := True;
  for i:=0 to 9 do for j:=0 to 9 do btanalys[i, j].isSuccess := 0;
  for i := 0 to 7 do for j := 0 to 7 do
  begin
    playerfield[i,j] := False; botfield[i,j] := False;
    planalys[i, j] := False;
  end;
  with Image1.Canvas do
  begin
    frect.Right := Image1.Width; frect.Bottom := Image1.Height;
    FillRect(frect);
    MoveTo(0, 0);
    Pen.Color := clBlue;
    Pen.Width := 10;
    Rectangle(5, 5, Image1.Width-4, Image1.Height-4);
    Pen.Width := 1;
    for i:=1 to 8 do
    begin
      MoveTo(9+i*40, 0);
      LineTo(9+i*40, Image1.Height);
      MoveTo(0, 9+i*40);
      LineTo(Image1.Width, 9+i*40);
    end;
  end;
  with Image2.Canvas do
  begin
    frect.Right := Image2.Width; frect.Bottom := Image2.Height;
    FillRect(frect);
    MoveTo(0, 0);
    Pen.Color := clBlue;
    Pen.Width := 10;
    Rectangle(5, 5, Image1.Width-4, Image1.Height-4);
    Pen.Width := 1;
    for i:=1 to 8 do
    begin
      MoveTo(9+i*40, 0);
      LineTo(9+i*40, Image1.Height);
      MoveTo(0, 9+i*40);
      LineTo(Image1.Width, 9+i*40);
    end;
  end;
end;

function XodPlayer(X, Y :Integer) :Boolean;
begin
  if botfield[x, y] then Result := True else Result := False;
  planalys[x, y] := True;
end;

procedure TForm1.StartBtnClick(Sender: TObject);
begin
  if (c1<>0)or(c2<>0)or(c3<>0)or(c4<>0) then
  begin
    ShowMessage('Следует расставить все корабли.');
    exit;
  end;
  Label2.Visible := True;
  BotInit;
  RadioGroup1.Enabled := False;
  Button1.Enabled := False;
  Button2.Enabled := False;
  Button3.Enabled := False;
  Button4.Enabled := False;
  RefreshBtn.Enabled := False;
  Image1.Enabled := False;
  Image2.Visible := True;
  StartBtn.Visible := False;
  StopBtn.Visible := True;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Старт игры.');
end;

procedure TForm1.StopBtnClick(Sender: TObject);
begin
  RadioGroup1.Enabled := True;
  Button1.Enabled := True;
  Button2.Enabled := True;
  Button3.Enabled := True;
  Button4.Enabled := True;
  RefreshBtn.Enabled := True;
  Image1.Enabled := True;
  Image2.Visible := False;
  StopBtn.Visible := False;
  StartBtn.Visible:=True;
  FormCreate(Form1);
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Игра прервана пользователем.');
end;

procedure TForm1.RefreshBtnClick(Sender: TObject);
begin
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Сброс расстановки пользователя.');
  FormCreate(Form1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if seltype <> 0 then exit;
  seltype := 4;
  c4 := c4-1;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Выбран тип корабля: 4х трубный.');
  if c4=0 then
  begin
    Button1.Enabled:=False;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Лимит 4х трубников исчерпан.');
    exit;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if seltype <> 0 then exit;
  seltype := 3;
  c3 := c3-1;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Выбран тип корабля: 3х трубный.');
  if c3=0 then
  begin
    Button2.Enabled:=False;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Лимит 3х трубников исчерпан.');
    exit;
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if seltype <> 0 then exit;
  seltype := 2;
  c2 := c2-1;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Выбран тип корабля: 2х трубный.');
  if c2=0 then
  begin
    Button3.Enabled:=False;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Лимит 2х трубников исчерпан.');
    exit;
  end;

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if seltype <> 0 then exit;
  seltype := 1;
  c1 := c1-1;
  Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Выбран тип корабля: 1но трубный.');
  if c1=0 then
  begin
    Button4.Enabled:=False;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Лимит 1но трубников исчерпан.');
    exit;
  end;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Field :TPoint; i :Integer;
begin
  if seltype = 0 then exit;
  Field.X := (X-10) div 40; Field.Y := (Y-10) div 40;
  if (Field.X<0)or(Field.X>7)or(Field.Y<0)or(Field.Y>7) then exit;
  Image1.Canvas.Pen.Width := 36;
  Image1.Canvas.Pen.Color := clBlack;
  Image1.Canvas.MoveTo((Field.X)*40+28, (Field.Y)*40+28);
  if RadioGroup1.ItemIndex = 0 then
  begin
    for i:=1 to seltype do
      if playerfield[Field.X+i, Field.Y+1] or (Field.X+i>8) then
      begin
        Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Ошибка: корабль не может быть установлен в указанном месте.');
        exit;
      end;
    Image1.Canvas.LineTo((Field.X+seltype-1)*40+29, (Field.Y)*40+29);
    for i:=1 to seltype do playerfield[Field.X+i, Field.Y+1] := True;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Пользователем установлен '+IntToStr(seltype)+'-трубник в поля '+IntToStr(Field.X+1)+'..'+IntToStr(Field.X+seltype)+'; '+IntToStr(Field.Y+1));
  end else
  begin
    for i:=1 to seltype do
      if playerfield[Field.X+1, Field.Y+i+1] or (Field.Y+i>8) then exit;
    Image1.Canvas.LineTo((Field.X)*40+29, (Field.Y+seltype-1)*40+29);
    for i:=1 to seltype do playerfield[Field.X+1, Field.Y+i] := True;
    Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Пользователем установлен '+IntToStr(seltype)+'-трубник в поля '+IntToStr(Field.X+1)+'; '+IntToStr(Field.Y+1)+'..'+IntToStr(Field.Y+seltype));
  end;
  seltype := 0;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  X := (X-10) div 40; Y := (Y-10) div 40;
  if planalys[X, Y] then exit;
  if not botWin then Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Ходит игрок...');
  if XodPlayer(X, Y) then with Image2.Canvas do
  begin
    Pen.Color := clRed;
    Pen.Width := 5;
    Ellipse((X+1)*40-27, (Y+1)*40-27, (X+1)*40+5, (Y+1)*40+5);
    pc4et := pc4et+1;
    if not botWin then Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': '+IntToStr(X+1)+','+IntToStr(Y+1)+' Попал!');
    if pc4et = 20 then
    begin
      ShowMessage('YOU WIN!!!');
      if not botWin then Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Победил игрок.');
      botWin := True;
    end;
  end else with Image2.Canvas do
  begin
    Pen.Color := clGray;
    Pen.Width := 5;
    MoveTo((X+1)*40-27, (Y+1)*40-27);
    LineTo((X+1)*40+5, (Y+1)*40+5);
    MoveTo((X+1)*40+5, (Y+1)*40-27);
    LineTo((X+1)*40-27, (Y+1)*40+5);
    if not botWin then Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': '+IntToStr(X+1)+','+IntToStr(Y+1)+' Мимо!');
    XodBot;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Label2.Caption := 'Счёт '+IntToStr(pc4et)+':'+IntToStr(bc4et);
end;

end.