Показать сообщение отдельно
Старый 30.09.2012, 16:34   #4
Mr.Extraneo
AnyKey`щик
 
Регистрация: 29.09.2012
Сообщений: 6
Написано 0 полезных сообщений
(для 0 пользователей)
Ответ: Крестики-Нолики

В коде уже нет ошибок.
program Tic_Tac_Toe;
var
  cmdOK,cmdExit,cmdContinue,clicked: command;
  p:array[1..9] of char;
  Ximg,Oimg: image;

procedure DrawPlace;
var i,y: integer;
begin
  SetColor(0,0,0);
  i:=GetHeight div 2;
  y:=i div 4;
  DrawLine(20,i-y,GetWidth-20,i-y);
  DrawLine(20,i+y,GetWidth-20,i+y);
  i:=GetWidth div 2;
  y:=i div 4;
  DrawLine(i-y,20,i-y,GetHeight-20);
  DrawLine(i+y,20,i+y,GetHeight-20);
  repaint;
end;

procedure DrawXO(c: char; pos: integer);
var
  x,x1,y,y1: integer;
  img: image;
begin
  if c='X' then img:=Ximg;
  if c='O' then img:=Oimg;
  x:=GetWidth; x1:=GetImageWidth(img)/2;
  y:=GetHeight; y1:=GetImageHeight(img)/2;
  if pos=1 then DrawImage(img,x div 4-x1, y div 4-y1);
  if pos=2 then DrawImage(img,x div 2-x1,y div 4-y1);
  if pos=3 then DrawImage(img,x-x1-x div 4,y div 4-y1);
  if pos=4 then DrawImage(img,x div 4-x1,y div 2-y1);
  if pos=5 then DrawImage(img,x div 2-x1,y div 2-y1);
  if pos=6 then DrawImage(img,x-(x div 4)-x1,y div 2-y1);
  if pos=7 then DrawImage(img,x div 4-x1, y-(y div 4)-y1);
  if pos=8 then DrawImage(img,x div 2-x1,y-(y div 4)-y1);
  if pos=9 then DrawImage(img,x-(x div 4)-x1,y-(y div 4)-y1);
end;

procedure DrawAll;
var i: integer;
begin
  for i:=1 to 9 do
    DrawXO(p[i],i);
end;

procedure ShowMess(s: string);
begin
  SetClip(0,0,GetWidth,GetHeight);
  SetColor(0,0,0);
  FillRect(0,GetHeight div 2+5,GetWidth,GetStringHeight(s));
  Setcolor(255,255,255);
  SetFont(FONT_FACE_SYSTEM,FONT_STYLE_BOLD,FONT_SIZE_LARGE);
  DrawText(s,(Getwidth div 2-GetStringWidth(s)/2),GetHeight div 2);
  repaint;
end;

function CheckFull: boolean;
var i,all: integer;
begin
  CheckFull:=false;
  all:=0;
  for i:=1 to 9 do
  if p[i]<>' ' then all:=all+1;
  if all=9 then CheckFull:=true;
end;

function CheckWin(c: char): boolean; forward;

function CheckGameEnd: boolean;
begin
  CheckGameEnd:=false;
  if checkWin('X') then
    begin
      CheckGameEnd:=true;
      ShowMess('You WIN!');
    end
  else if CheckWin('O') then
    begin
      CheckGameEnd:=true;
      ShowMess('You Lose');
    end
  else if CheckFull then
    begin
      CheckGameEnd:=true;
      ShowMess('Nobody win...');
    end;
end;

function CheckWin(c: char): boolean;
begin
  CheckWin:=false;
  if (p[1]=c) and (p[2]=c) and (p[3]=c) then checkWin:=true;
  if (p[4]=c) and (p[5]=c) and (p[6]=c) then checkWin:=true;
  if (p[7]=c) and (p[8]=c) and (p[9]=c) then CheckWin:=true;
  if (p[1]=c) and (p[4]=c) and (p[7]=c) then CheckWin:=true;
  if (p[2]=c) and (p[5]=c) and (p[8]=c) then CheckWin:=true;
  if (p[3]=c) and (p[6]=c) and (p[9]=c) then checkWin:=true;
  if (p[1]=c) and (p[5]=c) and (p[9]=c) then CheckWin:=true;
  if (p[3]=c) and (p[5]=c) and (p[7]=c) then CheckWin:=true;
end;

function Step(c: char; pos: integer): boolean;
begin
  Step:=false;
  if not ((pos<1) or (pos>9)) then
    if p[pos]=' ' then
      begin
        p[pos]:=c;
        step:=true;
      end;
end;

procedure CompStep;
var
  tmp: boolean;
begin
  tmp:=false;
  while not tmp do
    begin
      randomize;
      if not tmp then
      if (p[1]='O') and (p[2]='O') and (p[3]=' ') then Tmp:=Step('O',3) else
      if (p[1]<>' ') and (p[2]<>' ') and (p[3]=' ') then tmp:=step('O',3) else
      if (p[1]<>' ') and (p[2]=' ') and (p[3]<>' ') then tmp:=step('O',2) else
      if (p[1]=' ') and (p[2]<>' ') and (p[3]<>' ') then tmp:=step('O',1) else
      if (p[4]<>' ') and (p[5]<>' ') and (p[6]=' ') then tmp:=Step('O',6) else
      if (p[4]<>' ') and (p[5]=' ') and (p[6]<>' ') then tmp:=Step('O',5) else
      if (p[4]=' ') and (p[5]<>' ') and (p[6]<>' ') then tmp:=Step('O',4) else
      if (p[7]<>' ') and (p[8]<>' ') and (p[9]=' ') then tmp:=Step('O',9) else
      if (p[7]<>' ') and (p[8]=' ') and (p[9]<>' ') then tmp:=Step('O',8) else
      if (p[7]=' ') and (p[8]<>' ') and (p[9]<>' ') then tmp:=Step('O',7) else
      if (p[1]<>' ') and (p[4]<>' ') and (p[7]=' ') then tmp:=Step('O',7) else
      if (p[1]<>' ') and (p[4]=' ') and (p[7]<>' ') then tmp:=Step('O',4) else
      if (p[1]=' ') and (p[4]<>' ') and (p[7]<>' ') then tmp:=Step('O',1) else
      if (p[2]<>' ') and (p[5]<>' ') and (p[8]=' ') then tmp:=Step('O',8) else
      if (p[2]<>' ') and (p[5]=' ') and (p[8]<>' ') then tmp:=Step('O',5) else
      if (p[2]=' ') and (p[5]<>' ') and (p[8]<>' ') then tmp:=Step('O',2) else
      if (p[3]<>' ') and (p[6]<>' ') and (p[9]=' ') then tmp:=Step('O',9) else
      if (p[3]<>' ') and (p[6]=' ') and (p[9]<>' ') then tmp:=Step('O',6) else
      if (p[3]=' ') and (p[6]<>' ') and (p[9]<>' ') then tmp:=Step('O',3) else
      if (p[1]=' ') and (p[5]<>' ') and (p[9]<>' ') then tmp:=Step('O',1) else
      if (p[1]<>' ') and (p[5]=' ') and (p[9]<>' ') then tmp:=Step('O',5) else
      if (p[1]<>' ') and (p[5]<>' ') and (p[9]=' ') then tmp:=Step('O',9) else
      if (p[3]=' ') and (p[5]<>' ') and (p[7]<>' ') then tmp:=Step('O',3) else
      if (p[3]<>' ') and (p[5]=' ') and (p[7]<>' ') then tmp:=Step('O',5) else
      if (p[3]<>' ') and (p[5]<>' ') and (p[7]=' ') then tmp:=Step('O',7) else
      tmp:=Step('O',9-random(9));
    end;
end;

procedure CreateGame;
var
  i: integer;
  userstep: boolean;
  gameend: boolean;
begin
  Ximg:=loadimage('/50px-StAndrewsCross.png');
  Oimg:=loadimage('/circle.png');
  removecommand(cmdOk);
  showcanvas;
  addcommand(cmdexit);
  repaint;
  gameend:=false;
  for i:=1 to 9 do p[i]:=' ';
  while not GameEnd do
    begin
      SetColor(255,255,255);
      FillRect(0,0,getwidth,getheight);
      drawplace;
      compstep;
      repaint;
      drawall;
      repaint;
      gameEnd:=checkgameend;
      if (not GameEnd) then
        while not UserStep do
          while (getkeypressed=KE_NONE) do
            begin
              delay(100);
              if getClickedCommand=cmdExit then Halt;
              if GetKeyPressed=KE_KEY1 then i:=1;
              if GetKeyPressed=KE_KEY2 then i:=2;
              if GetKeyPressed=KE_KEY3 then i:=3;
              if GetKeyPressed=KE_KEY4 then i:=4;
              if GetKeyPressed=KE_KEY5 then i:=5;
              if GetKeyPressed=KE_KEY6 then i:=6;
              if GetKeyPressed=KE_KEY7 then i:=7;
              if GetKeyPressed=KE_KEY8 then i:=8;
              if GetKeyPressed=KE_KEY9 then i:=9;
              userstep:=step('X',i);
              i:=0;
            end;
      userstep:=false;
      DrawAll;
      repaint;
      GameEnd:=CheckGameEnd;
      end;
      addcommand(cmdContinue);
      repaint;
      repeat
        delay(100);
        clicked:=getclickedcommand;
      until clicked<>EmptyCommand;
      removecommand(cmdContinue);
      if clicked=cmdContinue then CreateGame;
end;

begin
  cmdok:=createcommand('Start',CM_OK,1);
  addcommand(cmdok);
  repeat
    delay(100);
    clicked:=getclickedcommand;
  until clicked=cmdOk;
  cmdExit:=createcommand('Exit',CM_EXIT,1);
  CreateGame;
end.

Последний раз редактировалось Mr.Extraneo, 30.09.2012 в 20:21.
(Offline)
 
Ответить с цитированием