Delphi - 线程中的 WndProc() 从未被调用

Question

我的代码在主 VCL 线程的上下文中运行时运行良好。该代码分配了它自己的 WndProc() 以处理 SendMessage() 调用。我现在尝试将其移至后台线程，因为我担心 SendMessage() 流量会对主 VCL 线程产生不利影响。因此，我创建了一个工作线程，其唯一目的是在其线程 Execute() 方法中分配 WndProc()，以确保 WndProc() 存在于线程的执行上下文中。 WndProc() 处理传入的 SendMessage() 调用。问题是工作线程的 WndProc() 方法永远不会被触发。

注意，doExecute() 是模板方法的一部分，由我的 TThreadExtended 类调用，该类是 Delphi 的 TThread 的后代。 TThreadExtended 实现线程 Execute() 方法并在循环中调用 doExecute()。我进行了三次检查，并且 doExecute() 被重复调用。另请注意，我在创建 WndProc() 之后立即调用 PeekMessage()，以确保 Windows 为线程创建消息队列。然而，我所做的事情是错误的，因为 WndProc() 方法从未被触发。代码如下:

// ========= BEGIN: CLASS - TWorkerThread ========================

constructor TWorkerThread.Create;
begin
    FWndProcHandle := 0;

    inherited Create(false);
end;

// ---------------------------------------------------------------

// This call is the thread's Execute() method.
procedure TWorkerThread.doExecute;
var
    Msg: TMsg;
begin
    // Create the WndProc() in our thread's context.
    if FWndProcHandle = 0 then
    begin
        FWndProcHandle := AllocateHWND(WndProc);

        // Call PeekMessage() to make sure we have a window queue.
        PeekMessage(Msg, FWndProcHandle, 0, 0, PM_NOREMOVE);
    end;

    if Self.Terminated then
    begin
        // Get rid of the WndProc().
        myDeallocateHWnd(FWndProcHandle);
    end;

    // Sleep a bit to avoid hogging the CPU.
    Sleep(5);
end;

// ---------------------------------------------------------------

procedure TWorkerThread.WndProc(Var Msg: TMessage);
begin
    // THIS CODE IS NEVER CALLED.
    try
        if Msg.Msg = WM_COPYDATA then
        begin
            // Is LParam assigned?
            if (Msg.LParam > 0) then
            begin
                // Yes.  Treat it as a copy data structure.
                with PCopyDataStruct(Msg.LParam)^ do
                begin
      ... // Here is where I do my work.
                end;
            end; // if Assigned(Msg.LParam) then
        end; // if Msg.Msg = WM_COPYDATA then
    finally
        Msg.Result := 1;
    end; // try()
end;

// ---------------------------------------------------------------

procedure TWorkerThread.myDeallocateHWnd(Wnd: HWND);
var
    Instance: Pointer;
begin
    Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));

    if Instance <> @DefWindowProc then
    begin
        // Restore the default windows procedure before freeing memory.
        SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
        FreeObjectInstance(Instance);
    end;

    DestroyWindow(Wnd);
end;

// ---------------------------------------------------------------


// ========= END  : CLASS - TWorkerThread ========================

谢谢，罗伯特

Answer 1

问题是您创建了一个窗口来接收消息，但是您没有标准的消息循环来实际从消息队列中检索消息并让目标窗口处理它们。您需要的是 Application 消息循环的等效项，其 API 形式如下所示:

while integer(GetMessage(Msg, HWND(0), 0, 0)) > 0 do begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
end;

在线程代码中执行此操作(或类似的操作)是必要的。

请注意，您的工作线程中根本不需要辅助窗口，因为线程本身可以有一个消息队列，可以通过调用 PostThreadMessage() 将消息排队到该队列中。 。这相当于标准 PostMessage()函数调用。两者都不会等待消息被处理，而是立即返回。如果这对您不起作用，那么您确实应该在线程中创建一个窗口并调用 SendMessage()为了它。然而，消息循环在所有情况下都是必要的。

由于 GetMessage() 是一个阻塞调用，因此您也不必担心“占用 CPU”，因此不需要 Sleep() 调用。