Разработка игры морской бой

    procedure KillShapeMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  private

  public

   path:string;

   { чтоб  схемы сохранять можно было }

   e_s, m_s:array[1..4, 1..4] of integer; //матрицы с координ. каждого корабля

   { для  html }

   e_sh, m_sh:array[1..8, 1..8] of integer; //матриксы с инфой об  игровом поле

   alph:string[8]; // -= смерть от напалма =-

   { для  конфа }

   game:integer; //0-не играемся, 1-играемся, 2-наигралися

  end;

var

  FormMain: TFormMain;

  set_ships:array[1..4] of bool; //трю - кор. стоит

  cnt:array[0..1] of integer; //запись счета

  paluba:integer; //сколькипалубный  кор. ставим сейчас

  e_k_ships, m_k_ships:integer; //кол-во убитых кораблей

  rotate, zalez:bool;

implementation

uses FunctionsUnit, ConfUnit, MBoxUnit, HistoryUnit, SaveShemeUnit,

     LoadDelShemeUnit, HTMLUnit, NapalmUnit, CleanerUnit;

{$R *.dfm}

{ все что на  форме помечено "+++" - пишется  программно }

//дает заключительный  таг корабля

function GetFinishTag( StartTag:integer; PalubaCount:integer;

Rot:bool ):integer;

var temp, tag_f:integer; str:string[2]; a,b :char;

begin

if Rot then

  begin

   a := 'c';

   b := 'r';

  end else

  begin

   a := 'r';

   b := 'c';

  end;

temp := GetNum( StartTag, a );

tag_f := GetNum( StartTag, b ) + ( PalubaCount - 1 );

//если за  край залез кораблиг

if tag_f > 8 then begin

  tag_f := 8;

  zalez := true;

end;

if Rot then str := IntToStr( tag_f ) + IntToStr( temp )

else str := IntToStr( temp ) + IntToStr( tag_f );

GetFinishTag := StrToInt( str );

end;

//свой месадж  бокс написал :(

function MesBox( Text:string; Caption:string ):bool;

begin

FormMBox.Label1.Caption := Text;

FormMBox.Caption := Caption;

 

FormMBox.ShowModal;

MesBox := FormMBox.a;

end;

//трю - если  есть соседи около корабля

function CheckNeig( StartTag:integer; FinishTag:integer; BoP:char ):boolean;

var str:string; i, m:integer;

begin

CheckNeig := false; //чтоб  не клюкавила

//берем соседей

str := GetNeigNums( StartTag, FinishTag );

m := Length( str ) div 2;

if BoP = 'b' then

  for i := 1 to m do

   if FormMain.e_sh[GetNum( GetTagFromStr( str, i ), 'r' ),

                    GetNum( GetTagFromStr( str, i ), 'c' )] = 1 then

           begin

            CheckNeig := true;

            Exit;

           end;

if BoP = 'p' then

  for i := 1 to m do

   if FormMain.m_sh[GetNum( GetTagFromStr( str, i ), 'r' ),

                    GetNum( GetTagFromStr( str, i ), 'c' )] = 1 then

           begin

            CheckNeig := true;

            Exit;

           end;

end;

//проверяет,  убит кор. или нет

function CheckKillShip( PalubaCount:integer; BoP:char ):boolean;

var i, r, c, tmp:integer;

begin

for i := 1 to PalubaCount do begin

  if BoP = 'b' then begin //координаты берем

   r := GetNum( FormMain.e_s[PalubaCount, i], 'r' );

   c := GetNum( FormMain.e_s[PalubaCount, i], 'c' );

  end

  else begin

   r := GetNum( FormMain.m_s[PalubaCount, i], 'r' );

   c := GetNum( FormMain.m_s[PalubaCount, i], 'c' );

  end;

  //валим в  темп значение по этому адресу

  if BoP = 'b' then tmp := FormMain.e_sh[r,c] else tmp := FormMain.m_sh[r,c];

   //если  туда не попали - выходим

   if ( tmp <> 3 ) then begin

    Result := false;

    Exit;

   end;

end;

//инкриментим  кол-во убитых кораблей

if BoP = 'b' then inc( e_k_ships ) else inc( m_k_ships );

Result := true;

end;

//сканит set_ships и  говорит, какой кораблик еще  не установлен

function GetPaluba:integer;

var i:integer;

begin

for i := 1 to 4 do

  if set_ships[i] = false then begin

   GetPaluba := i; //берем n-палубный не установ.  корабль

   FormMain.StatusLabel.Caption := 'Сейчас ставим:';

   FormMain.ManKillLabel.Caption := IntToStr( i ) + ' - палубный';

   Exit;

  end;

GetPaluba := 0; //значит  все на месте

end;

//пишет на  форме лабелы с инфой об игре ( тока для мена )

procedure WriteInfo( Kill, Lost:integer );

begin

with FormMain do begin

  if Kill <> -1 then

   ManKillLabel.Caption := ManKillLabel.Caption + ' ' + IntToStr( Kill );

  if Lost <> -1 then

   ManLostLabel.Caption := ManLostLabel.Caption + ' ' + IntToStr( Lost );

end;

end;

//ищит подбитые  таги с стренге

function GetRedTag( StrWithTags:string ):integer;

var i, l, r, c, tg:integer;

begin

l := Length( StrWithTags ) div 2;

