Open Forms in Delphi

Question

I want to create new instances of the form (and show them) from Thread. But it seems that it freezes my application and my thread (my thread becomes a non-sync thread, and it freezes my application).

Like this (but it doesn't do what I'm looking for)

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; 

I do not want to use the Classes.TThread.Synchronize method

Answer 1

You cannot create the notorious thread-unsafe form of VCL in this way (note - this is not only Delphi - all GUI work that I have seen has this limitation). Either use TThread.Synchronize to signal the main thread to create the form, or use some other signaling mechanism such as the PostMessage () API.

In general, it is best to try to save the contents of the GUI from secondary threads as much as possible. Secondary streams are best used for I / O without using a graphical interface (GUI) and / or CPU (especially if they can be split and executed in parallel).

PostMessage example (there is only one speed on it):

 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() is the easiest solution:

 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; 

If you are using a modern version of Delphi and you do not need to wait for TForm to complete before allowing the thread to move on, you can use TThread.Queue() instead:

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

Update:. If you want to use PostMessage() , the safest option is to send your messages to the TApplication window or to the highlighted window created using AllocateHWnd() , for example:

 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;