窗体的子类化

子类化的学习

去年就看了看子类化，但当前的水平很低，许多的东西还不明白，今天又看了看子类化，有了一个大概的了解

所谓的子类化，是指用自己的一个消息处理过程去替换指定的窗体的消息处理过程，当处理的消息不符合要求

时，要用原来的消息处理过程继续处理

其中 application 有一个 OnMessage 的消息处理过程

定义为

 TMessageEvent = procedure (var msg:TMessage;Handled:boolean);

可以自定义一个 TMessageEvent 的处理过程

如
 proceudure applicationOnMessage(var msg:Tmsg;handled:boolean);

.....

 proceudure TForm1.applicationOnMessage(var msg:Tmsg;handled:boolean);
 begin
    if msg.msg = wm_user_1 then
    begin
       // 这里自己处理
    end;
    // 后面什么也不用加
 end;

 proceudure Tform1.formCreate(sender:tobject);
 begin
   application.onMessage = form1.applicationONMessage;
 end;

像上面这样有一个问题是 application.onMessage 只能接收消息队列中的消息，就是用 postMessage 发送的消息 , 而不能接收用 sendMessage 发送的消息。

关于 sendMessage 和 postMessage 的说明

//-------------
SendMessage的原型如下：LRESULT SendMessage(HWND hWnd,UINT Msg,WPARAM wParam,LPARAM lParam)，这个函数主要是向一个或多个窗口发送一条消息，一直等到消息被处理之后才会返回。不过需要注意的是，如果接收消息的窗口是同一个应用程序的一部分，那么这个窗口的窗口函数就被作为一个子程序马上被调用；如果接收消息的窗口是被另外的线程所创建的，那么窗口系统就切换到相应的线程并且调用相应的窗口函数，这条消息不会被放进目标应用程序队列中。函数的返回值是由接收消息的窗口的窗口函数返回，返回的值取决于被发送的消息。
 
　　 PostMessage的原型如下：BOOL PostMessage(HWND hWnd,UINT Msg,WPARAM wParam,LPARAM lParam)，该函数把一条消息放置到创建hWnd窗口的线程的消息队列中，该函数不等消息被处理就马上将控制返回。
需要注意的是，如果 hWnd 参数为 HWND_BROADCAST ，那么，消息将被寄送给系统中的所有的重叠窗口和弹出窗口，但是子窗口不会收到该消息；如果 hWnd 参数为NULL，则该函数类似于将dwThreadID参数设置成当前线程的标志来调用
-------------//

VCL 中的消息处理是在 WndProc 中处理的  WndProc 定义为 TWndMethod = procedure (var msg:tmessage);

既然这样，那我们可以自定义一个 TWndMethod 来替换掉默认的 WndProc 就可以了，也就是所谓的子类化吧

这里有两种方法(用窗口过程来替换)

方法一
//--------------------
 private
   FOldWndProc : TWndMethod;
   procedure NewWndProc(var msg:TMessage);

 ...
 ...
 
 procedure TForm1.NewWndProc(var msg:TMessage);
 begin
   if msg.msg = wm_user_1  then // 这里的 wm_user_1 是自定义的消息
   begin
      // 自已处理
     exit; // 处理完后退出
   end;
   // 不符合条件

   FOldWndProc(msg); // 默认的消息处理过程
 end;
 
 procedure Tform1.formCreate(sender:TObjec);
 begin
   FOldWndProc := Form1.windowProc;    // 取得默认的消息处理过程  这里应该保存的是地址      
   {
   这里用 windowProc 因为 WindowProc 也就是 Wndproc
   我们查看了下源码
    constructor TControl.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FWindowProc := WndProc;                 --> 最后看这里                
    .....

   TControl = class(TComponent)
   private
    FParent: TWinControl;
    FWindowProc: TWndMethod;                          --> 再看这里
   ....
    property WindowProc: TWndMethod read FWindowProc write FWindowProc;      --> 先看这里
    

   }
  
   form1.WindowProc := self.NewWndProc;    // 赋予新的处理过程
   // 要是直接用 Form1.wndProc := self.NewWndProc 编译不能通过

 end;
  
 procedure Tform1.FormDestroy(sender:tobject);
 begin
    // 在释放时，把消息处理过程还原回去
   form1.WindowProc := FOldWndProc;
 end;

----------------------//

方法二

