Quite some time has passed since working with multiple threads was introduced in Delphi (Delphi 2, way back in 1996). The TThread class at that time was a very lightweight wrapper around the Windows CreateThread function. Those “crazy” enough to venture into the world of parallel executing code aka multi-threaded applications know how (proper) writing and debugging of such applications can become frustrating (at least).

Some more time has passed, and in Delphi XE7, Parallel Programming Library (PPL) was introduced to simplify the efforts we have to invest when there are needs to have more tasks (a unit of work you need to get done) being executed at the same time / in parallel.

If, until “now”, you were afraid of even trying to understand how to implement parallel programming in your applications – you should not be so. I think each and every application can benefit in some way of code being executed in multiple treads. The “Using TTask from the Parallel Programming Library” from Embarcadero’s DocWiki has more than enough to get you started.

I’m not going to list examples when multi-threading can come handy – I’m certain all this is known. Also, I’m not going to repeat the words of so many who wrote articles and blog posts (here’s one and another) explaining what TTask is, how VCL is not thread safe and how you need to use some synchronization to update the UI of the application (being run in the main thread), how to wait for all tasks to finish their execution or how to speed up your loops using TParallel.For.

Cancellable Tasks (in ThreadPool) Allowing Responsive UI

What I have in my application, is the need to run to some code on a number (hundreds) of files. One file at a time would be the standard, lame, approach. That’s slow. Why not run multiple threads / tasks and have each task do what it needs to do on one of those files. If, for example, 8 (or 16 or even 100) files are being processed at the same time – the total time-length of the entire process should be much faster than the lame one by one approach!

Also, I need a way to stop the entire process if I (actually The User) decides to do so. So, I need a way to cancel the tasks that did not even started their work.

Since I might have hundreds of files to process, and I should only have up to some number of tasks (files) being executed at the same time, I need a thread pool. A thread pool maintains multiple threads waiting for tasks to finish so the “next” task can be run in the idle thread. Thread pool ensures your X tasks are executed in only Y threads at once (makes sense when X > Y).

All the above is doable using Delphi’s PPL and the TTask/ TThreadPool classes in the System.Threading unit.

Cancellable Tasks With Progress Dialog

Further, while my tasks are being executed, the user should not be able to click on any other UI elements except some kind of “Cancel” button. So, the main UI must not freeze but must also not allow the user to click various buttons while tasks are run.

Yes, of course, I also need some kind of progress bar being displayed to the user (and updated) so the user has the feeling of how long until all done.

Ok, now that all that is needed is known, here’s my idea:

– Have a form that will be displayed as a modal dialog including a progress bar and the “Cancel” button. Why modal? When a modal window is displayed – the user cannot click nor do any actions in the application except in that window. When the modal form is shown, “the application can’t continue to run until the modal form is closed”. Yes, can not continue to run in its main thread, but I will have tasks being run in different threads:
– Run a list of tasks
– Show the modal form, update its progress and watch (/wait) for “all tasks done” or signal to cancel.

So, without further ado, here’s the code:

First the less interesting part: the progress form, not auto created, is TProgressForm (the “pf” var in ModalProgressTasksClick) has a button (btnCancel) and TProgressBar (runProgress):

constructor TProgressForm.Create(const numberOfTasks: integer);
begin
  inherited Create(nil);

  runProgress.Position := 0;
  runProgress.Min := 0;
  runProgress.Step := 1;
  runProgress.Max := numberOfTasks;
end;

procedure TProgressForm.btnCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

function TProgressForm.ExecuteModal(const tasksToGo: integer) : TModalResult;
begin
  if tasksToGo = 0 then
    result := mrIgnore
  else
    result := ShowModal;
end;

procedure TProgressForm.ProgressStep;
begin
  runProgress.StepIt;
end;

Then, the more interesting part:

procedure TTasksForm.ModalProgressTasksClick(Sender: TObject);
const
  NumberOfTasks = 42;
var
  i : integer;
  pf : TProgressForm;
  aTask : ITask;
  tasks : TList<ITask>;
  mrResult : TModalResult;
  taskCount : integer;
  tasksDone : integer;
begin
  Caption := NumberOfTasks.ToString() + ' tasks to do...';

  infoMemo.Clear;

  taskCount := NumberOfTasks;

  TThreadPool.Default.SetMaxWorkerThreads(TThread.ProcessorCount); //TThread.ProcessorCount is minimum

  infoMemo.Lines.Add('Max threads: ' + TThreadPool.Default.MaxWorkerThreads.ToString);

  tasks := TList<ITask>.Create;
  pf := TProgressForm.Create(taskCount);
  try
    for i := 1 to NumberOfTasks do
    begin
      tasks.Add(TTask.Run(
        procedure
        var
          tID : integer;
          sleepTime : Cardinal;
        begin
          sleepTime := 500 * (1 + Random(3));
          Sleep(sleepTime);

          tID := GetCurrentThreadId;

          TThread.Queue(TThread.Current,
            procedure
            begin
              if Assigned(pf) then pf.ProgressStep;

              infoMemo.Lines.Add(Format('Slept for %d in thread %d', [sleepTime, tID]));
            end);

          TInterlocked.Decrement(taskCount);

          if (taskCount <= 0) AND Assigned(pf) AND (fsModal in pf.FormState) then pf.ModalResult := mrOk;
        end));
    end;

    mrResult := pf.ExecuteModal(taskCount);

    if mrResult = mrCancel then
    begin
      tasksDone := 0;

      for aTask in tasks do
        if aTask.Status = TTaskStatus.Completed then
          Inc(tasksDone)
        else
          aTask.Cancel;

      TTask.WaitForAll(tasks.ToArray); //those running when cancel requested

      ShowMessage (Format('Canceled. Tasks done: %d / %d', [tasksDone, NumberOfTasks]));
    end
    else if mrResult = mrIgnore then
      ShowMessage ('All done before progress dialog displayed')
    else
      ShowMessage ('All done')
  finally
    tasks.Free;
    FreeAndNil(pf);
  end;
end; 

The form where this happens (TTasksForm) has a TMemo (infoMemo). I think (/hope) the code is self-explanatory, so I’m not going to repeat it in words.

Now, the above implementation using a modal dialog to act as tasks.WaitForAll (and show progress) might look weird, but works as needed, so weird is ok.

Disclaimer: the above is a proof of concept. There’s more code to be included for the idea to work without flaws (like catching the EOperationCanceled when TTask.WaitForAll(tasks.ToArray)).

Your thoughts on how to have a progress with cancel option without being able to click on anything else while tasks running?