Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.07.2008, 19:59   #1
aesoem
Форумчанин
 
Регистрация: 24.12.2007
Сообщений: 288
Смущение крестики нолики

здравствуйте пишу игру... точнее пытаюсь... Вот код по которому ходит компьютер, впринцепи все продумано! Есть один баг если рандум возвращает 0 и эта клетка занята выводится окошко в катором написана ошибка. Вот в чем проблема после моего хода компьютер иногда нехочет ходить хотя в отчете написано что комп сделал ход!
Код:
procedure TForm1.PKTimerTimer(Sender: TObject);
var
i:integer;
begin
sstatusbar1.Panels[0].Text:='компьютер делает ход';
i:=random(9);


if i=9 then
  begin
    IF IMAGE9.Tag=0 THEN
    image9.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(8);
  end;
if i=8 then
  begin
    IF IMAGE8.Tag=0 THEN
    image8.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(7);
  end;
if i=7 then
  begin
    IF IMAGE7.Tag=0 THEN
    image7.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(6);
  end;
if i=6 then
  begin
    IF IMAGE6.Tag=0 THEN
    image6.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(5);
  end;
if i=5 then
  begin
    IF IMAGE5.Tag=0 THEN
    image5.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(4);
  end;
if i=4 then
  begin
    IF IMAGE4.Tag=0 THEN
    image4.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(3);
  end;
if i=3 then
  begin
    IF IMAGE3.Tag=0 THEN
    image3.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(2);
  end;
if i=2 then
  begin
    IF IMAGE2.Tag=0 THEN
    image2.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=random(1);
  end;
if i=1 then
  begin
    IF IMAGE1.Tag=0 THEN
    image1.Picture.LoadFromFile(Extractfilepath(application.ExeName)+'FALSE.bmp') ELSE
    i:=1;
    form2.showmodal;

  end;
sstatusbar1.Panels[0].Text:='человек будет делать ход';
sstatusbar1.Panels[1].Text:='Компьютер сделал ход';            // <---------------
enabledp:=1;
PKTimer.Enabled:=False;


end;
aesoem вне форума Ответить с цитированием
Старый 18.07.2008, 20:17   #2
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Random(9) - это случайные числа из диапазона [0,8]. Если Вам не нужен ноль, пишите Random(9) +1; будет диапазон [1,9]. Верхнюю границу диапазона установите на один меньше , чем нужно. Чтобы числа не повторялись, в начале кода нужно прописать процедуру Randomize;
puporev вне форума Ответить с цитированием
Старый 18.07.2008, 20:28   #3
Altera
Старожил
 
Аватар для Altera
 
Регистрация: 29.01.2008
Сообщений: 2,406
По умолчанию

Вот, вкладываю всой исходник этой игры...
Ничего правдо там не помню давно писал, но кто ищет, то всегда танкист!
Вложения
Тип файла: rar Hrenka.rar (391.0 Кб, 646 просмотров)
Altera вне форума Ответить с цитированием
Старый 18.07.2008, 20:57   #4
aesoem
Форумчанин
 
Регистрация: 24.12.2007
Сообщений: 288
По умолчанию

всеравно компьютер пропускает ходы...
aesoem вне форума Ответить с цитированием
Старый 18.07.2008, 20:59   #5
Altera
Старожил
 
Аватар для Altera
 
Регистрация: 29.01.2008
Сообщений: 2,406
По умолчанию

Цитата:
Сообщение от aesoem Посмотреть сообщение
всеравно компьютер пропускает ходы...
Где, в моём исходнике?
Altera вне форума Ответить с цитированием
Старый 18.07.2008, 21:26   #6
Ring0Sn
Форумчанин
 
Аватар для Ring0Sn
 
Регистрация: 06.09.2007
Сообщений: 239
По умолчанию

aesoem, посмотри вот ето
Вложения
Тип файла: rar Krestik_nolik.rar (5.5 Кб, 664 просмотров)
Ring0Sn вне форума Ответить с цитированием
Старый 22.07.2008, 01:53   #7
Terran
Участник клуба
 
Аватар для Terran
 
Регистрация: 28.11.2007
Сообщений: 1,521
По умолчанию

Вот ещё один сиходник игры крестики нолики, очень хороший пример:

cross_zero.zip
Всегда рад помочь!
Terran вне форума Ответить с цитированием
Старый 16.05.2009, 16:49   #8
муська
Пользователь
 
Регистрация: 25.03.2009
Сообщений: 16
По умолчанию

как написать крестики-нолики в Delphi в консольном приложении через бинарные файлы? я вообще понятия не имею как эта игра будет запускать в Delphi . помогите пожалуйста.если есть у кого-нибудь программа этой игры и алгоритм,то выложите пожалуйста . очень прошу! если что, 379113303 моя ася. я просто могу забыть этот сайт или потерять
муська вне форума Ответить с цитированием
Старый 22.06.2009, 21:40   #9
муська
Пользователь
 
Регистрация: 25.03.2009
Сообщений: 16
По умолчанию

program KrestikiNoliki;

{$APPTYPE CONSOLE}
uses
SysUtils;

const n = 3;
type Matr = array [1..n,1..n] of char;
var x: matr;
k,l,i,j: byte;
a: boolean;
f: text;
str1, str2, s: string[20];



