Delphi World - Крестики - нолики с коброй
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Крестики - нолики с коброй

Оформил: DeeCo

Автор: Евгений Левшаков

CORBA

Сначала немного обязательной теории. Аббревиатура CORBA как известно расшифровывается как Common Object Request Broker Architecture, и представляет собой объектно-ориентированную архитектуру связи между клиентом и сервером. Приложения на основе CORBA состоят из двух частей: CORBA-сервер и CORBA-клиент. И сервер и клиент могут быть реализованы на любом языке и запущены на любой платформе. CORBA представляет собой независимую от языка программирования и операционной системы технологию. Это возможно, так как все параметры и типы, возвращаемые методами транспортируются через сеть в специально универсальном формате. А вот для того чтобы сервер и клиент понимали друг друга необходимо определить интерфейс CORBA-сервера, при этом необходимо учитывать независимость от операционной системы и языка на котором происходит разработка приложения. Для этой цели и был разработан интерфейс общения клиента и сервера Interface Definition Language (IDL). Используя IDL, можно определять специфические объекты с присущими им методами и свойствами. Данные методы подобны функциям, которые могут быть вызваны клиентом, и которые могут быть реализованы сервером. В Delphi например для реализации подобного интерфейса прийдеться компилировать специализированный IDL-файл. Вообще же преобразование из стандартного внутреннего стандарта языка программирования в подобный переносимый формат обозначают как marshalling. Обратный процесс преобразования из универсального формата в стандарт понятный программе называется unmarshalling.

Особенности установки VisiBroker

В стандартный набор Delphi 6 Enterprise входит поддержка CORBA в двух вариантах. Во время инсталляции Delphi необходимо выбрать поддержку VisiBroker 3.3 или VisiBroker 4. Это связано с тем, что VisiBroker 3.3 и VisiBroker 4 не могут быть установлены одновременно. В противном случаи, возможны проблемы при работе с Delphi 6. В более ранней версии VisiBroker 3.3 существует полезная возможность динамического вызова интерфейса. В VisiBroker 4 это функциональная особенность не поддерживается. Несмотря на это VisiBroker 4 представляет собой более совершенную реализацию стандарта CORBA, поэтому вопросы, связанные с предыдущей версией VisiBroker 3.3 рассматриваться не будут.

TicTacToe

А теперь рассмотрим возможности технологии CORBA в Delphi, с использованием VisiBroker 4, на примере практического создания небольшой программы. Ниже представлена конструкция IDL известной всем игры в "крестики-нолики", которая имеет гордое английское название TicTacToe. Модуль TTT с интерфейсом TicTacToe реализуется CORBA сервером, и CORBA клиент может соединяться с сервером во время игры.
module TTT
{
  interface TicTacToe
  {
    typedef long TGame;
    typedef long TPlace; // 0,1..9
    enum TPlayer
    {
      user,
      computer,
      none
    };
exception PlaceTaken
{
  TPlayer TakenBy;
};

TGame NewGame();
void MakeMove(in TGame Game, in TPlayer player, in TPlace Place)
raises(PlaceTaken);
TPlace NextMove(in TGame Game, in TPlayer player);
TPlayer IsWinner(in TGame Game);
TPlayer GetValue(in TGame Game, in TPlace Place);
};
};
Модуль TTT имеет интерфейс TicTacToe. Это интерфейс содержит определения ряда типов (видимы только внутри области интерфейса), определение исключения и определения ряда методов. Обратите внимание, что метод MakeMove может вызывать исключение PlaceTaken. Исключение PlaceTaken - фактически структура, которая также будет обработана.

IDL2Pas Wizard

Для использования IDL файла, его необходимо скомпилировать для Server Skeletons и Client Stubs. Для этого используется файл IDL2Pas, который является частью VisiBroker for Delphi. Но более простой путь, использовать мастера CORBA Server Application и CORBA Client Найти их можно в File | New | Other, закладка Corba.


New items

При выборе мастера CORBA Server Application появится окно и вы можете добавить туда IDL.


