Delphi - WndProc () in a thread never called

I had code that worked perfectly when working in the context of the main VCL thread. This code assigned it its own WndProc () to handle SendMessage () calls. Now I'm trying to move it to a background thread, because I'm worried that SendMessage () traffic affects the main VCL thread. So I created a workflow for the sole purpose of highlighting WndProc () in its Execute () thread method, to ensure that WndProc () exists in the context of the thread's execution. WndProc () processes SendMessage () calls as they arrive. The problem is that the WndProc () method of the workflow never starts.

Note. doExecute () is part of the template method that is called by my TThreadExtended class, which is a descendant of Delphi TThread. TThreadExtended implements the Execute () method and calls doExecute () in a loop. I am triple-checked and doExecute () is called repeatedly. Also note that I call PeekMessage () immediately after creating WndProc () to make sure Windows creates a message queue for the stream. However, what I am doing is wrong, since the WndProc () method never starts. Here is the code below:

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

constructor TWorkerThread.Create;
begin
    FWndProcHandle := 0;

    inherited Create(false);
end;

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

// This call is the thread Execute() method.
procedure TWorkerThread.doExecute;
var
    Msg: TMsg;
begin
    // Create the WndProc() in our thread 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 ========================

Thanks Robert

+3
source share
1 answer

, , , . , Application, API :

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

( - ) .

, , , , PostThreadMessage(). PostMessage(). , . , SendMessage(). .

GetMessage() , " ", Sleep() .

+6

Source: https://habr.com/ru/post/1740605/


All Articles