[ サブクラス化コンポーネント ]

デフォルトで IDE が設計時に自動的に派生クラスを作ってくれるのは、TForm の下位クラスだけである。したがって、この TForm の派生クラスではメッセージハンドラを付け加えて、簡単に任意のメッセージを捕まえることができる。他のコンポーネントの場合は、派生クラスをつくってメッセージハンドラを追加するか、TControl の派生クラスの場合は WndProc を override しなければならない。このようなときでも、VCL では TControl の派生クラスでは WindowProc プロパティーがあって、これを入れ替えることにより、簡単にサブクラス化してメッセージを捕獲できるようになっている。これは、VCL が用意してくれたサブクラス化するための機構である。ちょっとやってみよう。

右図のように、Panel1 に Button1、Edit1、CheckBox1 を置き、その下に Memo1 を置いて、Panel1 をサブクラス化してこれらのコントロールから送られる WM_COMMAND を捕まえてみよう。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    OriginalProc:TWndMethod;
    procedure SubClassProc(var Message:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalProc := Panel1.WindowProc;
  Panel1.WindowProc := SubClassProc;
end;

procedure TForm1.SubClassProc(var Message:TMessage);
var
  Msg:TWMCommand;
begin
  OriginalProc(Message);
  case Message.Msg of
    WM_COMMAND:begin
      Msg := TWMCommand(Message);
      Memo1.Lines.Add(FindControl(Msg.Ctl).Name);
    end;
  end;
end;

end.

結果は右図のようになり、クリックしたり Edit1 からフォーカスが移動したりすると、親である Panel1 が WM_COMMAND を通じてその通知メッセージを受け取っていることが分かるだろう。

そして、Panel1 のインスタンスが受け取るメッセージを SubClassProc で処理している。

ここでは最初に元の処理関数に渡し、それから WM_COMMAND をより分けて、どのコントロールが送ったかを FindControl() で見つけ、その Name を Memo1 に追加している。

さて、このように簡単にサブクラス化ができるにしても、この一連の手続きは定型的なのでコンポーネントにカプセル化して、メッセージの処理をイベントハンドラの形にできれば便利だろう。ここでは、その一例を示す。以下のユニットファイルでしめす TSubClass は、上の一連の手続きを自動的に行う非ビジュアルコンポーネントである。

unit SubClassUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls;

type
TMessageBefore = procedure (Sender:TObject;var Message:TMessage;
                            var Handled:Boolean) of object;
TMessageAfter = procedure (Sender:TObject;var Message:TMessage
                           ) of object;

TSubClass = class(TComponent)
private
  OriginalProc:TWndMethod;
  FOnMessageAfter:TMessageAfter;
  FOnMessageBefore:TMessageBefore;
  FTarget:TControl;
  procedure SetTarget(Ctrl:TControl);
protected
  procedure SubClassProc(var Msg:TMessage);
public
  destructor Destroy;override;
  procedure Notification(AComponent: TComponent;
                               Operation: TOperation);override;
published
  property TargetControl:TControl read FTarget write SetTarget;
  property OnMessageBefore:TMessageBefore read FOnMessageBefore
                                          write FOnMessageBefore;
  property OnMessageAfter:TMessageAfter read FOnMessageAfter
                                          write FOnMessageAfter;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TSubClass]);
end;

destructor TSubClass.Destroy;
begin
  SetTarget(nil);
  inherited;
end;

procedure TSubClass.SetTarget(Ctrl:TControl);
begin
  if FTarget<>nil then
  begin
    FTarget.WindowProc := OriginalProc;
    FTarget.RemoveFreeNotification(Self);
  end;

  if FTarget<>Ctrl then
  begin
    FTarget := Ctrl;
    if FTarget<>nil then
    begin
      FTarget.FreeNotification(Self);
      OriginalProc := Ctrl.WindowProc;
      Ctrl.WindowProc := SubClassProc;
    end;
  end;
end;

procedure TSubClass.SubClassProc(var Msg:TMessage);
var
  Handled:Boolean;
begin
  Handled := false;
  if Assigned(FOnMessageBefore) then FOnMessageBefore(self,Msg,Handled);
  if not Handled then OriginalProc(Msg);
  if Assigned(FOnMessageAfter) then FOnMessageAfter(self,Msg);
end;

procedure TSubClass.Notification(AComponent: TComponent;
                                 Operation: TOperation);
begin
  inherited;
  if (AComponent=FTarget) and (Operation=opRemove) then
    SetTarget(nil);
end;

end.

右図のようにこのコンポーネントをインストールしてから、フォームのどこかに置き、オブジェクトインスペクタで TargetControl プロパティーのドロップダウンリストから Panel1 を選ぶ。そして OnMessageAfter イベントハンドラに処理を書く。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    SubClass1: TSubClass;
    procedure SubClass1MessageAfter(Sender: TObject;
      var Message: TMessage);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SubClass1MessageAfter(Sender: TObject;
  var Message: TMessage);
var
  Msg:TWMCommand;
begin
  case Message.Msg of
    WM_COMMAND:begin
      Msg := TWMCommand(Message);
      Memo1.Lines.Add(FindControl(Msg.Ctl).Name);
    end;
  end;
end;

end.

実行結果は、先ほどのものと全く同じになる。このようにして、簡単にサブクラス化することができる。しかし、同じコントロールを複数回サブクラス化するとやっかいなことになる。このようにサブクラス化して、特定のメッセージを捕まえて処理し、ある動作を実現することに成功したら、そしてもし、その動作がそれ以降でも必要になることが予測できたら、そのコードを参考にして派生コンポーネントを作るほうがよいだろう。TSubClass はそのようなとき、または一時的に特別な動作を実現したいときに便利に使えるだろう。