logo标签列表

在TThread中创建一个窗口

delphidelphi-7
6
我正在尝试在两个不同的项目之间发送消息，但我的问题是我想让接收器在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进行查找。

4个回答
11
在Win32中可以在后台线程中运行wndproc，但这被普遍认为是一个不好的主意。要做到这一点，您必须确保您的后台线程包含一个消息分发循环：GetMessage / TranslateMessage / DispatchMessage。您必须确保您想要在后台线程中处理消息的窗口句柄是在后台线程上创建的（CreateWindow在后台线程的上下文中调用）以及所有它的子窗口也是如此。此外，您必须确保您的后台线程经常调用其消息循环，除了它正在执行的其他任何操作之外（这有点破坏了使用后台线程的目的！）
如果您的后台线程没有消息循环，则在后台线程上创建的窗口句柄将永远不会收到任何消息，因此什么也不会发生。
那么，为什么不应该这样做呢：窗口是消息驱动的，这意味着它们本质上是一种协作式多任务分发系统。每个GUI窗口应用程序都必须在主线程上具有消息循环才能完成任何工作。该消息循环将支持几乎任何数量的窗口，所有这些窗口都在主线程上。正确实现的UI不会在主线程上执行任何阻止执行的操作，因此消息循环将始终准备好并响应。
因此，如果主线程上的现有消息循环可以处理所有窗口消息需求而不会阻塞或冻结，则为什么要通过尝试在后台线程中运行第二个消息循环来使生活更加复杂呢？使用后台线程没有任何优势。
1
作为建议，让主线程获取消息并在有新数据可处理时向工作线程发出信号。 - jachguate
1
既然您提到其他进程发送回复以指示数据已准备就绪，您也可以考虑为每个进程/线程对使用一个命名的互斥对象。线程启动进程并传递互斥对象的名称作为参数，然后线程会阻塞等待互斥对象发出信号。当工作完成时，进程获取该命名互斥对象并发出信号。无需消息循环。（前提是您能够控制进程和线程的源代码）。 - dthorpe
1
@mghie：是的，Windows中的所有线程都是平等的。然而，并非所有程序员都是如此。如果有一种解决方案可以在不过多使用线程的情况下完成工作，请使用它。如果有一种解决方案可以在同一句话中不使用线程绑定窗口句柄、后台线程和COM来完成工作，那就更好了。人们像飞蛾扑火一样被线程吸引，结果也类似。 - dthorpe
进程向线程发送哪个消息编号来指示数据已经准备好？ - dthorpe
@mghie：线程有很多适当的用法，这是毋庸置疑的。我只是发现人们会过早地跳入线程中，并使问题变得更加复杂。对于一个合适的问题，经过正确设计的多线程解决方案是一件美妙的事情，同样也很少见。 - dthorpe
显示剩余10条评论
7

在TThread中创建一个窗口是可行的，前提是TThread实现了消息循环，并且CreateWindow()函数也在相同的线程上下文中被调用。换句话说，你必须从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;
@JerryDodge，我展示的代码中没有任何需要为新版本 Delphi 更改的内容。如果 GetMessage() 函数冻结，则窗口的消息队列中没有可用的消息。请再次检查发布代码是否失败，或者第一个消息处理程序是否在做某些事情来吞噬第二个消息。 - Remy Lebeau
请原谅我在没有提出问题的情况下试图得到答案 :-) 我正在尝试在实际提问之前寻找所有可能的解决方案。 - Jerry Dodge
@Remy确实如此，但它无法编译，所以它迫使我进行了更改。此外，我还不得不将UnregisterClass更改为Winapi.Windows.UnregisterClass(PChar(Self.ClassName), FWndClass.hInstance);。 - Jerry Dodge
1
@JerryDodge BOOL是一个4字节的整数（在Delphi中为LongBool）。GetMessage()能够返回-1、0和>0，但-1很少见。AllocateHWnd()不是线程安全的，因此直接使用CreatWindow()。GetMessage()只能返回由PostMessage()和PostThreadMessage()发送的消息（尽管它需要用于跨线程边界分派由SendMessage()发送的已发送消息）。WM_POWERBROADCAST不是一个已发布的消息，因此消息循环将无法看到它，您需要一个窗口过程来处理它。 - Remy Lebeau
谢谢，您能详细说明一下我的问题吗？https://dev59.com/LJ_ha4cB1Zd3GeqP6-og - Jerry Dodge
显示剩余6条评论
4
你不需要一个窗口来接收消息，尝试以下方法。在线程中（仅一次）调用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;
是的，但我怎么知道这个线程的句柄以便向其发送消息呢？因为发送者来自另一个进程。 - killercode
使用PostThreadMessage（http://msdn.microsoft.com/en-us/library/ms644946（VS.85）.aspx），它需要ThreadId而不是Window Handle。 - Remko
1
但是，您会遇到发送应用程序需要定位接收线程ID的问题。使用窗口可以使搜索变得更容易。 - Remy Lebeau
0
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;
AlocateHWND()，DeallocateHWND()，MakeObjectInstance()，FreeObjectInstance() - 这些函数不是线程安全的，因为它们使用全局资源，这些资源没有受到跨线程并发访问的保护。主线程相当广泛地使用这些函数，因此也使用它们的不安全工作线程可能会使它们混乱不堪。话虽如此，有第三方自定义实现在浮动，这些实现是线程安全的。否则，请根本不要使用它们，而是直接使用Win32 API函数调用（CreateWindow()，SetWindowLong()），这些函数在工作线程中可以正常工作。 - Remy Lebeau
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接