unit testLabel;

interface

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



type
  TtestLabel = class(TLabel)
   public 
    FoldWndProc:TWndMethod; 
    constructor Create(AOwner: TComponent);override; 
    destructor  Destroy;override; 
    procedure   MyWndProc(var Message: TMessage); 
  end;

procedure Register;

implementation

var WM_DetachProc:Cardinal;

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

constructor TtestLabel.Create(AOwner: TComponent); 
begin inherited; 
  if (AOwner is TCustomForm) then
  begin
   FOldWndProc := TCustomForm(AOwner).WindowProc;
   TCustomForm(AOwner).WindowProc := MyWndProc;
  end else begin 
   FOldWndProc := nil; 
  end; 
end; 


destructor TtestLabel.Destroy; 
var msg:TMessage; 
begin 
  msg.Msg:=WM_DetachProc;
  msg.WParam:=longint(self);
   (Owner as TCustomForm).WindowProc(msg);
  inherited; 
end; 

    //-------------------------------
    //メソッドが一致するかどうか調べる関数
    function SameMethod(const A, B: TWndMethod): Boolean;
    begin
      if (TMethod(A).Code = TMethod(B).Code) and (TMethod(A).Data = TMethod(B).Data) then
        Result := True
      else
        Result := False;
    end;


procedure TtestLabel.MyWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_DetachProc then
  begin
    if not SameMethod((Owner as TCustomForm).WindowProc, Self.MyWndProc) then
    begin

    end else
    begin

      (Owner as TCustomForm).WindowProc := FOldWndProc;
      if ( Message.WParam = LongInt(Self)) then
      begin
        FoldWndProc := nil;
      end else
      begin
        FOldWndProc(Message);//さらに解放を続ける
        FOldWndProc:=(Owner as TCustomForm) .WindowProc;
        (Owner as TCustomForm) .WindowProc:= MyWndProc;
      end;

    end;


  end else
  case Message.Msg of
    WM_CHAR:
    begin  //コンポーネントの動作チェック用
      text:=Char(Message.WPARAM);
      if assigned(FoldWndProc) then FoldWndProc(Message);
    end;

  else
    if assigned(FoldWndProc) then FoldWndProc(Message);
  end;
end; 

initialization
  WM_DetachProc := RegisterWindowMessage('WM_SubclassFreeNotify');

end.