在Delphi中打开线程表单

Question

我想从一个线程中创建并显示表单的新实例。但似乎这会冻结我的应用程序和线程(我的线程变成了非同步线程，并且冻结了我的应用程序)。

就像这样(但它并不能达到我想要的效果)

procedure a.Execute;
var frForm:TForm;
    B:TCriticalSection;
begin
   b:=TCriticalSection.Create;
   while 1=1 do
   begin
     b.Enter;

        frForm:=TForm.Create(Application);
        frForm.Show;
     b.Leave;
     sleep(500); //this sleep with sleep my entire application and not only the thread.
      //sleep(1000);
   end;
end;

我不想使用Classes.TThread.Synchronize方法。

- user558126

---

不要那样做。如果你想从除主线程外的其他线程创建表单，请发送例如消息到现有窗口，当它接收到消息时创建新的表单。 - TLama

我理解，但是没有其他的方法吗？ - user558126

为什么需要另一个方法？ - J...

有两种可能性，TThread.Synchronize和PostMessage()。其中一种效果不佳且简单，另一种效果良好但复杂。选择你的毒药吧。 - Martin James

不要忘记使用TThread.Queue()，它类似于PostMessage()的TThread等效方式，而无需窗口。 - Remy Lebeau

是的，我看过TThread.Queue。我会研究一下，但我并不抱太大希望。它需要TThread实例这一事实令人担忧。我几乎能闻到大量线程微观管理的味道。如果证明我错了，我会很高兴，但Delphi线程支持的历史并不理想。 - Martin James

Answer 1

TThread.Synchronize()是最简单的解决方案：

procedure a.Execute;
begin
  while not Terminated do
  begin
    Synchronize(CreateAndShowForm);
    Sleep(500);
  end;
end;

procedure a.CreateAndShowForm;
var
  frForm:TForm;
begin
  frForm:=TForm.Create(Application);
  frForm.Show;
end;

如果你正在使用现代版本的Delphi并且不需要等待TForm创建完成后才能让线程继续，那么你可以使用TThread.Queue()。

procedure a.Execute;
begin
  while not Terminated do
  begin
    Queue(CreateAndShowForm);
    Sleep(500);
  end;
end;

更新：如果您想使用PostMessage()，最安全的选项是将消息发布到TApplication窗口或通过AllocateHWnd()创建的专用窗口，例如：

const
  WM_CREATE_SHOW_FORM = WM_USER + 1;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TMainForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  frForm:TForm;
begin
  if Msg.message = WM_CREATE_SHOW_FORM then
  begin
    Handled := True;
    frForm := TForm.Create(Application);
    frForm.Show;
  end;
end;

procedure a.Execute;
begin
  while not Terminated do
  begin
    PostMessage(Application.Handle, WM_CREATE_SHOW_FORM, 0, 0);
    Sleep(500);
  end;
end;

.

const
  WM_CREATE_SHOW_FORM = WM_USER + 1;

var
  ThreadWnd: HWND = 0;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ThreadWnd := AllocateHWnd(ThreadWndProc);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DeallocateHwnd(ThreadWnd);
  ThreadWnd := 0;
end;

procedure TMainForm.ThreadWndProc(var Message: TMessage);
var
  frForm:TForm;
begin
  if Message.Msg = WM_CREATE_SHOW_FORM then
  begin
    frForm := TForm.Create(Application);
    frForm.Show;
  end else
    Message.Result := DefWindowProc(ThreadWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure a.Execute;
begin
  while not Terminated do
  begin
    PostMessage(ThreadWnd, WM_CREATE_SHOW_FORM, 0, 0);
    Sleep(500);
  end;
end;

- Remy Lebeau

---

+1.2 对于队列，-0.5 对于同步。如果你有一个 postmessage 的例子，我会给你更多的赞 :-) - Johan

如果你使用的 Delphi 版本有 TThread.Queue()，那么为什么还要使用 PostMessage() 呢？它们都能实现相同的功能，但是与 PostMessage() 不同，Queue() 不需要像 PostMessage() 那样需要一个 HWND。如果你使用 PostMessage()（甚至是 PostThreadMessage()），你必须编写额外的代码在主线程中处理该请求。而使用 Queue()，代码保持在线程类中，你不必修改主线程代码。 - Remy Lebeau

