Delphi关于线程的消息处理

来源：互联网发布：windows模板设置编辑：程序博客网时间：2024/04/28 13:34

我是一个初学者,看到很多的高手的文章,心里更加对DELPHI倾慕!如今,要到自己去动手实践的时候了,真想在这上面有一番作为,我会好好努力,我会把DELPHI作为我最好的朋友去对待,让我每一天都充满了希望!

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

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

1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446

第二。窗口可以处理消息是因为它有窗口句柄。为了使线程也能处理消息，我们可以通过为线程加上一个相应窗口类的窗口名柄。（源码在 <../消息处理设计(线程)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;