Tworzenie okna wewnątrz TThread

Question

próbuję wysłać wiadomość między 2 oddzielnymi projektami, ale moim problemem jest to, że próbuję uruchomić odbiornik wewnątrz obiektu TThread, ale WndProc nie będzie działał z wnętrza obiektu, musi być funkcją, czy mimo to tworzy się okno wewnątrz TThread, które może przetwarzać wiadomości wewnątrz wątku?

tutaj jest to, co mam na myśli

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; 

muszę mieć formę więc mogę dostać jego uchwyt z innej aplikacji za pomocą FindWindow i FindWindowEx razie potrzeby

Answer 1

Prowadzenie WndProc w wątku tła mogą być wykonane w Win32, ale jest powszechnie uważane za zły pomysł.

Aby to zrobić, należy się upewnić, że wątek w tle zawiera pętlę wysyłki komunikatu: GetMessage/TranslateMessage/DispatchMessage. Musisz upewnić się, że uchwyt okna, który chcesz przetwarzać wiadomości w wątku tła, jest tworzony w wątku tła (CreateWindow jest wywoływany w kontekście wątku tła) i wszystkich jego okien potomnych. Musisz też upewnić się, że wątek w tle często wywołuje pętlę komunikatów, niezależnie od tego, co robi (co w pewnym sensie pokonuje cel użycia wątku podstawowego).

Jeśli twój wątek tła nie ma pętli komunikatów, uchwyty okien tworzone na wątku tła nigdy nie otrzymają żadnych wiadomości, więc nic się nie stanie.

Teraz, dlaczego nie powinieneś tego robić: Windows jest sterowany komunikatami, co oznacza, że ​​są one z natury systemami wielozadaniowymi współpracującymi ze sobą. Każda aplikacja Windows GUI musi mieć pętlę wiadomości w głównym wątku, aby cokolwiek zrobić. Ta pętla komunikatów obsługuje praktycznie dowolną liczbę okien, wszystkie w głównym wątku. Poprawnie zaimplementowany interfejs użytkownika nie zrobi nic w głównym wątku, aby zablokować wykonanie, więc pętla komunikatów będzie zawsze gotowa i reaguje.

Więc jeśli istniejąca pętla komunikatów w głównym wątku obsłuży wszystkie potrzeby związane z wiadomościami w oknie bez blokowania lub zamrożenia, dlaczego chcesz uczynić swoje życie bardziej skomplikowanym, próbując uruchomić drugą pętlę wiadomości w wątku tła? Nie ma korzyści z używania wątku tła.

Answer 2

Do odbierania wiadomości nie jest potrzebne okno, spróbuj wykonać następujące czynności. w wątku (raz) zatelefonować do PeekMessage wymusić utworzenie Message Queue, np:

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

a Konfiguracja Wiadomość Pętla/Pump, przykład:

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

Tworzenie okna wewnątrz TThread działa dobrze, pod warunkiem, że TThread implementuje pętlę komunikatów, AND CreateWindow() jest wywoływana wewnątrz tego samego kontekstu wątku, co pętla komunikatów. Innymi słowy, należy wywołać CreateWindow() od wewnątrz metoda TThread za execute(), a nie od wewnątrz konstruktora, np:

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;