Delphi关于线程的消息处理

来源:互联网 发布:软件测试培训机构 编辑:程序博客网 时间:2024/03/29 23:20
在平时写程序时,总是碰到窗体(TForm)与线程(TThread)消息通信问题。令人烦恼的是窗体不能向线程(TThread)发送消息(线程没有窗口句柄)。经过几天的折腾,想出二种解决方案,拿出来跟大家探讨探讨。
第一。我们知道VC++ 中的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;