'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 |
|---|
