在delphi线程中实现消息循环
<br>
<br>
<p class="content" style="margin: 4px 2px 0px;">Delphi的TThread类使用很方便,但是有时候我们需要在线程类中使用消息循环,delphi没有提供.花了两天的事件研究了一下win32的消息系统,写了一个线程内消息循环的测试.但是没有具体应用过,贴出来给有这方面需求的DFW参考一下.<br>希望大家和我讨论.<br><br>{-----------------------------------------------------------------------------<br> Unit Name: uMsgThread<br> Author: xwing<br> eMail : xwing@263.net ; MSN : xwing1979@hotmail.com<br> Purpose: Thread with message Loop<br> History:<br><br> 2003-6-19, add function to Send Thread Message. ver 1.0<br> use Event List and waitforsingleObject<br> your can use WindowMessage or ThreadMessage<br> 2003-6-18, Change to create a window to Recving message<br> 2003-6-17, Begin.<br>-----------------------------------------------------------------------------}<br>unit uMsgThread;<br><br>interface<br>{$WARN SYMBOL_DEPRECATED OFF}<br>{$DEFINE USE_WINDOW_MESSAGE}<br>uses<br> Classes, windows, messages, forms, sysutils;<br><br>type<br> TMsgThread = class(TThread)<br> private<br> {$IFDEF USE_WINDOW_MESSAGE}<br> FWinName : string;<br> FMSGWin : HWND;<br> {$ELSE}<br> FEventList : TList;<br> FCtlSect : TRTLCriticalSection;<br> {$ENDIF}<br> FException : Exception;<br> fDoLoop : Boolean;<br> FWaitHandle : THandle;<br> {$IFDEF USE_WINDOW_MESSAGE}<br> procedure MSGWinProc(var Message: TMessage);<br> {$ELSE}<br> procedure ClearSendMsgEvent;<br> {$ENDIF}<br> procedure SetDoLoop(const Value: Boolean);<br> procedure WaitTerminate;<br><br> protected<br> Msg :tagMSG;<br> <br> procedure Execute; override;<br> procedure HandleException;<br> procedure DoHandleException;virtual;<br> //Inherited the Method to process your own Message<br> procedure DoProcessMsg(var Msg:TMessage);virtual;<br> //if DoLoop = true then loop this procedure<br> //Your can use the method to do some work needed loop. <br> procedure DoMsgLoop;virtual;<br> //Initialize Thread before begin message loop <br> procedure DoInit;virtual;<br> procedure DoUnInit;virtual;<br><br> procedure PostMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);<br> //When Use SendMsg method Must not use Synchronize Method in ThreadLoop !!!<br> //otherwise will caurse DeadLock<br> procedure SendMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);<br> <br> public<br> constructor Create(Loop:Boolean=False;ThreadName: string='');<br> destructor destroy;override;<br> procedure AfterConstruction;override;<br><br> //postMessage to Quit,and Free(if FreeOnTerminater = true)<br> //can call this in thread loop, don't use terminate property.<br> procedure QuitThread;<br> //PostMessage to Quit and Wait, only call in MAIN THREAD<br> procedure QuitThreadWait;<br> //just like Application.processmessage.<br> procedure ProcessMessage;<br> //enable thread loop, no waitfor message<br> property DoLoop: Boolean read fDoLoop Write SetDoLoop;<br><br> end;<br><br>implementation<br><br>{ TMsgThread }<br>{//}<br>constructor TMsgThread.Create(Loop:Boolean;ThreadName:string);<br>begin<br> {$IFDEF USE_WINDOW_MESSAGE}<br> if ThreadName <> '' then<br> FWinName := ThreadName<br> else<br> FWinName := 'Thread Window';<br> {$ELSE}<br> FEventList := TList.Create;<br> InitializeCriticalSection(fCtlSect);<br> {$ENDIF}<br><br> FWaitHandle := CreateEvent(nil, True, False, nil);<br><br> FDoLoop := Loop; //default disable thread loop<br> inherited Create(False); //Create thread<br> FreeOnTerminate := True; //Thread quit and free object<br><br> //Call resume Method in Constructor Method<br> Resume;<br> //Wait until thread Message Loop started <br> WaitForSingleObject(FWaitHandle,INFINITE);<br>end;<br><br>{------------------------------------------------------------------------------}<br>procedure TMsgThread.AfterConstruction;<br>begin<br>end;<br><br>{------------------------------------------------------------------------------}<br>destructor TMsgThread.destroy;<br>begin<br> {$IFDEF USE_WINDOW_MESSAGE}<br> {$ELSE}<br> FEventList.Free;<br> DeleteCriticalSection(FCtlSect);<br> {$ENDIF}<br> <br> inherited;<br>end;<br><br>{//}<br>procedure TMsgThread.Execute;<br>var<br> mRet:Boolean;<br> aRet:Boolean;<br> {$IFNDEF USE_WINDOW_MESSAGE}<br> uMsg:TMessage;<br> {$ENDIF}<br>begin<br>{$IFDEF USE_WINDOW_MESSAGE}<br> FMSGWin := CreateWindow('STATIC',PChar(FWinName),WS_POPUP,0,0,0,0,0,0,hInstance,nil);<br> SetWindowLong(FMSGWin, GWL_WNDPROC, Longint(MakeObjectInstance(MSGWinProc)));<br>{$ELSE}<br> PeekMessage(Msg,0,WM_USER,WM_USER,PM_NOREMOVE); //Force system alloc a msgQueue<br>{$ENDIF}<br><br> //notify Conctructor can returen.<br> SetEvent(FWaitHandle);<br> CloseHandle(FWaitHandle);<br><br> mRet := True;<br> try<br> DoInit;<br> while mRet do //Message Loop<br> begin<br> if |
|
转播
