这是一个不需要 Classes.pas 的循环,仅依赖 System.pas 来实现一些辅助函数,Windows.pas 用于 Win32 API 函数,Messages.pas 用于 WM_ 常量。
请注意,这里的窗口句柄是从工作线程创建和销毁的,但是主线程一直等到工作线程完成初始化。您可以将此等待推迟到稍后的时刻,当您真正需要窗口句柄时,主线程可能会在此期间做一些工作,而工作线程会自行设置。
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.