Delphi
Smalltalk
FireMonkey
objectpascal

Delphi / Object Pascal のメッセージシステム

More than 1 year has passed since last update.

Object Pascal と Smalltalk との関係

先日こんなツイートをしました。

これは、Programming Language Influence Network という「プログラミング言語が、何に影響を受け、何に影響を与えたか」を視覚的に表示するサイトで Object Pascal を見たところです。

Pascal から影響を受けたのは当然ですが Smalltalk からも影響を受けたと表示されました。

TObject.Dispatch / message

Smalltalk との関連、これは(思想は置いておいて実装的には) TObject.Dispatch / message 指令のことではないかと考えました。

TObject.Dispatch はメッセージをメッセージハンドラに投げるメソッドです。
定義は

TObject
procedure TObject.Dispatch(var Message);

こんな感じで型無しパラメータなので何でも投げられます。

また、message 指令

message指令
procedure TFoo.Handler(var Msg); message XXXXX;

こんな感じで定義すると XXXXX のメッセージを受け取った時自動的に呼び出されます。

Windows API

Dispatch を目にする機会は余りありませんが message は Delphi ユーザーならお馴染みではないかと思います。
例えば

Win32API
TFoo = class(TBar)
private
  procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
end;

こんな感じで Win32 API のメッセージを受け取っていますよね!

使ってみる

DispatchとメッセージID

Dispatch は全てのクラスの元である TObject に実装されているので、どのクラスからでも呼び出せます。
ただ、1つ注意があります。

メッセージとは、2バイトの数値(メッセージID)です。

そして、このメッセージIDは、何でも渡せる Dispatch の引数、先頭2バイトに存在しなくてはなりません。
それはDispatch の実装が

Dispatchの実装
type
  TDispatchMessage = record
    MsgID: Word;
  end;

procedure TObject.Dispatch(var Message);
var
  MsgID: Word;
begin
  MsgID := TDispatchMessage(Message).MsgID;
  // 処理
end;

こんな感じになっているからです。
実際、メッセージIDをどこに指定するかといったら何が渡されるか解らないので先頭2バイトというのは理にかなってますね。

メッセージの定義

まずは、メッセージを定義して、そのメッセージが受け取る型と、受け取るクラスも定義します(何でも投げられるので、ユーザーが定義した型も当然投げられます)。

const
  // メッセージは2バイトの数値(メッセージID)で管理される
  SAMPLE_MESSAGE_ID = $0032; // 値はサンプル $32 = 0x32

type
  // メッセージはどんな型でも投げられるが最初の2バイトは
  // メッセージIDになっていないといけない
  TMessagePacket = record
    ID: Word;  // 最初の2バイト
    Msg: String;
  end;

  // メッセージを受け取るクラス
  TFoo = class
  private
    // このメソッドは message 指令で指定されたメッセージIDを
    // 受け取ると呼び出される
    procedure Handler(var Packet: TMessagePacket); message SAMPLE_MESSAGE_ID;
  end;

{ TFoo } // メッセージを受け取ると TMessagePacket の Msg を表示します
procedure TFoo.Handler(var Packet: TMessagePacket);
begin
  Writeln(Packet.Msg);
end;

メッセージを投げる

では次にメッセージを投げる側です。

var
  Packet: TMessagePacket;
  FFoo: TFoo;
begin
  Packet.Id := SAMPLE_MESSAGE_ID; // 呼び出すメッセージIDを指定する
  Packet.Msg := 'Hello, Message!';

  FFoo := TFoo.Create;
  try
    // どのメソッドかわからないけどメッセージを受け取るメソッドを呼ぶ
    FFoo.Dispatch(Packet);
  finally
    FFoo.DisposeOf;
  end;

  Readln;
end.

これで、SAMPLE_MESSAGE_ID メッセージが TFoo に渡されて、このメッセージを処理するメソッドがあれば、そのメソッドが呼ばれるようになります。

ソース

短いので、ソーズを全部載せておきます。

program MessageSample;

{$APPTYPE CONSOLE}

const
  // メッセージは2バイトの数値(メッセージID)で管理される
  SAMPLE_MESSAGE_ID = $0032;

type
  // メッセージはどんな型でも投げられるが最初の2バイトは
  // メッセージIDになっていないといけない
  TMessagePacket = record
    ID: Word;  // 最初の2バイト
    Msg: String;
  end;

  TFoo = class
  private
    // このメソッドは message 指令で指定されたメッセージIDを
    // 受け取ると呼び出される
    procedure Handler(var Packet: TMessagePacket); message SAMPLE_MESSAGE_ID;
  end;

{ TFoo }

procedure TFoo.Handler(var Packet: TMessagePacket);
begin
  Writeln(Packet.Msg);
end;

var
  Packet: TMessagePacket;
  FFoo: TFoo;
begin
  Packet.Id := SAMPLE_MESSAGE_ID; // 呼び出すメッセージIDを指定する
  Packet.Msg := 'Hello, Message!';

  FFoo := TFoo.Create;
  try
    // どのメソッドかわからないけどメッセージを受け取るメソッドを呼ぶ
    FFoo.Dispatch(Packet);
  finally
    FFoo.DisposeOf;
  end;

  Readln;
end.

新しいメッセージシステム

XE 世代になってマルチキャスト可能なメッセージシステムが搭載されました。
この機能は RTL に新しく追加された System.Messaging というユニットに記載されています。
こちらはライブラリとして実装されているので言語の機能とは別ですが、FireMonkey には必須のクラスです。

まとめ

Smalltalk のメッセージシステムとは大分違う気がしますが、こんな感じで Smalltalk 由来だったりするのではないでしょうか。
どうでしょうか…どうなんだろう…