Delphi中window消息截获的实现方式

Posted 2020-07-28 小小猫钓小小鱼

Delphi是Borland公司提供的一种全新的WINDOWS编程开发工具。由于它采用了具有弹性的和可重用的面向对象Pascal(object-orientedpascal)语言，并有强大的数据库引擎(BDE)，快速的代码编译器，同时又提供了众多出色的构件。受到广大编程人员的青睐。在众多的编程语言(如VB，PowerBuilder，Powerpoint等)中脱颖而出。其中一个DELPHI强于其他编程语言(如VB4.0)的地方就是在DELPHI中可自定义消息，并可直接处理消息。这对于那些希望编写自己的构件(Component)，或者希望截获。过滤消息的用户来说是必不可少的。因为编写构件一般要对相应的消息进行处理。下面就对Delphi中消息处理机制进行一下介绍。

一。DELPHIVCL中消息的传递

Delphi中每一个VCL(VisualComponentLibrary)构件(如Tbutton，Tedit等)都有一内在的消息处理机制，其基本点就是构件类接收到某些消息并把它们发送给适当的处理方法，如果没有特定的处理方法，则调用缺省的消息处理句柄。

其中MainWndProc是定义在Twincontrol类中的一个静态方法，不能被重载(Override)。它不直接处理消息，而是交由wndproc方法处理，并为wndproc方法提供一个异常处理模块。Mainwndproc方法声明如下:
procedure MainWndProc(varMessage: TMessage);

WndProc是在Tcontrol类中定义的一个虚拟方法，由它调用dispatch方法来进行消息的分配，wndproc方法声明如下:
procedure WndProc(varMessage: TMessage); virtual;

dispatch方法是在Tobject根类中定义的，其声明如下:
procedure Tobject。dispatch(varMessage);传递给dispatch的消息参数必须是一个记录类型，且这个记录中第一个入点必须是一个Cardinal类型的域(field)，它包含了要分配的消息的消息号码。例如:

type
Tmessage=record
Msg:cardinal;
wparam:word;
lparam:longint;
result:longint;
end;

而Dispatch方法会根据消息号码调用构件的最后代类中处理此消息的句柄方法。如果此构件和它的祖先类中都没有对应此消息的处理句柄，Dispatch方法便会调用DefaultHandler方法。DefaultHandler方法是定义于TObject中的虚拟方法，其声明如下:
Procedure DefaultHandler(varMessage); virtual;

Tobject类中的DefaultHandler方法只是实现简单的返回而不对消息进行任何的处理。我们可以通过对此虚拟方法的重载，在子类中实现对消息的缺省处理。对于VCL中的构件而言，其DefaultHandler方法会启动windows API函数DefWindowProc对消息进行处理。

二。DELPHI中的消息处理句柄

在DELPHI中用户可以自定义消息及消息处理句柄。消息处理句柄的定义有如下几个原则:

1。消息处理句柄方法必须是一个过程，且只能传递一个Tmessage型变量参数。
2。方法声明后要有一个message命令，后接一个在0到32767之间的消息标号(整型常数)。
3。消息处理句柄方法不需要用override命令来显式指明重载祖先的一个消息处理句柄，另外它一般声明在构件的protected或private区。
4。在消息处理句柄中一般先是用户自己对消息的处理，最后用inherited命令调用祖先类中对应此消息的处理句柄（有些情况下可能正相反）。由于可能对祖先类中对此消息的处理句柄的名字和参数类型不清楚，而调用命令inherited可以避免此麻烦，同样如果祖先类中没有对应此消息的处理句柄，inherited就会自动调用Defaulthandler方法（当然如果要屏蔽掉此消息，就不用inherited命令了）。

消息处理句柄方法声明为：
procedure Mymsgmethod(var message:Tmessage);message Msgtype;

同样用户也可以定义自己的消息，用户自定义消息应从WM_USER开始。
自定义消息及消息处理句柄举例如下:

const my_paint=Wm_user+1;

type
Tmypaint=record
msgid:cardinal;
msize:word;
mcolor:longint;
msgresult:longint;
end;

type

Tmycontrol=class(TCustomControl)
protected
procedure change(var message:Tmypaint); message my_paint;
end;

procedure Tmycontrol.change(var message:Tmypaint);
begin
size:=message.msize; {设置Tmybutton尺寸属性}
color:=message.mcolor; {设置Tmybutton颜色属性}
{do something else}
inherited; {交由Tcustomcontrol处理}
end;

 

三。过滤消息

过滤消息又称消息陷阱。在一定情况下，用户可能需要屏蔽某些消息。或者截获某些消息进行处理。由以上介绍可以看出过滤消息一般有三种途径：
(1)。重载构件继承的虚拟方法wndproc。
(2)。针对某消息编写消息处理句柄。
(3)。重载构件继承的虚拟方法DefHandler，在其中对消息进行处理。其中常用的方法是方法(2)，在上节中已介绍过了，方法(1)与方法(3)相似，这里只简单介绍一下方法(1)。

重载虚拟方法wndproc的一般过程如下：
procedure Tmyobject.wndproc(var message: Tmessage);
begin
{判断此消息是否该处理}
inherited wndproc(message);
{未处理的消息交由父辈wndproc方法处理}
end;

由此可以看出在wndproc方法中处理消息的优势是可以过滤整个范围内的消息，而不必为每个消息指定一个处理句柄，事实上Tcontrol构件中就是利用它来过滤并处理所有的鼠标消息的(从WM_mousefirst到WM_mouselast，如下代码示)。同样利用它也可以阻止某些消息被发送给处理句柄。

procedure TControl.WndProc(var Message: TMessage);
begin

if (Message.Msg>=WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST)
then
if Dragging then DragMouseMsg(TWMMouse(Message)) {处理拖曳事件}
else {处理其他鼠标消息}
end;

