Delphi消息处理机制

消息是Windows发出的一个通知，它告诉应用程序某个事件发生了。在Delphi中，大多数情况下Windows的消息被封装在VCL的事件中，我们只需处理相应的VCL事件就可以了，但如果我们需要编写自己的控件、截获或过滤消息就必须深入研究Win32的消息处理机制。

在Delphi中消息以TMessage记录的方式定义。打开Message.pas文件，我们可以看到Tmessage是这样定义的：

type 
TMessage = packed record 
Msg: Cardinal; 
case Integer of 
0: ( WParam: Longint; 
LParam: Longint; 
Result: Longint); 

1: ( WParamLo: Word; 
WParamHi: Word; 
LParamLo: Word; 
LParamHi: Word; 
ResultLo: Word; 
ResultHi: Word); 
end; 

其中，Msg是区别于其他消息的常量值，这些常量值可以是Windows单元中预定义的常量，也可以是用户自己定义的常量。Wparam通常是一个与消息有关的常量值，也可以是窗口或控件的句柄。LParam通常是一个指向内存中数据的指针。

Result是消息处理的返回值。Wparam、Lparam和Result都是32位的，如果想访问其中的低16位或高16位可以分别使用WparamLo、WparamHi、 LParamLo、LparamHi、ResultLo和ResultHi。

在Delphi中除了通用的Tmessage外，还为每个Windows定义了一个特殊的消息记录。我们可以浏览Message.pas文件，下面是键盘的消息记录：

TWMKey = packed record 
Msg: Cardinal; 
CharCode: Word; 
Unused: Word; 
KeyData: Longint; 
Result: Longint; 

与键盘相关的消息如：WM_KEYDOWN、 WM_KEYUP、 WM_CHAR、 WM_SYSKEYDOWN  WM_SYSKEYUP、 WM_SYSCHAR的记录也被定义为TWMkey。在Message.pas文件中有以下声明：

TWMChar=TWMkey； 
TWMKeyDown= TWMkey；
TWMKeyUp=TWMkey；
 TWMSys -KeyDown=TWMkey;
 TWMSysKeyUp= TWMkey；
TWMSysChar=TWMkey； 
 

消息的发送

消息处理就是定义应用程序如何响应Windows的消息。在Delphi中每一个消息都有自己的处理过程，它必须是一个对象中的方法，且只能传递一个Tmessage或其他特殊的消息记录，方法声明后要有一个message命令，后接一个在0到32767之间的常量。

前面我们提到的消息都是标准的Windows消息（WM_X）,除此之外还有VCL内部消息、通知消息和用户自定义消息。

VCL内部消息通常以“CM_”开头，用于管理VCL内部的事物。如果改变了某个属性值或组件的其他一些特性后，需要通过内部消息将该变化通知其他组件。例如，激活输入焦点消息是向被激活的或被停用的组件发送的，用于接受或放弃输入焦点。

另外还有通知消息，一个窗口内的子控件发生了一些事情，需要通知父窗口，这是通过通知消息实现的。它只适用于标准的窗口控件，如按钮、列表框、编辑框等等。打开Message.pas文件，在标准的Windows后就是通知消息的声明:

const 
{$EXTERNALSYM BN_CLICKED} 
BN_CLICKED = 0; 
{$EXTERNALSYM BN_PAINT} 
BN_PAINT = 1; 
{$EXTERNALSYM BN_HILITE} 
BN_HILITE = 2; 

以上是按钮的通知消息，分别表示用户单击了按钮、按钮应当重画、用户加亮了按钮。

用户也可以自己定义消息、给自己发送消息和编写消息处理过程。消息的常量值为WM_USER+100到FFF, 这个范围是Windows为用户自定义消息保留的。

Delphi消息的发送有三种方法：

1．Tcontrol类的Perform对象方法。可以向任何一个窗体或控件发送消息，只需要知道窗体或控件的实例。其声明如下： function Tcontrol.Perform(Msg:Cardinal;Wparam,Lparam:Longint):Longint

2．Windows的API函数SendMessage（）和Postmessage（）。其声明如下：

function SendMessage（hWnd: HWND; Msg: UINT；wParam：WPARAM; lParam: LPARAM）：LRESULT；stdcall；

function PostMessage（hWnd: HWND; Msg: UINT；wParam: WPARAM; lParam：LPARAM）：LRESULT；stdcall

PostMessage函数将消息添加到应用程序的消息队列中去。应用程序的消息循环会从消息队列中提取登记的该消息，再发送到相应的窗口中。

