DELPHI中的消息處理機制（三種消息處理方法的比較，如何截斷消息）

DELPHI中的消息處理機制

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語句保護，從而導致程序不會動不動就崩潰。