Delphi关于线程的消息处理

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

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

unit MessageHandle;

XML:namespace prefix = o ns = "urn:schemas-microsoft-com: Office:office" /> 

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），实现对线程消息的处理。代码如下<详见../消息处理设计(线程)1/test/unit1.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;