SendMessage函数可以越过消息队列直接向窗口过程发送。所以当Windows需要立刻返回值时使用SendMessage，当需要不同的应用程序依次处理消息时使用PostMessage。而Perform从本质上和SendMessage相似，它们直接向窗口过程发送。SendMessage、Postmessage函数只需要知道窗口的句柄就可以发送消息，所以它们可以向非Delphi窗体发送一条消息，但而Perform必须知道窗体或控件的实例。

 

Delphi的消息处理流程

 

TApplication.OnMessage只在应用程序的消息队列接收到一个消息时才被触发。一般应用程序接收到的消息是与窗口管理有关的消息(例如WM_PAINT和WM_SIZE),或由PostMessage()、PostAppMessage()或BroadcastSystemMessage()等API函数发送出的消息。但是，由于Windows或SendMessage()有可能会绕过消息队列直接将消息发送给窗口过程。当发生这种情况时，TApplication.OnMessage就不会被触发。

 

VCL的消息系统：

VCL定义了消息分发系统，该系统将所有的Windows消息传给相应的对象，由各对象的消息分发系统进行处理。

VCL对象用于接受消息的方法叫做MainWndProc()。通过MainWndPorc()可以对消息进行任何的处理。不过，一般情况下很少直接调用MainWndProc()来处理消息，除非不想让消息通过VCL的消息系统分发。

从MainWndProc()反回后，消息被传递给对象的WndProc（）的方法，这就是该对象的窗体

过程，然后进入VCL的分发机构。分发机构使用Disptch()方法把消息分发给一个消息句柄。

消息到达该消息的处理句柄（Handler）后，经过该句柄的处理，这个消息处理过程就结束

了。事件--MainWndProc---WndProc----Dispatch----Handle

 

 

在平时写程序时,总是碰到窗体（TForm）与线程（TThread）消息通信问题。令人烦恼的是窗体不能向线程（TThread）发送消息（线程没有窗口句柄）。经过几天的折腾，想出二种解决方案，拿出来跟大家探讨探讨。

第一。我们知道VC++ 中的MFC类库是自已封装了消息处理（BEGINMESSAGE, ENDMESSAGE），在MFC中对消息的处理是通过建立一张消息映射表，而把方法（function）或过程（procedure）的地址保存到映射表里（消息处理实质上是方法或过程的调用）,再加上一个消息分发机制，来实现消息的接收发送 <详见VC++技术内幕>。所以我们只要为线程里建立一张消息映射表，并建立相应的消息分发机制。这样就可以处理窗体发送到线程的消息。以下代码是实现消息映射表和消息分发的类（详见 <..消息处理设计(线程)1MessageHandle.pas> 中 ）

unit MessageHandle; 
interface
uses messages,Classes,SysUtils,Dialogs;
const PMSG_BASE = $BE00;   //自定义消息基址; 
      PMSG_NUM = 200;      //消息表大小； 
{**自定义消息处理类 
  *;功能 = 建立自定义消息表，处理线程之间 
  *   以及与主窗体之间的自定义消息(宏观) 
*}
  //消息处理句柄
  TMessageHandle = procedure(var Message: TMessage) of Object;
  TPDispatcher = class(TObject)
  private 
    //消息对应表(消息ID为数组下标); 
    MessageHandles: array of TMessageHandle; 
    //从消息ID得到数组ID 
    function GetIndexFromMsgID(const aMessageID: cardinal): Integer; 
  public
    constructor Create;
    destructor Destroy;
    //发送消息
    procedure SendMessage(var Message: TMessage); overload; 
    //添加自定义消息到消息对应表; 
    procedure AddHandle(const aMessageID: cardinal; aMessageHandle: TMessageHandle);
  end;
  //
implementation
{ TPDispatcher }
constructor TPDispatcher.Create;
var i: Integer; 
begin
  SetLength(MessageHandles,PMSG_NUM);  //200个消息的消息对应表
  //初始化消息队列;
  for i := 0 to Pred(PMSG_NUM) do
    MessageHandles[i] := nil;
end;
destructor TPDispatcher.Destroy; 
begin 
   {释放消息对应表}
  FreeAndNil(MessageHandles);
end; 
procedure TPDispatcher.AddHandle(const aMessageID: cardinal; 
  aMessageHandle: TMessageHandle);
var tID: Integer;
begin
  tID := GetIndexFromMsgID(aMessageID);
  Assert((tID > 0) or (tID < Pred(PMSG_NUM)) );
  Assert(Assigned(aMessageHandle));
  MessageHandles[tID] := aMessageHandle;
end; 
function TPDispatcher.GetIndexFromMsgID(const aMessageID: cardinal): Integer; 
begin
  Result := aMessageID - PMSG_BASE;
end;
procedure TPDispatcher.SendMessage(var Message: TMessage);
var tID: Integer;
    tMsgHandle: TMessageHandle;