for i := 1 to l do begin

  tg := GetTagFromStr( StrWithTags, i ); //берем i-ый таг

  r := GetNum( tg, 'r' );

  c := GetNum( tg, 'c' );

  if FormMain.m_sh[r,c] = 3 then begin //если попадание

   Result := tg; //отдаем его

   Exit; //и  уходим ( больше одного не нужно,  потому что )

  end;

end;

Result := -1; //ни че не нашли

end;

//убирает таги, в которые уже стреляли

function FilterTargetTags( Str:string ):string;

var i, r, c, l:integer; res, tmp:string[8];

begin

res := '';

l := Length( Str ) div 2;

for i := 1 to l do begin

  tmp := IntToStr( GetTagFromStr( Str, i ) );

  r := StrToInt( tmp[1] );

  c := StrToInt( tmp[2] );

  if ( FormMain.m_sh[r,c] = 0 ) or ( FormMain.m_sh[r,c] = 1 ) then

   res := res + tmp;

end;

Result := res;

end;

//бот выбирает  таг корабля

function BotFireTag:integer;

var cross, tg:string[8]; i, j, k, r:integer; ran:boolean; stat:char;

begin

{ ламер - мочит  на шару

   перец  - не учитывает положение подбитых  кораблей

   матер  - boom bye yeah !!! }

Result := -1; //чтоб  компилятер не ругался

ran := false; //пока  ранений нету

r := -1;

//сложность

if FormMain.DiffComboBox.ItemIndex = 0 then i := 9

else i := 1;

//ищим попадание

while ( i <= 8 ) do begin

  for j := 1 to 8 do

   if FormMain.m_sh[i,j] = 3 then begin //нашел подбитый кораблик

    ran := true; //а вот и ранение

    cross := GetCoDTags( i, j, true );

    if FormMain.DiffComboBox.ItemIndex = 2 then

     r := GetRedTag( cross ); //смотрим на ранения

    if r <> -1 then begin

     tg := IntToStr( i ) + IntToStr( j ); //берем текущий  таг

     //определяем  положение корабля

     if GetNum( StrToInt( tg ), 'r' ) = GetNum( r, 'r' ) then stat := 'r'

     else stat := 'c';

     cross := FilterRedLineTags( cross, GetNum( r, stat ), stat );

    end;

    //выкидываем  подбитые таги

    cross := FilterTargetTags( cross );

    //если есть хоть один таг, то палим

    if cross <> '' then begin

     Randomize; //ни хера не помогает :)

     k := Random( Length( cross ) div 2 );

     inc( k );

     //результат  - таг для функции Fire

     Result := GetTagFromStr( cross, k );

     Exit;

    end;

   end;

  inc( i );

end;

//не нашел  ни одного раненого бойца и  палит на шару

if ran = false then Result := GetRandomTag;

end;

//пишет мему  с ходами

procedure WriteStepsMemo( Row, Col, Kill:integer; BoP:char );

var n, w, r, s:string; t:integer;

begin

if BoP = 'b' then w := 'Бот: ' else w := 'Игрок: ';

case Kill of

  -1: r := 'промазал';

  0: r := 'подбил';

  else begin

   r := 'убил';

   s := ' (' + IntToStr( Kill ) + ')';

  end

end;

with FormMain.StepsMemo.Lines do begin

  t := Count + 1;

  if t < 10 then

   n := '00' + IntToStr ( t ) + ') '

  else

   n := '0' + IntToStr ( t ) + ') ';

  Add( n + w + FormMain.alph[Row] + IntToStr( Col ) + ' - ' + r + s );

end;

end;

//пишет одно  заданное число во все заданные  элементы матрицы

procedure WriteNumsInBigMatrix( StrWithTags:string; Number:integer;

BoP:char );

var i, l, r, c:integer;

begin

l := Length( StrWithTags ) div 2;

for i := 1 to l do begin

  r := GetNum( GetTagFromStr( StrWithTags, i ), 'r' );

  c := GetNum( GetTagFromStr( StrWithTags, i ), 'c' );

  if BoP = 'b' then FormMain.e_sh[r,c] := Number

  else FormMain.m_sh[r,c] := Number;

end;

end;

//помечает в  матрице убитый корабль ( результ  - кол-во палуб убитого корабля  )

function MarkKillShip( BoP:char ):integer;

var i, s, f:integer;

begin

 Result := 0;

for i := 1 to 4 do begin

  if CheckKillShip( i, BoP ) = true then begin

   if BoP = 'b' then begin

    s := FormMain.e_s[i, 1];

    f := FormMain.e_s[i, i];

   end

   else begin

    s := FormMain.m_s[i, 1];

    f := FormMain.m_s[i, i];

   end;

   if BoP = 'b' then WriteInfo( i, -1 )

   else WriteInfo( -1, i );

   //чтоб  избежать кривого отображения,  сначала помечаем его соседей

   WriteNumsInBigMatrix( GetNeigNums( s, f ), 2, BoP );

   //помечаем  в матрице грохнутые корабли

   WriteNumsInBigMatrix( GetShipTags( s, f ), 4, BoP );

   Randomize;

   if ( BoP = 'b' ) and ( FormConf.KillCheckBox.Checked ) then

    case Random(5) of

     0: sndPlaySound( 'sounds\KillShip1.wav', SND_ASYNC );