这里用到了 MakeObjectInstance ,我对这个也不太清楚
//---------------------

  private
    FOldWndProc:pointer;   // 这里定义为指针 保存默认的地址
    FNewWndProc:pointer;   // 新的
   
    procedure NewWndProc(var msg:TMessage);

  ...
  ...
 
  procedure TForm1.NewWndProc(Var Msg:TMessage);
  begin
    if msg.msg = wm_user_1 then
    begin
       // 自己处理
      exit; // 处理完后退出
    end;
    msg.result := CallWindowProc(FOldWndProc,form1.handle,msg.msg,msg.wparam,msg.lparam);
    // 上面 的 form1.handle 可以换成 application.handle ，换成哪个的 handle 就是对哪个窗口
    // 进行子类化
  end;
 
  procedure TForm1.FormCreate(sender:Tobject);
  begin
    FNewWndProc := MakeObjectInstance ( NewWndProc);
    FOldWndProc := Pointer(setWindowLong(Form1.handle,GWL_WNDPROC,integer(FNewWndProc)));
    // 同样 form1.handle 也可以换成 application.handle
  end;
 
  procedure Tform1.FormDestroy(sender:tobject);
  begin
    // 先还原
    SetwindowLong(form1.handle,GWL_WNDPROC,Integer(FOldWndProc));
    // 再释放 makeObjectInstance 生成的 FNewWndproc
    FreeObjectInstance(FNewWndProc);
  end;
 
   
  
 
---------------------//

 

附，我练习用的代码

Form1
//------------------------------
unit Unit1;

interface

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

 const wm_user_1 = wm_user + 2;  // 自定义消息

type

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
   
    FOldOnMessage:TMessageEvent;
    FOldWndProc:TWndMethod;
    procedure applicationMessage(var msg:tmsg;var handled:boolean);
    procedure FormWndProc(var msg:tmessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure Tform1.applicationMessage(var msg:tmsg;var handled:boolean);
begin
  if msg.message = wm_user_1 then
    showmessage('application.onmessage 截获 自定义消息 WM_user_1 ');
  {
    onMessage 只能接收消息队列中的消息，而不能载获用 sendMessage 直接发送的
    消息
  }
 // self.FOldOnMessage(msg,handled);
end;

procedure TForm1.FormWndProc(var msg:TMessage);
begin
  if msg.Msg = wm_user_1 then
  begin
    showmessage('WndProc 截获 自定义消息 wm_user_1');
    exit;
  end;
  self.FOldWndProc(msg);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  application.OnMessage := self.applicationMessage;
  //form1.WindowProc := self.FormWndProc;
  //self.FOldWndProc :=  pointer(windows.SetWindowLong(form1.Handle,
  // GWL_WNDPROC,integer(FormWndProc));
  self.FOldWndProc := form1.WndProc;
  self.windowProc:= self.FormWndProc;
end;

 

procedure TForm1.Button1Click(Sender: TObject);
begin
  postmessage(form1.Handle,wm_user_1,0,0); //
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //sendMessage(application.Handle ,wm_user_1,0,0);
  sendMessage(form1.Handle ,wm_user_1,0,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  self.WindowProc := self.FOldWndProc;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  form2.Show;
end;

end.

-------------------------------//

 

Form2

//------------------------------
  unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
     FOldWndProcPtr:Pointer;
     FNewWndProcPtr:pointer;
     procedure NewWndProc(var msg:TMEssage);
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.NewWndProc(var msg:TMessage);
begin
  if msg.Msg = wm_user_1 then
  begin
    showmessage('form2.newWndProc 截获发住 application 的 wm_user_1 消息');
    exit;
  end;
  msg.Result :=
  windows.CallWindowProc(self.FOldWndProcPtr,application.Handle,msg.Msg,msg.wParam,msg.lParam);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
  sendmessage(application.Handle,wm_user_1,0,0);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  postmessage(form2.Handle,wm_user_1,0,0);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  self.FNewWndProcPtr := forms.MakeObjectInstance(self.NewWndProc);
  //  self.FOldWndProcPtr:=pointer(setWindowLong(form2.Handle,windows.GWL_WNDPROC,integer(self.FNewWndProcPtr)));
  self.FOldWndProcPtr:=pointer(setWindowLong(application.Handle,windows.GWL_WNDPROC,integer(self.FNewWndProcPtr)));
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
 { setWindowLong(form2.Handle,windows.GWL_WNDPROC,integer(self.FOldWndProcPtr));
  forms.FreeObjectInstance(self.FnewWndProcPtr);    }

  setWindowLong(application.Handle,windows.GWL_WNDPROC,integer(self.FOldWndProcPtr));
  forms.FreeObjectInstance(self.FnewWndProcPtr);
end;

end.

------------------------------//