Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2020年04月10日] [更新 2020年05月11日]　Delphi 一般・その他
継承クラス ( コンポーネント ) とサブクラス化
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
[整理番号 - 0600]






継承クラス ( コンポーネント ) とサブクラス化
InheritedClass_SubClass.zip　1,190 KB]　2020年05月11日版 (EXEなし)


クラスの継承は Delphi の強力な機能です。クラスを継承したクラス、それが継承クラスです。
コンポーネントの機能を変更したり、機能を拡張する時に、そのコンポーネントのクラスを継承したクラスを作成します。これを継承コンポーネントや派生コンポーネントと言うこともあります。コンポーネントのメッセージだけを処理したい場合は、サブクラス化という方法もあります。本ページは、それらに関する記事です。

全てのビジュアルコンポーネントは、クラス TObject からの派生クラスです。つまり、TObject から継承したクラス ((コンポーネント) ですが、本ページで扱うのは、既存のコンポーネントとしてのクラスを継承する場合です。

Delphi では、設計時にフォームに配置できるクラス型のオブジェクトをコンポーネントとしていますが、そうでない単なるクラスも便宜上コンポーネントと言うことがあります。コンポーネントはクラスであることは間違いありません。あまり厳密に考える必要はないかも知れません。





01_VCL のフォームは TForm の継承クラス


Delphi の IDE を起動して新規に VCL フォームアプリケーションを作成すると、Unit1 のコードは下のリストに示すようになっています。
このリストの type は型を宣言 (定義) する時に使用します。ここでは TForm1 というクラス型を宣言しています。最初の TForm1 = class(TForm) は、TForm1 というクラス型が TForm を継承したクラス型であることを意味します。TForm というクラスを継承して TForm1 というクラスを作成することを意味しています。		 

type
  TForm1 = class(TForm)


つまり、我々は、VCL フォームアプリケーションを作成する場合、好むと好まざるとにかかわらず、常に継承クラスとしてのフォームを使用していることになります。

変数を宣言 (定義) する時は以下のように var を使用します。 



var
  Form1: TForm1;

の宣言 (定義) は、TForm1 型を Form1 という変数で扱うようにする意味です。これは通常の var 宣言と同じです。
この変数宣言 (定義文) は interface 部にありますからグローバル変数です。したがって、他のユニットからも TForm1 を Form1 の変数名で扱えます。もちろん、TForm1 を使用する際、別の変数名を宣言して使用することもできます。

フォームの継承宣言も、この変数宣言も IDE のコードエディタで変更してはいけません。そりらの変更はオブジェクト・インスペクタで行います。



リスト1 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.



02_継承クラスと protected 部のプロパティやメソッドの使用


継承クラスを宣言すると、継承元のクラスの protected 部のプロパティやメソッドが使用できるようになります。
TPanel の public 部には Canvas (TCanvas 型) プロパティがありませんが、protected 部にはあります。その TPanel.Canvas を使用する例です。TPanel の継承クラスを宣言して、その継承クラスの型で元の TPanel の変数をキャストするだけです。


図1
設計時の画面
  • TPanel と TButton を配置
図2
EXE を実行して Button1 をクリック
  • TPanel.Canvas に文字列を描画

リスト2 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplPanelEx = class(TPanel);

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
end;

//=============================================================================
//  TPanel の TCanvas (protected 部のプロパティ) を使用する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFormat : TTextFormat;
  LRect   : TRect;
  LText   : string;
begin
  LFormat := [tfCenter, tfVerticalCenter, tfSingleLine];
  LRect   := Panel1.ClientRect;
  LText := 'テキストの描画';

  // 継承クラスの型でキャストすると protected 部のプロパティやメソッドが使用できる
  TplPanelEx(Panel1).Canvas.TextRect(LRect, LText, LFormat);
end;

end.


上のコードでは、interface 部で継承クラスの型宣言をしていますが、implementation 部だけで使用するであれば、以下のように implementation 部で宣言した方がいいでしょう。必要がないのにグローバルな型を宣言する必要はありません。 

implementation

{$R *.dfm}

type
  TplPanelEx = class(TPanel);

protected 部にどのようなプロパティやメソッドがあるかは、VCL のソースコードでも確認することができますが、ヘルプが便利です。
オンラインヘルプでは、下図のように [protected] をチェックすると protected 部のメンバも表示することができます。オンラインヘルプで、例えば TEitd を検索する時は、Edit ではなく<、プリフィックスの T を付けて TEdit というキーワードで検索します。


図3
[protected] をチェックする




03_継承元クラスのメソッドのオーバライド


継承したクラスで、元のクラスのメソッドをオーバライドして使用すると、元のクラスの機能を変更したり機能を拡張したりできます。
オーバライド (override) は乗り越えるとか優先するという意味です。これは、元のクラスに実装されているメソッドを継承したクラスで実行するための仕組みです。つまり、メソッドの置き換えです。

継承元のメソッドでは内部的に必要な処理が実行されています。したがって、オーバライドしたメソッドでは、継承元のメソッドの処理を行う必要があります。そのために用意されているのが inherited 指令です。これは受け継ぐ、つまり継承を意味します。オーバライドしたメソッド内で inherited を実行すると、それは継承元のメソッドを実行することを意味します。

メソッドをオーバライドする時は、VCL のソースコード内の protected 部の宣言文をコピーするのではなく、IDE の入力支援の機能を使用して宣言文を作成します。そうすれば、未定義のエラー等が発生するのを防止できます。オーバライドしたメソッド ( 関数や手続き) の宣言文の末尾には override 指令があります。



メソッドのオーバライドの例です。Create メソッドをオーバライドして、背景色が clLime の TPanel の継承クラスを作成します。このクラスはコンポーネントとして登録していないので、実行時に生成することになります。
継承元の Create メソッドは inherited Create(AOwner) と、引数付きで実行していますが、引数を省略しても結果は同じです。引数を省略しても、メソッドの引数の値は継承元に渡されます。
Create メソッドでは、inherited は最初に実行します。Destroy メソッドでは最後に実行します。 


 inherited Create(AOwner);  // 引数 (識別子) あり
  inherited;                // 引数 (識別子) なし

図4
設計時の画面
  • TPanel の継承クラスは実行時生成なのでフォームにはない
図5
コンパイルして実行
  • 継承クラスのコントロールが表示される

リスト3 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplPanelEx = class(TPanel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plPanelEx1 : TplPanelEx;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // TPanel の継承クラスのコンポーネントのインスタンス (実体) を生成
  plPanelEx1 := TplPanelEx.Create(Self);
  plPanelEx1.Parent := Self;
  plPanelEx1.Left := 32;
  plPanelEx1.Top  := 45;
end;

{ TplPanelEx }

//=============================================================================
//  TPanel の継承クラスのコンポーネントのコンストラクタ
//=============================================================================
constructor TplPanelEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width  := 185;
  Height := 41;

  Color := clLime;
  ParentBackground := False;
end;

end.


次は TEdit の例です。
この TEdit の継承クラスでは KeyPress メソッドだけをオーバライドして使用しています。
この KeyPress メソッドは、キーが押下されると自動的に実行されるメソッドです。protected 部のメソッドには、このようなイベント型のメソッドがあります。KeyPress メソッドでは OnKeyPress イベントと同じような処理が可能です。

この TEdit の継承クラスは、半角と全角の数字だけを TEdit に入力するようになっています。その処理を KeyPress メソッドで行っています。

このサンプルでも inherited を引数付きで実行していますが、引数を省略しても結果は同じです。引数を省略しても、メソッドの引数の値は継承元に渡されます。
継承元の OnKeyPress イベントに処理コードがあれば inherited の部分で実行されます。inherited をメソッドの最後に実行すると、この KeyPress メソッドの コード実行後に、継承元の OnKeyPress イベントのコードが実行されることになります。



図6
実行時の画面
  • TEdit の継承クラスは実行時生成

リスト4 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TplIntEdit = class(TEdit)
  protected
    procedure KeyPress(var Key: Char); override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plIntEdit1 : TplIntEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  System.Character;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // TEdit の継承クラスのコンポーネントのインスタンス (実体) を生成
  plIntEdit1 := TplIntEdit.Create(Self);
  plIntEdit1.Parent := Self;
  plIntEdit1.Left  := 20;
  plIntEdit1.Top   := 20;
  plIntEdit1.Width := 200;
end;

{ TplIntEdit }

//=============================================================================
//  TEdit の継承クラスの KeyPress メソッド
//  キーを押下すると自動的に実行されるメソッド
//  OnKeyPress イベントのような動作をする
//
//  キーボードから数字以外の入力を禁止(数字だけを許可する)
//  VK_BACKを含めておかないと[Back]キーが使用できない
//=============================================================================
procedure TplIntEdit.KeyPress(var Key: Char);
begin
  // 継承元の KeyPress メソッドのコードを実行
 // 継承元に OnKeyPress イベントのコードがあれば、それが実行される
  inherited KeyPress(Key);

  if not ((Key.IsNumber) or (Key = Char(VK_BACK))) then begin
    Key := #0;
  end else begin
    // コードポイントの値が全角の数字だったら半角の数字の値に変換
    if (Key >= #$FF10) and (Key <= #$FF19) then begin
      Key := Char(Ord(Key) - $FEE0);
    end;
  end;//
end;

end.

[備考]
継承元の public 部または protected 部のメソッドの内、末尾に virtual 指令または override 指令があるメソッドがオーバライド可能なメソッドです。継承元のメソッドの末尾に override 指令があるメソッドは、そのまた継承元に同じメソッドがあります。





04_継承クラスのメソッドにおける inherited の実行位置と引数


上の TEdit のサンプルで、inherited の実行位置について述べました。そのことを実際に確認するためのテストとその結果です。
inherited を継承クラスのメソッド内の最後で実行した場合は、継承したクラスのメソッド内の処理結果が継承元のメソッドに渡されていることが確認できます。また、 inherited の引数を省略しても、メソッドの引数の値が継承元に渡されていることも確認できます。

上のサンプルで使用した KeyPress メソッドの場合、inherited を最初に実行すると、OnKeyPress イベントが最初に処理されることになります。そのイベント内で Key の値を 0 にすると、引数の Key は var 渡しなので、継承クラスのメソッドは 0 を受け取ります。



図7
inherited をメソッドの最初で実行した場合
  • メソッドの引数の値が継承元に渡される
図8
inherited をメソッドの最後に実行した場合
  • メソッド内での処理結果が継承元に渡される

リスト5 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

 TBase = class(TObject)
  protected
    procedure TestProc(AText: string); virtual;
  end;

  TplBaseEx = class(TBase)
  protected
    procedure TestProc(AText: string); override;
  end;

  var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  継承クラスのメソッドで inherited を最初に実行する場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LplBase : TplBaseEx;
begin
  Memo1.Lines.Clear;

  LplBase := TplBaseEx.Create;
  try
    LplBase.TestProc('123');
  finally
    FreeAndNil(LplBase);
  end;
end;

{ TBase }

//-----------------------------------------------------------------------------
//  継承元のクラスのメソッドのコード
//-----------------------------------------------------------------------------
procedure TBase.TestProc(AText: string);
begin
  Form1.Memo1.Lines.Add('Base : ' + AText);
end;

{ TplBaseEx }

//-----------------------------------------------------------------------------
//  継承クラスのメソッドのコード
//-----------------------------------------------------------------------------
procedure TplBaseEx.TestProc(AText: string);
begin
  Form1.Memo1.Lines.Add(AText);
  inherited;

  AText := AText + 'ABC';
  Form1.Memo1.Lines.Add(AText);
end;

end.


リスト6 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

 TBase = class(TObject)
  protected
    procedure TestProc(AText: string); virtual;
  end;

  TplBaseEx = class(TBase)
  protected
    procedure TestProc(AText: string); override;
  end;

  var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  継承クラスのメソッドで inherited を最後に実行する場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LplBase : TplBaseEx;
begin
  Memo1.Lines.Clear;

  LplBase := TplBaseEx.Create;
  try
    LplBase.TestProc('123');
  finally
    FreeAndNil(LplBase);
  end;
end;

{ TBase }

//-----------------------------------------------------------------------------
//  継承元のクラスのメソッドのコード
//-----------------------------------------------------------------------------
procedure TBase.TestProc(AText: string);
begin
  Form1.Memo1.Lines.Add('Base : ' + AText);
end;

{ TplBaseEx }

//-----------------------------------------------------------------------------
//  継承クラスのメソッドのコード
//-----------------------------------------------------------------------------
procedure TplBaseEx.TestProc(AText: string);
begin
  Form1.Memo1.Lines.Add(AText);

  AText := AText + 'ABC';
  Form1.Memo1.Lines.Add(AText);

  inherited;
end;

end.


[備考]
inherited を引数付きにしておくと、引数の部分を [Ctrl] キーを押下した状態でマウスクリックすると、継承元のメソッドや関数のコードにジャンプできます。ジャンプしない場合は、プロジェクトをビルド (再構築) すると効果があることがあります。
プロジェクトのビルド (再構築) のキー操作は [Shift] + [F9] です。





05_継承クラスをコンポーネントとして登録して使用


上のサンプルでは継承クラスをコンポーネントとして登録しないで使用しました。継承クラスをコンポーネントとして登録すれば、設計時にフォームに配置して使用できます。

継承クラスをコンポーネントとして登録するには、継承クラス部分のコードだけを別ユニットして保存します。この時、コンポーネントの登録用の手続きである Register のコードを追加します。
必要のないユニットは uses から削除した方がいいでしょう。リソースの節約になります。

ユニット名は任意ですが、他のユニットと重複しない名前にします。コンポーネントとしてのクラス名も他のクラス名と重複しないようにします。コンポーネントの作者がよく使用する方法は、プリフィクスを付ける方法です。例えば、筆者の場合は プリフィクスとして pl を使用しています。

下に示すコードは、前出のサンプルで使用した、背景色が clLime の TPanel の継承クラスをコンポーネントとして登録するためのユニット例です。
このユニットのコードにはコンポーネントとして登録するクラスが 1 つしかありまんなが、1 つのユニットで複数のクラスのコードを書くこともあります。コンポーネントとして登録しないクラスや、関係する関数類を含めることもあります。このことは、VCL の StdCtrls 等のユニットと同じです。



リスト7
背景色のデフォルトが clLime の TPanel コンポーネントのソースコード
このコードを plPanelEx.pas の名前で保存する		 
unit plPanelEx;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.ExtCtrls;

type
  TplPanelEx = class(TPanel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

// コンポーネントとして登録するための手続き名  
procedure Register;

implementation

{ TplPanelEx }

constructor TplPanelEx.Create(AOwner: TComponent);
begin
  inherited;

  Width  := 185;
  Height := 41;

  Color := clLime;
  ParentBackground := False;
end;

// コンポーネントとして登録するための手続きの実現部  
// plXRAY はコンポーネントパレットのタブ名 (ない場合は自動で作成される)
// [ ] 内は登録するコンポーネントのクラス名のリスト
procedure Register;
begin
  RegisterComponents('plXRAY', [TplPanelEx]);
end;

end.


作成したコンポーネントを、新規の VCL フォームアプリのフォームに配置した結果です。
uses 部にコンポーネントのユニットである plPanelEx が追加されています。


図9
設計時の画面
  • 作成したコンポーネントをフォームに配置

リスト8 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  plPanelEx;

type
  TForm1 = class(TForm)
    plPanelEx1: TplPanelEx;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.


[備考 1]
上の例のように、コンポーネントの作成とは、継承クラスで、継承元のメソッド類を利用したり、独自のプロパティやメソッド、あるいはイベントを追加実装したりすることです。以下は独自のプロパティを実装した例です。
このようなクラス (コンポーネント) を、カスタマイズした、あるいはカスタマイズするという意味で、カスタムコンポーネントと言うことがあります。


[備考 2]
今回作成したクラス (コンポーネント) の継承元は TPanel です。これを TPanel を継承したクラス (コンポーネント) と言います。それよりも祖先を派生元と言います。TPanel 等、TControl の派生クラス (コンポーネント) の最初の派生元は TObject です。


[備考 3]
フォームは、コンポーネントとしての登録はできません。





06_継承クラスを継承元のコンポーネントと入れ換えて使用


継承クラスは、コンポーネントとして登録しないと設計時にフォームに配置して使用できません。コンポーネントをインストール (登録)しないで使用するには、uses にコンポーネントのユニット名を追加して、コンポーネントを実行時に生成して使用することになります。

以下のリンクのページに掲載している ChangeComponent 関数を使用すると、継承クラスと継承元のコンポーネントを入れ換えて操作できます。コンポーネントの実行時生成の処理は必要ありません。継承元のコンポーネントがフォームに配置されていれば、見かけ上、継承したクラスのコンポーネントがフォームに配置されているのと同じとなります。

コンポーネントの開発段階で、コンポーネントのコードを変更する度にコンポーネントを登録したパッケージをビルド (再構築) するのは手間がかかります。コンポーネントを入れ換えて作業すればその手間を省けます。

コンポーネントの開発では、継承元にはないイベントを実装することがあります。このコンポーネントを入れ換える方法では、そのようなイベントは実行時に設定する必要があります。

下のコードは、上のサンプルで使用した、背景色が clLime の TPanel の継承クラスを、フォームに配置してている TPanel と入れ換えて使用する例です。
継承クラスをコンポーネントとしてインストールして使用する時は、ChangeComponent 関数の部分とオブジェクトの変数定義部分を削除します。



図10
設計時の画面
  • TPanel をフォーム無に配置
  • uses にコンポーネントのユニット名を追加。今回の場合は plPanelEx を追加
図11
コンパイルして実行
  • フォームに配置した TPanel が、継承クラスのコンポーネントに入れ換わっている

リスト9 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  plPanelEx;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plPanelEx1 : TplPanelEx;
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plPanelEx1 は TplPanelEx 型の変数として宣言 (定義) しておく
  plPanelEx1 := TplPanelEx(ChangeComponent(Panel1, TplPanelEx));
end;

end.


作成した継承クラスをコンポーネントとして登録する必要がなく、別ユニットにもしないで使用する場合は、以下のようになります。
当サイトのサンプルプログラムの多くはこの形式です。必要になれば、前項で述べた方法でコンポーネントとしてンストール (登録) します。

リスト10 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplPanelEx = class(TPanel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plPanelEx1 : TplPanelEx;
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plPanelEx1 は TplPanelEx 型の変数として宣言 (定義) しておく
  plPanelEx1 := TplPanelEx(ChangeComponent(Panel1, TplPanelEx));
end;

{ TplPanelEx }

//=============================================================================
//  TPanel の継承クラスのコンポーネントのコンストラクタ
//=============================================================================
constructor TplPanelEx.Create(AOwner: TComponent);
begin
  inherited;

  Width  := 185;
  Height := 41;

  Color := clLime;
  ParentBackground := False;
end;

end.



07_継承クラスにおけるメッセージの捕捉


継承クラスではウインドウメッセージも捕捉できます。メッセージ捕捉用のメソッド名は任意です。したがって、メッセージの捕捉用メソッドは、メソッドのオーバライドではありません。
また、継承元のクラスには実装されていないメッセージ処理も、そのクラスで使用可能であれば使用できます。これらのことから、inherited 指令は引数なしで使用します。継承元に同じメッセージ処理がない場合、inherited は何も実行しません。

以下は、貼り付け操作である WM_PASTE メッセージを捕捉して処理する例です。
このサンプルは、クリップボードから TEdit に文字列を貼り付ける際に発生する WM_PASTE メッセージを捕捉して、整数値として使用できる文字列だけを TEdit の Text プロパティに代入します。

TEdit 等では、TPopupMenu コンポーネントを使用して [Ctrl] + [C], [Ctrl] + [V} 等のショートカットキーを設定しないとショートカットキーは使用できまんが、デフォルトで下図のようにポップアップメニューを表示することができます。これを利用して貼り付けのテストが可能です。



図12
クリップボードから貼り付け
図13
整数値に変換できない場合

リスト11 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TplIntEdit = class(TEdit)
  protected
    procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plIntEdit1 : TplIntEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plIntEdit1 は TplIntEdit 型の変数として宣言 (定義) しておく
  plIntEdit1 := TplIntEdit(ChangeComponent(Edit1, TplIntEdit));
end;

{ TplIntEdit }

//=============================================================================
//  TEdit の継承クラスの WM_PASTE メッセージ処理
//  クリップボードの文字列が整値に変換できれば Text プロパティに文字列をセット
//  整数に変換できない時は Text プロパティに空文字をセット
//=============================================================================
procedure TplIntEdit.WMPaste(var Message: TWMPaste);
var
  LClipbrdText : string;
  LInteger     : Integer;
  LMsgText     : string;
begin
  inherited;

  if Clipboard.HasFormat(CF_TEXT) then begin
    LClipbrdText := Clipboard.AsText;

    if TryStrToInt(LClipbrdText, LInteger) then begin
      Text := IntToStr(LInteger);
    end else begin
      Text := '';
      LMsgText := LClipbrdText + sLineBreak + 'は整数に変換できません';
      MessageBox(Handle, PChar(LMsgText), 'クリップボード', MB_ICONWARNING);
      SetFocus;
    end;
  end;
end;

end.


Delphi 専用の CN_XXX, CM_XXX 関係のメッセージも次のようにして捕捉できます。
このサンプルは、TPanel の Color プロパティの値が変わるとダイアログを表示します。



図14
TPanel の色が変わるとダイアログを表示

リスト12 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplPanelEx = class(TPanel)
  protected
    procedure CMColorchanged(var Message: TMessage); message CM_COLORCHANGED;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plPanelEx1 : TplPanelEx;
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // これがないと背景色の再描画が実行されないことがある
  Panel1.ParentBackground := False;

  // フォーム作成時にコンポーネントの入れ替え
  // plPanelEx1 は TplPanelEx 型の変数として宣言 (定義) しておく
  plPanelEx1 := TplPanelEx(ChangeComponent(Panel1, TplPanelEx));
end;

//=============================================================================
//  TPanel の背景色を変更
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  plPanelEx1.Color := clGray;
end;

{ TplPanelEx }

//=============================================================================
//  継承クラスの CM_COLORCHANGED メッセージの処理
//  コントロールの色が変更になると発生するメッセージ
//  Color プロパティに同じ色を設定しても発生しない
//=============================================================================
procedure TplPanelEx.CMColorchanged(var Message: TMessage);
begin
  inherited;
  if Parent = nil then Exit;

  MessageBox(Handle, '色が変更になりました。', '情報', MB_ICONINFORMATION);
end;

end.


[備考]
コントロール関係のメッセージとして CM_XXX, CN_XXX という形式のメッセージがあります。それらのメッセージは、下記のページに定数としての一覧は記載されていますが、ヘルプにはメッセージ個別のドキュメントはありません。





08_WndProc メソッド によるメッセージの捕捉


Delphi の多くのコンポーネント (クラス) には WndProc というメソッドが実装されています。これは、コンポーネントのウィンドウメッセージを処理するためのメソッドで、ウィンドウプロシージャと呼ばれています。
このメソッドを継承クラスでオーバライドして使用すると、コンポーネントのウィンドウメッセージを捕捉して処理できます。以下はその例です。

このサンプルは、上のサンプルと同じ機能です。クリップボードから TEdit に文字列を貼り付ける際に発生する WM_PASTE メッセージを捕捉して、整数値として使用できる文字列だけを TEdit の Text プロパティに代入します。


リスト13 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TplIntEdit = class(TEdit)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plIntEdit1 : TplIntEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd,
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plIntEdit1 は TplIntEdit 型の変数として宣言 (定義) しておく
  plIntEdit1 := TplIntEdit(ChangeComponent(Edit1, TplIntEdit));
end;

{ TplIntEdit }

//=============================================================================
//  TEdit の継承クラスの WndProc メソッド
//  WM_PASTE メッセージを処理
//  クリップボードの文字列が整値に変換できれば Text プロパティに文字列をセット
//  整数に変換できない時は Text プロパティに空文字をセット
//=============================================================================
procedure TplIntEdit.WndProc(var Message: TMessage);
var
  LClipbrdText : string;
  LInteger     : Integer;
  LMsgText     : string;
begin
  if Message.Msg = WM_PASTE then begin
    if Clipboard.HasFormat(CF_TEXT) then begin
      LClipbrdText := Clipboard.AsText;

      if TryStrToInt(LClipbrdText, LInteger) then begin
        Text := IntToStr(LInteger);
      end else begin
        Text := '';
        LMsgText := LClipbrdText + sLineBreak + 'は整数に変換できません';
        MessageBox(Handle, PChar(LMsgText), 'クリップボード', MB_ICONWARNING);
        SetFocus;
      end;

      // 処理したことにする (元の WndProc を実行しないで終了)
      Message.Result := 0;
      Exit;
    end;
  end;

  inherited WndProc(Message);
end;

end.


WndProc メソッドは、コントロール (クラス) の生成や解放、破棄等、そのコントロール (クラス) に関する全てのウィンドウメッセージを処理します。上のサンプルもメソッドのオーバライドです。元の WndProc メソッドのコードを実行する必要があります。上のコードではオーバライドしたメソッドの最後に実行しています。
inherited を実行しないと、下図のように例外が発生します。


図15
inherited 指令を実行しない場合

上のサンプルでは、メッセージが WM_PASTE の時は inherited 指令を実行していません。この場合、該当するメッセージは継承元で実行されないことになります。このようにに、メッセージによっては、継承元の処理内容を変更することができます。

リスト14 
      // 処理したことにする (元の WndProc を実行しないで終了)
      Message.Result := 0;
      Exit;
      // Exit なので、この後の inherited は実行されない 
    end;
  end;

  inherited WndProc(Message);
end;


継承元のコードを実行しない場合、そのメッセージに対応するイベントは実行されません。
以下は WM_LBUTTONDOWN メッセージを無効にする例てす。このコードの場合、マウスの左ボタン押しても OnMouseDown イベントは発生しません。オーバライドした WndProc メソッド (継承クラスに実装した WndProc メソッド) で、inherited 指令を最初に実行すればイベントが発生しますが、特定のメッセージに対して処理内容を変更する目的に適しているとは言えません。継承元の処理も行って、更に処理を追加するような場合は、inherited 指令を最初に実行することもあります。


リスト15 
//=============================================================================
//  Edit1 の OnMouseDown イベント処理
//  本サンプルでは、マウス左ボタン押下では発生しない
//  タプルクリック時は発生する
//=============================================================================
procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // この条件は WM_LBUTTONDOWN メッセージを無効にした場合のみ有効
  if (ssDouble in Shift) then Exit;

  Edit1.Text := 'OnMouseDown';
end;

{ TplIntEdit }

//=============================================================================
//  TEdit の継承クラスの WndProc メソッド
//  特定の メッセージを処理しない例
//=============================================================================
procedure TplIntEdit.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_LBUTTONDOWN then begin
    // 処理したことにする (元の WndProc を実行しないで終了)
    Message.Result := 0;
    Exit;
  end;

  inherited WndProc(Message);
end;


以上のようなメッセージ の処理に関することは、サブクラス化でも同じです。





09_CN_COMMAND によるコントロールの通知メッセージ捕捉


BN_XXX, NM_XXX, LVN_XXXX, TVN_XXX, HDN_XXX 等、N の付いたメッセージは、Windows が発行する通知メッセージ (Notification Messages) です。
これらの通知メッセージは、コントロールの親コントロールに送られてきます。標準コントロールの通知メッセージは WM_COMMAND メッセージの形式で送られてきます。コモンコントロールの通知メッセージは WM_NOTIFY メッセージの形式として送られてきます。

Delphi は、これらの通知メッセージを対象のコントロールで捕捉する仕組みを実装しています。
標準コントロールの場合は、以下のように、CN_COMMAND メッセージ処理用のメソッドを実装して、メッセージを TWMCommand でキャストして通知メッセージを判定します。
このサンプルは、TButton のクリックの通知メッセージを捕捉して、クリックの操作を無効にします。したがって、Button1 の OnClick イベントは発生しません。



図16
Button1 の OnClick イベントを無効にする

リスト16 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TplButtonEx = class(TButton)
  protected
    procedure CNCommand(var Message: TMessage); message CN_COMMAND;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    plButtonEx1 : TplButtonEx;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plButtonEx1 は TplButtonEx 型の変数として宣言 (定義) しておく
  plButtonEx1 := TplButtonEx(ChangeComponent(Button1, TplButtonEx));
end;

//=============================================================================
//  Button1 の OnClick イベント処理
//  本サンプルではこのイベントは発生しない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageBox(Handle, 'ボタンクリック', '情報', MB_ICONINFORMATION);
end;


{ TplButtonEx }

//=============================================================================
//  CN_COMMAND メッセージ処理
//  標準コントロールの通知メッセージの捕捉には CN_COMMAND メッセージを使用する
//=============================================================================
procedure TplButtonEx.CNCommand(var Message: TMessage);
begin
  if TWMCommand(Message).NotifyCode = BN_CLICKED then begin
    // 処理したことにして継承元のコードを実行しない
    // クリックのイベントが発生しなくなる
    Message.Result := 0;
    Exit;
  end;

  inherited;
end;

end.


TWMCommand でキャストするのが面倒であれば、次のように、メソッドの引数を TWMCommand にしてしまう方法もあります。メソッドの宣言の時に書き換えておけば、[Shift] + [Ctrl] + [C] で自動的にメソッドの実現部を作成できます。


リスト17 
//=============================================================================
//  CN_COMMAND メッセージ処理
//  標準コントロールの通知メッセージの捕捉には CN_COMMAND メッセージを使用する
//
//  引数の型を TWMCommand に変更している (元は TMessage 型)
//=============================================================================
procedure TplButtonEx.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then begin
    // 処理したことにして継承元のコードを実行しない
    // クリックのイベントが発生しなくなる
    Message.Result := 0;
    Exit;
  end;

  inherited;
end;


コントロールの通知メッセージを親コントロールで捕捉するには WM_COMMAND を使用します。
Button1 をクリックした時の BN_CLICKED メッセージを、Button1 の親コントロールであるフォームで捕捉する例です。



リスト18 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Button1 の OnClick イベント処理
//  本サンプルではこのイベントは発生しない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageBox(Handle, 'ボタンクリック', '情報', MB_ICONINFORMATION);
end;

//=============================================================================
//  WM_COMMAND メッセージ処理
//  標準コントロールの場合、
//  通知メッセージを親コントロールで捕捉するには WM_COMMAND メッセージを使用する
//=============================================================================
procedure TForm1.WMCommand(var Message: TWMCommand);
begin
  if Message.Ctl = Button1.Handle then begin
    if Message.NotifyCode = BN_CLICKED then begin
      // 処理したことにして継承元のコードを実行しない
      // クリックのイベントが発生しなくなる
      Message.Result := 0;
      Exit;
    end;
  end;

  inherited;
end;

end.


[備考]
通知メッセージは受信専用のメッセージです。
TButton にボタンクリックのメッセージである BM_CLICK を送信すると、そのボタンの親コントロールに、BN_CLICKED 通知メッセージが Windows から送られてきます。
一方、ウィンドウメッセージ WM_XXX は、メッセージの送信にも受信にも使われます。





10_CN_NOTIFY によるコントロールの通知メッセージ捕捉


NM_XXX, LVN_XXXX, TVN_XXX, HDN_XXX 等の通知メッセージ (Notification Messages) は、コモンコントロール (コンポーネント) である TListView, TTreeView 等の通知メッセージです。　
これらの通知メッセージは、対象のコモンコントロールの親コントロールに WM_NOTIFY メッセージの形式で送られてきます。

Delphi は、これらの通知メッセージを対象のコントロールで捕捉する仕組みを実装しています。
コモンコントロールの場合は、以下のように、CN_NOTIFY メッセージ処理用のメソッドを実装して、メッセージを TWMNotify でキャストして通知メッセージを判定します。
このサンプルは、TListView のクリックを検出します。



図17
ListView1 をクリックするとダイアログを表示

リスト19 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Winapi.CommCtrl, Vcl.ComCtrls;

type
  TplListViewEx = class(TListView)
  protected
    procedure CNNotify(var Message: TMessage); message CN_NOTIFY;
  end;

  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plListViewEx1 : TplListViewEx;
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  // plListViewEx1 は TplListViewEx 型の変数として宣言 (定義) しておく
  plListViewEx1 := TplListViewEx(ChangeComponent(ListView1, TplListViewEx));

  ListView1.ViewStyle := vsList;

  ListView1.Items.Add.Caption := '第 1 項目';
  ListView1.Items.Add.Caption := '第 2 項目';
end;

{ TplListViewEx }

//=============================================================================
//  CN_NOTIFY メッセージ処理
//  CN_NOTIFY はコモンコントロールの通知メッセージ用
//  (NM_XXX, LVN_XXXX, TVN_XXX, HDN_XXX 等)
//=============================================================================
procedure TplListViewEx.CNNotify(var Message: TMessage);
begin
  if TWMNotify(Message).NMHdr.code = NM_CLICK then begin
    MessageBox(Handle, '　クリック', '情報', MB_ICONINFORMATION);
  end;

  Inherited;
end;

end.


TWMNotify でキャストするのが面倒であれば、次のように、メソッドの引数を TWMNotify にしてしまう方法もあります。メソッドの宣言の時に書き換えておけば、[Shift] + [Ctrl] + [C] で自動的にメソッドの実現部を作成できます。


リスト20 
//=============================================================================
//  CN_NOTIFY メッセージ処理
//  CN_NOTIFY はコモンコントロールの通知メッセージ用
//  (NM_XXX, LVN_XXXX, TVN_XXX, HDN_XXX 等)
//
//  引数の型を TWMNotify に変更している (元は TMessage)
//=============================================================================
procedure TplListViewEx.CNNotify(var Message: TWMNotify);
begin
  if Message.NMHdr.code = NM_CLICK then begin
    MessageBox(Handle, '　クリック', '情報', MB_ICONINFORMATION);
  end;

  Inherited;
end;


コモンコントロールの通知メッセージを親コントロールで捕捉するには WM_NOTIFY を使用します。
ListView1 をクリックした時の NM_CLICK メッセージを、ListView1 の親コントロールであるフォームで捕捉する例です。


リスト21 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Winapi.CommCtrl, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsList;

  ListView1.Items.Add.Caption := '第 1 項目';
  ListView1.Items.Add.Caption := '第 2 項目';
end;

//=============================================================================
//  WM_NOTIFY メッセージ処理
//  WM_NOTIFY はコモンコントロールの通知メッセージ用
//  (NM_XXX, LVN_XXXX, TVN_XXX, HDN_XXX 等)
//
//  親でコモンコントロールの通知メッセージを捕捉するには WM_NOTIFY 使用する
//=============================================================================
procedure TForm1.WMNotify(var Message: TWMNotify);
begin
  if Message.NMHdr.idFrom = ListView1.Handle then begin
    if Message.NMHdr.code = NM_CLICK then begin
      MessageBox(Handle, '　クリック', '情報', MB_ICONINFORMATION);
    end;
  end;

  Inherited;
end;

end.



11_WindowProc プロパティを使用したサブクラス化


TControl の継承クラスには WindowProc プロパティがあります。WindowProc プロパティを使用すると、コントロールのウィンドウプロシージャを置き換えて、コントロールのウィンドウメッセージを処理することができます。このことをサブクラス化と言っています。
サブクラス化の方法では、継承クラスを作成しなくても、コントロールのウィンドウメッセージを捕捉して処理することができます。
置き換えたメソッド内では元の WindowProc を実行する必要があります。特定の条件で継承元のてメッセージを実行しない場合は戻り値を 0 にします。

以下のサンプルは、前述のサンプルと同じ機能です。クリップボードから TEdit に文字列を貼り付ける際に発生する WM_PASTE メッセージを捕捉して、整数値として使用できる文字列だけを TEdit の Text プロパティに代入します。

サブクラス化で処理可能なのはメッセージ関係だけです。コントロールの protected 部のプロパティやメソッド類にアクセスして操作できるわけではありません。サブクラス化のメソッドは、特定のコントロール用です、本サンプルでは Edit1 専用です。Edit1 用のサブクラスのメソッドを、他のコントロール用として共有することはできません。



リスト22 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FOriginEditProc : TWndMethod;
    procedure EditSubClassProc(var message: TMessage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // TEdit の 元の WindowProc を退避し、新しく WindowProc を設定
  FOriginEditProc  := Edit1.WindowProc;
  Edit1.WindowProc := EditSubClassProc;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // TEdit の WindowProc を元に戻す
  Edit1.WindowProc := FOriginEditProc;
end;

//-----------------------------------------------------------------------------
//  Edit1 のサブクラス化プロシージャ
//  TControl.WndProc に相当するメソッド
//  (継承クラスを作成して処理する場合は WndProc メソッドを使用する)
//-----------------------------------------------------------------------------
procedure TForm1.EditSubClassProc(var message: TMessage);
var
  LClipbrdText : string;
  LInteger     : Integer;
  LMsgText     : string;
begin
  if message.Msg = WM_PASTE then begin
    if Clipboard.HasFormat(CF_TEXT) then begin
      LClipbrdText := Clipboard.AsText;

      if TryStrToInt(LClipbrdText, LInteger) then begin
        Edit1.Text := IntToStr(LInteger);
      end else begin
        Edit1.Text := '';
        LMsgText := LClipbrdText + sLineBreak + 'は整数に変換できません';
        MessageBox(Handle, PChar(LMsgText), 'クリップボード', MB_ICONWARNING);
        SetFocus;
      end;
      // 処理を終了したことにする
      // 元の WindowProc を実行しない
      message.Result := 0;
      Exit;
    end;
  end;

  // 元の WindowProc の実行
  FOriginEditProc(message);
end;

end.


TApplicationEvents コンポーネントの OnMessage イベントで各種のメッセージが捕捉できますが、 TEdit の WM_PASTE メッセージは捕捉できません。 

//=============================================================================
//  TApplicationEvents コンポーネントの OnMessage イベント
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if Msg.hwnd = Edit1.Handle then begin
    if Msg.message = WM_PASTE then begin
      // 捕捉できない
    end;
  end;
end;

end.


[備考]
VCL のフォームは TControl の派生クラスですから、WindowProc プロパティがありますが、VCL のフォームのサブクラス化は必要ありません。VCL のフォームは TForm の継承クラスです。継承元の TFrom の WndProc メソッドは protected 部にあります。この WndProc メソッド (ウィンドウプロシージャ) をオーバライドして使用できます。
ただし、別のフォームのメッセージの処理をメインフォーム側で行いたい場合等に、別のフォームをサブクラス化することがあります。





12_SetWindowLong 関数を使用したサブクラス化


TControl の派生クラスではない TPrinterSetupDialog 等には WindowPorc プロパティは実装されていません。TPrinterSetupDialog 等のサブクラス化は、Windows API の SetWindowLong 関数の第 2 引数をGWL_WNDPROC にして、第 3 引数のコールバック関数を設定します。そのコールバック関数がウィンドウプロシージャとなります。

以下のサンプルは SetWindowLong 関数を使用する例です。機能は上のサンプルと同じです。クリップボードから TEdit に文字列を貼り付ける際に発生する WM_PASTE メッセージを捕捉して、整数値として使用できる文字列だけを TEdit の Text プロパティに代入します。



リスト23 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function EditWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;

var
  Form1: TForm1;

implementation

uses
  Vcl.Clipbrd;

{$R *.dfm}

var
  FOriginEditProc : Pointer;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // TEdit の 元の WndProc を退避し、新しく WndProc を設定
  FOriginEditProc := Pointer(SetWindowLong(Edit1.Handle,
                                           GWL_WNDPROC,
                                           NativeInt(@EditWindowProc)));
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // TEdit の WndProc を元に戻す
  SetWindowLong(Edit1.Handle, GWL_WNDPROC, NativeInt(FOriginEditProc));
end;

//-----------------------------------------------------------------------------
//  SetWindowLong 関数のコールバック関数
//  Edit1 のサブクラス化処理
//
//  この関数の定義文は Delphi XE5 のソースコードをコピー
//-----------------------------------------------------------------------------
function EditWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
var
  LClipbrdText : string;
  LInteger     : Integer;
  LMsgText     : string;
begin
  if Msg = WM_PASTE then begin
    if Clipboard.HasFormat(CF_TEXT) then begin
      LClipbrdText := Clipboard.AsText;

      if TryStrToInt(LClipbrdText, LInteger) then begin
        Form1.Edit1.Text := IntToStr(LInteger);
      end else begin
        Form1.Edit1.Text := '';
        LMsgText := LClipbrdText + sLineBreak + 'は整数に変換できません';
        MessageBox(Form1.Handle, PChar(LMsgText), 'クリップボード', MB_ICONWARNING);
        Form1.Edit1.SetFocus;
      end;
    end;
    // 処理したことにする
    // 元ウィンドウプロシージを実行しない
    Result := 0;
    Exit;
  end;

  // 元のウィンドウプロシージャを実行してメッセージを処理
  EditWindowProc := CallWindowProc(FOriginEditProc, hWnd, Msg, wParam, lParam);
end;

end.


[備考]
SetWindowLong 関数だと、他のプロセスのウィンドウプロシージャも置き換えそうな印象を受けるかも知れませんが、別のプロセスとして起動しているプログラムのウィンドウプロシージャを置き換えることはできません。