Версия 1:

program graph_01;

uses GraphABC;
const
  dtx = 70;
  dty = 5;
  FontSize = 100;
  
var
  dx, dy: integer;
  sym, sym_user: char;
  xom: array[0..2, 0..2] of char;

function MessageBox(h: integer; m, c: string; t: integer): integer; 
  external 'User32.dll' name 'MessageBox'; 

function get_num(x, y: integer): integer;
var num: integer;
begin
    num := 0;
    if x < dx then
        if y < dy then
            num := 1
        else if y > dy * 2 then
            num := 7
        else
            num := 4
    else if x > dx * 2 then
        if y < dy then
            num := 3
        else if y > dy * 2 then
            num := 9
        else
            num := 6
    else
        if y < dy then
            num := 2
        else if y > dy * 2 then
            num := 8
        else
            num := 5;
    get_num := num;
end;

procedure xom_clear;
var i, j: byte;
begin
  for i := 0 to 2 do
      for j := 0 to 2 do
        xom[i, j] := ' ';
end;

procedure xom_set(x, y: integer; _sym: char);
var num_, i, j: integer;
begin
  num_ := get_num(x, y);
  i := (num_ - 1) div 3;
  j := (num_ - 1) mod 3;
  xom[i, j] := _sym;
end;

function xom_check(_sym: char): boolean;
var i, j: integer;
  flag: boolean;
begin
  flag := (_sym = xom[0, 0]) and (xom[0, 0] = xom[1, 1]) and
                                 (xom[1, 1] = xom[2, 2]); // диагональ
  if not flag then
      flag := (_sym = xom[2, 0]) and (xom[2, 0] = xom[1, 1]) and
                                     (xom[1, 1] = xom[0, 2]); // обратная диагональ
  if not flag then
      for i := 0 to 2 do  begin
        flag := (_sym = xom[i, 0]) and (xom[i, 0] = xom[i, 1]) and
                                       (xom[i, 1] = xom[i, 2]); // i-ая строка
        if flag then  break;
        flag := (_sym = xom[0, i]) and (xom[0, i] = xom[1, i]) and
                                       (xom[1, i] = xom[2, i]); // i-ый столбец
        if flag then  break;
      end;
  xom_check := flag;
end;
  
function get_sym(_sym: char): char;
begin
    if _sym = 'O' then
      _sym := 'X'
    else
        if _sym = 'X' then
          _sym := 'O';
    get_sym := _sym;
end;

// _z - какую координату, _dtz - начальная точка, _dz - дельта
function get_point(_z, _dtz, _dz: integer): integer;
var tz: integer;
begin
    if _z > _dz * 2 then
        tz := _dtz + _dz * 2
    else if _z < _dz then
        tz := _dtz
    else
        tz := _dtz + _dz;
    get_point := tz;    
end;

procedure MouseUp(x, y, mb: integer);
var  tx, ty: integer;
  msg: String;
begin
  sym := get_sym(sym);
  tx := get_point(x, dtx, dx);
  ty := get_point(y, dty, dy);
  xom_set(x, y, sym);
  Font.Size := FontSize;
  Font.Style := FontStyleType.fsBold;
  TextOut(tx, ty, sym);
  if xom_check(sym) then  begin
    msg := sym + ' Выиграли!!!';    
    MessageBox(0, msg ,'Сообщение', 0);
  end;
end;

begin
  xom_clear;
  //print(WindowWidth, ' x ', WindowHeight);
  dx := WindowWidth div 3;
  dy := WindowHeight div 3;
 
  Line(dx, 0, dx, WindowHeight);
  Line(dx * 2, 0, dx * 2, WindowHeight);
  Line(0, dy, WindowWidth, dy);
  Line(0, dy * 2, WindowWidth, dy * 2);
  
  readln(sym_user);
  case sym_user of
    'O', 'o', '0': sym := 'X';
  else
    sym := 'O';
  end;

  // Привязка обработчиков к событиям
  OnMouseUp := MouseUp;
end.

Версия 2:

program graph_02;

uses GraphABC;
const
  N = 6;
  
var
  dx, dy, dtx, dty, FontSize: integer;
  sym, sym_user: char;
  set_sym: boolean;
  xom: array[0..N-1, 0..N-1] of char;

function MessageBox(h: integer; m, c: string; t: integer): integer; 
  external 'User32.dll' name 'MessageBox'; 

procedure set_param;
begin
  //print(WindowWidth, ' x ', WindowHeight);
  dx := WindowWidth div N; // длина ячейки
  dy := WindowHeight div N;// высота ячейки
  FontSize := dy * 2 div 3; // WindowWidth div 10;
  dty := (dy - FontSize) div 30;
  dtx := FontSize div 2; // dx div 20;
  set_sym := true;