谢谢Remy，您的评论非常有启迪性。在+1的投票中，您的帖子被低估了很多。我现在将离开并研究“tthread.queue”的源代码。 - Johan

Answer 2

以这种方式创建臭名昭著的线程不安全 VCL 表单是不可行的，（请注意 - 不仅限于 Delphi - 所有我见过的 GUI 开发都有此限制）。要么使用 TThread.Synchronize 信号主线程来创建表单，要么使用其他信号机制，如 PostMessage() API。

总体而言，尽可能将 GUI 相关内容保持在主线程之内。次要线程最好用于非 GUI I/O 和/或 CPU 密集型操作（尤其是如果可以分割并并行执行）。

PostMessage 示例（该表单只包含一个 SpeedButton）：

unit mainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons;

const
  CM_OBJECTRX=$8FF0;

type
  EmainThreadCommand=(EmcMakeBlueForm,EmcMakeGreenForm,EmcMakeRedForm);

  TformMakerThread = class(TThread)
  protected
    procedure execute; override;
  public
    constructor create;
  end;

  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
  private
    myThread:TformMakerThread;
  protected
    procedure CMOBJECTRX(var message:Tmessage); message CM_OBJECTRX;
  end;

var
  Form1: TForm1;
  ThreadPostWindow:Thandle;

implementation


{$R *.dfm}

{ TForm1 }

procedure TForm1.CMOBJECTRX(var message: Tmessage);
var thisCommand:EmainThreadCommand;

  procedure makeForm(formColor:integer);
  var newForm:TForm1;
  begin
    newForm:=TForm1.Create(self);
    newForm.Color:=formColor;
    newForm.Show;
  end;

begin
  thisCommand:=EmainThreadCommand(message.lparam);
  case thisCommand of
    EmcMakeBlueForm:makeForm(clBlue);
    EmcMakeGreenForm:makeForm(clGreen);
    EmcMakeRedForm:makeForm(clRed);
  end;
end;

function postThreadWndProc(Window: HWND; Mess, wParam, lParam: Longint): Longint; stdcall;
begin
  result:=0;
  if (Mess=CM_OBJECTRX) then
  begin
    try
      TControl(wparam).Perform(CM_OBJECTRX,0,lParam);
      result:=-1;
    except
      on e:exception do application.messageBox(PChar(e.message),PChar('PostToMainThread perform error'),MB_OK);
    end;
  end
    else
      Result := DefWindowProc(Window, Mess, wParam, lParam);
end;

var
  ThreadPostWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @postThreadWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TpostThreadWindow');

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  TformMakerThread.create;
end;

{ TformMakerThread }

constructor TformMakerThread.create;
begin
  inherited create(true);
  freeOnTerminate:=true;
  resume;
end;

procedure TformMakerThread.execute;
begin
  while(true) do
  begin
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeBlueForm));
    sleep(1000);
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeGreenForm));
    sleep(1000);
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeRedForm));
    sleep(1000);
  end;
end;

initialization
  Windows.RegisterClass(ThreadPostWindowClass);
  ThreadPostWindow:=CreateWindow(ThreadPostWindowClass.lpszClassName, '', 0,
      0, 0, 0, 0, 0, 0, HInstance, nil);
finalization
  DestroyWindow(ThreadPostWindow);
end.

- Martin James

---

哦 - 我错过了那个“我不想使用Classes.TThread.Synchronize方法”的内容 - 我也是！向主线程发送PostMessage请求，在消息处理程序中创建表单。 - Martin James

谢谢，那我会使用TThread.Synchronize方法来解决我的问题。 - user558126

这意味着，亲爱的userX，你实际上根本没有使用线程。 - Warren P

@Martin；你的想法是在主线程中发送后续消息，然后从UI处理程序对象创建并显示表单，这似乎是正确的方法。TThread.Synchronize经常被新手误解为某种魔法酱，而不是在前台线程上下文中执行代码并冻结后台线程的东西。 - Warren P

Answer 3

只需使用 "TThread.Synchronize" 静态方法，因为它是静态和公共的，所以甚至可以在线程外部使用

TThread.Synchronize(MyThread, procedure begin Myform.Show(); end);

至少在这个事件中，如果 "MyForm.DoubleBuffered:=true;"，你将不会有同步问题，但任何东西都可以调用 "Application.ProcessMessages();" 方法。

- RoCkHeLuCk