IDL2Pas Create Server Dialog

Закладка Options содержит ряд специфических установок, который будут выполнены в командной строке IDL2Pas. Обратите внимание на опцию "Overwrite Implementation Units", она не установлена по умолчанию. Кстати, при повторной компиляции данную опцию необходима снять - иначе созданная до этого IDL-файл будет перекомпилировать.


IDL2Pas Create Server Dialog

Установки закладки Options мастера IDL2Pas хранятся в секции [idl2pas] файла defproj.dof, находящегося в директории Delphi6\bin, и все выбранные установки будут использованы при следующей загрузки мастера IDL2Pas.

CORBA Server Skeleton

После того как вы нажмете на кнопку ОК в CORBA Server Application Wizard, будут сгенерировано несколько файлов: TTT.IDL будет использован для генерации файла TTT_c.pas (client stubs и helpers), TTT_i.pas будет содержать определения интерфейса, TTT_impl.pas будет использован для реализации интерфейса и TTT_s.pas содержащий server skeletons. Далее можно будет только модифицировать файл TTT_impl.pas, тогда как другие могут быть сгенерированы заново с помощью IDL2Pas.

Interface Definitions (TTT_i.pas)

Файл интерфейса ТТТ TTT_i.pas содержит определение интерфейса TicTacToe. Причиной использования в определениях типов префикса TicTacToe_ является использование этих типов внутри интерфейса. Если мы определяем их вне интерфейса TicTacToe, то транслироваться они буду без префикса TicTacToe_.
unit TTT_i;
interface
uses
  CORBA;

type
  TicTacToe_TPlayer = (user, computer, none);

type
  TicTacToe = interface;
  TicTacToe_TGame = Integer;
  TicTacToe_TPlace = Integer;

  TicTacToe = interface
    ['{50B30FC5-4B18-94AB-1D5F-4148BB7467B4}']
    function NewGame: TTT_i.TicTacToe_TGame;
    procedure MakeMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer;
      const Place: TTT_i.TicTacToe_TPlace);
    function NextMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer):
      TTT_i.TicTacToe_TPlace;
    function IsWinner(const Game: TTT_i.TicTacToe_TGame):
      TTT_i.TicTacToe_TPlayer;
    function GetValue(const Game: TTT_i.TicTacToe_TGame;
      const Place: TTT_i.TicTacToe_TPlace):
      TTT_i.TicTacToe_TPlayer;
  end;
Можно заметить, что здесь не видны определения исключения. Оно появится в файле Client Stub TTT_c.pas.

Client Stubs and Helpers (TTT_c.pas)

Файл TTT_s.pas содержит не только Client Stubs, но и классы helper. Конечно, лучше было бы если Client Stubs был включен в TTT_c.pas, а классы helper в TTT_h.pas. Но раз все обстоит не так, придется включить файл TTT_c.pas в предложение uses нашего файла Server Skeleton TTT_s.pas.
unit TTT_c;
interface
uses
  CORBA, TTT_i;

