Крестики и нолики

uses
  GraphABC, ABCButtons;
 
var
{s1,s2,s3,s4,s5,s6,s7,s8,s9,p1,p2,v,n,x,y,w:integer;
label 1,2,3,4,5,6;}
a,b,c, d,t: buttonabc;
fon,fon1: Picture;
procedure bot;forward; 
procedure two;forward; 
procedure tutorial;forward; 
procedure igra;forward;
procedure menu; 
begin 
fon := Picture.Create('C:\Users\Admin\Desktop/b2'+'.jpg'); 
fon.Draw(0, 0); 
 
begin 
 
B := new ButtonABC(250, 50, 200, 50, 'старт', clAzure); 
c := new ButtonABC(250, 150, 200, 50, 'выбрать уровень', clAzure);
d := new ButtonABC(250, 250, 200, 50, 'инструкция к игре', clAzure); 
a := new ButtonABC(250, 350, 200, 50, 'выйти из игры', clAzure); 
B.OnClick := bot; 
c.OnClick := two; 
d.OnClick := tutorial; 
a.OnClick := closewindow; 
 
end; 
end; 
procedure bot;
begin
clearwindow;
b.destroy; 
c.destroy; 
a.destroy; 
d.destroy; 
t:= new ButtonABC(700, 400,100,50, 'В главное меню', clAzure); 
t.OnClick := menu; 
 
end;
 
procedure two; 
begin 
clearwindow;
b.destroy; 
c.destroy; 
a.destroy; 
d.destroy; 
igra;
t:= new ButtonABC(700, 400,100,50, 'В главное меню', clAzure); 
t.OnClick := menu; end;
procedure igra;
var
s1,s2,s3,s4,s5,s6,s7,s8,s9,p1,p2,v,n,x,y,w:integer;
label 1,2,3,4,5,6;
begin
s1:=0;
s2:=0;
s3:=0;
s4:=0;
s5:=0;
s6:=0;
s7:=0;
s8:=0;
s9:=0;
rectangle(95,15,545,465);
rectangle(95,15,395,315);
rectangle(95,15,245,165);
rectangle(545,465,245,165);
rectangle(545,465,395,315);
rectangle(395,315,245,165);
 
1:read(p1);
if p1=1 then 
if s1=0 then s1:=1 else goto 1;
if p1=2 then 
if s2=0 then s2:=1 else goto 1;
if p1=3 then 
if s3=0 then s3:=1 else goto 1;
if p1=4 then 
if s4=0 then s4:=1 else goto 1;
if p1=5 then 
if s5=0 then s5:=1 else goto 1;
if p1=6 then 
if s6=0 then s6:=1 else goto 1;
if p1=7 then 
if s7=0 then s7:=1 else goto 1;
if p1=8 then 
if s8=0 then s8:=1 else goto 1;
if p1=9 then 
if s9=0 then s9:=1 else goto 1;
if p1>9 then goto 1;
 
if s7=1 then 
begin
setpencolor(clRed);
line(110+150*0,30+150*0,230+150*0,150+150*0);
line(110+150*0,150+150*0,230+150*0,30+150*0);
end;
 
if s8=1 then 
begin
setpencolor(clRed);
line(110+150*1,30+150*0,230+150*1,150+150*0);
line(110+150*1,150+150*0,230+150*1,30+150*0);
end;
 
if s9=1 then 
begin
setpencolor(clRed);
line(110+150*2,30+150*0,230+150*2,150+150*0);
line(110+150*2,150+150*0,230+150*2,30+150*0);
end;
 
if s4=1 then 
begin
setpencolor(clRed);
line(110+150*0,30+150*1,230+150*0,150+150*1);
line(110+150*0,150+150*1,230+150*0,30+150*1);
end;
 
if s5=1 then 
begin
setpencolor(clRed);
line(110+150*1,30+150*1,230+150*1,150+150*1);
line(110+150*1,150+150*1,230+150*1,30+150*1);
end;
 
if s6=1 then 
begin
setpencolor(clRed);
line(110+150*2,30+150*1,230+150*2,150+150*1);
line(110+150*2,150+150*1,230+150*2,30+150*1);
end;
 