Dispatch(Message);

{否则正常发送消息}

end;

下例为一简单的自定义构件例子：
Tmyedit类是从Tedit类派生出的一个新类，它的特点是在运行中不能获得焦点，不能由键盘输入（有点类似Tlabel构件）。我们可在其wndproc方法中过滤出WM_setfocus，WM_mousemove消息并进行处理来达到上述要求，源程序如下：

unit myedit;

interface

uses

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

type

Tmyedit = class(TEdit)
protected
procedure wndproc(var message:Tmessage);override;
end;

procedure Register;

implementation

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

procedure Tmyedit.WndProc(var message:tmessage);
begin
if message.msg=wm_mousemove then
begin
cursor:=crarrow; { 设置光标为crarrow， 而不是缺省的crBeam 光 标}
exit;
end;

if message.msg=wm_SetFocus then exit;
{屏蔽掉WM_setfocus消息，不让Tmyedit控件获得输入焦点}

inherited wndproc(message);
{其他消息交父辈wndproc处理}

end;

end.

您可以将Tmyedit 加 到Component Palette中检验其性能。

由以上介绍可以看出，只有清楚了DelphiVCL中的消息处理机制，掌握好处理各种消息的方法和时机（必要时要借助各种工具，如winsight32，spy等），并结合OOP语言的特点，我们才可能编出高质量的构件。这当然要靠读者在实践中不断摸索，积累经验。

===============================================================

上文写的很不错，但是读完之后，引发一个问题，就是三种消息函数的触发顺序。经过我的研究，应该是WndProc最有优先权，它处理完以后，还要看它是否继续传递。如果继续传递，可以继续触发下一个消息函数。其中消息处理句柄函数优先权更高，如果它存在，就触发它，然后看它是否继续传递。如果继续传递还可以传递给DefaultHandler方法。这样一条消息就可以同时触发三个消息处理函数。

但是如果消息处理句柄函数不存在，那么WndProc会直接传递消息给DefaultHandler（其实是WndProc找不到消息处理句柄函数之后，靠TObject的Dispatch发送消息到DefaultHandler的）。

unit Unit1;

interface

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

const
  WM_TEST=WM_USER+100;
    
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure WndProc(var Message: TMessage); override;  // 第一优先权
    procedure MyMessage(var Msg: TMessage); message WM_TEST; // 第二优先权
    procedure DefaultHandler(var Message); override; // 第三优先权
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_TEST: begin ShowMessage(\'message in wndproc\'); end; // 这里加上Exit就不再继续传递了
  end;
  // 一定要加上这句，否则编译通不过。因为绝大部分消息没人处理了
  inherited WndProc(Message); // 会一路向上调用，直到TControl.WndProc调用Dispatch来寻找消息处理函数
end;

procedure TForm1.MyMessage(var Msg: TMessage);
begin
  // 消息编号处理函数会首先响应Dispatch函数
  ShowMessage(\'message in MyMessage function\');
  // 处理完以后，可选择是否继续传递给DefaultHandler
  inherited; // 加上这句就会继续传递，否则就到此为止了
end;

procedure TForm1.DefaultHandler(var Message);
var
  P: PChar;
begin
  with TMessage(Message) do
    case Msg of
      WM_TEST: begin ShowMessage(\'message in DefaultHandler\'); Exit; end; // 这里加不加Exit都不影响
    else
      // 一定要加上这句，否则编译通不过。因为一些基本的消息没人处理，程序就没法正常运行了。（没有默认的消息处理函数了，消息没法自然终止）
      inherited DefaultHandler(Message); // 它会调用TCustomForm.DefaultHandler，然后继续向上传递
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(Handle, WM_TEST, 0, 0);  // 第一种发消息方法
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Perform(WM_TEST, 0, 0); // 第二种发消息方法
end;

end.

但是如果这样写：

procedure TForm1.WndProc(var Message: TMessage);
begin
  // 一定要加上这句，否则编译通不过。因为绝大部分消息没人处理了
  inherited WndProc(Message); // 会一路向上调用，直到TControl.WndProc调用Dispatch来寻找消息处理函数

  case Message.Msg of
    WM_TEST: begin ShowMessage(\'message in wndproc\'); end; // 这里加上Exit就不再继续传递了
  end;
end;

虽然WndProc仍然具有最高优先权，但是因为调用关系，它自身处理消息的结果会在最后显示。

疑问：那两个编译不过的地方，本来应该不是问题。但Delphi在建立窗体和初始化的过程中，使用了某些消息处理，而且还是需要返回值的，所以不处理就会出问题了。有空做个测试研究一下。

============================================================

新的方法：可以这样改变现有控件的WndProc指针（不修改控件的源代码）：截获DBGrid的滚动条消息。这种方法其实相当于就是windows的子类化技术。之所以说“相当于”是因为并没有直接替换窗口类的回调函数，而是替换了Delphi函数之间的替换而已。

FOldProc : TWndMethod;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FOldProc := dbgrid1.WindowProc;
  dbgrid1.WindowProc := MyProc; // 简单替换窗口函数
end;

procedure TForm1.MyProc(var message: TMessage);
begin
  if message.Msg = WM_VSCROLL then
    showmessage(\'vscroll\')
  else if message.Msg = WM_HSCROLL then
    showmessage(\'hscroll\');
  FOldProc(message); // 当场使用旧窗口函数的函数指针，简单又完美
end;

总结：Delphi的魅力真是无穷呀，除了WndProc，另两种方法都是Delphi自己提供的。就算是WndProc也变得有所不同——换成了Delphi自己的函数，不带句柄，且可相互替换和传递，空前灵活且威力巨大。甚至还能加上try catch语句保护，从而导致程序不会动不动就崩溃。