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

Answer 1

不能创建在一个出了名的线程安全的VCL形式这样，（注意 - 这不仅仅是德尔福 - 我见过的所有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. 

Answer 2

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和唐的现代版” t需要等待TForm创建完成后才允许线程继续运行，则可以使用TThread.Queue()代替：

更新：如果你想使用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;