if s1=1 then 
begin
setpencolor(clRed);
line(110+150*0,30+150*2,230+150*0,150+150*2);
line(110+150*0,150+150*2,230+150*0,30+150*2);
end;
 
if s2=1 then 
begin
setpencolor(clRed);
line(110+150*1,30+150*2,230+150*1,150+150*2);
line(110+150*1,150+150*2,230+150*1,30+150*2);
end;
 
if s3=1 then 
begin
setpencolor(clRed);
line(110+150*2,30+150*2,230+150*2,150+150*2);
line(110+150*2,150+150*2,230+150*2,30+150*2);
end;
 
if (s1>0) and (s2>0) and (s3>0) and (s4>0) and (s5>0) and (s5>0) and (s6>0) and (s7>0)  and (s7>0) and (s8>0) and (s9>0) then goto 6;
 
2:read(p2);
if p2=1 then 
if s1=0 then s1:=2 else goto 2;
if p2=2 then 
if s2=0 then s2:=2 else goto 2;
if p2=3 then 
if s3=0 then s3:=2 else goto 2;
if p2=4 then 
if s4=0 then s4:=2 else goto 2;
if p2=5 then 
if s5=0 then s5:=2 else goto 2;
if p2=6 then 
if s6=0 then s6:=2 else goto 2;
if p2=7 then 
if s7=0 then s7:=2 else goto 2;
if p2=8 then 
if s8=0 then s8:=2 else goto 2;
if p2=9 then 
if s9=0 then s9:=2 else goto 2;
if p2>9 then goto 2;
 
if s7=2 then 
begin
setpencolor(clBlue);
circle(170+150*0,90+150*0,60);
end;
 
if s8=2 then 
begin
setpencolor(clBlue);
circle(170+150*1,90+150*0,60);
end;
 
if s9=2 then 
begin
setpencolor(clBlue);
circle(170+150*2,90+150*0,60);
end;
 
if s4=2 then 
begin
setpencolor(clBlue);
circle(170+150*0,90+150*1,60);
end;
 
if s5=2 then 
begin
setpencolor(clBlue);
circle(170+150*1,90+150*1,60);
end;
 
if s6=2 then 
begin
setpencolor(clBlue);
circle(170+150*2,90+150*1,60);
end;
 
if s1=2 then 
begin
setpencolor(clBlue);
circle(170+150*0,90+150*2,60);
end;
 
if s2=2 then 
begin
setpencolor(clBlue);
circle(170+150*1,90+150*2,60);
end;
 
if s3=2 then 
begin
setpencolor(clBlue);
circle(170+150*2,90+150*2,60);
end;
 
6:if (s7=s8) and (s8=s9) and (s9=1) then v:=1;
if (s4=s5) and (s5=s6) and (s6=1) then v:=1;
if (s1=s2) and (s2=s3) and (s3=1) then v:=1;
if (s1=s4) and (s4=s7) and (s7=1) then v:=1;
if (s2=s5) and (s5=s8) and (s8=1) then v:=1;
if (s3=s6) and (s6=s9) and (s9=1) then v:=1;
if (s3=s5) and (s5=s7) and (s7=1) then v:=1;
if (s1=s5) and (s5=s9) and (s9=1) then v:=1;
 
if v=1 then n:=1;
 
if (s7=s8) and (s8=s9) and (s9=2) then v:=2;
if (s4=s5) and (s5=s6) and (s6=2) then v:=2;
if (s1=s2) and (s2=s3) and (s3=2) then v:=2;
if (s1=s4) and (s4=s7) and (s7=2) then v:=2;
if (s2=s5) and (s5=s8) and (s8=2) then v:=2;
if (s3=s6) and (s6=s9) and (s9=2) then v:=2;
if (s3=s5) and (s5=s7) and (s7=2) then v:=2;
if (s1=s5) and (s5=s9) and (s9=2) then v:=2;
 
 
if (n=1) and (v=2) then n:=2;
 
if v<2 then
if (s1>0) and (s2>0) and (s3>0) and (s4>0) and (s5>0) and (s5>0) and (s6>0) and (s7>0)  and (s7>0) and (s8>0) and (s9>0) then n:=2;
 
