Delphi Clinic C++Builder Gate Training & Consultancy Delphi Notes Weblog Dr.Bob's Webshop
Dr.Bob's Delphi Notes Dr.Bob's Delphi Clinics Dr.Bob's Delphi Courseware Manuals
 Dr.Bob Examines... #21
See Also: other Dr.Bob Examines columns or Delphi articles

This article was used for my VisiBroker 4 for Delphi 6 CORBA session at the Borland 7th Annual UK Conference

VisiBroker for Delphi (CORBA)
This session is focused entirely on CORBA possibilities of Delphi, using VisiBroker 4 for Delphi 6. A solid introduction is followed by the design of a simple yet practical CORBA application implemented in Delphi 6 Enterprise. Topics that are covered in the session include IDL-2-PAS, the new IDL-2-PAS Wizard, Client Stubs, Server Skeletons, structs as arguments, CORBA client and server side Exceptions, and more (if we have some time left).

CORBA
CORBA stands for Common Object Request Broker Architecture, and is an object-oriented communication architecture between a client and a server. Communication is handled by the ORB (Object Request Broker) and IIOP (Internet InterORB Protocol). Using IDL (Interface Definition Language) we can specify objects with methods and properties. Methods are like functions that can be called by the client, and will be implemented (serviced) by the server. In order to do so, the IDL file must be compiled. This results in stub code for the client (so we can invoke the methods without worrying about the underlying communication) and skeleton code for the server (which is the basis for our communication on the server side). In this session, I'll explain that CORBA is both platform and language independent. This can only work if the parameters and return types of the methods are transported over the network in a portable format. Conversion from a native type to a portable IDL type is called marshalling, while the conversion from a portable IDL type back to a native platform/language type is called unmarshalling. But more on this later.

VisiBroker for Delphi
Delphi 6 Enterprise contains CORBA support in two flavours. During installation of Delphi 6 Enterprise you're asked if you want to install VisiBroker 3.3 or VisiBroker 4 (or no CORBA at all). The main reason why this is done during installation of Delphi 6 itself is caused by the fact that VisiBroker 3.3 and VisiBroker 4 cannot co-exist on the same machine (there's a hack, see http://www.drbob42.com/cbuilder/lstfnd16.htm for the way to do it using C++Builder).

Why does Delphi 6 support both VisiBroker 3.3 and VisiBroker 4 (although not at the same time), you may ask? Well, there is at least one thing possible in VisiBroker 3.3 that's not possible in VisiBroker 4, and that's DII or Dynamic Interface Invocation. But since VisiBroker 4 is otherwise "newer" than the VisiBroker 3.3 standard, let's just go in and use VisiBroker 4 for this session. For more information about VisiBroker 3.3 for Delphi, please see the white papers that I've writen last year at http://www.borland.com/visibroker/delphi/whitepapers and http://www.drbob42.com/corba

CORBA Applications
A CORBA application consists of two parts: a CORBA server and a CORBA client. Both can be written in just about any language and run on just about any platform (within reason, of course). In this session, I will only be using Delphi 6 Enterprise on Windows, so the strong point about cross-language and cross-platform will not be made clear, but I hope you get the idea when I tell you I could have done the same using JBuilder (on any Java paltform) and C++Builder. And hopefully Kylix Enterprise edition is out soon with support for CORBA as well.

Interface Definition Language
Since the CORBA Server and CORBA Client can potentially be written in different langauges and be running on different platforms, we need some intermediate format (and agent) to transport requests (method calls) and parameters from the CORBA client to the CORBA server (and the answers back again to the client). The method calls, parameters and return types of the methods are transported over the network in a portable format. Conversion from a native type to a portable type is called marshalling, while the conversion from a portable type back to a native platform/language type is called unmarshalling.

The certral point here is the portable type (language and platform independent). And in order for the CORBA Server and CORBA Client to understand each other, the definition of the CORBA Server interface (methods, arguments) must be specified in a special platform and language independent format, which is called the Interface Definition Language (or IDL).

