Queue don't refresh progress bar on Firemonkey

Question

I'm using Queue to create many Forms on Delphi Application Initialization but it don't work properly.

Bellow a fragment of code

TThread.Queue(TThread.CurrentThread,
         procedure()
         begin
               Application.CreateForm(TForm1, form1);
               Application.CreateForm(TForm2, form2);
               Application.CreateForm(TForm3, form3);
               .....
               Application.CreateForm(TForm9, form9);
               Application.CreateForm(TDatamodule1, datamodule1);
         end);

I hope to show the progress of creating in a progressBar and label. For example: For each Tform finally created, I set TProgressBar.Value=TProgressBar.Value + 10, and update label.text for next Form: 'loading form2...'

The apllication works in Windows and Android. The same behaviour I see in both platform, The screen freeze and just update 'loading complete' when the process end. What I'm doing wrong?

Note: Last time I was using Synchronize, but I couldn't create Forms on TTHread context, then Synchronize was necessary to access global var Form1 and update label, which was not good idea.

The complete code,

TfrmSplash.create(Sender:TObject);
begin
TThread.Queue(TThread.CurrentThread,
         procedure()
         begin
               Application.CreateForm(TForm1, form1);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form2';
               Application.CreateForm(TForm2, form2);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form3';
               Application.CreateForm(TForm3, form3);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading form4';
               .....
               Application.CreateForm(TForm9, form9);
               TProgressBar.Value=TProgressBar.Value + 10
               Label1.text:='Loading data';
               Application.CreateForm(TDatamodule1, datamodule1);
               TProgressBar.Value:=100
               Label1.text:='100% complete';
               Sleep(200);
               frmSplash.hide;
               Form1.show;
         end);
end;

XE doesn't support Android or Firemonkey. It is sometimes useful to know what version you are using. Be precise about such details.I explained much of this at your last question. It is important for you to heed this. As for the question, we really need a clear picture of the context that this code executes in. So please provide a [mcve]. — David Heffernan, May 15 '17 at 20:34
You are wrong, Firemonkey and Android are supported since Delphi Xe2. The code works in xe7, xe5 and xe2. I will improve the code to you help me. — Ricardo da Rocha Vitor, May 15 '17 at 20:47
XE is the version before XE2. It targets Windows only. We need a [mcve]. Please provide one. — David Heffernan, May 15 '17 at 21:29
Why not simply using the "Application.Processmessage;" command ? (it depend what's done in the back ground ? and could interfer with the splashscreen ?) — ffert2907, Oct 17 '21 at 21:56

Remy Lebeau · Accepted Answer · 2017-05-15T22:06:44.837

There are two problems with your code:

you are performing all of your UI updates within a single call to TThread.Queue() without processing any new UI messages in between the updates. The main message loop is blocked until the queued procedure exits. That is why you see only your final update message being displayed and none of the intermediate messages.
note that TThread.Queue() is synchronous when called in the context of the main UI thread (please vote for RSP-15427 Add an option to let TThread.Queue() run asynchronously when called by the main UI thread). So, assuming you are creating your TfrmSplash object in the main thread and not in a worker thread, all of your UI updates will not be displayed until the TfrmSplash object is fully created.

You need to let the message queue process new messages (at least painting messages) while you are creating your objects. You can call either Application.ProcessMessages() (not recommended) or the splash form's Update() method (preferred) in between creating each object.

Try something more like this instead:

procedure TfrmSplash.Create(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Queue(nil, CreateObjects);
    end
  ).Start;
end;

procedure TfrmSplash.SetProgress(Progress: Integer; const Text: string);
begin
  TProgressBar.Value := Progress;
  Label1.Text := Text;
  //Application.ProcessMessages;
  Update;
end;

procedure TfrmSplash.CreateObjects;
begin
  SetProgress(0, 'Loading form1');
  Application.CreateForm(TForm1, form1);

  SetProgress(10, 'Loading form2');
  Application.CreateForm(TForm2, form2);

  SetProgress(20, 'Loading form3');
  Application.CreateForm(TForm3, form3);

  SetProgress(30, 'Loading form4');
  ...

  SetProgress(80, 'Loading form9');
  Application.CreateForm(TForm9, form9);

  SetProgress(90, 'Loading data');
  Application.CreateForm(TDatamodule1, datamodule1);

  SetProgress(100, '100% complete');

  Hide;
  Form1.Show;
end;

Thanks a lot. That is all I need. Indeed, processMessages is not allowed in Firemonkey, I think. — Ricardo da Rocha Vitor, May 15 '17 at 22:20

Queue don't refresh progress bar on Firemonkey

1 Answers1