在delphi線程中實現消息迴圈 |
|
|
|
conundrum
尊榮會員   發表：893 回覆：1272 積分：643 註冊：2004-01-06 發送簡訊給我 |
在delphi線程中實現消息迴圈.
http://www.delphibbs.com/keylife/iblog_show.asp?xid=1193
KeyLife富翁筆記
作者?: xwings
標題?: 在delphi線程中實現消息迴圈.
關鍵字: TThread,消息迴圈,線程,消息
分類?: Win32系統
密級?: 公開
Delphi的TThread類使用很方便,但是有時候我們需要線上程類中使用消息迴
圈,delphi沒有提供.花了兩天的事件研究了一下win32的消息系統,寫了一個線程
內消息迴圈的測試.但是沒有具體應用過,貼出來給有這方面需求的DFW參考一下. 希望大家和我討論. {-----------------------------------------------------------------------------
Unit Name: uMsgThread
Author: xwing
eMail : xwing@263.net ; MSN : xwing1979@hotmail.com
Purpose: Thread with message Loop
History: 2003-6-19, add function to Send Thread Message. ver 1.0
use Event List and waitforsingleObject
your can use WindowMessage or ThreadMessage
2003-6-18, Change to create a window to Recving message
2003-6-17, Begin.
-----------------------------------------------------------------------------}
unit uMsgThread; interface
{$WARN SYMBOL_DEPRECATED OFF}
{$DEFINE USE_WINDOW_MESSAGE}
uses
Classes, windows, messages, forms, sysutils; type
TMsgThread = class(TThread)
private
{$IFDEF USE_WINDOW_MESSAGE}
FWinName : string;
FMSGWin : HWND;
{$ELSE}
FEventList : TList;
FCtlSect : TRTLCriticalSection;
{$ENDIF}
FException : Exception;
fDoLoop : Boolean;
FWaitHandle : THandle;
{$IFDEF USE_WINDOW_MESSAGE}
procedure MSGWinProc(var Message: TMessage);
{$ELSE}
procedure ClearSendMsgEvent;
{$ENDIF}
procedure SetDoLoop(const Value: Boolean);
procedure WaitTerminate; protected
Msg :tagMSG;
procedure Execute; override;
procedure HandleException;
procedure DoHandleException;virtual;
//Inherited the Method to process your own Message
procedure DoProcessMsg(var Msg:TMessage);virtual;
//if DoLoop = true then loop this procedure
//Your can use the method to do some work needed loop.
procedure DoMsgLoop;virtual;
//Initialize Thread before begin message loop
procedure DoInit;virtual;
procedure DoUnInit;virtual; procedure PostMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);
//When Use SendMsg method Must not use Synchronize Method in ThreadLoop !!!
//otherwise will caurse DeadLock
procedure SendMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);
public
constructor Create(Loop:Boolean=False;ThreadName: string='');
destructor destroy;override;
procedure AfterConstruction;override; //postMessage to Quit,and Free(if FreeOnTerminater = true)
//can call this in thread loop, don't use terminate property.
procedure QuitThread;
//PostMessage to Quit and Wait, only call in MAIN THREAD
procedure QuitThreadWait;
//just like Application.processmessage.
procedure ProcessMessage;
//enable thread loop, no waitfor message
property DoLoop: Boolean read fDoLoop Write SetDoLoop; end; implementation { TMsgThread }
{//////////////////////////////////////////////////////////////////////////////}
constructor TMsgThread.Create(Loop:Boolean;ThreadName:string);
begin
{$IFDEF USE_WINDOW_MESSAGE}
if ThreadName <> '' then
FWinName := ThreadName
else
FWinName := 'Thread Window';
{$ELSE}
FEventList := TList.Create;
InitializeCriticalSection(fCtlSect);
{$ENDIF} FWaitHandle := CreateEvent(nil, True, False, nil); FDoLoop := Loop; //default disable thread loop
inherited Create(False); //Create thread
FreeOnTerminate := True; //Thread quit and free object //Call resume Method in Constructor Method
Resume;
//Wait until thread Message Loop started
WaitForSingleObject(FWaitHandle,INFINITE);
end; {------------------------------------------------------------------------------}
procedure TMsgThread.AfterConstruction;
begin
end; {------------------------------------------------------------------------------}
destructor TMsgThread.destroy;
begin
{$IFDEF USE_WINDOW_MESSAGE}
{$ELSE}
FEventList.Free;
DeleteCriticalSection(FCtlSect);
{$ENDIF}
inherited;
end; {//////////////////////////////////////////////////////////////////////////////}
procedure TMsgThread.Execute;
var
mRet:Boolean;
aRet:Boolean;
{$IFNDEF USE_WINDOW_MESSAGE}
uMsg:TMessage;
{$ENDIF}
begin
{$IFDEF USE_WINDOW_MESSAGE}
FMSGWin := CreateWindow('STATIC',PChar(FWinName),WS_POPUP,0,0,0,0,0,0,hInstance,nil);
SetWindowLong(FMSGWin, GWL_WNDPROC, Longint(MakeObjectInstance(MSGWinProc)));
{$ELSE}
PeekMessage(Msg,0,WM_USER,WM_USER,PM_NOREMOVE); //Force system alloc a msgQueue
{$ENDIF} //notify Conctructor can returen.
SetEvent(FWaitHandle);
CloseHandle(FWaitHandle); mRet := True;
try
DoInit;
while mRet do //Message Loop
begin
if fDoLoop then
begin
aRet := PeekMessage(Msg,0,0,0,PM_REMOVE);
if aRet and (Msg.message <> WM_QUIT) then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(Msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
{$ENDIF} if Msg.message = WM_QUIT then
mRet := False;
end;
{$IFNDEF USE_WINDOW_MESSAGE}
ClearSendMsgEvent; //Clear SendMessage Event
{$ENDIF}
DoMsgLoop;
end
else begin
mRet := GetMessage(Msg,0,0,0);
if mRet then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(Msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
ClearSendMsgEvent; //Clear SendMessage Event
{$ENDIF}
end;
end;
end;
DoUnInit;
{$IFDEF USE_WINDOW_MESSAGE}
DestroyWindow(FMSGWin);
FreeObjectInstance(Pointer(GetWindowLong(FMSGWin, GWL_WNDPROC)));
{$ENDIF}
except
HandleException;
end;
end; {------------------------------------------------------------------------------}
{$IFNDEF USE_WINDOW_MESSAGE}
procedure TMsgThread.ClearSendMsgEvent;
var
aEvent:PHandle;
begin
EnterCriticalSection(FCtlSect);
try
if FEventList.Count <> 0 then
begin
aEvent := FEventList.Items[0];
if aEvent <> nil then
begin
SetEvent(aEvent^);
CloseHandle(aEvent^);
Dispose(aEvent);
end;
FEventList.Delete(0);
end;
finally
LeaveCriticalSection(FCtlSect);
end;
end;
{$ENDIF} {------------------------------------------------------------------------------}
procedure TMsgThread.HandleException;
begin
FException := Exception(ExceptObject); //Get Current Exception object
try
if not (FException is EAbort) then
inherited Synchronize(DoHandleException);
finally
FException := nil;
end;
end; {------------------------------------------------------------------------------}
procedure TMsgThread.DoHandleException;
begin
if FException is Exception then
Application.ShowException(FException)
else
SysUtils.ShowException(FException, nil);
end; {//////////////////////////////////////////////////////////////////////////////}
{$IFDEF USE_WINDOW_MESSAGE}
procedure TMsgThread.MSGWinProc(var Message: TMessage);
begin
DoProcessMsg(Message);
with Message do
Result:=DefWindowProc(FMSGWin,Msg,wParam,lParam);
end;
{$ENDIF} {------------------------------------------------------------------------------}
procedure TMsgThread.DoProcessMsg(var Msg:TMessage);
begin
end; {------------------------------------------------------------------------------}
procedure TMsgThread.ProcessMessage;
{$IFNDEF USE_WINDOW_MESSAGE}
var
uMsg:TMessage;
{$ENDIF}
begin
while PeekMessage(Msg,0,0,0,PM_REMOVE) do
if Msg.message <> WM_QUIT then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
{$ENDIF}
end;
end; {//////////////////////////////////////////////////////////////////////////////}
procedure TMsgThread.DoInit;
begin
end; procedure TMsgThread.DoUnInit;
begin
end; procedure TMsgThread.DoMsgLoop;
begin
Sleep(1);
end; {//////////////////////////////////////////////////////////////////////////////}
procedure TMsgThread.QuitThread;
begin
{$IFDEF USE_WINDOW_MESSAGE}
PostMessage(FMSGWin,WM_QUIT,0,0);
{$ELSE}
PostThreadMessage(ThreadID,WM_QUIT,0,0);
{$ENDIF}
end; {------------------------------------------------------------------------------}
procedure TMsgThread.QuitThreadWait;
begin
QuitThread;
WaitTerminate;
end; {------------------------------------------------------------------------------}
procedure TMsgThread.SetDoLoop(const Value: Boolean);
begin
if Value = fDoLoop then Exit;
fDoLoop := Value;
if fDoLoop then
PostMsg(WM_USER,0,0);
end; {------------------------------------------------------------------------------}
//Can only call this method in MAIN Thread!!
procedure TMsgThread.WaitTerminate;
var
xStart:Cardinal;
begin
xStart:=GetTickCount;
try
//EnableWindow(Application.Handle,False);
while WaitForSingleObject(Handle, 10) = WAIT_TIMEOUT do
begin
Application.ProcessMessages;
if GetTickCount > (xStart 4000) then
begin
TerminateThread(Handle, 0);
Beep;
Break;
end;
end;
finally
//EnableWindow(Application.Handle,True);
end;
end; {------------------------------------------------------------------------------}
procedure TMsgThread.PostMsg(Msg: Cardinal; wParam, lParam: Integer);
begin
{$IFDEF USE_WINDOW_MESSAGE}
postMessage(FMSGWin,Msg,wParam,lParam);
{$ELSE}
EnterCriticalSection(FCtlSect);
try
FEventList.Add(nil);
PostThreadMessage(ThreadID,Msg,wParam,lParam);
finally
LeaveCriticalSection(FCtlSect);
end;
{$ENDIF}
end; {------------------------------------------------------------------------------}
procedure TMsgThread.SendMsg(Msg: Cardinal; wParam, lParam: Integer);
{$IFNDEF USE_WINDOW_MESSAGE}
var
aEvent:PHandle;
{$ENDIF}
begin
{$IFDEF USE_WINDOW_MESSAGE}
SendMessage(FMSGWin,Msg,wParam,lParam);
{$ELSE}
EnterCriticalSection(FCtlSect);
try
New(aEvent);
aEvent^ := CreateEvent(nil, True, False, nil);
FEventList.Add(aEvent);
PostThreadMessage(ThreadID,Msg,wParam,lParam);
finally
LeaveCriticalSection(FCtlSect);
end;
WaitForSingleObject(aEvent^,INFINITE);
{$ENDIF}
end; end.
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2003-6-22 11:02:24 我參考了一下msdn,還有windows核心編程.
寫了一個類來封裝這個功能,不知道對不對.
裏面使用了兩個方法,一個使用一個隱含表單來處理消息
還有一個是直接使用thread的消息佇列來處理,但是這個時候sendmessage無法工
作,所以我自己設想了一個方法,雖然不完全達到了要求但是我簡單測試了一下,
好像還能工作. 切換兩種工作方式要修改編譯條件
{$DEFINE USE_WINDOW_MESSAGE} 使用隱含表單來處理消息
{-$DEFINE USE_WINDOW_MESSAGE} 使用線程消息佇列來處理消息
2003-6-22 11:02:54 還有我想要等待線程開始進行消息迴圈的時候create
函數才返回.但是現在好像還沒有這樣(用一個事件來處理).只是開始進入了
threadexecute函數,線程的create就返回了.可能會出問題.
2003-6-23 8:55:22 通過設置 DoLoop屬性可以設定線程是否迴圈(不阻塞等
待消息),這樣派生類線程在迴圈做一些其他事情的同時還可以接受消息. 例如:
派生類裏面迴圈發送緩衝區的資料,還可以回應其他線程發送過來的消息(如停
止,啟動,退出,等等)
2003-8-4 10:21:18
重新修改了一下，現在用起來基本沒有問題了。 {-----------------------------------------------------------------------------
Unit Name: uMsgThread
Author: xwing
eMail : xwing@263.net ; MSN : xwing1979@hotmail.com
Purpose: Thread with message Loop
History: 2003-7-15 Write thread class without use delphi own TThread.
2003-6-19, add function to Send Thread Message. ver 1.0
use Event List and waitforsingleObject
your can use WindowMessage or ThreadMessage
2003-6-18, Change to create a window to Recving message
2003-6-17, Begin.
-----------------------------------------------------------------------------}
unit uMsgThread; interface
{$WARN SYMBOL_DEPRECATED OFF} {$DEFINE USE_WINDOW_MESSAGE}
uses
Classes, windows, messages, forms, sysutils; const
NM_EXECPROC = $8FFF;
type
EMsgThreadErr = class(Exception);
TMsgThreadMethod = procedure of object; TMsgThread = class
private
SyncWindow : HWND;
FMethod : TMsgThreadMethod;
procedure SyncWindowProc(var Message: TMessage); private
m_hThread : THandle;
threadid : DWORD; {$IFDEF USE_WINDOW_MESSAGE}
FWinName : string;
FMSGWin : HWND;
{$ELSE}
FEventList : TList;
FCtlSect : TRTLCriticalSection;
{$ENDIF} FException : Exception;
fDoLoop : Boolean;
FWaitHandle : THandle; {$IFDEF USE_WINDOW_MESSAGE}
procedure MSGWinProc(var Message: TMessage);
{$ELSE}
procedure ClearSendMsgEvent;
{$ENDIF} procedure SetDoLoop(const Value: Boolean);
procedure Execute; protected
Msg :tagMSG; {$IFNDEF USE_WINDOW_MESSAGE}
uMsg :TMessage;
fSendMsgComp:THandle;
{$ENDIF} procedure HandleException;
procedure DoHandleException;virtual; //Inherited the Method to process your own Message
procedure DoProcessMsg(var Msg:TMessage);virtual; //if DoLoop = true then loop this procedure
//Your can use the method to do some work needed loop.
procedure DoMsgLoop;virtual; //Initialize Thread before begin message loop
procedure DoInit;virtual;
procedure DoUnInit;virtual; procedure PostMsg(Msg:Cardinal;wParam:Integer;lParam:Integer);
//When Use SendMsg method Must not use Synchronize Method in ThreadLoop !!!
//otherwise will caurse DeadLock
function SendMsg(Msg:Cardinal;wParam:Integer;lParam:Integer):Integer; public
constructor Create(Loop:Boolean=False;ThreadName: string='');
destructor destroy;override; // Return TRUE if the thread exists. FALSE otherwise
function ThreadExists: BOOL; procedure Synchronize(syncMethod:TMsgThreadMethod); function WaitFor:Longword;
function WaitTimeOut(timeout:DWORD=4000):Longword; //postMessage to Quit,and Free(if FreeOnTerminater = true)
//can call this in thread loop, don't use terminate property.
procedure QuitThread; //just like Application.processmessage.
procedure ProcessMessage; //enable thread loop, no waitfor message
property DoLoop: Boolean read fDoLoop Write SetDoLoop; end; implementation function msgThdInitialThreadProc(pv:Pointer):DWORD;stdcall;
var
obj:TMsgThread;
begin
obj := TMsgThread(pv);
obj.execute;
Result := 0;
end; { TMsgThread }
{//////////////////////////////////////////////////////////////////////////////}
constructor TMsgThread.Create(Loop:Boolean;ThreadName:string);
begin
{$IFDEF USE_WINDOW_MESSAGE}
if ThreadName <> '' then
FWinName := ThreadName
else
FWinName := 'Thread Window';
{$ELSE}
FEventList := TList.Create;
InitializeCriticalSection(fCtlSect);
fSendMsgComp := CreateEvent(nil, True, False, nil);
{$ENDIF} FDoLoop := Loop; //default disable thread loop //Create a Window for sync method
SyncWindow := CreateWindow('STATIC','SyncWindow',WS_POPUP,0,0,0,0,0,0,hInstance,nil);
SetWindowLong(SyncWindow, GWL_WNDPROC, Longint(MakeObjectInstance(SyncWindowProc))); FWaitHandle := CreateEvent(nil, True, False, nil);
//Create Thread
m_hThread := CreateThread(nil,0,@msgThdInitialThreadProc,Self,0,threadid);
if m_hThread = 0 then
raise EMsgThreadErr.Create('不能創建線程。');
//Wait until thread Message Loop started
WaitForSingleObject(FWaitHandle,INFINITE);
end; {------------------------------------------------------------------------------}
destructor TMsgThread.destroy;
begin
if m_hThread <> 0 then
QuitThread;
waitfor; //Free Sync Window
DestroyWindow(SyncWindow);
FreeObjectInstance(Pointer(GetWindowLong(SyncWindow, GWL_WNDPROC))); {$IFDEF USE_WINDOW_MESSAGE}
{$ELSE}
FEventList.Free;
DeleteCriticalSection(FCtlSect);
CloseHandle(fSendMsgComp);
{$ENDIF}
inherited;
end; {//////////////////////////////////////////////////////////////////////////////}
procedure TMsgThread.Execute;
var
mRet:Boolean;
aRet:Boolean;
begin
{$IFDEF USE_WINDOW_MESSAGE}
FMSGWin := CreateWindow('STATIC',PChar(FWinName),WS_POPUP,0,0,0,0,0,0,hInstance,nil);
SetWindowLong(FMSGWin, GWL_WNDPROC, Longint(MakeObjectInstance(MSGWinProc)));
{$ELSE}
PeekMessage(Msg,0,WM_USER,WM_USER,PM_NOREMOVE); //Force system alloc a msgQueue
{$ENDIF} mRet := True;
try
DoInit; //notify Conctructor can returen.
SetEvent(FWaitHandle);
CloseHandle(FWaitHandle); while mRet do //Message Loop
begin
if fDoLoop then
begin
aRet := PeekMessage(Msg,0,0,0,PM_REMOVE);
if aRet and (Msg.message <> WM_QUIT) then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(Msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
{$ENDIF} if Msg.message = WM_QUIT then
mRet := False;
end;
{$IFNDEF USE_WINDOW_MESSAGE}
ClearSendMsgEvent; //Clear SendMessage Event
{$ENDIF}
DoMsgLoop;
end
else begin
mRet := GetMessage(Msg,0,0,0);
if mRet then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(Msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
ClearSendMsgEvent; //Clear SendMessage Event
{$ENDIF}
end;
end;
end;
DoUnInit;
{$IFDEF USE_WINDOW_MESSAGE}
DestroyWindow(FMSGWin);
FreeObjectInstance(Pointer(GetWindowLong(FMSGWin, GWL_WNDPROC)));
{$ENDIF}
except
HandleException;
end;
end; {------------------------------------------------------------------------------}
{$IFNDEF USE_WINDOW_MESSAGE}
procedure TMsgThread.ClearSendMsgEvent;
var
aEvent:PHandle;
begin
EnterCriticalSection(FCtlSect);
try
if FEventList.Count <> 0 then
begin
aEvent := FEventList.Items[0];
if aEvent <> nil then
begin
SetEvent(aEvent^);
CloseHandle(aEvent^);
Dispose(aEvent);
WaitForSingleObject(fSendMsgComp,INFINITE);
end;
FEventList.Delete(0);
end;
finally
LeaveCriticalSection(FCtlSect);
end;
end;
{$ENDIF} {------------------------------------------------------------------------------}
procedure TMsgThread.HandleException;
begin
FException := Exception(ExceptObject); //Get Current Exception object
try
if not (FException is EAbort) then
Synchronize(DoHandleException);
finally
FException := nil;
end;
end; {------------------------------------------------------------------------------}
procedure TMsgThread.DoHandleException;
begin
if FException is Exception then
Application.ShowException(FException)
else
SysUtils.ShowException(FException, nil);
end; {//////////////////////////////////////////////////////////////////////////////}
{$IFDEF USE_WINDOW_MESSAGE}
procedure TMsgThread.MSGWinProc(var Message: TMessage);
begin
DoProcessMsg(Message);
if Message.Msg < wm_user then
with Message do
Result:=DefWindowProc(FMSGWin,Msg,wParam,lParam);
end;
{$ENDIF} {------------------------------------------------------------------------------}
procedure TMsgThread.DoProcessMsg(var Msg:TMessage);
begin end; {------------------------------------------------------------------------------}
procedure TMsgThread.ProcessMessage;
{$IFNDEF USE_WINDOW_MESSAGE}
var
uMsg:TMessage;
{$ENDIF}
begin
while PeekMessage(Msg,0,0,0,PM_REMOVE) do
if Msg.message <> WM_QUIT then
begin
{$IFDEF USE_WINDOW_MESSAGE}
TranslateMessage(Msg);
DispatchMessage(msg);
{$ELSE}
uMsg.Msg := Msg.message;
uMsg.wParam := Msg.wParam;
uMsg.lParam := Msg.lParam;
DoProcessMsg(uMsg);
{$ENDIF}
end;
end; {//////////////////////////////////////////////////////////////////////////////}
procedure TMsgThread.DoInit;
begin
end; procedure TMsgThread.DoUnInit;
begin
end; procedure TMsgThread.DoMsgLoop;
begin
Sleep(0);
end; {//////////////////////////////////////////////////////////////////////////////}
function TMsgThread.ThreadExists: BOOL;
begin
if m_hThread = 0 then
Result := false
else
Result := True;
end; {------------------------------------------------------------------------------}
procedure TMsgThread.QuitThread;
begin
{$IFDEF USE_WINDOW_MESSAGE}
PostMessage(FMSGWin,WM_QUIT,0,0);
{$ELSE}
PostThreadMessage(ThreadID,WM_QUIT,0,0);
{$ENDIF}
end; {------------------------------------------------------------------------------}
procedure TMsgThread.SetDoLoop(const Value: Boolean);
begin
if Value = fDoLoop then Exit;
fDoLoop := Value;
if fDoLoop then
PostMsg(WM_USER,0,0);
end; {------------------------------------------------------------------------------}
function TMsgThread.WaitTimeOut(timeout:dword):Longword;
var
xStart:Cardinal;
H: THandle;
begin
H := m_hThread;
xStart:=GetTickCount;
while WaitForSingleObject(h, 10) = WAIT_TIMEOUT do
begin
Application.ProcessMessages;
if GetTickCount > (xStart timeout) then
begin
TerminateThread(h, 0);
Break;
end;
end;
GetExitCodeThread(H, Result);
end; {------------------------------------------------------------------------------}
function TMsgThread.WaitFor: Longword;
var
Msg: TMsg;
H: THandle;
begin
H := m_hThread;
if GetCurrentThreadID = MainThreadID then
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 1 do
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
else
WaitForSingleObject(H, INFINITE);
GetExitCodeThread(H, Result);
end; {------------------------------------------------------------------------------}
procedure TMsgThread.PostMsg(Msg: Cardinal; wParam, lParam: Integer);
begin
{$IFDEF USE_WINDOW_MESSAGE}
postMessage(FMSGWin,Msg,wParam,lParam);
{$ELSE}
EnterCriticalSection(FCtlSect);
try
FEventList.Add(nil);
PostThreadMessage(ThreadID,Msg,wParam,lParam);
finally
LeaveCriticalSection(FCtlSect);
end;
{$ENDIF}
end; {------------------------------------------------------------------------------}
function TMsgThread.SendMsg(Msg: Cardinal; wParam, lParam: Integer):Integer;
{$IFNDEF USE_WINDOW_MESSAGE}
var
aEvent:PHandle;
{$ENDIF}
begin
{$IFDEF USE_WINDOW_MESSAGE}
Result := SendMessage(FMSGWin,Msg,wParam,lParam);
{$ELSE}
EnterCriticalSection(FCtlSect);
try
New(aEvent);
aEvent^ := CreateEvent(nil, True, False, nil);
FEventList.Add(aEvent);
PostThreadMessage(ThreadID,Msg,wParam,lParam);
finally
LeaveCriticalSection(FCtlSect);
end;
WaitForSingleObject(aEvent^,INFINITE);
Result := uMsg.Result;
SetEvent(fSendMsgComp);
{$ENDIF}
end; {------------------------------------------------------------------------------}
procedure TMsgThread.Synchronize(syncMethod: TMsgThreadMethod);
begin
FMethod := syncMethod;
SendMessage(SyncWindow,NM_EXECPROC,0,Longint(Self));
end; {------------------------------------------------------------------------------}
procedure TMsgThread.SyncWindowProc(var Message: TMessage);
begin
case Message.Msg of
NM_EXECPROC:
with TMsgThread(Message.lParam) do
begin
Message.Result := 0;
try
FMethod;
except
raise EMsgThreadErr.Create('執行同步線程方法錯誤。');
end;
end;
else
Message.Result:=DefWindowProc(SyncWindow,Message.Msg,Message.wParam,Message.lParam);
end;
end; end. 發表人 - conundrum 於 2004/06/06 00:09:19
|
發表時間：2004-06-06 00:05:50
IP:61.64.xxx.xxx 未訂閱
系統時間：2024-06-27 3:48:08
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |