Главная » База знаний » ActiveX, COM, DCOM, MIDAS, CORBA, интерфейсы, OLE, DDE » Общие вопросы о CORBA технологии

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

Falk0ner, вс, 06/07/2008 - 15:35.

Крестики - нолики с 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 Move(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 Move (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 Move(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 Move(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 _Move(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 Move(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.Move(const Game: TTT_i.TicTacToe_TGame;

const player: TTT_i.TicTacToe_TPlayer):

TTT_i.TicTacToe_TPlace;

begin

 { *************************** }

 { *** User code goes here *** }

 { *************************** }

 Result := TTT.Move(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, A, 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,,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, A, AWidth, AHeight: Integer);
const
 Grid = 3;
 GridX = 2;
 GridY = 2;
var
 X,DX,W,Y,DY,H: Word;
begin
 inherited SetBounds(ALeft,A,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.Move(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.Move(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 был запущен до того как вы фактически создаете этот компонент. DelphiWorld 6.0

Отправить комментарий

  • Адреса страниц и электронной почты автоматически преобразуются в ссылки.
  • Для цитирования используйте тег [quote]
  • Use <!--newpage--> to create page breaks.
  • You can enable syntax highlighting of source code with the following tags: <code>, <blockcode>. Beside the tag style "<foo>" it is also possible to use "[foo]".
  • You can use BBCode tags in the text, URLs will automatically be converted to links.
Проверка
Антиспам проверка
Image CAPTCHA
...