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

Previous  Top  Next

    
 

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

 

Code:

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_.

 

 

Code:

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.

 

Code:

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 .

 

 

Code:

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.

 

Code:

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:

 

 

Code:

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 формы:

 

Code:

procedure TForm1.FormCreate(Sender: TObject);

begin

InitCorba;

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

TTT := nil;

end;

 

Можно сделать вывод, что сервер лучше иметь в виде консольного приложения. Ниже оно представлено. Там используется старомодный оператор writeln, с помощью которого и сообщается пользователю о запуске новой игры. Консольное приложение использует те же самые элементы, что и визуальная версия, но в конце добавлен вызов BOA.ImplIsReady.

Code:

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 сервера:

 

Code:

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, может выглядеть следующим образом:

 

Code:

private

TicTacToe: TicTacToe;

Фактическое связывание интерфейса TicTacToe с CORBA сервером реализуется следующим образом:

Code:

TicTacToe := TTicTacToeHelper.bind;

Теперь можно использовать TicTacToe как обыкновенный класс, включающий поддержку Code Insight.

 

Action!

 

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

 

Code:

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 был запущен до того как вы фактически создаете этот компонент.

©Drkb::04359

http://delphiworld.narod.ru/

DelphiWorld 6.0