unit TObjectDispatch_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

// BeginExample: TObjectDispatch
// Method: System.TObject.Dispatch
// Method: System.TObject.DefaultHandler
// BeginCode
{
This example demonstrates the use of message dispatching
on TObject and any descendants. Using the same techniques
a form of message based OOP can be acheived where an object
"implements" a certain interface based on messages.
}

{ Define the object interface messages }
const
  INTF_MESSAGE_LOWER_STR = 1;
  INTF_MESSAGE_UPPER_STR = 2;

type
  { String container message that will be passed }
  TStrCntrMessage = packed record
    MessageId : Word;
    MsgText   : String;
  end;

  { String handler object that will serve requests }
  TStringHandler = class
  private
    procedure StrUpCase(var AMessage : TStrCntrMessage);
      message INTF_MESSAGE_UPPER_STR;

    procedure StrLowCase(var AMessage : TStrCntrMessage);
      message INTF_MESSAGE_LOWER_STR;

  public
    procedure DefaultHandler(var Message); override;

  end;

{ TStringHandler }

procedure TStringHandler.DefaultHandler(var Message);
var
  MessageId : Word absolute Message;
begin
  { Display out message then pass control to default handler }
  MessageDlg('Unhandled message ' + IntToStr(MessageId) +
    ' received!', mtInformation, [mbOK], 0);

  inherited;
end;

procedure TStringHandler.StrLowCase(
  var AMessage: TStrCntrMessage);
begin
  AMessage.MsgText := LowerCase(AMessage.MsgText);
end;

procedure TStringHandler.StrUpCase(
  var AMessage: TStrCntrMessage);
begin
  AMessage.MsgText := UpperCase(AMessage.MsgText);
end;

{ TForm2}

procedure TForm2.FormCreate(Sender: TObject);
var
  Hndlr: TStringHandler;
  Msg: TStrCntrMessage;
begin
  { Create object instance, dispatch a message and free it }
  Hndlr := TStringHandler.Create();

  { Lower-case a string using messaging }
  Msg.MessageId := INTF_MESSAGE_LOWER_STR;
  Msg.MsgText := 'Hello World';

  Hndlr.Dispatch(Msg);

  MessageDlg('Lower-cased string: ' + Msg.MsgText,
    mtInformation, [mbOK], 0);

  { Upper-case a string using messaging }
  Msg.MessageId := INTF_MESSAGE_UPPER_STR;
  Msg.MsgText := 'Hello World';

  Hndlr.Dispatch(Msg);

  MessageDlg('Upper-cased string: ' + Msg.MsgText,
    mtInformation, [mbOK], 0);

  Hndlr.Free;
end;
// EndCode
// EndExample: TObjectDispatch


end.