TicTacToe
As main example, featuring many of the IDL constructs that I want to show in this session, we'll be using a TicTacToe game engine. The module TTT with interface TicTacToe is implemented by a CORBA Server, and CORBA Clients can connect to it in order to play a game. The game engine was first described in my Under Construction column in issue #2 (July 1995) of The Delphi Magazine.

  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);
    };
  };
The module TTT has an interface TicTacToe. This interface contains a number of type definitions (visible only within the scopt of the interface), an exception type definition and a number of methods. Note that the MakeMove method is one that can (potentially) raise the PlaceTaken exception. Also note that the exception PlaceTaken is in fact a struct, and will be treated as such (as we'll see in a moment).

IDL2Pas Wizard
In order to use the IDL file, we must translate (or compile) the IDL file to Server Skeletons and Client Stubs. This is done using the IDL2Pas batch file which is part of VisiBroker for Delphi. Or you can use the new CORBA Server Application and CORBA Client Application Wizards in Delphi 6, of course. Since the Wizards are just a wrapper around the IDL2Pas batch file, let's use the Wizard here. Just start Delphi 6 Enterprise, do File | New | Other and go to the Corba tab of the Object Repository:

The CORBA Server Application Wizard will appear, and we can add IDL files to it, as follows:

The options page contains a number of special settings (or flags) that will be passed on to the IDL2Pas command-line. Note the "Overwrite Implementation Units" option, which is not set (by default). It should be clear what happens if you run the IDL2Pas Wizard again when this option is checked (been there, done that, lost my implementation code).

The settings on the options page of the IDL2Pas Wizard are stored in the [idl2pas] section of the defproj.dof file in the Delphi6\bin directory, so all your custom IDL2Pas settings will be used next time you use the IDL2Pas Wizard (I should know, I wrote that part of the IDL2Pas Wizard code).

CORBA Server Skeleton
After you clicked on the OK button of the CORBA Server Application Wizard, a number of files have been generated: TTT.IDL has been used to generate TTT_c.pas (client stubs and helpers), TTT_i.pas (interface definitions), TTT_impl.pas (the file we have to use for the implementation) and TTT_s.pas (server skeletons). We should only modify the TTT_impl.pas file, as the others will be regenerated every time we run IDL2Pas anyway. Let's examine some of the generated code in some more detail now.

Interface Definitions (TTT_i.pas)
The TTT interface file TTT_i.pas contains the ObjectPascal definition of our TicTacToe interface, as well as the TicTacToe_Player enumerated type, the TictacToe_TGame and TicTacToe_TPlace type definitions and of course the methods inside the TicTacToe interface. The reason that the type definitions have a prefix of TicTacToe_ is because they were defined inside the interface. If we had defined them outside of the TicTacToe interface (as a more global type definition), then they would have been translated to an ObjectPascal type without TicTacToe_ as prefix in their name.

  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;
Note that we do not see a type definition for the exception, yet (this will appear in the TTT_c.pas Client Stub file, as we'll see in a moment).

Client Stubs and Helpers (TTT_c.pas)
The file TTT_s.pas does not only contain the Client Stubs (in that case we wouldn't need it when writing a CORBA Server) but also the helper classes. This is a bit illogical, since it would make more sense to have a real Client Stub file like TTT_c.pas and a file with only the helper classes in TTT_h.pas (or something like that). Alas, now we need to include the TTT_c.pas file in the uses clause of our Server Skeleton file 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;
Note the declaration for the ETicTacToe_PlaceTaken exception, which has two constructors: one default, without arguments, and one with the TakenBy argument to automatically initialize the exception (which is what we'll be using in a moment).

Server Skeletons (TTT_s.pas)
The TTT server skeletons file TTT_s.pas uses the TTT_i.pas interface file as well as the TTT_c.pas client stubs and helpers file. The TTicTacToeSkeleton class is the one that we need to use to create an instance of the TicTacToe CORBA Server, passing a name for the InstanceName argument, and a TicTacToe interface instance (taken from our implementation of the TicTacToe interface in file TTT_impl.pas).

  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)
The final generated file is TTT_impl.pas and the (only) one to edit and insert our CORBA server implementation code. Just for clarify, I'll list the unit before implementing the TicTacToe game engine itself (so you can see the comment sections that indicate where user variables and user code should be placed). I've been using the same Magic unit that was used for the ITicTacToe web service in Delphi 6:

  unit TTT_impl;
  interface
  uses
    SysUtils, CORBA, TTT_i, TTT_c,
    Magic; // implementation of Magic.TTicTacToe (source not available, sorry)

  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.
We now have all the pieces we need to actually put the puzzle together and create a CORBA server application.

CORBA Server Application
Apart from the four generated files, we also have a new project and main form unit. Save the project in TTTServer.dpr and the main form in file GameUnit. The GameUnit has some instructions (using the Account example) to tell you where to place the CORBA Server interface skeleton object. If we replace those by the actual TTT skeleton object of type TicTacToe, then the unit source code should look as follows (note the four TTT units in the uses clause of the interface section):

  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.
Note that you still have to make sure InitCorba is called (for example in your form's OnCreate event handler, and that you may want to explicitly set the TTT field to nil (so the instance of the CORBA server is cleaned-up) in the OnDestroy event handler as follows:
  procedure TForm1.FormCreate(Sender: TObject);
  begin
    InitCorba
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
    TTT := nil
  end;
In retrospect, it would make more sense to have the TicTacToe game server show itself as a console application; one that uses simple writeln statements to report the incoming of a new game. The CORBA Console project source code, which contains the same elements as the GUI application, but ends with a BOA.ImplIsReady to enter the "CORBA message-loop", is as follows:
  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.
Let's now make a CORBA Client to connect to these CORBA Servers.

CORBA Client Application
We can use the same CORBA Wizard, this time for a CORBA Client to create a Windows CORBA Client Application. Again, the TTT.IDL file is processed, and the TTT_i.pas, TTT_c.pas and TTT_s.pas files are generated (the TTT_impl.pas is not regenerated, as you generally don't want to overwrite your implementation - I reckon). Apart from these three TTT files, we also have a unit with main form and the main project file. Save the unit in file MainForm.pas and save the project in file TTTClient.dpr. The unit MainForm.pas contains some hints in order to show you how to create an instance of the CORBA server:

  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.
Again, we have to make sure that the InitCorba method is called from within the OnCreate event handler (or any other event handler of the form), so we indeed call CorbaInitialize at the right moment. We also need to add the TTT_c, TTT_i and TTT_impl units to the uses clause of this main form. Without those, we cannot use the helper classes (in TTT_c.pas) to create an instance of the CORBA server that implements (in TTT_impl.pas) the TicTacToe interface (in TTT_i.pas). The declaration of the CORBA interface variable can be done as follows:
  private
    TicTacToe: TicTacToe;
The actual binding, so the TicTacToe interface is bound to the CORBA Server is implemented as follows:
    TicTacToe := TTicTacToeHelper.bind;
And now we can use TicTacToe as if it was a regular class, including Code Insight support.

Action!
Instead of using the TicTacToe interface methods directly, I've written a little wrapper component around them, based on the original TicTacToe game component that I implemented for issue #2 of The Delphi Magazine (which at the time was based on a 16-bit engine DLL, illustrating how to build components on top of DLLs). The resulting code is implemented in unit MagicTTT.pas - which internally uses the TTT_i, TTT_c and TTT_impl units and creates an instance of the TicTacToe interface when needed.

  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.
Note that the constructor of this TTTControl also calls CorbaInitialize, so you need to have the Smart Agent running before you can actualy create this component (at design-time or at run-time). Playing a game of TicTacToe now consists of dropping this component on a form, making sure you can connect to the TicTacToe CORBA Server, and playing away.


This webpage © 2001-2010 by Bob Swart (aka Dr.Bob - www.drbob42.com). All Rights Reserved.