type
  TTicTacToeHelper = class;
  TTicTacToeStub = class;
  TTicTacToe_TGameHelper = class;
  TTicTacToe_TPlaceHelper = class;
  TTicTacToe_TPlayerHelper = class;
  ETicTacToe_PlaceTaken = class;

  TTicTacToeHelper = class
    class procedure Insert(var _A: CORBA.Any; const _Value: TTT_i.TicTacToe);
    class function Extract(var _A: CORBA.Any): TTT_i.TicTacToe;
    class function TypeCode: CORBA.TypeCode;
    class function RepositoryId: string;
    class function Read(const _Input: CORBA.InputStream): TTT_i.TicTacToe;
    class procedure Write(const _Output: CORBA.OutputStream; const _Value:
      TTT_i.TicTacToe);
    class function Narrow(const _Obj: CORBA.CORBAObject; _IsA: Boolean = False):
      TTT_i.TicTacToe;
    class function Bind(const _InstanceName: string = ''; _HostName: string =
      ''):
      TTT_i.TicTacToe; overload;
    class function Bind(_Options: BindOptions; const _InstanceName: string = '';
      _HostName: string = ''): TTT_i.TicTacToe; overload;
  end;

  TTicTacToeStub = class(CORBA.TCORBAObject, TTT_i.TicTacToe)
  public
    function NewGame: TTT_i.TicTacToe_TGame; virtual;
    procedure MakeMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer;
      const Place: TTT_i.TicTacToe_TPlace); virtual;
    function NextMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer):
      TTT_i.TicTacToe_TPlace; virtual;
    function IsWinner(const Game: TTT_i.TicTacToe_TGame):
      TTT_i.TicTacToe_TPlayer; virtual;
    function GetValue(const Game: TTT_i.TicTacToe_TGame;
      const Place: TTT_i.TicTacToe_TPlace):
      TTT_i.TicTacToe_TPlayer; virtual;
  end;

  TTicTacToe_TGameHelper = class
    class procedure Insert(var _A: CORBA.Any; const _Value:
      TTT_i.TicTacToe_TGame);
    class function Extract(const _A: CORBA.Any): TTT_i.TicTacToe_TGame;
    class function TypeCode: CORBA.TypeCode;
    class function RepositoryId: string;
    class function Read(const _Input: CORBA.InputStream): TTT_i.TicTacToe_TGame;
    class procedure Write(const _Output: CORBA.OutputStream; const _Value:
      TTT_i.TicTacToe_TGame);
  end;

  TTicTacToe_TPlaceHelper = class
    class procedure Insert(var _A: CORBA.Any; const _Value:
      TTT_i.TicTacToe_TPlace);
    class function Extract(const _A: CORBA.Any): TTT_i.TicTacToe_TPlace;
    class function TypeCode: CORBA.TypeCode;
    class function RepositoryId: string;
    class function Read(const _Input: CORBA.InputStream):
      TTT_i.TicTacToe_TPlace;
    class procedure Write(const _Output: CORBA.OutputStream; const _Value:
      TTT_i.TicTacToe_TPlace);
  end;

  TTicTacToe_TPlayerHelper = class
    class procedure Insert(var _A: CORBA.Any; const _Value:
      TTT_i.TicTacToe_TPlayer);
    class function Extract(const _A: CORBA.Any): TTT_i.TicTacToe_TPlayer;
    class function TypeCode: CORBA.TypeCode;
    class function RepositoryId: string;
    class function Read(const _Input: CORBA.InputStream):
      TTT_i.TicTacToe_TPlayer;
    class procedure Write(const _Output: CORBA.OutputStream; const _Value:
      TTT_i.TicTacToe_TPlayer);
  end;

  ETicTacToe_PlaceTaken = class(UserException)
  private
    FTakenBy: TTT_i.TicTacToe_TPlayer;
  protected
    function _get_TakenBy: TTT_i.TicTacToe_TPlayer; virtual;
  public
    property TakenBy: TTT_i.TicTacToe_TPlayer read _get_TakenBy;
    constructor Create; overload;
    constructor Create(const TakenBy: TTT_i.TicTacToe_TPlayer); overload;
    procedure Copy(const _Input: InputStream); override;
    procedure WriteExceptionInfo(var _Output: OutputStream); override;
  end;
На что следует обратить внимание, так это на декларацию исключения ETicTacToe_PlaceTaken, которое имеет два конструктора: по умолчанию без аргументов и с одним аргументом TakenBy, который автоматически инициализируя исключение.

Server Skeletons (TTT_s.pas)

Класс TticTacToeSkeleton единственный класс, который мы используем для создания экземпляра CORBA Server TicTacToe, принимающего в качестве аргументов имя InstanceName и экземпляр интерфейса TicTacToe.
unit TTT_s;
interface
uses
  CORBA, TTT_i, TTT_c;