if v=1 then 
begin
setpencolor(clRed);
3:x:=random(635)+6;
y:=random(475)+6;
line(x-5,y-5,x+5,y+5);
line(x+5,y-5,x-5,y+5);
sleep(50);
goto 3;
end;
 
if n=2 then 
begin
4:x:=random(635)+6;
y:=random(475)+6;
w:=random(2)+1;
if w=1 then
begin
setpencolor(clRed);
line(x-5,y-5,x+5,y+5);
line(x+5,y-5,x-5,y+5);
sleep(50);
goto 4;
end;
x:=random(640)+1;
y:=random(480)+1;
setpencolor(clBlue);
circle(x,y,5);
sleep(50);
goto 4;
end;
 
if v=2 then 
begin
setpencolor(clBlue);
5:x:=random(640)+1;
y:=random(480)+1;
circle(x,y,5);
sleep(50);
goto 5;
end;
 
goto 1;
 
end;
 
procedure tutorial; begin 
clearwindow; 
b.destroy; 
c.destroy; 
a.destroy; 
d.destroy; 
fon1 := Picture.Create('C:\Users\Admin\Desktop/b2'+'.jpg'); 
fon1.Draw(0, 0); 
t:= new ButtonABC(700, 400,100,50, 'Назад', clAzure); 
t.OnClick := menu; 
 end;
 
 
 
begin
setwindowwidth(800); 
 setwindowheight(450);
 menu;
{fon := Picture.Create('C:\Users\Admin\Desktop/b2'+'.jpg'); 
  fon.Draw(0, 0);
  B := new ButtonABC(250, 50, 200, 50, 'Игра с ботом', clAzure);
  c := new ButtonABC(250, 150, 200, 50, 'Игра на двоих', clAzure);
  d := new ButtonABC(250, 250, 200, 50, 'Справка по игре', clAzure);
  a := new ButtonABC(250, 350, 200, 50, 'Выход из игры', clAzure);
  B.OnClick := bot; 
  c.OnClick := two;
  d.OnClick := tutorial;
  a.OnClick:= closewindow;}
 
end.

uses GraphABC;
const
  N = 2;
  Z = '0';
  K = 'X';
  Size = 200;
  Border = 1;
  Sx = 1200;
  Sy = 70;
 
var
  Matrix: array [0..N, 0..N] of char;
  Player1: boolean;
 
procedure Draw();
  procedure DrawZ(i, j: integer);
  begin
    SetPenColor(clCyan);
    SetPenWidth(4);
    var size2 := Size div 2;
    DrawCircle((i + 1) * Size - size2, (j + 1) * Size - size2, Round(size2 * 0.7));
  end;
  
  procedure DrawK(i, j: integer);
    procedure RLine(x, y, x1, y1: real):=Line(Round(x), Round(y), Round(x1), Round(y1));
 
  begin
    SetPenColor(clPink);
    SetPenWidth(4);
    var size2 := Size div 2 * 0.3;
    var cx1 := i * Size + size2;
    var cy1 := j * Size + size2;
    var cx2 := (i + 1) * Size - size2;
    var cy2 := (j + 1) * Size - size2;
    RLine(cx1, cy1, cx2, cy2);
    RLine(cx1, cy2, cx2, cy1);
  end;
 
  begin
    ClearWindow(clBlack);
    if Player1 then SetWindowCaption('Ходит первый игрок') else SetWindowCaption('Ходит второй игрок');
    for var i := 0 to N do
      for var j := 0 to N do
      begin
        SetPenColor(clLightBlue);
        SetPenWidth(1);
        DrawRectangle(i * Size + Border, j * Size + Border, (i + 1) * Size - Border, (j + 1) * Size - Border);
        if Matrix[i, j] = Z then DrawZ(i, j)
        else if Matrix[i, j] = K then DrawK(i, j);
      end;
    Redraw();
  end;
 
function Won(c: char): boolean;
var
  count: byte;
