Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Thread open forms in Delphi

I want to create new instances of form(and show them) from a Thread. But it seems that it freeze my application and my thread(my thread becomes an non syncrhonization thread, and it freeze my aplication).

Like this(but it doesn't make what i am 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 don't want to use Classes.TThread.Synchronize method

like image 208
user558126 Avatar asked Mar 15 '12 12:03

user558126


1 Answers

TThread.Synchronize() is the simplest 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 don't need to wait for the TForm creation to complete before letting the thread move on, you could 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 post your messages to either the TApplication window or a dedicated window created via AllocateHWnd(), eg:

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;
like image 198
Remy Lebeau Avatar answered Sep 19 '22 22:09

Remy Lebeau