type
  TTicTacToeSkeleton = class;

  TTicTacToeSkeleton = class(CORBA.TCorbaObject, TTT_i.TicTacToe)
  private
    FImplementation: TicTacToe;
  public
    constructor Create(const InstanceName: string; const Impl: TicTacToe);
    destructor Destroy; override;
    function GetImplementation: TicTacToe;

    function NewGame: TTT_i.TicTacToe_TGame;
    procedure MakeMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer;
      const Place: TTT_i.TicTacToe_TPlace);
    function NextMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer):
      TTT_i.TicTacToe_TPlace;
    function IsWinner(const Game: TTT_i.TicTacToe_TGame):
      TTT_i.TicTacToe_TPlayer;
    function GetValue(const Game: TTT_i.TicTacToe_TGame;
      const Place: TTT_i.TicTacToe_TPlace):
      TTT_i.TicTacToe_TPlayer;
  published
    procedure _NewGame(const _Input: CORBA.InputStream; _Cookie: Pointer);
    procedure _MakeMove(const _Input: CORBA.InputStream; _Cookie: Pointer);
    procedure _NextMove(const _Input: CORBA.InputStream; _Cookie: Pointer);
    procedure _IsWinner(const _Input: CORBA.InputStream; _Cookie: Pointer);
    procedure _GetValue(const _Input: CORBA.InputStream; _Cookie: Pointer);
  end;
Implementation (TTT_impl.pas)

Файл TTT_impl.pas, единственный файл который редактируется и в который вставляется код реализации CORBA сервера. Тут использован модуль Magic, который использовался для ITicTacToe web service в Delphi 6.
unit TTT_impl;
interface
uses
  SysUtils, CORBA, TTT_i, TTT_c,
  Magic; // implementation of Magic.TTicTacToe

type
  TTicTacToe = class(TInterfacedObject, TTT_i.TicTacToe)
  protected
    TTT: Magic.TTicTacToe;
  public
    constructor Create;
    function NewGame: TTT_i.TicTacToe_TGame;
    procedure MakeMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer;
      const Place: TTT_i.TicTacToe_TPlace);
    function NextMove(const Game: TTT_i.TicTacToe_TGame;
      const player: TTT_i.TicTacToe_TPlayer):
      TTT_i.TicTacToe_TPlace;
    function IsWinner(const Game: TTT_i.TicTacToe_TGame):
      TTT_i.TicTacToe_TPlayer;
    function GetValue(const Game: TTT_i.TicTacToe_TGame;
      const Place: TTT_i.TicTacToe_TPlace):
      TTT_i.TicTacToe_TPlayer;
  end;

implementation

constructor TTicTacToe.Create;
begin
  inherited;
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  TTT := Magic.TTicTacToe.Create;
end;

function TTicTacToe.NewGame: TTT_i.TicTacToe_TGame;
begin
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  Result := TTT.NewGame
end;

procedure TTicTacToe.MakeMove(const Game: TTT_i.TicTacToe_TGame;
  const player: TTT_i.TicTacToe_TPlayer;
  const Place: TTT_i.TicTacToe_TPlace);
begin
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  TTT.MakeMove(Game, Ord(Player), Place);
end;

function TTicTacToe.NextMove(const Game: TTT_i.TicTacToe_TGame;
  const player: TTT_i.TicTacToe_TPlayer):
  TTT_i.TicTacToe_TPlace;
begin
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  Result := TTT.NextMove(Game, Ord(Player))
end;

function TTicTacToe.IsWinner(const Game: TTT_i.TicTacToe_TGame):
  TTT_i.TicTacToe_TPlayer;
begin
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  Result := TTT_i.TicTacToe_TPlayer(TTT.IsWinner(Game))
end;

function TTicTacToe.GetValue(const Game: TTT_i.TicTacToe_TGame;
  const Place: TTT_i.TicTacToe_TPlace):
  TTT_i.TicTacToe_TPlayer;
begin
  { *************************** }
  { *** User code goes here *** }
  { *************************** }
  Result := TTT_i.TicTacToe_TPlayer(TTT.GetValue(Game, Place))
end;

initialization

