I have a Delphi 6 application that has a thread dedicated to communicating with a foreign application that uses SendMessage() and WM_COPYDATA messages to interface with external programs. Therefore, I create a hidden window with AllocateHWND() to service that need since a thread message queue won't work due to the SendMessage() function only accepting window handles, not thread IDs. What I'm not sure about is what to put in the thread Execute() method.
I assume that if I use a GetMessage() loop or a create a loop with a WaitFor*() function call in it that the thread will block and therefore the thread's WndProc() will never process the SendMessage() messages from the foreign program right? If so, what is the correct code to put in an Execute() loop that will not consume CPU cycles unnecessarily but will exit once a WM_QUIT message is received? I can always do a loop with a Sleep() if necessary but I'm wondering if there is a better way.
AllocateHWnd() (more specifically, MakeObjectInstance()) is not thread-safe, so you have to be careful with it. Better to use CreatWindow/Ex() directly instead (or a thread-safe version of AllocateHWnd(), like DSiAllocateHwnd().
In any case, an HWND is tied to the thread context that creates it, so you have to create and destroy the HWND inside your Execute() method, not in the thread's constructor/destructor. Also, even though SendMessage() is being used to send the messages to you, they are coming from another process, so they will not be processed by your HWND until its owning thread performs message retrieval operations, so the thread needs its own message loop.
Your Execute() method should look something like this:
procedure TMyThread.Execute;
var
Message: TMsg;
begin
FWnd := ...; // create the HWND and tie it to WndProc()...
try
while not Terminated do
begin
if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLINPUT) = WAIT_OBJECT_0 then
begin
while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Message);
DispatchMessage(Message);
end;
end;
end;
finally
// destroy FWnd...
end;
end;
procedure TMyThread.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_COPYDATA then
begin
...
Message.Result := ...;
end else
Message.Result := DefWindowProc(FWnd, Message.Msg, Message.WParam, Message.LParam);
end;
Alternatively:
// In Delphi XE2, a virtual TerminatedSet() method was added to TThread,
// which is called when TThread.Terminate() is called. In earlier versions,
// use a custom method instead...
type
TMyThread = class(TThread)
private
procedure Execute; override;
{$IF RTLVersion >= 23}
procedure TerminatedSet; override;
{$IFEND}
public
{$IF RTLVersion < 23}
procedure Terminate; reintroduce;
{$IFEND}
end;
procedure TMyThread.Execute;
var
Message: TMsg;
begin
FWnd := ...; // create the HWND and tie it to WndProc()...
try
while not Terminated do
begin
if WaitMessage then
begin
while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
begin
if Message.Msg = WM_QUIT then Break;
TranslateMessage(Message);
DispatchMessage(Message);
end;
end;
end;
finally
// destroy FWnd...
end;
end;
{$IF RTLVersion < 23}
procedure TMyThread.Terminate;
begin
inherited Terminate;
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
{$ELSE}
procedure TMyThread.TerminatedSet;
begin
PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
{$IFEND}
Here is a loop that doesn't require Classes.pas and relies solely on System.pas for some auxiliary functions, Windows.pas for Win32 API functions and Messages.pas for the WM_ constants.
Please note that the window handle here is created and destroyed from the worker thread, but the main thread waits until the worker thread completes the initialization. You can postpone this wait until a later moment, when you actually need the window handle, so the main thread may do some work in the meanwhile, while the worker thread sets itself up.
unit WorkerThread;
interface
implementation
uses
Messages,
Windows;
var
ExitEvent, ThreadReadyEvent: THandle;
ThreadId: TThreadID;
ThreadHandle: THandle;
WindowHandle: HWND;
function HandleCopyData(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
Result := 0; // handle it
end;
function HandleWmUser(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
// you may handle other messages as well - just an example of the WM_USER handling
begin
Result := 0; // handle it
end;
function MyWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if Msg = WM_COPYDATA then
begin
Result := HandleCopyData(hWnd, Msg, wParam, lParam);
end else
if Msg = WM_USER then
begin
// you may handle other messages as well - just an example of the WM_USER handling
// if you have more than 2 differnt messag types, use the "case" switch
Result := HandleWmUser(hWnd, Msg, wParam, lParam);
end else
begin
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;
end;
const
WindowClassName = 'MsgHelperWndClass';
WindowClass: TWndClass = (
style: 0;
lpfnWndProc: @MyWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: WindowClassName);
procedure CreateWindowFromThread;
var
A: ATOM;
begin
A := RegisterClass(WindowClass);
WindowHandle := CreateWindowEx(WS_EX_TOOLWINDOW, WindowClassName, 'Message Helper Window', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
end;
procedure FreeWindowFromThread;
var
H: HWND;
begin
H := WindowHandle;
WindowHandle := 0;
DestroyWindow(H);
UnregisterClass(WindowClassName, hInstance);
end;
function ThreadFunc(P: Pointer): Integer; //The worker thread main loop, windows handle initialization and finalization
const
EventCount = 1;
var
EventArray: array[0..EventCount-1] of THandle;
R: Cardinal;
M: TMsg;
begin
Result := 0;
CreateWindowFromThread;
try
EventArray[0] := ExitEvent; // you may add other events if you need - just enlarge the Events array
SetEvent(ThreadReadyEvent);
repeat
R := MsgWaitForMultipleObjects(EventCount, EventArray, False, INFINITE, QS_ALLINPUT);
if R = WAIT_OBJECT_0 + EventCount then
begin
while PeekMessage(M, WindowHandle, 0, 0, PM_REMOVE) do
begin
case M.Message of
WM_QUIT:
Break;
else
begin
TranslateMessage(M);
DispatchMessage(M);
end;
end;
end;
if M.Message = WM_QUIT then
Break;
end else
if R = WAIT_OBJECT_0 then
begin
// we have the ExitEvent signaled - so the thread have to quit
Break;
end else
if R = WAIT_TIMEOUT then
begin
// do nothing, the timeout should not have happened since we have the INFINITE timeout
end else
begin
// some errror happened, or the wait was abandoned with WAIT_ABANDONED_0 to (WAIT_ABANDONED_0 + nCount– 1)
// just exit the thread
Break;
end;
until False;
finally
FreeWindowFromThread;
end;
end;
procedure InitializeFromMainThread;
begin
ExitEvent := CreateEvent(nil, False, False, nil);
ThreadReadyEvent := CreateEvent(nil, False, False, nil);
ThreadHandle := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
end;
procedure WaitUntilHelperThreadIsReady;
begin
WaitForSingleObject(ThreadReadyEvent, INFINITE); // wait until the worker thread start running and initialize the main window
CloseHandle(ThreadReadyEvent); // we won't need it any more
ThreadReadyEvent := 0;
end;
procedure FinalizeFromMainThread;
begin
SetEvent(ExitEvent); // we should call it AFTER terminate for the Terminated property would already be True when the tread exits from MsgWaitForMultipleObjects
WaitForSingleObject(ThreadHandle, INFINITE);
CloseHandle(ThreadHandle); ThreadHandle := 0;
CloseHandle(ExitEvent); ExitEvent := 0;
end;
initialization
InitializeFromMainThread;
WaitUntilHelperThreadIsReady; // we can call it later, just before we need the window handle
finalization
FinalizeFromMainThread;
end.
来源：https://stackoverflow.com/questions/7700410/thread-message-loop-for-a-thread-with-a-hidden-window