用子类化能不能截获VCL消息(100分)

我在控件中用了子类化技术，可以截获Windows消息，
但是好象不能截获VCL消息，请问用什么方法能截获VCL消息。

什么叫子类化啊，孤陋寡闻了，呵呵！能不能给解释一下，按道理说VCL不过是Delphi
自定义的windows消息而已，只要有给它发消息的话，应该能够截获的

VCL消息一般由Perform函数调用

Perform函数代码：
function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
Message: TMessage;
begin
Message.Msg := Msg;
Message.WParam := WParam;
Message.LParam := LParam;
Message.Result := 0;
if Self <> nil then WindowProc(Message);
Result := Message.Result;
end;
说白了，也是送消息到视窗，只不过省了sendmessage，而直接用windowproc，因为
sendmessage后也是到windowproc处理，已经有了windowproc就不用再拐弯抹角了，直接调用就得了。
所以，对FORM是怎么截获消息的对控件也是这样截获。
还有VCL应该说的是它对delphi封闭这些控件的架构，而不是指具体控件。

现在的问题是：
我编了一个自定义控件，它需要截获Form的消息
（包括Windows消息和VCL消息），不修改窗体的
原代码，所以我用子类化技术，但是现在不能截获
VCL消息。

给你一个我以前写的控件代码,里面有关于截获FORM消息的代码,一看就明白,
打*的地方：


{*******************************************************}
{ }
{ Borland Delphi Run-time Library }
{ }
{ Copyright (c) 2001-2001, Oncor information }
{ }
{ Translator: 江厚东 }
{ }
{*******************************************************}

unit SystemMenu;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,MenuS;

type
TSystemMenu = class(TComponent)
private
{ Private declarations }
Factive :Boolean ;
FpopupMenu :TPopupMenu ;
FWnd :HWND ;
Fmenu :HMENU ;
FoldWinProc:FARPROC ;
FNewWinProc:FARPROC ;
procedure AppendMenuToSysmenu();
procedure DeleteMenuFrSysmenu();
procedure SetActive(value :Boolean );
procedure SetPopMenu(value:TPopupMenu );
procedure _SysCommand(var Message :TMessage);
protected
{ Protected declarations }
procedure WndProc(var Message: TMessage);
procedure Loaded;override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy ;override;
procedure Open;
procedure Close;
published
{ Published declarations }
property Active : Boolean Read Factive Write SetActive;
property PopMenu: TPopupMenu Read FPopupMenu Write SetPopMenu;
end;

procedure Register;

implementation


{TsystemMenu}

constructor TSystemMenu.Create (AOwner :TComponent);
begin
inherited;
if (Owner is TForm ) then
begin
FWnd := (Owner as TForm) .Handle ;
Fmenu := GetSystemMenu (FWnd ,False );
FoldWinProc := pointer(GetWindowLong (FWnd ,GWL_WNDPROC));
Factive := False ;
end
else
begin
Raise Exception .Create ('The owner muse be TForm!');
end;
end;

destructor TSystemMenu.Destroy ;
begin
Close ;
inherited Destroy ;
end;

procedure TSystemMenu.WndProc(var Message: TMessage);
begin
with Message do
begin
case Msg of
WM_SYSCOMMAND : _SysCommand( Message );
else
Result := CallWindowProc(FoldWinProc , FWnd , Msg, wParam, lParam);
end;
end;
end;


procedure TSystemMenu._SysCommand (var Message :TMessage);
var
i:Byte ;
begin
with TWMCOMMAND(Message) do
begin
for i:= 0 to FpopupMenu .Items .Count - 1 do
if TWMCOMMAND(Message).ItemID = FpopupMenu .Items .Command then
begin
FpopupMenu .Items .Click ;
end;
end;
CallWindowProc(FoldWinProc , FWnd ,Message. Msg,Message . wParam,Message .lParam);
end;

procedure TsystemMenu.AppendMenuToSysmenu ();
var
i:Integer ;
begin

for i:=0 to FpopupMenu .Items .Count - 1 do
begin
AppendMenu (FMenu ,MF_BYPOSITION ,i+1,
PCHAR(FpopupMenu .Items .Items .Caption ));
end;
DrawMenuBar (FWnd );
end;

procedure TsystemMenu.DeleteMenuFrSysmenu ;
var
i:Integer ;
begin
for i:=0 to FpopupMenu .Items .Count - 1 do
begin
DeleteMenu(Fmenu ,i+1,MF_BYCOMMAND );
end;
DrawMenuBar (FWnd );
end;

procedure TsystemMenu.SetPopMenu (Value :TPopupMenu);
begin
FpopupMenu := value ;
end;

procedure TSystemMenu.SetActive(value :Boolean );
begin
if FActive <> Value then
begin
FActive := Value;
if FActive then
begin
if Assigned(FPopupMenu) then
begin
AppendMenuTosysmenu();
Factive := value ;
FNewWinProc := MakeObjectInstance (WndProc );
*****************************************
FoldWinProc := pointer(GetWindowLong (FWnd ,GWL_WNDPROC ));
*****************************************
SetWindowLong(FWnd , GWL_WNDPROC, LongInt(FNewWinProc));
*****************************************
end;
end else begin
if Assigned(FPopupMenu) then
begin
DeleteMenuFrSysmenu() ;
Factive := value ;
SetWindowLong(FWnd , GWL_WNDPROC, LongInt(FoldWinProc ));
*****************************************
FreeObjectInstance(FNewWinProc);
*****************************************
end;
end;
end;
end;
{
procedure TSystemMenu.SetActive(value :Boolean );
begin
if (value = True) and ( Factive = False ) then
begin
if FpopupMenu <> nil then
begin
AppendMenuTosysmenu();
Factive := value ;
FNewWinProc := MakeObjectInstance (WndProc );
FoldWinProc := pointer(GetWindowLong (FWnd ,GWL_WNDPROC ));
SetWindowLong(FWnd , GWL_WNDPROC, LongInt(FNewWinProc));
end;
end;
if (Value = False) and ( Factive = True ) then
begin
if FpopupMenu <> nil then
begin
DeleteMenuFrSysmenu() ;
Factive := value ;
SetWindowLong(FWnd , GWL_WNDPROC, LongInt(FoldWinProc ));
FreeObjectInstance(FNewWinProc);
end;
end;
end;
}
procedure TSystemMenu.Open ;
begin
SetActive (True);
end;

procedure TsystemMenu.Close ;
begin
SetActive (False);
end;

procedure TSystemMenu.Loaded;
begin
inherited;
FActive := False; //直接赋值
Active := True;
if Active then
begin
FActive := False; //直接赋值
Active := True;
end;
end;

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

end.

to Jhdandc:
谢谢你给我的原代码，不过你的子类化技术还是截获的是Windows消息。
我的意思是截获用TControl.Perform函数发送的消息。

TO 鲁小班
在Controls单元中4144行：
function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
Message: TMessage;
begin
Message.Msg := Msg;
Message.WParam := WParam;
Message.LParam := LParam;
Message.Result := 0;
if Self <> nil then WindowProc(Message);
Result := Message.Result;
end;
其实Perform也是直接调用windowproc而已，所以只要你能capture到windowproc里处理的
消息你就等于capture到所有消息了。

多人接受答案了。