Создание окна внутри TThread

Question

я пытаюсь отправить сообщение между двумя отдельными проектами, но моя проблема в том, что я пытаюсь заставить получателя работать внутри объекта 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 управляется сообщениями, что означает, что они по своей природемногозадачная система диспетчеризации.Каждое приложение с графическим интерфейсом должно иметь цикл сообщений в главном потоке, чтобы что-то сделать.Этот цикл сообщений будет поддерживать практически любое количество окон, все в основном потоке.Правильно реализованный пользовательский интерфейс не будет ничего делать в главном потоке, чтобы блокировать выполнение, поэтому цикл сообщений всегда будет готов и отзывчив.

Так что, если существующий цикл сообщений в главном потоке будет обрабатывать все ваши потребности обмена сообщениями в окнебез блокировки или замораживания, почему вы хотите усложнить свою жизнь, пытаясь запустить второй цикл сообщений в фоновом потоке?Использование фонового потока не дает никаких преимуществ.

Answer 2

Создание окна внутри TThread работает нормально, при условии, что TThread реализует цикл сообщений, а CreateWindow () вызывается в том же контексте потока, что и цикл сообщений. Другими словами, вы должны вызывать CreateWindow () из метода Execute () TThread, а не из его конструктора, например:

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

Вам не нужно окно для получения сообщений, попробуйте следующее. В потоке (один раз) сделайте вызов 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 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;