begin
  Result := false;
  for var i := 0 to N do
  begin
    count := 0;
    for var j := 0 to N do
      if Matrix[i, j] = c then Inc(count);
    if count = 3 then Result := true;
  end;
  
  if not Result then
  begin
    for var i := 0 to N do
    begin
      count := 0;
      for var j := 0 to N do
        if Matrix[j, i] = c then Inc(count);
      if count = 3 then Result := true;
    end;
    
    if not Result then
    begin
      count := 0;
      for var i := 0 to N do
        if Matrix[i, i] = c then Inc(count);
      if count = 3 then Result := true;
      
      if not Result then
      begin
        count := 0;
        for var i := 0 to N do
          if Matrix[N - i, i] = c then Inc(count);
        if count = 3 then Result := true;
      end;
    end;
  end;
end;
 
function IsFull(): boolean;
begin
  Result := true;
  for var i := 0 to N do
    for var j := 0 to N do
      if (Matrix[i, j] <> Z) and (Matrix[i, j] <> K) then
      begin
        Result := false;
        break;
      end;
end;
 
procedure MouseDown(x, y, mb: integer);
  procedure ShowWinner(s: string; c: Color);
  begin
    SetWindowCaption('Результат игры');
    Sleep(2000);
    SetWindowSize(Sx, Sy);
    CenterWindow();
    ClearWindow(clBlack);
    
    SetFontSize(16);
    SetFontStyle(fsBold);
    SetFontColor(c);
    DrawTextCentered(0, 0, Sx, Sy, s);
    
    Redraw();
    Sleep(2000);
    Halt();
  end;
 
begin
  var i := x div Size;
  var j := y div Size;
  if (Matrix[i, j] <> Z) and (Matrix[i, j] <> K) then
  begin
    if Player1 then Matrix[i, j] := Z else Matrix[i, j] := K;
    Draw();
    
    var winnerExists := Won(Z) or Won(K);
    if winnerExists then
      if Player1 then ShowWinner('Игрок первый победил!', clLightBlue) else ShowWinner('Игрок второй победил!', clLightBlue);
    
    if IsFull() and not winnerExists then ShowWinner('Ничья!', clOrange);
    
    Player1 := not Player1;
  end;
end;
 
begin
  var Size2 := Size * 3;
  SetWindowIsFixedSize(true);
  SetWindowSize(Size2, Size2);
  CenterWindow();
  LockDrawing();
  
  Player1 := true;
  Draw();
  
  OnMouseDown := MouseDown;
end.

uses GraphAbc;
type arr=array[1..3,1..3] of byte;
var
  a:arr;
  b:arr=((2,7,6),(9,5,1),(4,3,8));
  m:integer;
  hod:boolean;
  NGame:boolean;
 
procedure DrawRect(y,x:integer;c,c1:color);
var
  i,j:integer;
begin
  SetBrushColor(c1);
  SetBrushStyle(bsSolid);
  Rectangle(x*100+2,y*100+2,(x+1)*100-2,(y+1)*100-2);
  SetFontName('Times New Roman');
  SetFontColor(c);
  SetFontSize(48);
  if a[y,x]=1 then TextOut(x*100+50-TextWidth('X') div 2,Y*100+50-TextHeight('X') div 2,'X') else
  if a[y,x]=2 then TextOut(x*100+50-TextWidth('0') div 2,Y*100+50-TextHeight('0') div 2,'0');
end;
 
procedure MouseUp(x,y,mb: integer);
var
  tx,ty:integer;
begin
  if ((x>10) and (x<100)) and ((y>WindowHeight-40) and (y<WindowHeight-10)) then NGame:=true;
  if ((x>WindowWidth-100) and (x<WindowWidth-10)) and ((y>WindowHeight-40) and (y<WindowHeight-10)) then CloseWindow;
  tx:=x div 100;
  ty:=y div 100;
  if ((tx>0) and (tx<4)) and ((ty>0) and (ty<4)) and (a[ty,tx]=0) then begin
    a[ty,tx]:=1;
    DrawRect(ty,tx,clRed,clBlue);
    hod:=false;
  end;
end;
 
function EndGame:integer;{0-draw game;2-pc wins;1-human wins;4-continue}
var
  i,j,c,h:integer;
  ok:boolean;
