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

01.01.2007

Известно расшифровывается как 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.

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

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

Установки закладки 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
    { protected declarations }
    // declare your Corba interface variables like this
    // Acct : Account;
    procedure InitCorba;
  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
      MessageDlg('Congratulations, you have won!', mtInformation, [mbOk], 0)
    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 был запущен до того как вы фактически создаете этот компонент.

https://delphiworld.narod.ru/

DelphiWorld 6.0