end;

// _z - какую координату, _dtz - начальная точка, _dz - дельта
function get_point(_z, _dtz, _dz: integer): integer; // [-V]
var _N: integer;
begin
  _N := _z div _dz;
  get_point := _dtz + _dz * _N;    
end;

function get_num(x, y: integer): integer; // [-V] по координатам получить номер по порядку
var num, i, k: integer;
begin
    i := x div dx;
    k := y div dy;
    get_num := k * N + i + 1;
end;

procedure xom_clear; // [+]
var i, j: byte;
begin
  for i := 0 to N - 1 do
      for j := 0 to N - 1 do
        xom[i, j] := ' ';
end;

function xom_set(x, y: integer; _sym: char): boolean; // [+]
var num_, i, j: integer;
  set_flag: boolean;
begin
  set_flag := false;
  num_ := get_num(x, y);
  i := (num_ - 1) div N; // получаем ряд
  j := (num_ - 1) mod N; // получаем столбец/колонку
  if xom[i, j] = ' ' then  begin
    xom[i, j] := _sym;
    set_flag := true;
  end;
  xom_set := set_flag;
end;

function xom_check(_sym: char): boolean; // [***]
var i, k: integer;
  flag: boolean;
begin
  //Z := 0;
  // проверка каждой строки
  for i := 0 to N - 1 do  begin // строки
    flag := True;
    for k := 0 to N - 1 do     // столбцы
      if _sym <> xom[i, k] then  begin
        flag := False;
        break
      end;
    if flag = True then  break; // Если flag после после прохода по строке остался True - выходим
  end; // for i
  
  // проверка каждого столбца
  if not flag then
    for k := 0 to N - 1 do  begin  // столбцы
      flag := True;
      for i := 0 to N - 1 do  // строки
        if _sym <> xom[i, k] then  begin
          flag := False;
          break
        end;
      if flag = True then  break; // Если flag после после прохода по столбцу остался True - выходим
    end; // for k

  // Диагональ основная
  if not flag then  begin
    flag := True;
    for i := 0 to N - 1 do  
      if _sym <> xom[i, i] then  begin
        flag := False;
        break
     end;    
  end;

  // Диагональ Обратная
  if not flag then  begin
    flag := True;
    for i := 0 to N - 1 do  
      if _sym <> xom[N - i - 1, i] then  begin
        flag := False;
        break
     end;    
  end;
    
  xom_check := flag;
end;

function get_sym(_sym: char): char; // [+]
begin
    if _sym = 'O' then
      _sym := 'X'
    else
        if _sym = 'X' then
          _sym := 'T'
        else
            if _sym = 'T' then
              _sym := 'O';
    get_sym := _sym;
end;

procedure draw_field(); // прорисовыет сетку (снова и снова)
var i: integer;
begin
  for i := 1 to N - 1 do  begin
    Line(dx * i, 0, dx * i, WindowHeight);
    Line(0, dy * i, WindowWidth, dy * i);
  end;
end;

procedure MouseUp(x, y, mb: integer); // [-V]
var  tx, ty: integer;
  msg: String;
begin
//  if (x < 50) and (y < 50) then
//     MessageBox(0, 'Введите символ первого хода: ', 'Вопрос', 5);

//  if MessageDlg( 'Удалить ?', mtConfirmation, 'mbYes, mbNo', 0) = mrYes then
//    MessageBox(0, 'Введите символ первого хода: ', 'Вопрос', 5);

  if set_sym = true then
    sym := get_sym(sym); // получаем новый символ
  set_sym := xom_set(x, y, sym);
  if set_sym = true then  begin
    Font.Size := FontSize;
    Font.Style := FontStyleType.fsBold;
    tx := get_point(x, dtx, dx);
    ty := get_point(y, dty, dy);
    TextOut(tx, ty, sym);
    draw_field;
    if xom_check(sym) then  begin
    msg := sym + ' Выиграли!!!';    
    MessageBox(0, msg ,'Сообщение', 0);
    xom_clear;
    clearwindow;
    draw_field;
    end;
  end;
end;


begin
  // write('Введите символ первого хода: ');
 
  //readln(sym_user);
  xom_clear;
  set_param;
  
  draw_field;
  
  case sym_user of
    'O', 'o', '0': sym := 'X';
  else
    sym := 'O';
  end;

  // Привязка обработчиков к событиям
  OnMouseUp := MouseUp;
end.

Вложения:

tic-tac-toe_2.pas	[ ]	4 Кб
tiс-taс-toe.pas	[ ]	3 Кб