在 TThread 中创建一个窗口

Question

我试图在 2 个单独的项目之间发送消息，但我的问题是我试图让接收器在 TThread 对象内运行，但 WndProc 不能从对象内工作，必须是一个函数，无论如何要创建TThread 中的一个窗口，可以处理线程内的消息？

这就是我的意思

function TDataThread.WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
 Result := 0;
 case uMsg of
   WM_DATA_AVA: MessageBox(0, 'Data Avaibale', 'Test', 0);
  else Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
 end;
end;

Procedure TDataThread.Create(const Title:String);
begin
 HAppInstance := HInstance;
 with WndClass do
 begin
  Style := 0;
  lpfnWndProc := @WindowProc;          //The Error Lies here (Variable Required)
  cbClsExtra := 0;
  cbWndExtra := 0;
  hInstance := HAppInstance;
  hIcon := 0;
  hCursor := LoadCursor(0, IDC_ARROW);
  hbrBackground := COLOR_WINDOW;
  lpszMenuName := nil;
  lpszClassName := 'TDataForm';
 end;
 Windows.RegisterClass(WndClass);
 MainForm := CreateWindow('TDataForm', PAnsiChar(Title), WS_DLGFRAME , XPos, YPos, 698, 517, 0, 0, hInstance, nil);
end;

我需要一个表单，以便我可以从另一个应用程序获取它的句柄，如果需要，使用 FindWindow 和 FindWindowEx

Answer 1

在后台线程中运行 wndproc 可以在 Win32 中完成，但人们普遍认为这是一个坏主意。

为此，您必须确保您的后台线程包含消息分发循环：GetMessage/TranslateMessage/DispatchMessage。您必须确保要在后台线程中处理消息的窗口句柄是在后台线程（在后台线程的上下文中调用 CreateWindow）及其所有子窗口上创建的。而且你必须确保你的后台线程除了它正在做的任何事情之外还经常调用它的消息循环（这有点违背了使用后台线程的目的！）

如果您的后台线程没有消息循环，则在后台线程上创建的窗口句柄将永远不会收到任何消息，因此不会发生任何事情。

那么，为什么不应该这样做：Windows 是消息驱动的，这意味着它们本质上是一个协作式多任务调度系统。每个 GUI windows 应用程序都必须在主线程中有一个消息循环才能完成任何事情。该消息循环将支持几乎任意数量的窗口，所有这些都在主线程上。正确实现的 UI 不会在主线程中做任何事情来阻止执行，因此消息循环将始终准备好并响应。

因此，如果主线程上的现有消息循环将处理您所有的窗口消息传递需求而不会阻塞或冻结，那么您为什么要通过尝试在后台线程中运行第二个消息循环来使您的生活变得更加复杂呢？使用后台线程没有任何好处。

Answer 2

您不需要 Window 来接收消息，请尝试以下操作。 在线程中（一次）调用 PeekMessage 以强制创建消息队列，例如：

  // Force Message Queue Creation
  PeekMessage(Msg, 0, WM_USER, WM_USER, PM_NOREMOVE);

然后设置一个消息循环/泵，例如：

  // Run until terminated
  while not Terminated do
  begin

    if GetMessage(@Msg, 0, 0, 0) then
    begin
      case Msg.message of
        WM_DATA_AV: MessageBox(0, 'Data Avaibale', 'Test', 0); 
      else begin
        TranslateMessage(@Msg);
        DispatchMessage(@Msg);
      end;
    end;
  end;

Answer 3

如果 TThread 实现了消息循环，并且在与消息循环相同的线程上下文中调用 CreateWindow()，则在 TThread 中创建窗口可以正常工作。换句话说，您必须从 TThread 的 Execute() 方法内部调用 CreateWindow()，而不是从其构造函数内部调用，例如：

type
  TDataThread = class(TThread)
  private
    FTitle: String;
    FWnd: HWND;
    FWndClass: WNDCLASS;
    FRegistered: boolean;
    class function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; static;
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(const Title:String); reintroduce;
  end;

constructor TDataThread.Create(const Title: String); 
begin 
  inherited Create(False);
  FTitle := Title;
  with FWndClass do 
  begin 
    Style := 0; 
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0; 
    cbWndExtra := 0; 
    hInstance := HInstance; 
    hIcon := 0; 
    hCursor := LoadCursor(0, IDC_ARROW); 
    hbrBackground := COLOR_WINDOW; 
    lpszMenuName := nil; 
    lpszClassName := 'TDataForm'; 
  end; 
end; 

procedure TDataThread.Execute; 
var
  Msg: TMsg;
begin
  FRegistered := Windows.RegisterClass(FWndClass) <> 0;
  if not FRegistered then Exit;
  FWnd := CreateWindow(FWndClass.lpszClassName, PChar(FTitle), WS_DLGFRAME, XPos, YPos, 698, 517, 0, 0, HInstance, nil); 
  if FWnd = 0 then Exit;
  while GetMessage(Msg, FWnd, 0, 0) > 0 do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg)
  end;
end;

procedure TDataThread.DoTerminate;
begin
  if FWnd <> 0 then DestroyWindow(FWnd);
  if FRegistered then Windows.UnregisterClass(FWndClass.lpszClassName, HInstance);
  inherited;
end;

function TDataThread.WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result := 0;
  case uMsg of
    WM_DATA_AVA:
      MessageBox(0, 'Data Available', 'Test', 0);
  else
    Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
  end;
end; 

Answer 4

TTestLoopThread = class(TThread)
      private
        FWinHandle: HWND;
        procedure DeallocateHWnd(Wnd: HWND);
      protected
        procedure Execute; override;
        procedure WndProc(var msg: TMessage);
      public
        constructor Create;
        destructor Destroy; override;
      end;

    implementation

    var
      WM_SHUTDOWN_THREADS: Cardinal;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      WM_SHUTDOWN_THREADS := RegisterWindowMessage('TVS_Threads');
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      TTestLoopThread.Create;
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      SendMessage(wnd_broadcast, WM_SHUTDOWN_THREADS, 0, 0);
    end;

    { TTestLoopThread }

    constructor TTestLoopThread.Create;
    begin
      inherited Create(False);
    end;

    destructor TTestLoopThread.Destroy;
    begin
      inherited;
    end;

    procedure TTestLoopThread.DeallocateHWnd(Wnd: HWND);
    var
      Instance: Pointer;
    begin
      Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
      if Instance <> @DefWindowProc then
        // make sure we restore the old, original windows procedure before leaving
        SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
      FreeObjectInstance(Instance);
      DestroyWindow(Wnd);
    end;

    procedure TTestLoopThread.Execute;
    var
      Msg: TMsg;
    begin
      FreeOnTerminate := True;
      FWinHandle := AllocateHWND(WndProc); //Inside Thread
      try
      while GetMessage(Msg, 0, 0, 0) do
        begin
         TranslateMessage(Msg);
         DispatchMessage(Msg);
        end;
      finally
      DeallocateHWND(FWinHandle);
      end;
    end;

    procedure TTestLoopThread.WndProc(var msg: TMessage);
    begin
      if Msg.Msg = WM_SHUTDOWN_THREADS then
      begin
       Form1.Memo1.Lines.Add('Thread ' + IntToStr(ThreadID) + ' shutting down.');
       PostMessage(FWinHandle, WM_QUIT, 0, 0);
      end
      else
       Msg.Result := DefWindowProc(FWinHandle, Msg.Msg, Msg.wParam, Msg.lParam);
    end;