begin
  tID := GetIndexFromMsgID(Message.Msg);
  Assert((tID > 0) or (tID < Pred(PMSG_NUM)));
  tMsgHandle := MessageHandles[tID];
  if Assigned(tMsgHandle) then
    tMsgHandle(Message);
end;

现在我们只需要注册一下自定义的消息，然后通过消息分发类（TPDispatcher），实现对线程消息的处理。代码如下<详见..消息处理设计(线程)1testunit1.pas>：

Unit unit1
const 
      {自定久线程消息}
      MY_MESSAGE2 = PMSG_BASE + 02;  
type
  TForm1 = class(TForm)
    AddMsgList: TButton;
    SendThead: TButton;
    sendForm: TButton;
    sendOther: TButton;
    procedure SendTheadClick(Sender: TObject);  //发送消息
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Fdispatcher: TPDispatcher;  消息映射表类
    Fhandle: TPHandler;
    FThread:  TPTHread;  自定义线程类
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.SendTheadClick(Sender: TObject);
var aMessage: TMessage;
begin
    aMessage.Msg := MY_MESSAGE2;
    aMessage.WParam := 1;
    Fdispatcher.SendMessage(aMessage);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  {创建消息映射表类}
  Fdispatcher := TPDispatcher.Create;
  Fhandle := TPHandler.Create;
  {创建线程}
    FThread := TPThread.Create(false);
  {向映射表中增加消息}
   Fdispatcher.AddHandle(MY_MESSAGE2,FThread.DoMessage);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var i: Integer;
begin
  FreeAndNil(Fdispatcher);
  FreeAndNil(Fhandle);
  for i:= 0 to 3 do
    FreeAndNil(FThread[i]);
end;

第二。窗口可以处理消息是因为它有窗口句柄。为了使线程也能处理消息，我们可以通过为线程加上一个相应窗口类的窗口名柄。（源码在 <..消息处理设计(线程)2 pThread.pas >中）

unit pThread; 
interface
uses classes,sysutils,Windows,Messages,Dialogs;
const MY_MESSAGE1 = $BD00 + 01;
Type
{** 消息处理线程类
  *;功能 = 添加线程处理消息能力，
*}
  TPMsgThread = class(TThread)
  private
    //窗口句柄
    FWndHandle: HWND;
    //窗口数据信息
    FWndClass: WNDCLASS;
    //指向窗口回调函数的指针
    FObjectInstance: Pointer;
    //初始化窗口数据
    procedure InitWnd;
    //创建隐藏窗口
    procedure CreateWnd;
    //注册隐藏窗口
    procedure RegistWnd;
    procedure DestroyWnd;
    //窗口回调函数
    procedure pWndProc(var Message: TMessage); virtual;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(CreateSuspended: Boolean); virtual;
    property WndHandle: HWND read FWndHandle write FWndHandle;
  end;
 
implementation 
const WND_NAME = 'PY20'; 
{ TPMsgThread }
constructor TPMsgThread.Create(CreateSuspended: Boolean);
begin 
  inherited Create(CreateSuspended); 
  FWndHandle := Integer(nil);
  InitWnd;
  RegistWnd;
  CreateWnd;
end;
 
procedure TPMsgThread.CreateWnd;
begin
  if(WndHandle = Integer(nil)) then
    WndHandle := CreateWindow(FWndClass.lpszClassName, FWndClass.lpszClassName,
      WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
      or WS_MINIMIZEBOX,
      GetSystemMetrics(SM_CXSCREEN) div 2,
      GetSystemMetrics(SM_CYSCREEN) div 2,
      0, 0, 0, 0, FWndClass.hInstance, nil);
  //置换窗口回调函数
  SetWindowLong(WndHandle, GWL_WNDPROC, Longint(FObjectInstance));
end; 
procedure TPMsgThread.DestroyWnd; 
begin
  UnregisterClass(FWndClass.lpszClassName,FWndClass.hInstance);
  DestroyWindow(WndHandle);
end; 
procedure TPMsgThread.DoTerminate; 
begin
  inherited;
  DestroyWnd;
end; 
procedure TPMsgThread.Execute; 
begin 
end; 
procedure TPMsgThread.InitWnd;
begin
  FwndClass.lpszClassName := PChar(WND_NAME);
  FWndClass.hInstance := Handle;
  FWndClass.lpfnWndProc := @DefWindowProc;
end; 
procedure TPMsgThread.pWndProc(var Message: TMessage); 
begin 
end;procedure TPMsgThread.RegistWnd; 
begin
  FObjectInstance := Classes.MakeObjectInstance(pWndProc);
  if(FWndClass.hInstance <> Integer(nil)) then
    RegisterClass(FWndClass);
end;