Show activity indicator while the main thread is blocked (continue)

Question

Continue with previous question I want to be able to show some activity indicator even if the main thread is blocked. (based on this article).

Problems

Answer 1

Canvas does not allow drawing. Exception In the line:

FBitmap.StretchDraw(Rect(Left, ImageRect.Top, Right, ImageRect.Bottom), FfgPattern)

Is caused by the fact that TBitmap canvas is not thread safe unless you lock it (even in the main UI thread). in my experience even if you do Lock the canvas in a worker thread it's DC might be freed by Graphics.pas Garbage collection/GDI caching, while messages are processed in the main UI TWinControl.MainWndProc. Every bitmap canvas that is being accessed needs to be locked including FBitmap + FbkPattern + FfgPattern in my code.

See FreeMemoryContexts in Graphis.pas:

{ FreeMemoryContexts is called by the VCL main winproc to release
  memory DCs after every message is processed (garbage collection).
  Only memory DCs not locked by other threads will be freed.
}

Possible solution is NOT using TBitmap.Canvas directly and use a CreateCompatibleDC as described here: How to load images from disk in background (multiple threads) [AKA: TBitmap is not thread-safe] or lock every TCanvas you use.

More references:
How threadsafe is TBitmap
GDI handle leak using TGIFImage in a second thread
QC: TJPEGImage.Draw() is not thread safe

---

The code that worked for me insured every TBitmap.Canvas is being locked in the worker thread context:
Working TAnimationThread
This works solid whether the main UI thread is blocked or not.

procedure TForm1.Button1Click(Sender: TObject);
var
  at1, at2, at3, at4, at5: TAnimationThread;
begin
  at1 := TAnimationThread.Create(Panel1, Panel1.ClientRect, 10);
  at2 := TAnimationThread.Create(Panel2, Panel2.ClientRect, 10);
  at3 := TAnimationThread.Create(Panel3, Panel3.ClientRect, 10);
  at4 := TAnimationThread.Create(Panel4, Panel4.ClientRect, 10);
  at5 := TAnimationThread.Create(Panel5, Panel5.ClientRect, 10);
  // Sleep(5000); // do some work for 5 seconds, block main thread
  // at1.Terminate; at2.Terminate; at3.Terminate; at4.Terminate; at5.Terminate;
end;

Now, if I omit for example locking FfgPattern.Canvas.Lock;, the DC of the TBitmaps is being killed while I move the UI form (in case where I do NOT block the main thread i.e not Sleeping for 5 seconds and not terminating the threads).

My conclusions:

1. "you cannot draw on a VCL control from anything but the main thread" (From the comments). Not true! Any main VCL windowed control DC can bee accessed from a worker thread without any problems (in fact, many applications draw directly to the Desktop window DC for example).

2. TBitmap canvas is thread safe if you know where/when to lock it.

3. Since I'm not sure where/when to lock it, better NOT to use TBitmap canvas in a worker thread. use API bitmap manipulations, use CreateCompatibleDC/CreateBitmap; TWICImage which stands on top of Windows Imaging Components. TBitmap garbage collection is evil!

4. I do not recommend this method. a better method would be to create a pure API Window in the context of the worker thread and show activity indicator there e.g. Displaying splash screen in Delphi when main thread is busy

5. The best approach (as already mentioned in the comments) is to do the hard work in a worker thread and show activity indicator in the main UI tread while the worker thread is working.

Answer 2

Initially this always crashed. Then I found the solution:

1) Wrap the while loop inside a try-finally structure with FBitmap.Canvas.Lock;:

FBitmap.Canvas.Lock;
try
  while not Terminated do
  begin
    with FBitmap.Canvas do
    begin
      StretchDraw(FImageRect, FbkPattern);
      case State of
        incRight:
          begin
            Inc(Right, Increment);
            if Right > FImageRect.Right then
            begin
              Right := FImageRect.Right;
              Inc(State);
            end;
          end;
        incLeft:
          begin
            Inc(Left, Increment);
            if Left >= Right then
            begin
              Left := Right;
              Inc(State);
            end;
          end;
        decLeft:
          begin
            Dec(Left, Increment);
            if Left <= 0 then
            begin
              Left := 0;
              Inc(State);
            end;
          end;
        decRight:
          begin
            Dec(Right, Increment);
            if Right <= 0 then
            begin
              Right := 0;
              State := incRight;
            end;
          end;
      end;

      StretchDraw(Rect(Left, FImageRect.Top, Right, FImageRect.Bottom), FfgPattern);
    end; { with }

    // Synchronize(PaintTargetWindow); // not painting when the main thread is blocked
    PaintTargetWindow;

    SleepEx(FInterval, False);
  end; { While }
finally
  FBitmap.Canvas.Unlock;
end;

2) In FormCreate of your application call this procedure:

procedure DisableProcessWindowsGhosting;
var
  DisableProcessWindowsGhostingProc: procedure;
begin
  DisableProcessWindowsGhostingProc := GetProcAddress(GetModuleHandle('user32.dll'), 'DisableProcessWindowsGhosting');
  if Assigned(DisableProcessWindowsGhostingProc) then
    DisableProcessWindowsGhostingProc;
end;

Now it works perfectly - never crashed so far! Delphi XE2, Win7 x64

Answer 3

Again, the only threadsafe way to draw on a window is to draw from the same thread that created a window; anything else is unsafe.

As a possible explanation why your code worked well with old Windows versions and does not work with modern versions read this The Old New Thing article.