Function Stolbci(var a: matr): boolean;
var i,j,k: byte;
x: boolean;
begin
x:=false;
{ Проверка совпадений по строкам }
for i := 1 to n do
begin
k:=0;
for j := 1 to n-1 do
begin
if (a[i,j]<>'@') then
if (a[i,j]=a[i,j+1]) then inc(k);
end;
if k=n-1 then
begin
x:=true;
break;
end;
end;
Stolbci:=x;
end;



Function Stroki(var a: matr): boolean;
var i,j,k: byte;
x: boolean;
begin
x:=false;
{ Проверка совпадений по столбцам }
for j := 1 to n do
begin
k:=0;
for i := 1 to n-1 do
begin
if (a[i,j]<>'@') then
if (a[i,j]=a[i+1,j]) then inc(k);
end;
if k=n-1 then
begin
x:=true;
break;
end;
end;
Stroki:=x;
end;



Function LR(var a: matr): boolean;
var i,j,k: byte;
begin
{ Проверка совпадений по диагонали из левого верхнего угла в правый нижний }
LR:=false;
k:=0;
for i := 1 to n-1 do
if a[i,i]<>'@' then
if a[i,i]=a[i+1,i+1] then inc(k);
if k=n-1 then LR:=true;
end;



Function RL(var a: matr): boolean;
var i,j,k: byte;
begin
RL:=false;
{ Проверка совпадений по диагонали из правого верхнего угла в левый нижний }
k:=0;
for i := n downto 2 do
for j := 1 to n-1 do
if a[i,j]<>'@' then
if a[i,j]=a[i-1,j+1] then inc(k);
if k=n-1 then RL:=true;
end;


Function proverka(var a: matr): boolean;
var x: boolean;
begin
{ Итоговая проверка совпадений }
x:=Stroki(a);
if x=false then
begin
x:=Stolbci(a);
if x=false then
begin
x:=LR(a);
if x=false then x:=RL(a);
end;
end;
Proverka:=x;
end;
муська вне форума Ответить с цитированием
Старый 22.06.2009, 21:40   #10
муська
Пользователь
 
Регистрация: 25.03.2009
Сообщений: 16
По умолчанию

Procedure XodX (var a: matr);
var i,j: byte;
begin
{ Ход 1 игрока }
write(str1, ', vash xod. Sdelayte xod X : ');
read(i,j);
write(f,'Ход первого игрка :' );
write(f,i);
writeln(f,j);
if a[i,j]='@' then a[i,j]:='X';
end;



Procedure XodO(var a: matr);
var i,j : byte;
begin
{ Ход 2 игрока }
write(str2, ', vash xod. Sdelayte xod O: ');
read(i,j);
write(f,'Ход второго игрока: ' );
write(f,i);
writeln(f,j);
if a[i,j]='@' then a[i,j]:='O';
end;



begin
{ Крестики-нолики }

AssignFile(f,'igra.txt');
Append(f);
writeln;
writeln('-------------------------------------------------------------------------------- ');
writeln('---ZDRAVSTVUYTE. VAS PRIVETSTVUET IGRA KRESTIKI-NOLIKI MEZHDU DVUMYA IGROKAMI--- ');
writeln ('-------------------------------------------------------------------------------- ');
writeln;
writeln(' **************************');
writeln (' ***Imya pervogo igroka:***');
writeln(' **************************');
writeln;
readln(str1);
writeln (f, str1);
writeln;
writeln(' **************************');
writeln (' ***Imya vtorogo igroka:***');
writeln(' **************************');
writeln;
readln(str2);
writeln (f, str2);
writeln;
writeln('!!! IGRA NACHALAS !!! JELAU USPEXOV !!! VPERED !!!');
writeln;
writeln(f,'Игра крестики-нолики между двумя игроками');
l:=0; {Счетчик}
for i := 1 to n do
for j := 1 to n do
x[i,j]:='@';
vivodmatr(x);
writeln;
for k := 1 to n*n do
begin
while l<>n*n do
begin
XodX(x);
l:=l+1;
a:=Proverka(x);
if a=true then
begin
writeln;
Vivodmatr(x);
writeln;
writeln( str1, ', pozdravlyau! Vi pobedili!!! ');
writeln(f, str1, ', Вы победили');
break;
end;

begin
writeln;
Vivodmatr(x);
writeln;
XodO(x);
l:=l+1;
a:=Proverka(x);
if a=true then
begin
writeln;
Vivodmatr(x);
writeln;
writeln( str2, ', pozdravlyau! Vi pobedili!!! ');
writeln(f, str2, ', Вы победили');
break;
end;
readln;
writeln;
Vivodmatr(x);
writeln;
end;
end;
end;
if l=n*n then
begin
writeln('NICYA');
end;

write(f,'Количество ходов: ');
writeln(f,l);
CloseFile(f);
readln;
readln;
end.
муська вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Крестики нолики на C++ Alar Gamedev - cоздание игр: Unity, OpenGL, DirectX 11 15.03.2010 16:09
Крестики - Нолики Иваненко Помощь студентам 6 09.05.2008 22:09
x_O Крестики-нолики by -ORTODOX- Общие вопросы Delphi 1 10.03.2008 19:03
Еще раз крестики - нолики. Иваненко Помощь студентам 2 17.12.2007 20:09