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;