end.
Теперь мы имеем на руках практически все части для создания
приложения с использованием технологии CORBA.Пусть даже это и
игрушка.CORBA Server ApplicationПомимо
сгенерированных файлов должен же быть и сам проект с главным модулем
формы.Сохранив проект как TTTServer.dpr а модуль главной формы как
GameUnit.Если заменить фактический ТТТ на объект skeleton типа TicTacToe,
код модуля будет выглядеть следующим образом.Тут следует обратить
внимание на использование четырех модулей в предложении uses секции
interface: unit GameUnit;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Corba, TTT_i, TTT_c, TTT_s, TTT_impl;

type
  TForm1 = class(TForm)
  private
    { private declarations }
  protected
    { protected declarations }
    TTT: TicTacToe; // skeleton object
    procedure InitCorba;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.InitCorba;
begin
  CorbaInitialize;
  TTT := TTicTacToeSkeleton.Create('TTT', TTicTacToe.Create);
  BOA.ObjIsReady(TTT as _Object)
end;

end.
Вызов InitCorba будем производить из обработчика события OnCreate формы:
procedure TForm1.FormCreate(Sender: TObject);
begin
  InitCorba
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TTT := nil
end;
Можно сделать вывод, что сервер лучше иметь в виде консольного приложения. Ниже оно представлено. Там используется старомодный оператор writeln, с помощью которого и сообщается пользователю о запуске новой игры. Консольное приложение использует те же самые элементы, что и визуальная версия, но в конце добавлен вызов BOA.ImplIsReady.
program TTTCServer;
{$APPTYPE CONSOLE}
uses
  SysUtils, CORBA, TTT_c, TTT_i, TTT_s, TTT_impl;

var
  TTT: TicTacToe; // skeleton object

begin
  writeln('CorbaInitialize');
  CorbaInitialize;
  writeln('TTicTacToe.Create');
  TTT := TTicTacToeSkeleton.Create('TTT', TTicTacToe.Create);
  writeln('BOA.ObjIsReady');
  BOA.ObjIsReady(TTT as _Object);
  writeln('BOA.ImplIsReady');
  BOA.ImplIsReady
end.
Теперь можно приступать к созданию CORBA-клиента.

CORBA Client Application

Для создания CORBA-клента так же можно использовать CORBA Wizard. Проделываем тоже самое что мы делали для формирования сервера CORBA. Только не следует создавать снова TTT_impl.pas. Кроме уже описанных выше файлов, в наличие есть и файл главной формы и файл проекта. Сохраним их как MainForm.pas и TTTClient.dpr. Модуль MainForm.pas содержит подсказки, чтобы показать вам как создать экземпляр CORBA сервера:
unit MainForm;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Corba;