begin
  ok:=true;
  for i:=1 to 3 do 
    if ok then begin
        c:=0;h:=0;
        for j:=1 to 3 do begin
          h:=h+b[i,j]*ord(a[i,j]=1);
          c:=c+b[i,j]*ord(a[i,j]=2);
        end;
       ok:=not((h=15) or (c=15));
     end;
  if ok then
  for j:=1 to 3 do 
    if ok then begin
        c:=0;h:=0;
       for i:=1 to 3 do begin
          h:=h+b[i,j]*ord(a[i,j]=1);
          c:=c+b[i,j]*ord(a[i,j]=2);
        end;
       ok:=not((h=15) or (c=15));
    end;
  if ok then begin
    c:=0;h:=0;
    for i:=1 to 3 do begin
       h:=h+b[i,i]*ord(a[i,i]=1);
       c:=c+b[i,i]*ord(a[i,i]=2);
     end;
       ok:=not((h=15) or (c=15));
  end;
  if ok then begin
    c:=0;h:=0;
    for i:=1 to 3 do begin
       h:=h+b[i,4-i]*ord(a[i,4-i]=1);
       c:=c+b[i,4-i]*ord(a[i,4-i]=2);
     end;
       ok:=not((h=15) or (c=15));
  end;
  m:=0;
  for i:=1 to 3 do
    for j:=1 to 3 do
      if a[i,j]=0 then m:=m+1;
  Result:=4;
  if h=15 then Result:=1 else
  if c=15 then Result:=2 else
  if m=0 then Result:=0;
end;
 
procedure PC_Try;
var
  i,j,cx,cy:integer;
 
begin
  for i:=1 to 3 do
    for j:=1 to 3 do
      if a[i,j]=0 then begin
        a[i,j]:=2;
        if EndGame=2 then begin
          drawrect(i,j,clYellow,clBlue);
          exit;
        end else a[i,j]:=0;
      end;
  for i:=1 to 3 do
    for j:=1 to 3 do
      if a[i,j]=0 then begin
        a[i,j]:=1;
        if EndGame=1 then begin
          a[i,j]:=2;
          drawrect(i,j,clYellow,clBlue);
          exit;
        end else a[i,j]:=0;
      end;
  repeat
    cx:=random(3)+1;cy:=random(3)+1;
  until ((m<7) and (a[cx,cy]=0)) or ((a[cx,cy]=0) and not (b[cx,cy] in [7,3,9,1]));
  a[cx,cy]:=2;
  drawrect(cx,cy,clYellow,clBlue)
end;
 
procedure DrawRectText(x1,y1,x2,y2:integer;c:color;s:string);
begin
  SetFontColor(clBlack);
  SetFontName('Times New Roman');
  SetFontSize(12);
  SetBrushStyle(bsSolid);
  SetBrushColor(c);
  SetPenColor(clBlack);
  RoundRect(x1,y1,x2,y2,10,10);
  TextOut(x1+abs(x2-x1)div 2-TextWidth(s) div 2,y1+abs(y2-y1)div 2-TextHeight(s) div 2,s);
end;  
 
var
  i,j:integer;
begin
  SetWindowSize(640,480);
  SetWindowIsFixedSize(true);
  OnMouseUp:=MouseUp;
  randomize;
  repeat
    NGame:=false;
    ClearWindow;
    DrawRectText(10,WindowHeight-40,100,WindowHeight-10,clAzure,'New Game');
    DrawRectText(WindowWidth-100,WindowHeight-40,WindowWidth-10,WindowHeight-10,clAquamarine,'End Game');    
    hod:=random(2)=1;
    for i:=1 to 3 do
      for j:=1 to 3 do begin a[i,j]:=0;DrawRect(i,j,clBlack,clBlue);end;
  repeat
    if hod then while (hod) and (not NGame) do ;
    if EndGame=4 then PC_try;
    hod:=true;
  until (Endgame<>4) or (NGame);
  Case EndGame of
    1:TextOut(1,1,'You win');
    2:TextOut(1,1,'I win');
    0:TextOut(1,1,'Draw Game');
  end;
  while not NGame do;
 until false;
  CloseWindow;
end.