'Setting mouse cursor with a delay from another thread

I have some work to do in my main thread that sometimes last longer than a few seconds. I want to change the mouse cursor to a busy state (hourglass, over the whole main form) when that happens. But this must be done with a delay (say 250 ms), because most of the time the work is shorter and changing the cursor too often is annoying. I cannot do this from the main thread because it is obviously busy doing something else. So I thought to do it from another thread. But... surprise ! Setting Screen.Cursor:= crHourGlass from a thread does not work. I think the Screen object is meant to be accessed only from the main thread. I cannot synchronize anything with the main thread while it is busy... Any ideas on how to make it work ?

unit MouseCursor;

interface

uses
  System.Classes, Winapi.Windows;

type
  TMouseCursor = class(TThread)
  private type
    TCommand = (cmdSetBusy = $FB45BA57,cmdSetDone = $C75F1D29);
  private
    hResume: THandle;
    Command: TCommand;
    TimeOut: Cardinal;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure Busy;
    procedure Done;
  end;

implementation

uses
  Vcl.Forms, Vcl.Controls;

const
  BusyDelay  = 250;

{ TMouseCursor }

constructor TMouseCursor.Create;
begin
 inherited Create(False);
 FreeOnTerminate:= True;
 hResume:= CreateEvent(nil, False, False, nil);
end;

destructor TMouseCursor.Destroy;
begin
 CloseHandle(hResume);
 inherited;
end;

procedure TMouseCursor.TerminatedSet;
begin
 Command:= cmdSetDone;
 inherited;
 SetEvent(hResume);
end;

procedure TMouseCursor.Busy;
begin
 Command:= cmdSetBusy;
 SetEvent(hResume);
end;

procedure TMouseCursor.Done;
begin
 Command:= cmdSetDone;
 SetEvent(hResume);
end;

procedure TMouseCursor.Execute;
var WaitRes: Cardinal;
begin
 TimeOut:= INFINITE;
 repeat
  WaitRes:= WaitForSingleObject(hResume, TimeOut);
  case WaitRes of
   WAIT_TIMEOUT : begin Screen.Cursor:= crHourGlass; TimeOut:= INFINITE; end;
   WAIT_OBJECT_0: case Command of
     cmdSetBusy: TimeOut:= BusyDelay;
     cmdSetDone: begin Screen.Cursor:= crDefault; TimeOut:= INFINITE; end;
   end;
  end;
 until Terminated;
end;

end. 


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source