type
  TForm1 = class(TForm)
  private
    { private declarations }
  protected
    // declare your Corba interface variables like this
    // Acct : Account;
    procedure InitCorba;
    { protected declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.InitCorba;
begin
  CorbaInitialize;
  // Bind to the Corba server like this
  // Acct := TAccountHelper.bind;
end;

end.
Здесь нужно вызвать метод InitCorba из обработчика OnCreate формы. Надо включить в предложение uses модуля MainForm модули TTT_c, TTT_i и TTT_impl, без которых не будут доступны классы helpers. Непосредственно же объявление переменной типа интерфейса CORBA, может выглядеть следующим образом:
private
TicTacToe: TicTacToe;
Фактическое связывание интерфейса TicTacToe с CORBA сервером реализуется следующим образом:
TicTacToe := TTicTacToeHelper.bind;
Теперь можно использовать TicTacToe как обыкновенный класс, включающий поддержку Code Insight.

Action!

Внизу представлен небольшой компонент, основанный на оригинальном компоненте игры TicTacToe. Результирующий код, реализован в MagicTTT.pas - содержит в предложении uses модули TTT_i, TTT_c and TTT_impl и создает экземпляр интерфейса TicTacToe:
unit MagicTTT;
interface
uses
  SysUtils, Classes, Controls, StdCtrls, Dialogs, TTT_c, TTT_i, TTT_impl;

const
  NoneID = 0;
  UserID = 1;
  CompID = 2;

const
  chrUser = 'X';
  chrComp = '@';

const
  FirstPlace = 1;
  LastPlace = 9;

type
  TPlace = FirstPlace..LastPlace;

type
  TTTTControl = class(TWinControl)
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

  private
    TicTacToe: TicTacToe;

  private { 9 game buttons }
    Game: Integer;
    Button: array[TPlace] of TButton;
    procedure ButtonClick(Sender: TObject);
    procedure ComputerMove;
    procedure UserMove(Move: TPlace);

  private { start button }
    TheStartButton: TButton;
    procedure StartButtonClick(Sender: TObject);

  private { game properties }
    FStartButton: Boolean;
    FUserStarts: Boolean;
    FUserChar: Char;
    FCompChar: Char;

  protected { design interface }
    procedure SetStartButton(Value: Boolean);
    procedure SetUserStarts(Value: Boolean);
    procedure SetUserChar(Value: Char);
    procedure SetCompChar(Value: Char);
    function GetCaption: string;
    procedure SetCaption(Value: string);

  published { user interface }
    property StartButton: Boolean
      read FStartButton write FStartButton default False;
    property Caption: string
      read GetCaption write SetCaption;
    property UserStarts: Boolean
      read FUserStarts write SetUserStarts default False;
    property UserChar: Char
      read FUserChar write SetUserChar default chrUser;
    property CompChar: Char
      read FCompChar write SetCompChar default chrComp;
  end {TTTTControl};

procedure Register;

implementation
uses
  Forms;

constructor TTTTControl.Create(AOwner: TComponent);
var
  ButtonIndex: TPlace;
begin
  inherited Create(AOwner);
  Game := 0;
  UserStarts := False;
  FUserChar := chrUser;
  FCompChar := chrComp;
  TheStartButton := TButton.Create(Self);
  TheStartButton.Parent := Self;
  TheStartButton.Visible := True;
  TheStartButton.Caption := 'Humor me...';
  TheStartButton.OnClick := StartButtonClick;
  CorbaInitialize;
  TicTacToe := TTicTacToeHelper.bind;
  for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
  begin
    Button[ButtonIndex] := TButton.Create(Self);
    Button[ButtonIndex].Parent := Self;
    Button[ButtonIndex].Caption := '';
    Button[ButtonIndex].Visible := False;
    Button[ButtonIndex].OnClick := ButtonClick;
  end;
  SetBounds(Left, Top, 132, 132)
end {Create};

destructor TTTTControl.Destroy;
var
  ButtonIndex: TPlace;
begin
  TheStartButton.Destroy;
  for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
    Button[ButtonIndex].Destroy;
  TicTacToe := nil; // explicit!
  inherited Destroy
end {Destroy};

procedure TTTTControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
const
  Grid = 3;
  GridX = 2;
  GridY = 2;
var
  X, DX, W, Y, DY, H: Word;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  TheStartButton.SetBounds(0, 0, Width, Height);
  X := GridX;
  DX := (Width div (Grid * (GridX + GridX))) * (GridX + GridX);
  W := DX - GridX;
  Y := GridY;
  DY := (Height div (Grid * (GridY + GridY))) * (GridY + GridY);
  H := DY - GridY;
  Button[8].SetBounds(X, Y, W, H);
  Button[1].SetBounds(X, Y + DY, W, H);
  Button[6].SetBounds(X, Y + DY + DY, W, H);
  Inc(X, DX);
  Button[3].SetBounds(X, Y, W, H);
  Button[5].SetBounds(X, Y + DY, W, H);
  Button[7].SetBounds(X, Y + DY + DY, W, H);
  Inc(X, DX);
  Button[4].SetBounds(X, Y, W, H);
  Button[9].SetBounds(X, Y + DY, W, H);
  Button[2].SetBounds(X, Y + DY + DY, W, H)
end {SetBounds};

procedure TTTTControl.StartButtonClick(Sender: TObject);
var
  ButtonIndex: TPlace;
begin
  try
    Game := TicTacToe.NewGame;
    if Parent is TForm then
      (Parent as TForm).Caption := IntToStr(Game);
    TheStartButton.Visible := False;
    for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
      Button[ButtonIndex].Visible := True;
    if UserStarts then
    begin
      MessageDlg('You may start...', mtInformation, [mbOk], 0);
      Button[5].SetFocus; { hint... }
    end
    else
      ComputerMove
  except
    on E: Exception do
      MessageDlg('Sorry: ' + E.Message, mtError, [mbOk], 0)
  end
end {StartButtonClick};

procedure TTTTControl.ButtonClick(Sender: TObject);
var
  ButtonIndex: TPlace;
begin
  Enabled := False;
  for ButtonIndex := Low(ButtonIndex) to High(ButtonIndex) do
    if Button[ButtonIndex] = Sender as TButton then
      UserMove(ButtonIndex)
end {ButtonClick};

procedure TTTTControl.ComputerMove;
var
  Move: Integer;
begin
  Move := TicTacToe.NextMove(Game, TicTacToe_TPlayer(CompID));
  if Move = 0 then
    MessageDlg('Neither has won, the game is a draw!', mtInformation, [mbOk], 0)
  else
  begin
    TicTacToe.MakeMove(Game, TicTacToe_TPlayer(CompID), Move);
    Button[Move].Caption := CompChar;
    Button[Move].Update;
    if TicTacToe.IsWinner(Game) = TicTacToe_TPlayer(CompID) then
      MessageDlg('I have won!', mtInformation, [mbOk], 0)
    else
    begin
      Move := TicTacToe.NextMove(Game, TicTacToe_TPlayer(UserID));
      if Move = 0 then
        MessageDlg('Neither has won, the game is a draw!', mtInformation,
          [mbOk], 0)
      else if Move in [FirstPlace..LastPlace] then
      begin
        Enabled := True;
        Button[Move].SetFocus { hint... }
      end
      else if Parent is TForm then
        (Parent as TForm).Caption := IntToStr(Move)
    end
  end
end {ComputerMove};

procedure TTTTControl.UserMove(Move: TPlace);
begin
  if Button[Move].Caption <> '' then
    MessageDlg('This place is occupied!', mtWarning, [mbOk], 0)
  else
  begin
    Button[Move].Caption := UserChar;
    Button[Move].Update;
    TicTacToe.MakeMove(Game, TicTacToe_TPlayer(UserID), Move);
    if TicTacToe.IsWinner(Game) = TicTacToe_TPlayer(UserID) then
    begin
      MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
    end
    else
      ComputerMove
  end
end {UserMove};

procedure TTTTControl.SetUserChar(Value: Char);
begin
  if Value = FCompChar then
    MessageDlg('Character ' + Value + ' already in use by CompChar!', mtError,
      [mbOk], 0)
  else
    FUserChar := Value
end {SetUserChar};

procedure TTTTControl.SetCompChar(Value: Char);
begin
  if Value = FUserChar then
    MessageDlg('Character ' + Value + ' already in use by UserChar!', mtError,
      [mbOk], 0)
  else
    FCompChar := Value
end {SetCompChar};

procedure TTTTControl.SetUserStarts(Value: Boolean);
begin
  FUserStarts := Value;
end {SetUserStarts};

procedure TTTTControl.SetStartButton(Value: Boolean);
begin
  FStartButton := Value
end {SetStartButton};

function TTTTControl.GetCaption: string;
begin
  GetCaption := TheStartButton.Caption
end {GetCaption};

procedure TTTTControl.SetCaption(Value: string);
begin
  TheStartButton.Caption := Value
end {SetCaption};

procedure Register;
begin
  RegisterComponents('DrBob42', [TTTTControl])
end {Register};

end.
Обратите внимание, что конструктор TTTControl также вызывает CorbaInitialize для того чтобы Smart Agent был запущен до того как вы фактически создаете этот компонент. А вот так собственно будет выглядеть сама игра:

game
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования