Creating a Window Inside TThread

Question

im trying to send a message between 2 separate projects, but my problem is that im trying to make the receiver run inside a TThread Object, but WndProc wont work from inside an Object, must be a function, is there anyway to create a window inside a TThread that can process messages inside the thread?

here is what i mean

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;

i need to have a form so i can get its handle from another application Using FindWindow and FindWindowEx if needed

Answer 1

Running a wndproc in a background thread can be done in Win32, but it's widely regarded as a bad idea.

To do it, you must ensure that your background thread contains a message dispatch loop: GetMessage/TranslateMessage/DispatchMessage. You must ensure that the window handle you want to process messages in the background thread is created on the background thread (CreateWindow is called in the context of the background thread) and all its child windows as well. And you must ensure that your background thread calls its message loop frequently in addition to whatever else it's doing (which kinda defeats the purpose of using a background thread!)

If your background thread doesn't have a message loop, the window handles that are created on the background thread will never receive any messages, so nothing will happen.

Now then, why you shouldn't do this: Windows are message-driven, which means they are inherently a cooperatively multitasked dispatch system. Every GUI windows app has to have a message loop in the main thread to get anything done. That message loop will support virtually any number of windows, all on the main thread. A properly implemented UI will not do anything in the main thread to block execution, so the message loop will always be ready and responsive.

So if the existing message loop on the main thread will handle all your window messaging needs without blocking or freezing, why would you want to make your life more complicated by trying to run a second message loop in a background thread? There is no advantage to using a background thread.

Answer 2

Creating a window inside a TThread works fine, provided the TThread implements a message loop, AND CreateWindow() is called inside the same thread context as the message loop. In other words, you must call CreateWindow() from inside the TThread's Execute() method, NOT from inside its constructor, eg:

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 3

You don't need a Window to receive messages, try the following. In the thread (once) make a call to PeekMessage to force the creation of a Message Queue, example:

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

Then setup a Message Loop/Pump, example:

  // 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 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;