Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Работа: предложения и спрос
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #9  
Старый 10.06.2012, 14:29
Аватар для @Rafa3L
@Rafa3L @Rafa3L вне форума
Начинающий
 
Регистрация: 09.11.2011
Адрес: Москва
Сообщения: 144
Версия Delphi: XE2
Репутация: 11216
По умолчанию

Допилил код для компа.
Код еще ужаснее, зато комп начал играть намного лучше. заложил некую логику ИИ, реализщовано правда через сами понимаете всем известное место - ж@пу)

Теперь для победы нужно не просто тыкать ячейки подряд, а включать мозг, и надеяться на везение. А также правильно расставить корабли.
Соотношение сил 50/50.

Переменные:
kx,cx1,cy1:integer;
cokil2:boolean;

Код:
bum:=false;
cokil:=true;
cokil2:=false;
kx:=0;
while ((bum=false) or (cokil=true))and(kx<10000) do   //стрел-ть до тех пор пока не попал в клетку в которую не
//стрелял и если она пустая
begin
m:=random(10)+1;
n:=random(10)+1;

kx:=kx+1;
if random(7)=5 then
begin
for i:=1 to 9 do
for j:=1 to 10 do
if (b1[i,j]=4)and(b1[i+1,j]=2) then
begin
m:=i+1;
n:=j;
end;
end;

if random(7)=6 then
begin
for i:=1 to 10 do
for j:=1 to 9 do
if (b1[i,j]=4)and(b1[i,j+1]=2) then
begin
m:=i;
n:=j+1;
end;
end;

if cokil2=true then
begin
  case random(4) of
  0: begin
  m:=cx1+1;
  n:=cy1;
  if b1[m,n]<>2 then m:=cx1-1;
  if m<1 then m:=2;
  if m>10 then m:=9;
  end;
  1: begin
  m:=cx1-1;
  n:=cy1;
  if b1[m,n]<>2 then m:=cx1+1;
  if m<1 then m:=2;
  if m>10 then m:=9;
  end;
  2: begin
  m:=cx1;
  n:=cy1+1;
  if b1[m,n]<>2 then n:=cy1-1;
  if n<1 then n:=2;
  if n>10 then n:=9;
    end;
  3: begin
  m:=cx1;
  n:=cy1-1;
  if b1[m,n]<>2 then n:=cy1+1;
  if n<1 then n:=2;
  if n>10 then n:=9;
  end;
  end;
end;

case b1[m,n] of
  3,4:  begin
      bum:=false;
      cokil:=false;
      cokil2:=false;
      end;
  0: begin
      b1[m,n]:=3;
      bum:=true;
      cokil:=false;
      cokil2:=false;
     end;
  2: begin
      b1[m,n]:=4;
      bum:=true;
      cokil:=true;
      cokil2:=true;
      cx1:=m;
      cy1:=n;
      if (((b1[i+1,j]=2)
          or(b1[i,j+1]=2)
          or(b1[i-1,j]=2)
          or(b1[i,j-1]=2))
          or(((b1[i+1,j]=4)and(b1[i+2,j]=2))
          or((b1[i,j+1]=4)and(b1[i,j+2]=2))
          or((b1[i-1,j]=4)and(b1[i-2,j]=2))
          or((b1[i,j-1]=4)and(b1[i,j-2]=2)))
          or(((b1[i+1,j]=4)and(b1[i+2,j]=4)and(b1[i+3,j]=2))
          or((b1[i,j+1]=4)and(b1[i,j+2]=4)and(b1[i,j+3]=2))
          or((b1[i-1,j]=4)and(b1[i-2,j]=4)and(b1[i-3,j]=2))
          or((b1[i,j-1]=4)and(b1[i,j-2]=4)and(b1[i,j-3]=2))))=FALSE
      then
        lUserKilled.Caption:=IntToStr(StrToInt(lUserKilled.Caption)+1);
     end
end;

For i:=1 to 10 do                   //рисуется графическое поле игрока
  for j:=1 to 10 do
    begin
     case b1[i,j] of
     4:begin                       //клетка в котрой стоит подбитый или не доконца подбитый корабль
          if ((b1[i+1,j]=2)
          or(b1[i,j+1]=2)
          or(b1[i-1,j]=2)
          or(b1[i,j-1]=2))
          or(((b1[i+1,j]=4)and(b1[i+2,j]=2))
          or((b1[i,j+1]=4)and(b1[i,j+2]=2))
          or((b1[i-1,j]=4)and(b1[i-2,j]=2))
          or((b1[i,j-1]=4)and(b1[i,j-2]=2)))
          or(((b1[i+1,j]=4)and(b1[i+2,j]=4)and(b1[i+3,j]=2))
          or((b1[i,j+1]=4)and(b1[i,j+2]=4)and(b1[i,j+3]=2))
          or((b1[i-1,j]=4)and(b1[i-2,j]=4)and(b1[i-3,j]=2))
          or((b1[i,j-1]=4)and(b1[i,j-2]=4)and(b1[i,j-3]=2)))
             then begin                                       //не доконца подбитый корабль
               image1.Canvas.pen.Color:=clred;
               image1.Canvas.MoveTo(20*i-19,20*j-19);
               image1.Canvas.LineTo(20*i-1,20*j-1);
               image1.Canvas.MoveTo(20*i-1,20*j-19);
               image1.Canvas.LineTo(20*i-19,20*j-1);
               image1.Canvas.pen.Color:=clblack;
                b1[i+1,j-1]:=3;
                b1[i+1,j+1]:=3;
                b1[i-1,j+1]:=3;
                b1[i-1,j-1]:=3;
             end
             else                                           //подбитый корабль
             begin
              image1.Canvas.Brush.Color:=clred;
              image1.Canvas.pen.color:=clBlack;
              image1.Canvas.pen.Width:=2;
              image1.Canvas.Rectangle(20*i-19,20*j-19,20*i-1,20*j-1);
              image1.Canvas.pen.Width:=1;
                if (b1[i,j+1]<>4) then  b1[i,j+1]:=3;
                if (b1[i,j-1]<>4) then  b1[i,j-1]:=3;
                if (b1[i+1,j]<>4) then  b1[i+1,j]:=3;
                if (b1[i-1,j]<>4) then  b1[i-1,j]:=3;
                b1[i+1,j-1]:=3;
                b1[i+1,j+1]:=3;
                b1[i-1,j+1]:=3;
                b1[i-1,j-1]:=3;
             end;
       end;
    end;
  end;
end;

For i:=1 to 10 do                   //рисуется графическое поле игрока
  for j:=1 to 10 do
     if b1[i,j]=3 then
         begin                       //простреленая пустая клетка
         image1.Canvas.Brush.Color:=clwhite;
         image1.Canvas.Rectangle(20*i-15,20*j-15,20*i-5,20*j-5)
        end;

lose:=true;
For i:=1 to 10 do              //если находится хотябы один неподбитый корабль то проигрыша нет
  for j:=1 to 10 do
    if b1[i,j]=2 then
      lose:=false;
if lose=true then
 begin
  kon:=true;
  showmessage ('Вы проиграли.'+#13+'Попробуйте ещё раз!');
  exit
 end;
end;
end;
procedure TForm1.N3Click(Sender: TObject);    //процедура нажатия на кнопку "выход"
begin
close
end;
__________________
Помогаю платно.
Помогаю иногда бесплатно.

Последний раз редактировалось @Rafa3L, 10.06.2012 в 14:39.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 20:56.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025