http://delphi.cjcsoft.net//viewthread.php?tid=635

在delphi线程中实现消息循环

在delphi线程中实现消息循环

Delphi的TThread类使用很方便,但是有时候我们需要在线程类中使用消息循环,delphi没有提供.

 
花了两天的事件研究了一下win32的消息系统,写了一个线程内消息循环的测试.
 
但是没有具体应用过,贴出来给有这方面需求的DFW参考一下.希望大家和我讨论.
 
  1. {-----------------------------------------------------------------------------
  2. Unit Name: uMsgThread
  3. Author:    xwing
  4. eMail :    xwing@263.net ; MSN : xwing1979@hotmail.com
  5. Purpose:   Thread with message Loop
  6. History:
  7.  
  8. 2003-6-19, add function to Send Thread Message.            ver 1.0
  9.             use Event List and waitforsingleObject
  10.             your can use WindowMessage or ThreadMessage
  11. 2003-6-18, Change to create a window to Recving message
  12. 2003-6-17, Begin.
  13. -----------------------------------------------------------------------------}
  14. unit uMsgThread;
  15.  
  16. interface
  17. {$WARN SYMBOL_DEPRECATED OFF}
  18. {$DEFINE USE_WINDOW_MESSAGE}
  19. uses
  20.     Classes, windows, messages, forms, sysutils;
  21.  
  22. type
  23.     TMsgThread = class(TThread)
  24.     private
  25.         {$IFDEF USE_WINDOW_MESSAGE}
  26.         FWinName    : string;
  27.         FMSGWin     : HWND;
  28.         {$ELSE}
  29.         FEventList  : TList;
  30.         FCtlSect    : TRTLCriticalSection;
  31.         {$ENDIF}
  32.         FException  : Exception;
  33.         fDoLoop     : Boolean;
  34.         FWaitHandle : THandle;
  35.         {$IFDEF USE_WINDOW_MESSAGE}
  36.         procedure MSGWinProc(var Message: TMessage);
  37.         {$ELSE}
  38.         procedure ClearSendMsgEvent;
  39.         {$ENDIF}
  40.         procedure SetDoLoop(const Value: Boolean);
  41.         procedure WaitTerminate;
  42.  
  43.     protected
  44.         Msg         :tagMSG;
  45.  
  46.         procedure Execute; override;
  47.         procedure HandleException;
  48.         procedure DoHandleException;virtual;
  49.         //Inherited the Method to process your own Message
  50.         procedure DoProcessMsg(var Msg:TMessage);virtual;
  51.         //if DoLoop = true then loop this procedure
  52.         //Your can use the method to do some work needed loop.
  53.         procedure DoMsgLoop;virtual;
  54.         //Initialize Thread before begin message loop
  55.         procedure DoInit;virtual;
  56.         procedure DoUnInit;virtual;
  57.  
  58.         procedure PostMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);
  59.         //When Use SendMsg method Must not use Synchronize Method in ThreadLoop !!!
  60.         //otherwise will caurse DeadLock
  61.         procedure SendMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);
  62.  
  63.     public
  64.         constructor Create(Loop:Boolean=False;ThreadName: string='');
  65.         destructor destroy;override;
  66.         procedure AfterConstruction;override;
  67.  
  68.         //postMessage to Quit,and Free(if FreeOnTerminater = true)
  69.         //can call this in thread loop, don't use terminate property.
  70.         procedure QuitThread;
  71.         //PostMessage to Quit and Wait, only call in MAIN THREAD
  72.         procedure QuitThreadWait;
  73.         //just like Application.processmessage.
  74.         procedure ProcessMessage;
  75.         //enable thread loop, no waitfor message
  76.         property DoLoop: Boolean read fDoLoop Write SetDoLoop;
  77.  
  78.     end;
  79.  
  80. implementation
  81.  
  82. { TMsgThread }
  83. {//////////////////////////////////////////////////////////////////////////////}
  84. constructor TMsgThread.Create(Loop:Boolean;ThreadName:string);
  85. begin
  86.     {$IFDEF USE_WINDOW_MESSAGE}
  87.     if ThreadName <> '' then
  88.         FWinName := ThreadName
  89.     else
  90.         FWinName := 'Thread Window';
  91.     {$ELSE}
  92.     FEventList := TList.Create;
  93.     InitializeCriticalSection(fCtlSect);
  94.     {$ENDIF}
  95.  
  96.     FWaitHandle := CreateEvent(nil, True, False, nil);
  97.  
  98.     FDoLoop := Loop;            //default disable thread loop
  99.     inherited Create(False);    //Create thread
  100.     FreeOnTerminate := True;    //Thread quit and free object
  101.  
  102.     //Call resume Method in Constructor Method
  103.     Resume;
  104.     //Wait until thread Message Loop started
  105.     WaitForSingleObject(FWaitHandle,INFINITE);
  106. end;
  107.  
  108. {------------------------------------------------------------------------------}
  109. procedure TMsgThread.AfterConstruction;
  110. begin
  111. end;
  112.  
  113. {------------------------------------------------------------------------------}
  114. destructor TMsgThread.destroy;
  115. begin
  116.     {$IFDEF USE_WINDOW_MESSAGE}
  117.     {$ELSE}
  118.     FEventList.Free;
  119.     DeleteCriticalSection(FCtlSect);
  120.     {$ENDIF}
  121.  
  122.     inherited;
  123. end;
  124.  
  125. {//////////////////////////////////////////////////////////////////////////////}
  126. procedure TMsgThread.Execute;
  127. var
  128.     mRet:Boolean;
  129.     aRet:Boolean;
  130.     {$IFNDEF USE_WINDOW_MESSAGE}
  131.     uMsg:TMessage;
  132.     {$ENDIF}
  133. begin
  134. {$IFDEF USE_WINDOW_MESSAGE}
  135.     FMSGWin := CreateWindow('STATIC',PChar(FWinName),WS_POPUP,,,,,,,hInstance,nil);
  136.     SetWindowLong(FMSGWin, GWL_WNDPROC, Longint(MakeObjectInstance(MSGWinProc)));
  137. {$ELSE}
  138.     PeekMessage(Msg,,WM_USER,WM_USER,PM_NOREMOVE); //Force system alloc a msgQueue
  139. {$ENDIF}
  140.  
  141.     //notify Conctructor can returen.
  142.     SetEvent(FWaitHandle);
  143.     CloseHandle(FWaitHandle);
  144.  
  145.     mRet := True;
  146.     try
  147.         DoInit;
  148.         while mRet do   //Message Loop
  149.         begin
  150.             if fDoLoop then
  151.             begin
  152.                 aRet := PeekMessage(Msg,,,,PM_REMOVE);
  153.                 if aRet and (Msg.message <> WM_QUIT) then
  154.                 begin
  155.                     {$IFDEF USE_WINDOW_MESSAGE}
  156.                     TranslateMessage(Msg);
  157.                     DispatchMessage(Msg);
  158.                     {$ELSE}
  159.                     uMsg.Msg := Msg.message;
  160.                     uMsg.wParam := Msg.wParam;
  161.                     uMsg.lParam := Msg.lParam;
  162.                     DoProcessMsg(uMsg);
  163.                     {$ENDIF}
  164.  
  165.                     if Msg.message = WM_QUIT then
  166.                         mRet := False;
  167.                 end;
  168.                 {$IFNDEF USE_WINDOW_MESSAGE}
  169.                 ClearSendMsgEvent;      //Clear SendMessage Event
  170.                 {$ENDIF}
  171.                 DoMsgLoop;
  172.             end
  173.             else begin
  174.                 mRet := GetMessage(Msg,,,);
  175.                 if mRet then
  176.                 begin
  177.                     {$IFDEF USE_WINDOW_MESSAGE}
  178.                     TranslateMessage(Msg);
  179.                     DispatchMessage(Msg);
  180.                     {$ELSE}
  181.                     uMsg.Msg := Msg.message;
  182.                     uMsg.wParam := Msg.wParam;
  183.                     uMsg.lParam := Msg.lParam;
  184.                     DoProcessMsg(uMsg);
  185.                     ClearSendMsgEvent;      //Clear SendMessage Event
  186.                     {$ENDIF}
  187.                 end;
  188.             end;
  189.         end;
  190.         DoUnInit;
  191.         {$IFDEF USE_WINDOW_MESSAGE}
  192.         DestroyWindow(FMSGWin);
  193.         FreeObjectInstance(Pointer(GetWindowLong(FMSGWin, GWL_WNDPROC)));
  194.         {$ENDIF}
  195.     except
  196.         HandleException;
  197.     end;
  198. end;
  199.  
  200. {------------------------------------------------------------------------------}
  201. {$IFNDEF USE_WINDOW_MESSAGE}
  202. procedure TMsgThread.ClearSendMsgEvent;
  203. var
  204.     aEvent:PHandle;
  205. begin
  206.     EnterCriticalSection(FCtlSect);
  207.     try
  208.         if FEventList.Count <>  then
  209.         begin
  210.             aEvent := FEventList.Items[];
  211.             if aEvent <> nil then
  212.             begin
  213.                 SetEvent(aEvent^);
  214.                 CloseHandle(aEvent^);
  215.                 Dispose(aEvent);
  216.             end;
  217.             FEventList.Delete();
  218.         end;
  219.     finally
  220.         LeaveCriticalSection(FCtlSect);
  221.     end;
  222. end;
  223. {$ENDIF}
  224.  
  225. {------------------------------------------------------------------------------}
  226. procedure TMsgThread.HandleException;
  227. begin
  228.     FException := Exception(ExceptObject);  //Get Current Exception object
  229.     try
  230.         if not (FException is EAbort) then
  231.             inherited Synchronize(DoHandleException);
  232.     finally
  233.         FException := nil;
  234.     end;
  235. end;
  236.  
  237. {------------------------------------------------------------------------------}
  238. procedure TMsgThread.DoHandleException;
  239. begin
  240.     if FException is Exception then
  241.         Application.ShowException(FException)
  242.     else
  243.         SysUtils.ShowException(FException, nil);
  244. end;
  245.  
  246. {//////////////////////////////////////////////////////////////////////////////}
  247. {$IFDEF USE_WINDOW_MESSAGE}
  248. procedure TMsgThread.MSGWinProc(var Message: TMessage);
  249. begin
  250.     DoProcessMsg(Message);
  251.     with Message do
  252.         Result:=DefWindowProc(FMSGWin,Msg,wParam,lParam);
  253. end;
  254. {$ENDIF}
  255.  
  256. {------------------------------------------------------------------------------}
  257. procedure TMsgThread.DoProcessMsg(var Msg:TMessage);
  258. begin
  259. end;
  260.  
  261. {------------------------------------------------------------------------------}
  262. procedure TMsgThread.ProcessMessage;
  263. {$IFNDEF USE_WINDOW_MESSAGE}
  264. var
  265.     uMsg:TMessage;
  266. {$ENDIF}
  267. begin
  268.     while PeekMessage(Msg,,,,PM_REMOVE) do
  269.     if Msg.message <> WM_QUIT then
  270.     begin
  271.         {$IFDEF USE_WINDOW_MESSAGE}
  272.         TranslateMessage(Msg);
  273.         DispatchMessage(msg);
  274.         {$ELSE}
  275.         uMsg.Msg := Msg.message;
  276.         uMsg.wParam := Msg.wParam;
  277.         uMsg.lParam := Msg.lParam;
  278.         DoProcessMsg(uMsg);
  279.         {$ENDIF}
  280.     end;
  281. end;
  282.  
  283. {//////////////////////////////////////////////////////////////////////////////}
  284. procedure TMsgThread.DoInit;
  285. begin
  286. end;
  287.  
  288. procedure TMsgThread.DoUnInit;
  289. begin
  290. end;
  291.  
  292. procedure TMsgThread.DoMsgLoop;
  293. begin
  294.     Sleep();
  295. end;
  296.  
  297. {//////////////////////////////////////////////////////////////////////////////}
  298. procedure TMsgThread.QuitThread;
  299. begin
  300.     {$IFDEF USE_WINDOW_MESSAGE}
  301.     PostMessage(FMSGWin,WM_QUIT,,);
  302.     {$ELSE}
  303.     PostThreadMessage(ThreadID,WM_QUIT,,);
  304.     {$ENDIF}
  305. end;
  306.  
  307. {------------------------------------------------------------------------------}
  308. procedure TMsgThread.QuitThreadWait;
  309. begin
  310.     QuitThread;
  311.     WaitTerminate;
  312. end;
  313.  
  314. {------------------------------------------------------------------------------}
  315. procedure TMsgThread.SetDoLoop(const Value: Boolean);
  316. begin
  317.     if Value = fDoLoop then Exit;
  318.     fDoLoop := Value;
  319.     if fDoLoop then
  320.         PostMsg(WM_USER,,);
  321. end;
  322.  
  323. {------------------------------------------------------------------------------}
  324. //Can only call this method in MAIN Thread!!
  325. procedure TMsgThread.WaitTerminate;
  326. var
  327.     xStart:Cardinal;
  328. begin
  329.     xStart:=GetTickCount;
  330.     try
  331.         //EnableWindow(Application.Handle,False);
  332.         while WaitForSingleObject(Handle, ) = WAIT_TIMEOUT do
  333.         begin
  334.             Application.ProcessMessages;
  335.             if GetTickCount > (xStart + ) then
  336.             begin
  337.                 TerminateThread(Handle, );
  338.                 Beep;
  339.                 Break;
  340.             end;
  341.         end;
  342.     finally
  343.         //EnableWindow(Application.Handle,True);
  344.     end;
  345. end;
  346.  
  347. {------------------------------------------------------------------------------}
  348. procedure TMsgThread.PostMsg(Msg: Cardinal; wParam, lParam: Integer);
  349. begin
  350.     {$IFDEF USE_WINDOW_MESSAGE}
  351.     postMessage(FMSGWin,Msg,wParam,lParam);
  352.     {$ELSE}
  353.     EnterCriticalSection(FCtlSect);
  354.     try
  355.         FEventList.Add(nil);
  356.         PostThreadMessage(ThreadID,Msg,wParam,lParam);
  357.     finally
  358.         LeaveCriticalSection(FCtlSect);
  359.     end;
  360.     {$ENDIF}
  361. end;
  362.  
  363. {------------------------------------------------------------------------------}
  364. procedure TMsgThread.SendMsg(Msg: Cardinal; wParam, lParam: Integer);
  365. {$IFNDEF USE_WINDOW_MESSAGE}
  366. var
  367.     aEvent:PHandle;
  368. {$ENDIF}
  369. begin
  370.     {$IFDEF USE_WINDOW_MESSAGE}
  371.     SendMessage(FMSGWin,Msg,wParam,lParam);
  372.     {$ELSE}
  373.     EnterCriticalSection(FCtlSect);
  374.     try
  375.         New(aEvent);
  376.         aEvent^ := CreateEvent(nil, True, False, nil);
  377.         FEventList.Add(aEvent);
  378.         PostThreadMessage(ThreadID,Msg,wParam,lParam);
  379.     finally
  380.         LeaveCriticalSection(FCtlSect);
  381.     end;
  382.     WaitForSingleObject(aEvent^,INFINITE);
  383.     {$ENDIF}
  384. end;
  385.  
  386. end.

我参考了一下msdn,还有windows核心编程. 写了一个类来封装这个功能,不知道对不对.

里面使用了两个方法,一个使用一个隐含窗体来处理消息

还有一个是直接使用thread的消息队列来处理,但是这个时候sendmessage无法工作,

所以我自己设想了一个方法,虽然不完全达到了要求但是我简单测试了一下,好像还能工作.

切换两种工作方式要修改编译条件

{$DEFINE USE_WINDOW_MESSAGE} 使用隐含窗体来处理消息

{-$DEFINE USE_WINDOW_MESSAGE} 使用线程消息队列来处理消息

还有我想要等待线程开始进行消息循环的时候create函数才返回.

但是现在好像还没有这样(用一个事件来处理).只是开始进入了threadexecute函数,线程的create就返回了.可能会出问题.

通过设置 DoLoop属性可以设定线程是否循环(不阻塞等待消息),这样派生类线程在循环做一些其他事情的同时还可以接受消息. 例如:

派生类里面循环发送缓冲区的数据,还可以响应其他线程发送过来的消息(如停止,启动,退出,等等)

重新修改了一下，现在用起来基本没有问题了。

  1. { -----------------------------------------------------------------------------
  2.   Unit Name: uMsgThread
  3.   Author:    xwing
  4.   eMail :    xwing@263.net ; MSN : xwing1979@hotmail.com
  5.   Purpose:   Thread with message Loop
  6.   History:
  7.  
  8.   2003-7-15  Write thread class without use delphi own TThread.
  9.   2003-6-19, add function to Send Thread Message.            ver 1.0
  10.   use Event List and waitforsingleObject
  11.   your can use WindowMessage or ThreadMessage
  12.   2003-6-18, Change to create a window to Recving message
  13.   2003-6-17, Begin.
  14.   ----------------------------------------------------------------------------- }
  15. unit uMsgThread;
  16.  
  17. interface
  18.  
  19. {$WARN SYMBOL_DEPRECATED OFF}
  20. {$DEFINE USE_WINDOW_MESSAGE}
  21.  
  22. uses
  23.   Classes, windows, messages, forms, sysutils;
  24.  
  25. const
  26.   NM_EXECPROC = $8FFF;
  27.  
  28. type
  29.   EMsgThreadErr = class( Exception );
  30.  
  31.   TMsgThreadMethod = procedure of object;
  32.  
  33.   TMsgThread = class
  34.   private
  35.     SyncWindow : HWND;
  36.     FMethod : TMsgThreadMethod;
  37.     procedure SyncWindowProc( var Message : TMessage );
  38.  
  39.   private
  40.     m_hThread : THandle;
  41.     threadid : DWORD;
  42.  
  43. {$IFDEF USE_WINDOW_MESSAGE}
  44.     FWinName : string;
  45.     FMSGWin : HWND;
  46. {$ELSE}
  47.     FEventList : TList;
  48.     FCtlSect : TRTLCriticalSection;
  49. {$ENDIF}
  50.     FException : Exception;
  51.     fDoLoop : Boolean;
  52.     FWaitHandle : THandle;
  53.  
  54. {$IFDEF USE_WINDOW_MESSAGE}
  55.     procedure MSGWinProc( var Message : TMessage );
  56. {$ELSE}
  57.     procedure ClearSendMsgEvent;
  58. {$ENDIF}
  59.     procedure SetDoLoop( const Value : Boolean );
  60.     procedure Execute;
  61.  
  62.   protected
  63.     Msg : tagMSG;
  64.  
  65. {$IFNDEF USE_WINDOW_MESSAGE}
  66.     uMsg : TMessage;
  67.     fSendMsgComp : THandle;
  68. {$ENDIF}
  69.     procedure HandleException;
  70.     procedure DoHandleException; virtual;
  71.  
  72.     // Inherited the Method to process your own Message
  73.     procedure DoProcessMsg( var Msg : TMessage ); virtual;
  74.  
  75.     // if DoLoop = true then loop this procedure
  76.     // Your can use the method to do some work needed loop.
  77.     procedure DoMsgLoop; virtual;
  78.  
  79.     // Initialize Thread before begin message loop
  80.     procedure DoInit; virtual;
  81.     procedure DoUnInit; virtual;
  82.  
  83.     procedure PostMsg( Msg : Cardinal; wParam : Integer; lParam : Integer );
  84.     // When Use SendMsg method Must not use Synchronize Method in ThreadLoop !!!
  85.     // otherwise will caurse DeadLock
  86.     function SendMsg( Msg : Cardinal; wParam : Integer; lParam : Integer )
  87.       : Integer;
  88.  
  89.   public
  90.     constructor Create( Loop : Boolean = False; ThreadName : string = '' );
  91.     destructor destroy; override;
  92.  
  93.     // Return TRUE if the thread exists. FALSE otherwise
  94.     function ThreadExists : BOOL;
  95.  
  96.     procedure Synchronize( syncMethod : TMsgThreadMethod );
  97.  
  98.     function WaitFor : Longword;
  99.     function WaitTimeOut( timeout : DWORD =  ) : Longword;
  100.  
  101.     // postMessage to Quit,and Free(if FreeOnTerminater = true)
  102.     // can call this in thread loop, don't use terminate property.
  103.     procedure QuitThread;
  104.  
  105.     // just like Application.processmessage.
  106.     procedure ProcessMessage;
  107.  
  108.     // enable thread loop, no waitfor message
  109.     property DoLoop : Boolean read fDoLoop write SetDoLoop;
  110.  
  111.   end;
  112.  
  113. implementation
  114.  
  115. function msgThdInitialThreadProc( pv : Pointer ) : DWORD; stdcall;
  116. var
  117.   obj : TMsgThread;
  118. begin
  119.   obj := TMsgThread( pv );
  120.   obj.Execute;
  121.   Result := ;
  122. end;
  123.  
  124. { TMsgThread }
  125. { ////////////////////////////////////////////////////////////////////////////// }
  126. constructor TMsgThread.Create( Loop : Boolean; ThreadName : string );
  127. begin
  128. {$IFDEF USE_WINDOW_MESSAGE}
  129.   if ThreadName <> '' then
  130.     FWinName := ThreadName
  131.   else
  132.     FWinName := 'Thread Window';
  133. {$ELSE}
  134.   FEventList := TList.Create;
  135.   InitializeCriticalSection( FCtlSect );
  136.   fSendMsgComp := CreateEvent( nil, True, False, nil );
  137. {$ENDIF}
  138.   fDoLoop := Loop; // default disable thread loop
  139.  
  140.   // Create a Window for sync method
  141.   SyncWindow := CreateWindow( 'STATIC', 'SyncWindow', WS_POPUP, , , , , ,  , hInstance, nil );
  142.   SetWindowLong( SyncWindow, GWL_WNDPROC,  Longint( MakeObjectInstance( SyncWindowProc ) ) );
  143.  
  144.   FWaitHandle := CreateEvent( nil, True, False, nil );
  145.   // Create Thread
  146.   m_hThread := CreateThread( nil, , @msgThdInitialThreadProc, Self, , threadid );
  147.   if m_hThread =  then
  148.     raise EMsgThreadErr.Create( '不能创建线程。' );
  149.   // Wait until thread Message Loop started
  150.   WaitForSingleObject( FWaitHandle, INFINITE );
  151. end;
  152.  
  153. { ------------------------------------------------------------------------------ }
  154. destructor TMsgThread.destroy;
  155. begin
  156.   if m_hThread <>  then
  157.     QuitThread;
  158.   WaitFor;
  159.  
  160.   // Free Sync Window
  161.   DestroyWindow( SyncWindow );
  162.   FreeObjectInstance( Pointer( GetWindowLong( SyncWindow, GWL_WNDPROC ) ) );
  163.  
  164. {$IFDEF USE_WINDOW_MESSAGE}
  165. {$ELSE}
  166.   FEventList.Free;
  167.   DeleteCriticalSection( FCtlSect );
  168.   CloseHandle( fSendMsgComp );
  169. {$ENDIF}
  170.  
  171.   inherited;
  172. end;
  173.  
  174. { ////////////////////////////////////////////////////////////////////////////// }
  175. procedure TMsgThread.Execute;
  176. var
  177.   mRet : Boolean;
  178.   aRet : Boolean;
  179. begin
  180. {$IFDEF USE_WINDOW_MESSAGE}
  181.   FMSGWin := CreateWindow( 'STATIC', PChar( FWinName ), WS_POPUP, , , , , ,  , hInstance, nil );
  182.   SetWindowLong( FMSGWin, GWL_WNDPROC,  Longint( MakeObjectInstance( MSGWinProc ) ) );
  183. {$ELSE}
  184.   PeekMessage( Msg, , WM_USER, WM_USER, PM_NOREMOVE );  // Force system alloc a msgQueue
  185. {$ENDIF}
  186.  
  187.   mRet := True;
  188.   try
  189.     DoInit;
  190.  
  191.     // notify Conctructor can returen.
  192.     SetEvent( FWaitHandle );
  193.     CloseHandle( FWaitHandle );
  194.  
  195.     while mRet do // Message Loop
  196.     begin
  197.       if fDoLoop then
  198.       begin
  199.         aRet := PeekMessage( Msg, , , , PM_REMOVE );
  200.         if aRet and ( Msg.Message <> WM_QUIT ) then
  201.         begin
  202. {$IFDEF USE_WINDOW_MESSAGE}
  203.           TranslateMessage( Msg );
  204.           DispatchMessage( Msg );
  205. {$ELSE}
  206.           uMsg.Msg := Msg.Message;
  207.           uMsg.wParam := Msg.wParam;
  208.           uMsg.lParam := Msg.lParam;
  209.           DoProcessMsg( uMsg );
  210. {$ENDIF}
  211.           if Msg.Message = WM_QUIT then
  212.             mRet := False;
  213.         end;
  214. {$IFNDEF USE_WINDOW_MESSAGE}
  215.         ClearSendMsgEvent; // Clear SendMessage Event
  216. {$ENDIF}
  217.         DoMsgLoop;
  218.       end else begin
  219.         mRet := GetMessage( Msg, , ,  );
  220.         if mRet then
  221.         begin
  222. {$IFDEF USE_WINDOW_MESSAGE}
  223.           TranslateMessage( Msg );
  224.           DispatchMessage( Msg );
  225. {$ELSE}
  226.           uMsg.Msg := Msg.Message;
  227.           uMsg.wParam := Msg.wParam;
  228.           uMsg.lParam := Msg.lParam;
  229.           DoProcessMsg( uMsg );
  230.           ClearSendMsgEvent; // Clear SendMessage Event
  231. {$ENDIF}
  232.         end;
  233.       end;
  234.     end;
  235.     DoUnInit;
  236. {$IFDEF USE_WINDOW_MESSAGE}
  237.     DestroyWindow( FMSGWin );
  238.     FreeObjectInstance( Pointer( GetWindowLong( FMSGWin, GWL_WNDPROC ) ) );
  239. {$ENDIF}
  240.   except
  241.     HandleException;
  242.   end;
  243. end;
  244.  
  245. { ------------------------------------------------------------------------------ }
  246. {$IFNDEF USE_WINDOW_MESSAGE}
  247.  
  248. procedure TMsgThread.ClearSendMsgEvent;
  249. var
  250.   aEvent : PHandle;
  251. begin
  252.   EnterCriticalSection( FCtlSect );
  253.   try
  254.     if FEventList.Count <>  then
  255.     begin
  256.       aEvent := FEventList.Items[  ];
  257.       if aEvent <> nil then
  258.       begin
  259.         SetEvent( aEvent^ );
  260.         CloseHandle( aEvent^ );
  261.         Dispose( aEvent );
  262.         WaitForSingleObject( fSendMsgComp, INFINITE );
  263.       end;
  264.       FEventList.Delete(  );
  265.     end;
  266.   finally
  267.     LeaveCriticalSection( FCtlSect );
  268.   end;
  269. end;
  270. {$ENDIF}
  271.  
  272. { ------------------------------------------------------------------------------ }
  273. procedure TMsgThread.HandleException;
  274. begin
  275.   FException := Exception( ExceptObject ); // Get Current Exception object
  276.   try
  277.     if not( FException is EAbort ) then
  278.       Synchronize( DoHandleException );
  279.   finally
  280.     FException := nil;
  281.   end;
  282. end;
  283.  
  284. { ------------------------------------------------------------------------------ }
  285. procedure TMsgThread.DoHandleException;
  286. begin
  287.   if FException is Exception then
  288.     Application.ShowException( FException )
  289.   else
  290.     sysutils.ShowException( FException, nil );
  291. end;
  292.  
  293. { ////////////////////////////////////////////////////////////////////////////// }
  294. {$IFDEF USE_WINDOW_MESSAGE}
  295.  
  296. procedure TMsgThread.MSGWinProc( var Message : TMessage );
  297. begin
  298.   DoProcessMsg( message );
  299.   if message.Msg < WM_USER then
  300.     with message do
  301.       Result := DefWindowProc( FMSGWin, Msg, wParam, lParam );
  302. end;
  303. {$ENDIF}
  304.  
  305. { ------------------------------------------------------------------------------ }
  306. procedure TMsgThread.DoProcessMsg( var Msg : TMessage );
  307. begin
  308.  
  309. end;
  310.  
  311. { ------------------------------------------------------------------------------ }
  312. procedure TMsgThread.ProcessMessage;
  313. {$IFNDEF USE_WINDOW_MESSAGE}
  314. var
  315.   uMsg : TMessage;
  316. {$ENDIF}
  317. begin
  318.   while PeekMessage( Msg, , , , PM_REMOVE ) do
  319.     if Msg.Message <> WM_QUIT then
  320.     begin
  321. {$IFDEF USE_WINDOW_MESSAGE}
  322.       TranslateMessage( Msg );
  323.       DispatchMessage( Msg );
  324. {$ELSE}
  325.       uMsg.Msg := Msg.Message;
  326.       uMsg.wParam := Msg.wParam;
  327.       uMsg.lParam := Msg.lParam;
  328.       DoProcessMsg( uMsg );
  329. {$ENDIF}
  330.     end;
  331. end;
  332.  
  333. { ////////////////////////////////////////////////////////////////////////////// }
  334. procedure TMsgThread.DoInit;
  335. begin
  336. end;
  337.  
  338. procedure TMsgThread.DoUnInit;
  339. begin
  340. end;
  341.  
  342. procedure TMsgThread.DoMsgLoop;
  343. begin
  344.   Sleep(  );
  345. end;
  346.  
  347. { ////////////////////////////////////////////////////////////////////////////// }
  348. function TMsgThread.ThreadExists : BOOL;
  349. begin
  350.   if m_hThread =  then
  351.     Result := False
  352.   else
  353.     Result := True;
  354. end;
  355.  
  356. { ------------------------------------------------------------------------------ }
  357. procedure TMsgThread.QuitThread;
  358. begin
  359. {$IFDEF USE_WINDOW_MESSAGE}
  360.   PostMessage( FMSGWin, WM_QUIT, ,  );
  361. {$ELSE}
  362.   PostThreadMessage( threadid, WM_QUIT, ,  );
  363. {$ENDIF}
  364. end;
  365.  
  366. { ------------------------------------------------------------------------------ }
  367. procedure TMsgThread.SetDoLoop( const Value : Boolean );
  368. begin
  369.   if Value = fDoLoop then
  370.     Exit;
  371.   fDoLoop := Value;
  372.   if fDoLoop then
  373.     PostMsg( WM_USER, ,  );
  374. end;
  375.  
  376. { ------------------------------------------------------------------------------ }
  377. function TMsgThread.WaitTimeOut( timeout : DWORD ) : Longword;
  378. var
  379.   xStart : Cardinal;
  380.   H : THandle;
  381. begin
  382.   H := m_hThread;
  383.   xStart := GetTickCount;
  384.   while WaitForSingleObject( H,  ) = WAIT_TIMEOUT do
  385.   begin
  386.     Application.ProcessMessages;
  387.     if GetTickCount > ( xStart + timeout ) then
  388.     begin
  389.       TerminateThread( H,  );
  390.       Break;
  391.     end;
  392.   end;
  393.   GetExitCodeThread( H, Result );
  394. end;
  395.  
  396. { ------------------------------------------------------------------------------ }
  397. function TMsgThread.WaitFor : Longword;
  398. var
  399.   Msg : TMsg;
  400.   H : THandle;
  401. begin
  402.   H := m_hThread;
  403.   if GetCurrentThreadID = MainThreadID then
  404.     while MsgWaitForMultipleObjects( , H, False, INFINITE, QS_SENDMESSAGE )
  405.       = WAIT_OBJECT_ +  do
  406.       PeekMessage( Msg, , , , PM_NOREMOVE )
  407.   else
  408.     WaitForSingleObject( H, INFINITE );
  409.   GetExitCodeThread( H, Result );
  410. end;
  411.  
  412. { ------------------------------------------------------------------------------ }
  413. procedure TMsgThread.PostMsg( Msg : Cardinal; wParam, lParam : Integer );
  414. begin
  415. {$IFDEF USE_WINDOW_MESSAGE}
  416.   PostMessage( FMSGWin, Msg, wParam, lParam );
  417. {$ELSE}
  418.   EnterCriticalSection( FCtlSect );
  419.   try
  420.     FEventList.Add( nil );
  421.     PostThreadMessage( threadid, Msg, wParam, lParam );
  422.   finally
  423.     LeaveCriticalSection( FCtlSect );
  424.   end;
  425. {$ENDIF}
  426. end;
  427.  
  428. { ------------------------------------------------------------------------------ }
  429. function TMsgThread.SendMsg( Msg : Cardinal; wParam, lParam : Integer )
  430.   : Integer;
  431. {$IFNDEF USE_WINDOW_MESSAGE}
  432. var
  433.   aEvent : PHandle;
  434. {$ENDIF}
  435. begin
  436. {$IFDEF USE_WINDOW_MESSAGE}
  437.   Result := SendMessage( FMSGWin, Msg, wParam, lParam );
  438. {$ELSE}
  439.   EnterCriticalSection( FCtlSect );
  440.   try
  441.     New( aEvent );
  442.     aEvent^ := CreateEvent( nil, True, False, nil );
  443.     FEventList.Add( aEvent );
  444.     PostThreadMessage( threadid, Msg, wParam, lParam );
  445.   finally
  446.     LeaveCriticalSection( FCtlSect );
  447.   end;
  448.   WaitForSingleObject( aEvent^, INFINITE );
  449.   Result := uMsg.Result;
  450.   SetEvent( fSendMsgComp );
  451. {$ENDIF}
  452. end;
  453.  
  454. { ------------------------------------------------------------------------------ }
  455. procedure TMsgThread.Synchronize( syncMethod : TMsgThreadMethod );
  456. begin
  457.   FMethod := syncMethod;
  458.   SendMessage( SyncWindow, NM_EXECPROC, , Longint( Self ) );
  459. end;
  460.  
  461. { ------------------------------------------------------------------------------ }
  462. procedure TMsgThread.SyncWindowProc( var Message : TMessage );
  463. begin
  464.   case message.Msg of
  465.     NM_EXECPROC :
  466.       with TMsgThread( message.lParam ) do
  467.       begin
  468.         message.Result := ;
  469.         try
  470.           FMethod;
  471.         except
  472.           raise EMsgThreadErr.Create( '执行同步线程方法错误。' );
  473.         end;
  474.       end;
  475.   else
  476.     message.Result := DefWindowProc( SyncWindow, message.Msg, message.wParam,
  477.       message.lParam );
  478.   end;
  479. end;
  480.  
  481. end.

http://www.techques.com/question/1-4073197/How-do-I-send-and-handle-message-between-TService-parent-thread-and-child-thread?

I took a look at OmniThreadLibrary and it looked like overkill for my purposes.

I wrote a simple library I call TCommThread.

It allows you to pass data back to the main thread without worrying about

any of the complexities of threads or Windows messages.

Here's the code if you'd like to try it.

CommThread Library:

  1.  unit Threading.CommThread;
  2.  
  3.  interface
  4.  
  5.  uses
  6.    Classes, SysUtils, ExtCtrls, SyncObjs, Generics.Collections, DateUtils;
  7.  
  8.  const
  9.    CTID_USER = ;
  10.    PRM_USER = ;
  11.  
  12.    CTID_STATUS = ;
  13.    CTID_PROGRESS = ;
  14.  
  15.  type
  16.    TThreadParams = class(TDictionary<String, Variant>);
  17.    TThreadObjects = class(TDictionary<String, TObject>);
  18.  
  19.    TCommThreadParams = class(TObject)
  20.    private
  21.      FThreadParams: TThreadParams;
  22.      FThreadObjects: TThreadObjects;
  23.    public
  24.      constructor Create;
  25.      destructor Destroy; override;
  26.  
  27.      procedure Clear;
  28.  
  29.      function GetParam(const ParamName: String): Variant;
  30.      function SetParam(const ParamName: String; ParamValue: Variant): TCommThreadParams;
  31.      function GetObject(const ObjectName: String): TObject;
  32.      function SetObject(const ObjectName: String; Obj: TObject): TCommThreadParams;
  33.    end;
  34.  
  35.    TCommQueueItem = class(TObject)
  36.    private
  37.      FSender: TObject;
  38.      FMessageId: Integer;
  39.      FCommThreadParams: TCommThreadParams;
  40.    public
  41.      destructor Destroy; override;
  42.  
  43.      property Sender: TObject read FSender write FSender;
  44.      property MessageId: Integer read FMessageId write FMessageId;
  45.      property CommThreadParams: TCommThreadParams read FCommThreadParams write FCommThreadParams;
  46.    end;
  47.  
  48.    TCommQueue = class(TQueue<TCommQueueItem>);
  49.  
  50.    ICommDispatchReceiver = interface
  51.      ['{A4E2C9D1-E4E8-497D-A9BF-FAFE2D3A7C49}']
  52.      procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
  53.      procedure CommThreadTerminated(Sender: TObject);
  54.      function Cancelled: Boolean;
  55.    end;
  56.  
  57.    TCommThread = class(TThread)
  58.    protected
  59.      FCommThreadParams: TCommThreadParams;
  60.      FCommDispatchReceiver: ICommDispatchReceiver;
  61.      FName: String;
  62.      FProgressFrequency: Integer;
  63.      FNextSendTime: TDateTime;
  64.  
  65.      procedure SendStatusMessage(const StatusText: String; StatusType: Integer = ); virtual;
  66.      procedure SendProgressMessage(ProgressID: Int64; Progress, ProgressMax: Integer; AlwaysSend: Boolean = TRUE); virtual;
  67.    public
  68.      constructor Create(CommDispatchReceiver: TObject); reintroduce; virtual;
  69.      destructor Destroy; override;
  70.  
  71.      function SetParam(const ParamName: String; ParamValue: Variant): TCommThread;
  72.      function GetParam(const ParamName: String): Variant;
  73.      function SetObject(const ObjectName: String; Obj: TObject): TCommThread;
  74.      function GetObject(const ObjectName: String): TObject;
  75.      procedure SendCommMessage(MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;
  76.  
  77.      property Name: String read FName;
  78.    end;
  79.  
  80.    TCommThreadClass = Class of TCommThread;
  81.  
  82.    TCommThreadQueue = class(TObjectList<TCommThread>);
  83.  
  84.    TCommThreadDispatchState = (
  85.      ctsIdle,
  86.      ctsActive,
  87.      ctsTerminating
  88.    );
  89.  
  90.    TOnReceiveThreadMessage = procedure(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams) of object;
  91.    TOnStateChange = procedure(Sender: TObject; State: TCommThreadDispatchState) of object;
  92.    TOnStatus = procedure(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer) of object;
  93.    TOnProgress = procedure(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer) of object;
  94.  
  95.    TBaseCommThreadDispatch = class(TComponent, ICommDispatchReceiver)
  96.    private
  97.      FProcessQueueTimer: TTimer;
  98.      FCSReceiveMessage: TCriticalSection;
  99.      FCSCommThreads: TCriticalSection;
  100.      FCommQueue: TCommQueue;
  101.      FActiveThreads: TList;
  102.      FCommThreadClass: TCommThreadClass;
  103.      FCommThreadDispatchState: TCommThreadDispatchState;
  104.  
  105.      function CreateThread(const ThreadName: String = ''): TCommThread;
  106.      function GetActiveThreadCount: Integer;
  107.      function GetStateText: String;
  108.    protected
  109.      FOnReceiveThreadMessage: TOnReceiveThreadMessage;
  110.      FOnStateChange: TOnStateChange;
  111.      FOnStatus: TOnStatus;
  112.      FOnProgress: TOnProgress;
  113.      FManualMessageQueue: Boolean;
  114.      FProgressFrequency: Integer;
  115.  
  116.      procedure SetManualMessageQueue(const Value: Boolean);
  117.      procedure SetProcessQueueTimerInterval(const Value: Integer);
  118.      procedure SetCommThreadDispatchState(const Value: TCommThreadDispatchState);
  119.      procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
  120.      procedure OnProcessQueueTimer(Sender: TObject);
  121.      function GetProcessQueueTimerInterval: Integer;
  122.  
  123.      procedure CommThreadTerminated(Sender: TObject); virtual;
  124.      function Finished: Boolean; virtual;
  125.  
  126.      procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); virtual;
  127.      procedure DoOnStateChange; virtual;
  128.  
  129.      procedure TerminateActiveThreads;
  130.  
  131.      property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
  132.      property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
  133.      property OnStatus: TOnStatus read FOnStatus write FOnStatus;
  134.      property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  135.  
  136.      property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
  137.      property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
  138.      property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  139.      property CommThreadDispatchState: TCommThreadDispatchState read FCommThreadDispatchState write SetCommThreadDispatchState;
  140.    public
  141.      constructor Create(AOwner: TComponent); override;
  142.      destructor Destroy; override;
  143.  
  144.      function NewThread(const ThreadName: String = ''): TCommThread; virtual;
  145.      procedure ProcessMessageQueue; virtual;
  146.      procedure Stop; virtual;
  147.      function State: TCommThreadDispatchState;
  148.      function Cancelled: Boolean;
  149.  
  150.      property ActiveThreadCount: Integer read GetActiveThreadCount;
  151.      property StateText: String read GetStateText;
  152.  
  153.      property CommThreadClass: TCommThreadClass read FCommThreadClass write FCommThreadClass;
  154.    end;
  155.  
  156.    TCommThreadDispatch = class(TBaseCommThreadDispatch)
  157.    published
  158.      property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
  159.      property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
  160.  
  161.      property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
  162.      property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
  163.      property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  164.    end;
  165.  
  166.    TBaseStatusCommThreadDispatch = class(TBaseCommThreadDispatch)
  167.    protected
  168.      FOnStatus: TOnStatus;
  169.      FOnProgress: TOnProgress;
  170.  
  171.      procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;
  172.  
  173.      procedure DoOnStatus(Sender: TObject;const ID: String; const StatusText: String; StatusType: Integer); virtual;
  174.      procedure DoOnProgress(Sender: TObject; const ID: String; Progress, ProgressMax: Integer); virtual;
  175.  
  176.      property OnStatus: TOnStatus read FOnStatus write FOnStatus;
  177.      property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  178.    end;
  179.  
  180.    TStatusCommThreadDispatch = class(TBaseStatusCommThreadDispatch)
  181.    published
  182.      property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage;
  183.      property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
  184.      property OnStatus: TOnStatus read FOnStatus write FOnStatus;
  185.      property OnProgress: TOnProgress read FOnProgress write FOnProgress;
  186.  
  187.      property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency;
  188.      property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval;
  189.      property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue;
  190.    end;
  191.  
  192.  implementation
  193.  
  194.  const
  195.    PRM_STATUS_TEXT = 'Status';
  196.    PRM_STATUS_TYPE = 'Type';
  197.    PRM_PROGRESS_ID = 'ProgressID';
  198.    PRM_PROGRESS = 'Progess';
  199.    PRM_PROGRESS_MAX = 'ProgressMax';
  200.  
  201.  resourcestring
  202.    StrCommReceiverMustSupportInterface = 'CommDispatchReceiver must support ICommDispatchReceiver interface';
  203.    StrSenderMustBeATCommThread = 'Sender must be a TCommThread';
  204.    StrUnableToFindTerminatedThread = 'Unable to find the terminated thread';
  205.    StrIdle = 'Idle';
  206.    StrTerminating = 'Terminating';
  207.    StrActive = 'Active';
  208.  
  209.  { TCommThread }
  210.  
  211.  constructor TCommThread.Create(CommDispatchReceiver: TObject);
  212.  begin
  213.    Assert(Supports(CommDispatchReceiver, ICommDispatchReceiver, FCommDispatchReceiver), StrCommReceiverMustSupportInterface);
  214.  
  215.    inherited Create(TRUE);
  216.  
  217.    FCommThreadParams := TCommThreadParams.Create;
  218.  end;
  219.  
  220.  destructor TCommThread.Destroy;
  221.  begin
  222.    FCommDispatchReceiver.CommThreadTerminated(Self);
  223.  
  224.    FreeAndNil(FCommThreadParams);
  225.  
  226.    inherited;
  227.  end;
  228.  
  229.  function TCommThread.GetObject(const ObjectName: String): TObject;
  230.  begin
  231.    Result := FCommThreadParams.GetObject(ObjectName);
  232.  end;
  233.  
  234.  function TCommThread.GetParam(const ParamName: String): Variant;
  235.  begin
  236.    Result := FCommThreadParams.GetParam(ParamName);
  237.  end;
  238.  
  239.  procedure TCommThread.SendCommMessage(MessageId: Integer;
  240.    CommThreadParams: TCommThreadParams);
  241.  begin
  242.    FCommDispatchReceiver.QueueMessage(Self, MessageId, CommThreadParams);
  243.  end;
  244.  
  245.  procedure TCommThread.SendProgressMessage(ProgressID: Int64; Progress,
  246.    ProgressMax: Integer; AlwaysSend: Boolean);
  247.  begin
  248.    if (AlwaysSend) or (now > FNextSendTime) then
  249.    begin
  250.      // Send a status message to the comm receiver
  251.      SendCommMessage(CTID_PROGRESS, TCommThreadParams.Create
  252.        .SetParam(PRM_PROGRESS_ID, ProgressID)
  253.        .SetParam(PRM_PROGRESS, Progress)
  254.        .SetParam(PRM_PROGRESS_MAX, ProgressMax));
  255.  
  256.      if not AlwaysSend then
  257.        FNextSendTime := now + (FProgressFrequency * OneMillisecond);
  258.    end;
  259.  end;
  260.  
  261.  procedure TCommThread.SendStatusMessage(const StatusText: String;
  262.    StatusType: Integer);
  263.  begin
  264.    // Send a status message to the comm receiver
  265.    SendCommMessage(CTID_STATUS, TCommThreadParams.Create
  266.      .SetParam(PRM_STATUS_TEXT, StatusText)
  267.      .SetParam(PRM_STATUS_TYPE, StatusType));
  268.  end;
  269.  
  270.  function TCommThread.SetObject(const ObjectName: String;
  271.    Obj: TObject): TCommThread;
  272.  begin
  273.    Result := Self;
  274.  
  275.    FCommThreadParams.SetObject(ObjectName, Obj);
  276.  end;
  277.  
  278.  function TCommThread.SetParam(const ParamName: String;
  279.    ParamValue: Variant): TCommThread;
  280.  begin
  281.    Result := Self;
  282.  
  283.    FCommThreadParams.SetParam(ParamName, ParamValue);
  284.  end;
  285.  
  286.  { TCommThreadDispatch }
  287.  
  288.  function TBaseCommThreadDispatch.Cancelled: Boolean;
  289.  begin
  290.    Result := State = ctsTerminating;
  291.  end;
  292.  
  293.  procedure TBaseCommThreadDispatch.CommThreadTerminated(Sender: TObject);
  294.  var
  295.    idx: Integer;
  296.  begin
  297.    FCSCommThreads.Enter;
  298.    try
  299.      Assert(Sender is TCommThread, StrSenderMustBeATCommThread);
  300.  
  301.      // Find the thread in the active thread list
  302.      idx := FActiveThreads.IndexOf(Sender);
  303.  
  304.      Assert(idx <> -, StrUnableToFindTerminatedThread);
  305.  
  306.      // if we find it, remove it (we should always find it)
  307.      FActiveThreads.Delete(idx);
  308.    finally
  309.      FCSCommThreads.Leave;
  310.    end;
  311.  end;
  312.  
  313.  constructor TBaseCommThreadDispatch.Create(AOwner: TComponent);
  314.  begin
  315.    inherited;
  316.  
  317.    FCommThreadClass := TCommThread;
  318.  
  319.    FProcessQueueTimer := TTimer.Create(nil);
  320.    FProcessQueueTimer.Enabled := FALSE;
  321.    FProcessQueueTimer.Interval := ;
  322.    FProcessQueueTimer.OnTimer := OnProcessQueueTimer;
  323.    FProgressFrequency := ;
  324.  
  325.    FCommQueue := TCommQueue.Create;
  326.  
  327.    FActiveThreads := TList.Create;
  328.  
  329.    FCSReceiveMessage := TCriticalSection.Create;
  330.    FCSCommThreads := TCriticalSection.Create;
  331.  end;
  332.  
  333.  destructor TBaseCommThreadDispatch.Destroy;
  334.  begin
  335.    // Stop the queue timer
  336.    FProcessQueueTimer.Enabled := FALSE;
  337.  
  338.    TerminateActiveThreads;
  339.  
  340.    // Pump the queue while there are active threads
  341.    while CommThreadDispatchState <> ctsIdle do
  342.    begin
  343.      ProcessMessageQueue;
  344.  
  345.      sleep();
  346.    end;
  347.  
  348.    // Free everything
  349.    FreeAndNil(FProcessQueueTimer);
  350.    FreeAndNil(FCommQueue);
  351.    FreeAndNil(FCSReceiveMessage);
  352.    FreeAndNil(FCSCommThreads);
  353.    FreeAndNil(FActiveThreads);
  354.  
  355.    inherited;
  356.  end;
  357.  
  358.  procedure TBaseCommThreadDispatch.DoOnReceiveThreadMessage(Sender: TObject;
  359.    MessageId: Integer; CommThreadParams: TCommThreadParams);
  360.  begin
  361.    // Don't send the messages if we're being destroyed
  362.    if not (csDestroying in ComponentState) then
  363.    begin
  364.      if Assigned(FOnReceiveThreadMessage) then
  365.        FOnReceiveThreadMessage(Self, Sender, MessageId, CommThreadParams);
  366.    end;
  367.  end;
  368.  
  369.  procedure TBaseCommThreadDispatch.DoOnStateChange;
  370.  begin
  371.    if (Assigned(FOnStateChange)) and (not (csDestroying in ComponentState)) then
  372.      FOnStateChange(Self, FCommThreadDispatchState);
  373.  end;
  374.  
  375.  function TBaseCommThreadDispatch.GetActiveThreadCount: Integer;
  376.  begin
  377.    Result := FActiveThreads.Count;
  378.  end;
  379.  
  380.  function TBaseCommThreadDispatch.GetProcessQueueTimerInterval: Integer;
  381.  begin
  382.    Result := FProcessQueueTimer.Interval;
  383.  end;
  384.  
  385.  function TBaseCommThreadDispatch.GetStateText: String;
  386.  begin
  387.    case State of
  388.      ctsIdle: Result := StrIdle;
  389.      ctsTerminating: Result := StrTerminating;
  390.      ctsActive: Result := StrActive;
  391.    end;
  392.  end;
  393.  
  394.  function TBaseCommThreadDispatch.NewThread(const ThreadName: String): TCommThread;
  395.  begin
  396.    if FCommThreadDispatchState = ctsTerminating then
  397.      Result := nil
  398.    else
  399.    begin
  400.      // Make sure we're active
  401.      if CommThreadDispatchState = ctsIdle then
  402.        CommThreadDispatchState := ctsActive;
  403.  
  404.      Result := CreateThread(ThreadName);
  405.  
  406.      FActiveThreads.Add(Result);
  407.  
  408.      if ThreadName = '' then
  409.        Result.FName := IntToStr(Integer(Result))
  410.      else
  411.        Result.FName := ThreadName;
  412.  
  413.      Result.FProgressFrequency := FProgressFrequency;
  414.    end;
  415.  end;
  416.  
  417.  function TBaseCommThreadDispatch.CreateThread(
  418.    const ThreadName: String): TCommThread;
  419.  begin
  420.    Result := FCommThreadClass.Create(Self);
  421.  
  422.    Result.FreeOnTerminate := TRUE;
  423.  end;
  424.  
  425.  procedure TBaseCommThreadDispatch.OnProcessQueueTimer(Sender: TObject);
  426.  begin
  427.    ProcessMessageQueue;
  428.  end;
  429.  
  430.  procedure TBaseCommThreadDispatch.ProcessMessageQueue;
  431.  var
  432.    CommQueueItem: TCommQueueItem;
  433.  begin
  434.    if FCommThreadDispatchState in [ctsActive, ctsTerminating] then
  435.    begin
  436.      if FCommQueue.Count >  then
  437.      begin
  438.        FCSReceiveMessage.Enter;
  439.        try
  440.          CommQueueItem := FCommQueue.Dequeue;
  441.  
  442.          while Assigned(CommQueueItem) do
  443.          begin
  444.            try
  445.              DoOnReceiveThreadMessage(CommQueueItem.Sender, CommQueueItem.MessageId, CommQueueItem.CommThreadParams);
  446.            finally
  447.              FreeAndNil(CommQueueItem);
  448.            end;
  449.  
  450.            if FCommQueue.Count >  then
  451.              CommQueueItem := FCommQueue.Dequeue;
  452.          end;
  453.        finally
  454.          FCSReceiveMessage.Leave
  455.        end;
  456.      end;
  457.  
  458.      if Finished then
  459.      begin
  460.        FCommThreadDispatchState := ctsIdle;
  461.  
  462.        DoOnStateChange;
  463.      end;
  464.    end;
  465.  end;
  466.  
  467.  function TBaseCommThreadDispatch.Finished: Boolean;
  468.  begin
  469.    Result := FActiveThreads.Count = ;
  470.  end;
  471.  
  472.  procedure TBaseCommThreadDispatch.QueueMessage(Sender: TObject; MessageId: Integer;
  473.    CommThreadParams: TCommThreadParams);
  474.  var
  475.    CommQueueItem: TCommQueueItem;
  476.  begin
  477.    FCSReceiveMessage.Enter;
  478.    try
  479.      CommQueueItem := TCommQueueItem.Create;
  480.      CommQueueItem.Sender := Sender;
  481.      CommQueueItem.MessageId := MessageId;
  482.      CommQueueItem.CommThreadParams := CommThreadParams;
  483.  
  484.      FCommQueue.Enqueue(CommQueueItem);
  485.    finally
  486.      FCSReceiveMessage.Leave
  487.    end;
  488.  end;
  489.  
  490.  procedure TBaseCommThreadDispatch.SetCommThreadDispatchState(
  491.    const Value: TCommThreadDispatchState);
  492.  begin
  493.    if FCommThreadDispatchState <> ctsTerminating then
  494.    begin
  495.      if Value = ctsActive then
  496.      begin
  497.        if not FManualMessageQueue then
  498.          FProcessQueueTimer.Enabled := TRUE;
  499.      end
  500.      else
  501.        TerminateActiveThreads;
  502.    end;
  503.  
  504.    FCommThreadDispatchState := Value;
  505.  
  506.    DoOnStateChange;
  507.  end;
  508.  
  509.  procedure TBaseCommThreadDispatch.SetManualMessageQueue(const Value: Boolean);
  510.  begin
  511.    FManualMessageQueue := Value;
  512.  end;
  513.  
  514.  procedure TBaseCommThreadDispatch.SetProcessQueueTimerInterval(const Value: Integer);
  515.  begin
  516.    FProcessQueueTimer.Interval := Value;
  517.  end;
  518.  
  519.  function TBaseCommThreadDispatch.State: TCommThreadDispatchState;
  520.  begin
  521.    Result := FCommThreadDispatchState;
  522.  end;
  523.  
  524.  procedure TBaseCommThreadDispatch.Stop;
  525.  begin
  526.    if CommThreadDispatchState = ctsActive then
  527.      TerminateActiveThreads;
  528.  end;
  529.  
  530.  procedure TBaseCommThreadDispatch.TerminateActiveThreads;
  531.  var
  532.    i: Integer;
  533.  begin
  534.    if FCommThreadDispatchState = ctsActive then
  535.    begin
  536.      // Lock threads
  537.      FCSCommThreads.Acquire;
  538.      try
  539.        FCommThreadDispatchState := ctsTerminating;
  540.  
  541.        DoOnStateChange;
  542.  
  543.        // Terminate each thread in turn
  544.        for i :=  to pred(FActiveThreads.Count) do
  545.          TCommThread(FActiveThreads[i]).Terminate;
  546.      finally
  547.        FCSCommThreads.Release;
  548.      end;
  549.    end;
  550.  end;
  551.  
  552.  { TCommThreadParams }
  553.  
  554.  procedure TCommThreadParams.Clear;
  555.  begin
  556.    FThreadParams.Clear;
  557.    FThreadObjects.Clear;
  558.  end;
  559.  
  560.  constructor TCommThreadParams.Create;
  561.  begin
  562.    FThreadParams := TThreadParams.Create;
  563.    FThreadObjects := TThreadObjects.Create;
  564.  end;
  565.  
  566.  destructor TCommThreadParams.Destroy;
  567.  begin
  568.    FreeAndNil(FThreadParams);
  569.    FreeAndNil(FThreadObjects);
  570.  
  571.    inherited;
  572.  end;
  573.  
  574.  function TCommThreadParams.GetObject(const ObjectName: String): TObject;
  575.  begin
  576.    Result := FThreadObjects.Items[ObjectName];
  577.  end;
  578.  
  579.  function TCommThreadParams.GetParam(const ParamName: String): Variant;
  580.  begin
  581.    Result := FThreadParams.Items[ParamName];
  582.  end;
  583.  
  584.  function TCommThreadParams.SetObject(const ObjectName: String;
  585.    Obj: TObject): TCommThreadParams;
  586.  begin
  587.    FThreadObjects.AddOrSetValue(ObjectName, Obj);
  588.  
  589.    Result := Self;
  590.  end;
  591.  
  592.  function TCommThreadParams.SetParam(const ParamName: String;
  593.    ParamValue: Variant): TCommThreadParams;
  594.  begin
  595.    FThreadParams.AddOrSetValue(ParamName, ParamValue);
  596.  
  597.    Result := Self;
  598.  end;
  599.  
  600.  { TCommQueueItem }
  601.  
  602.  destructor TCommQueueItem.Destroy;
  603.  begin
  604.    if Assigned(FCommThreadParams) then
  605.      FreeAndNil(FCommThreadParams);
  606.  
  607.    inherited;
  608.  end;
  609.  
  610.  { TBaseStatusCommThreadDispatch }
  611.  
  612.  procedure TBaseStatusCommThreadDispatch.DoOnReceiveThreadMessage(
  613.    Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);
  614.  begin
  615.    inherited;
  616.  
  617.    case MessageId of
  618.      // Status Message
  619.      CTID_STATUS: DoOnStatus(Sender,
  620.                              Name,
  621.                              CommThreadParams.GetParam(PRM_STATUS_TEXT),
  622.                              CommThreadParams.GetParam(PRM_STATUS_TYPE));
  623.      // Progress Message
  624.      CTID_PROGRESS: DoOnProgress(Sender,
  625.                                  CommThreadParams.GetParam(PRM_PROGRESS_ID),
  626.                                  CommThreadParams.GetParam(PRM_PROGRESS),
  627.                                  CommThreadParams.GetParam(PRM_PROGRESS_MAX));
  628.    end;
  629.  end;
  630.  
  631.  procedure TBaseStatusCommThreadDispatch.DoOnStatus(Sender: TObject; const ID,
  632.    StatusText: String; StatusType: Integer);
  633.  begin
  634.    if (not (csDestroying in ComponentState)) and (Assigned(FOnStatus)) then
  635.      FOnStatus(Self, Sender, ID, StatusText, StatusType);
  636.  end;
  637.  
  638.  procedure TBaseStatusCommThreadDispatch.DoOnProgress(Sender: TObject;
  639.    const ID: String; Progress, ProgressMax: Integer);
  640.  begin
  641.    if not (csDestroying in ComponentState) and (Assigned(FOnProgress)) then
  642.      FOnProgress(Self, Sender, ID, Progress, ProgressMax);
  643.  end;
  644.  
  645.  end.

To use the library, simply descend your thread from the TCommThread thread and override the Execute procedure:

MyCommThreadObject = class(TCommThread)

public

  procedure Execute; override;

end;

Next, create a descendant of the TStatusCommThreadDispatch component and set it's events.

MyCommThreadComponent := TStatusCommThreadDispatch.Create(Self);

  // Add the event handlers

  MyCommThreadComponent.OnStateChange := OnStateChange;

  MyCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage;

  MyCommThreadComponent.OnStatus := OnStatus;

  MyCommThreadComponent.OnProgress := OnProgress;

  // Set the thread class

  MyCommThreadComponent.CommThreadClass := TMyCommThread;

Make sure you set the CommThreadClass to your TCommThread descendant.

Now all you need to do is create the threads via MyCommThreadComponent:

FCommThreadComponent.NewThread

    .SetParam('MyThreadInputParameter', '')

    .SetObject('MyThreadInputObject', MyObject)

    .Start;

Add as many parameters and objects as you like. In your threads Execute method you can retrieve the parameters and objects.

MyThreadParameter := GetParam('MyThreadInputParameter'); //

MyThreadObject := GetObject('MyThreadInputObject'); // MyObject

Parameters will be automatically freed. You need to manage objects yourself.

To send a message back to the main thread from the threads execute method:

FCommDispatchReceiver.QueueMessage(Self, CTID_MY_MESSAGE_ID, TCommThreadParams.Create

  .SetObject('MyThreadObject', MyThreadObject)

  .SetParam('MyThreadOutputParameter', MyThreadParameter));

Again, parameters will be destroyed automatically, objects you have to manage yourself.

To receive messages in the main thread either attach the OnReceiveThreadMessage event

or override the DoOnReceiveThreadMessage procedure:

procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;

Use the overridden procedure to process the messages sent back to your main thread:

procedure THostDiscovery.DoOnReceiveThreadMessage(Sender: TObject;

  MessageId: Integer; CommThreadParams: TCommThreadParams);

begin

  inherited;

  case MessageId of

    CTID_MY_MESSAGE_ID:

      begin

        // Process the CTID_MY_MESSAGE_ID message

        DoSomethingWithTheMessage(CommThreadParams.GetParam('MyThreadOutputParameter'),

                                  CommThreadParams.GeObject('MyThreadObject'));

      end;

  end;

end;

The messages are pumped in the ProcessMessageQueue procedure.

This procedure is called via a TTimer.

If you use the component in a console app you will need to call ProcessMessageQueue manually.

The timer will start when the first thread is created.

It will stop when the last thread has finished.

If you need to control when the timer stops you can override the Finished procedure.

You can also perform actions depending on the state of the threads by overriding the DoOnStateChange procedure.

Take a look at the TCommThread descendant TStatusCommThreadDispatch.

It implements the sending of simple Status and Progress messages back to the main thread.

I hope this helps and that I've explained it OK.

This is related to my previous answer, but I was limited to 30000 characters.

Here's the code for a test app that uses TCommThread:

Test App (.pas)

unit frmMainU;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComCtrls, ExtCtrls, StdCtrls,

  Threading.CommThread;

type

  TMyCommThread = class(TCommThread)

  public

    procedure Execute; override;

  end;

  TfrmMain = class(TForm)

    Panel1: TPanel;

    lvLog: TListView;

    btnStop: TButton;

    btnNewThread: TButton;

    StatusBar1: TStatusBar;

    btn30NewThreads: TButton;

    tmrUpdateStatusBar: TTimer;

    procedure FormCreate(Sender: TObject);

    procedure btnStopClick(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure tmrUpdateStatusBarTimer(Sender: TObject);

  private

    FCommThreadComponent: TStatusCommThreadDispatch;

    procedure OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);

    procedure OnStateChange(Sender: TObject; State: TCommThreadDispatchState);

    procedure UpdateStatusBar;

    procedure OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer);

    procedure OnProgress(Source, Sender: TObject; const ID: String; Progress,  ProgressMax: Integer);

  public

  end;

var

  frmMain: TfrmMain;

implementation

resourcestring

  StrStatusIDDProgre = 'StatusID: %s, Progress: %d, ProgressMax: %d';

  StrActiveThreadsD = 'Active Threads: %d, State: %s';

  StrIdle = 'Idle';

  StrActive = 'Active';

  StrTerminating = 'Terminating';

{$R *.dfm}

{ TMyCommThread }

procedure TMyCommThread.Execute;

var

  i: Integer;

begin

  SendCommMessage(, TCommThreadParams.Create.SetParam('status', 'started'));

  for i :=  to  do

  begin

    sleep();

    SendStatusMessage(format('Thread: %s, i = %d', [Name, i]), );

    if Terminated then

      Break;

    sleep();

    SendProgressMessage(Integer(Self), i, , FALSE);

  end;

  if Terminated then

    SendCommMessage(, TCommThreadParams.Create.SetParam('status', 'terminated'))

  else

    SendCommMessage(, TCommThreadParams.Create.SetParam('status', 'finished'));

end;

{ TfrmMain }

procedure TfrmMain.btnStopClick(Sender: TObject);

begin

  FCommThreadComponent.Stop;

end;

procedure TfrmMain.Button3Click(Sender: TObject);

var

  i: Integer;

begin

  for i :=  to  do

    FCommThreadComponent.NewThread

      .SetParam('input_param1', 'test_value')

      .Start;

end;

procedure TfrmMain.Button4Click(Sender: TObject);

begin

  FCommThreadComponent.NewThread

    .SetParam('input_param1', 'test_value')

    .Start;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

  FCommThreadComponent := TStatusCommThreadDispatch.Create(Self);

  // Add the event handlers

  FCommThreadComponent.OnStateChange := OnStateChange;

  FCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage;

  FCommThreadComponent.OnStatus := OnStatus;

  FCommThreadComponent.OnProgress := OnProgress;

  // Set the thread class

  FCommThreadComponent.CommThreadClass := TMyCommThread;

end;

procedure TfrmMain.OnProgress(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer);

begin

  With lvLog.Items.Add do

  begin

    Caption := '-';

    SubItems.Add(format(StrStatusIDDProgre, [Id, Progress, ProgressMax]));

  end;

end;

procedure TfrmMain.OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams);

begin

  if MessageID =  then

    With lvLog.Items.Add do

    begin

      Caption := IntToStr(MessageId);

      SubItems.Add(CommThreadParams.GetParam('status'));

    end;

end;

procedure TfrmMain.UpdateStatusBar;

begin

  StatusBar1.SimpleText := format(StrActiveThreadsD, [FCommThreadComponent.ActiveThreadCount, FCommThreadComponent.StateText]);

end;

procedure TfrmMain.OnStateChange(Sender: TObject; State: TCommThreadDispatchState);

begin

  With lvLog.Items.Add do

  begin

    case State of

      ctsIdle: Caption := StrIdle;

      ctsActive: Caption := StrActive;

      ctsTerminating: Caption := StrTerminating;

    end;

  end;

end;

procedure TfrmMain.OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer);

begin

  With lvLog.Items.Add do

  begin

    Caption := IntToStr(StatusType);

    SubItems.Add(StatusText);

  end;

end;

procedure TfrmMain.tmrUpdateStatusBarTimer(Sender: TObject);

begin

  UpdateStatusBar;

end;

end.

Test app (.dfm)

object frmMain: TfrmMain

  Left =

  Top =

  Caption = 'CommThread Test'

  ClientHeight =

  ClientWidth =

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch =

  TextHeight =

  object Panel1: TPanel

    AlignWithMargins = True

    Left =

    Top =

    Width =

    Height =

    Margins.Right =

    Align = alLeft

    BevelOuter = bvNone

    TabOrder =

    object btnStop: TButton

      AlignWithMargins = True

      Left =

      Top =

      Width =

      Height =

      Margins.Left =

      Margins.Top =

      Margins.Right =

      Margins.Bottom =

      Align = alTop

      Caption = 'Stop'

      TabOrder =

      OnClick = btnStopClick

    end

    object btnNewThread: TButton

      Left =

      Top =

      Width =

      Height =

      Align = alTop

      Caption = 'New Thread'

      TabOrder =

      OnClick = Button4Click

    end

    object btn30NewThreads: TButton

      Left =

      Top =

      Width =

      Height =

      Align = alTop

      Caption = '30 New Threads'

      TabOrder =

      OnClick = Button3Click

    end

  end

  object lvLog: TListView

    AlignWithMargins = True

    Left =

    Top =

    Width =

    Height =

    Align = alClient

    Columns = <

      item

        Caption = 'Message ID'

        Width =

      end

      item

        AutoSize = True

        Caption = 'Info'

      end>

    ReadOnly = True

    RowSelect = True

    TabOrder =

    ViewStyle = vsReport

  end

  object StatusBar1: TStatusBar

    Left =

    Top =

    Width =

    Height =

    Panels = <>

    SimplePanel = True

  end

  object tmrUpdateStatusBar: TTimer

    Interval =

    OnTimer = tmrUpdateStatusBarTimer

    Left =

    Top =

  end

end

TMsgThread, TCommThread -- 在delphi线程中实现消息循环的更多相关文章

  1. TMsgThread, TCommThread -- 在delphi线程中实现消息循环（105篇博客，好多研究消息的文章）

    在delphi线程中实现消息循环 在delphi线程中实现消息循环 Delphi的TThread类使用很方便,但是有时候我们需要在线程类中使用消息循环,delphi没有提供.   花了两天的事件研究了 ...

  2. TCommThread -- 在delphi线程中实现消息循环

    http://www.techques.com/question/1-4073197/How-do-I-send-and-handle-message-between-TService-parent- ...

  3. Looper.loop() android线程中的消息循环

    Looper用于封装了android线程中的消息循环,默认情况下一个线程是不存在消息循环(message loop)的,需要调用Looper.prepare()来给线程创建一个消息循环,调用Loope ...

  4. 安卓中的消息循环机制Handler及Looper详解

    我们知道安卓中的UI线程不是线程安全的,我们不能在UI线程中进行耗时操作,通常我们的做法是开启一个子线程在子线程中处理耗时操作,但是安卓规定不允许在子线程中进行UI的更新操作,通常我们会通过Handl ...

  5. delphi XE7 中的消息

    在delphi XE7的程序开发中,消息机制保证进程间的通信. 在程序中,消息来自: 1)系统: 通知你的程序用户输入,涂画以及其他的系统范围的事件: 2)你的程序:不同的程序部分之间的通信信息.   ...

  6. 【转载】Delphi7从子线程中发送消息到主线程触发事件执行

    在对数据库的操作时,有时要用一个子线程来进行后台的数据操作.比如说数据备份,转档什么的.在主窗口还能同是进行其它操作.而有时后台每处理一个数据文件,要向主窗口发送消息,让主窗口实时显示处理进度在窗口上 ...

  7. Chrome中的消息循环

    主要是自己做个学习笔记吧,我经验也不是很丰富,以前学习多线程的时候就感觉写多线程程序很麻烦.主要是线程之间要通信,要切线程,要同步,各种麻烦.我本身的工作经历决定了也没有太多的工作经验,所以chrom ...

  8. Windows 消息循环(2) - WPF中的消息循环

    接上文: Windows 消息循环(1) - 概览 win32/MFC/WinForm/WPF 都依靠消息循环驱动,让程序跑起来. 本文介绍 WPF 中是如何使用消息循环来驱动程序的. 4 消息循环在 ...

  9. 事件循环和线程没有必然关系（就像Windows子线程默认没有消息循环一样），模态对话框和事件循环也没有必然关系（QWidget直接就可以）

    周末天冷,索性把电脑抱到床上上网,这几天看了 dbzhang800 博客关于 Qt 事件循环的几篇 Blog,发现自己对 Qt 的事件循环有不少误解.从来只看到现象,这次借 dbzhang800 的博 ...

随机推荐

  1. 可进行JavaScript代码测试与调试的12个网站

    概述:JavaScript是网站前端开发最为重要的一门编程语言,本文收集了能够在线测试与调试JavaScript代码的12个网站 1.JS Bin JS bin是一个为JavaScript和CSS爱好 ...

  2. 多态.xml

    pre{ line-height:1; color:#1e1e1e; background-color:#f0f0f0; font-size:16px;}.sysFunc{color:#627cf6; ...

  3. 数往知来C#之接口 值类型与引用类型 静态非静态 异常处理 GC垃圾回收 值类型引用类型内存分配<四>

    C# 基础接口篇 一.多态复习 使用个new来实现,使用virtual与override    -->new隐藏父类方法 根据当前类型,电泳对应的方法(成员)    -->override ...

  4. fork（）函数详解

    linux中fork()函数详解(原创!!实例讲解) (转载)    一.fork入门知识 一个进程,包括代码.数据和分配给进程的资源.fork()函数通过系统调用创建一个与原来进程几乎完全相同的进程 ...

  5. 新手须知设计的法则 Mark

    经常看到一些讲如何学习设计的文章,坦白讲感觉有些千篇一律.且不痛不痒,都说要看点书.学点画.练软件.多观察……唉,练软件这事还要说么,难道你还需要告诉一个人学开发是需要学习编程语言的? 学习是基于过往 ...

  6. Page Scroll Menu (页面中锚点菜单)

    Technorati 标签: Page Scroll Menu,页面锚点菜单,Menu,Too Long,页面太长   当页面太长时,会导致浏览不便,这时就需要一个页面锚点菜单(Page Scroll ...

  7. iframe和frame的区别

    在同时有frame和Iframe的一个窗口里frame最大可以做个frameset的儿子,Iframe最大也只能做到frameset的孙子.frame的布局限于几种,Iframe想放哪里放哪里.fra ...

  8. CircleLayout

    CircleLayout https://developer.apple.com/library/ios/samplecode/CircleLayout/Introduction/Intro.html ...

  9. php 开发最好的ide: PhpStorm

    PhpStorm 跨平台. 对PHP支持refactor功能. 自动生成phpdoc的注释,非常方便进行大型编程. 内置支持Zencode. 生成类的继承关系图,如果有一个类,多次继承之后,可以通过这 ...

  10. 未找到与约束contractname Microsoft.VisualStudio.Utilities.IContentTypeRegistryService

    在項目中遇到的問題,網上找到的答案,做個記錄, 项目能打开,但是当要在项目中查看文件时弹出 未找到与约束 Microsoft.VisualStudio.Utilities.IContentTypeRe ...