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] or (Field.Y+i>8) then begin Memo1.Lines.Append(DateToStr(Date)+' '+TimeToStr(Time)+': Ошибка: корабль не может быть установлен в указанном месте.'); exit; end; 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.