在Delphi中打开表单

Question

我想从Thread创建表单的新实例(并显示它们).但似乎它冻结了我的应用程序和我的线程(我的线程变成了非同步线程,它冻结了我的应用程序).

像这样(但它不是我想要的)

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方法

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;

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.