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

#Object Pascal と Smalltalk との関係

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

Object Pascal の起源が Pascal と Smalltalk とな。 pic.twitter.com/7sozkBSVuK

— HOSOKAWA Jun (@pik) 2017年1月16日

これは、Programming Language Influence Network という「プログラミング言語が、何に影響を受け、何に影響を与えたか」を視覚的に表示するサイトで [Object Pascal を見たところ](https://exploringdata.github.io/vis/programming-languages-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 に実装されているので、どのクラスからでも呼び出せます。
ただ、１つ注意があります。

メッセージとは、２バイトの数値（メッセージID）です。

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

Dispatchの実装

type
  TDispatchMessage = record
    MsgID: Word;
  end;

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

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

##メッセージの定義

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

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

type
  // メッセージはどんな型でも投げられるが最初の２バイトは
  // メッセージIDになっていないといけない
  TMessagePacket = record
    ID: Word;  // 最初の２バイト
    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
  // メッセージは２バイトの数値(メッセージID)で管理される
  SAMPLE_MESSAGE_ID = $0032;

type
  // メッセージはどんな型でも投げられるが最初の２バイトは
  // メッセージIDになっていないといけない
  TMessagePacket = record
    ID: Word;  // 最初の２バイト
    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 由来だったりするのではないでしょうか。
どうでしょうか…どうなんだろう…