从另一个线程延迟设置鼠标光标
Setting mouse cursor with a delay from another thread
我的主线程中有一些工作要做,有时会持续超过几秒钟。发生这种情况时,我想将鼠标光标更改为忙碌状态(沙漏,在整个主窗体上)。但这必须延迟完成(比如 250 毫秒),因为大部分时间工作时间较短,而且过于频繁地更改光标很烦人。我不能从主线程执行此操作,因为它显然正忙于做其他事情。所以我想从另一个线程来做。但是……惊喜!从线程设置 Screen.Cursor:= crHourGlass
不起作用。我认为 Screen
对象只能从主线程访问。当主线程很忙时,我无法与主线程同步任何内容...关于如何使其工作的任何想法?
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.
您必须使用创建 window 的线程设置光标。我建议更改您的设计并将主线程正在完成的工作放入可以由主线程监视的工作线程(可能使用计时器或由发出 Synchronize
调用的工作线程)。你的主线程不应该放弃保持程序 运行 和响应的消息循环。所以一般来说,你的主线程应该不断地监听和处理发送给它的系统消息。如果有任何工作可能需要一些时间将其放入工作线程。
要使 Synchronise
方法工作,主线程必须处于空闲状态 - 等待 Synchronise
在消息循环中被拾取。
我的主线程中有一些工作要做,有时会持续超过几秒钟。发生这种情况时,我想将鼠标光标更改为忙碌状态(沙漏,在整个主窗体上)。但这必须延迟完成(比如 250 毫秒),因为大部分时间工作时间较短,而且过于频繁地更改光标很烦人。我不能从主线程执行此操作,因为它显然正忙于做其他事情。所以我想从另一个线程来做。但是……惊喜!从线程设置 Screen.Cursor:= crHourGlass
不起作用。我认为 Screen
对象只能从主线程访问。当主线程很忙时,我无法与主线程同步任何内容...关于如何使其工作的任何想法?
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.
您必须使用创建 window 的线程设置光标。我建议更改您的设计并将主线程正在完成的工作放入可以由主线程监视的工作线程(可能使用计时器或由发出 Synchronize
调用的工作线程)。你的主线程不应该放弃保持程序 运行 和响应的消息循环。所以一般来说,你的主线程应该不断地监听和处理发送给它的系统消息。如果有任何工作可能需要一些时间将其放入工作线程。
要使 Synchronise
方法工作,主线程必须处于空闲状态 - 等待 Synchronise
在消息循环中被拾取。