屏幕.光标在Firemonkey中

Question

在Delphi6中，我可以使用Screen.Cursor:更改所有表单的鼠标光标

procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
end;

我正在Firemonkey中搜索等价物。

以下功能不起作用：

procedure SetCursor(ACursor: TCursor);
var
  CS: IFMXCursorService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
  begin
    CS := TPlatformServices.Current.GetPlatformService(IFMXCursorService) as IFMXCursorService;
  end;
  if Assigned(CS) then
  begin
    CS.SetCursor(ACursor);
  end;
end;

当我在过程结束时插入Sleep(2000);时，我可以看到光标2秒钟。但是接口可能会被释放，因此，光标会在过程结束时自动重新设置。我还尝试将CS定义为全局变量，并在过程的末尾添加CS._AddRef，以防止释放接口。但这也无济于事。

以下代码确实有效，但仅适用于主窗体：

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.MainForm.Cursor := crHourGlass;
end;

由于我想更改所有表单的光标，我需要遍历所有表单，但回滚到以前的光标很棘手，因为我需要知道每个表单的前一个光标。

我的意图：

procedure TForm1.Button1Click(Sender: TObject);
var
  prevCursor: TCursor;
begin
  prevCursor := GetCursor;
  SetCursor(crHourglass); // for all forms
  try
    Work;
  finally
    SetCursor(prevCursor);
  end;
end;

Answer 1

您必须实现自己的游标服务，以便强制执行某个游标。

unit Unit2;
interface
uses
  FMX.Platform, FMX.Types, System.UITypes;
type
  TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  private
    class var FPreviousPlatformService: IFMXCursorService;
    class var FWinCursorService: TWinCursorService;
    class var FCursorOverride: TCursor;
    class procedure SetCursorOverride(const Value: TCursor); static;
  public
    class property CursorOverride: TCursor read FCursorOverride write SetCursorOverride;
    class constructor Create;
    procedure SetCursor(const ACursor: TCursor);
    function GetCursor: TCursor;
  end;
implementation
{ TWinCursorService }
class constructor TWinCursorService.Create;
begin
  FWinCursorService := TWinCursorService.Create;
  FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned
  TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;
function TWinCursorService.GetCursor: TCursor;
begin
  result :=  FPreviousPlatformService.GetCursor;
end;
procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
  if FCursorOverride = crDefault then
  begin
    FPreviousPlatformService.SetCursor(ACursor);
  end
  else
  begin
    FPreviousPlatformService.SetCursor(FCursorOverride);
  end;
end;

class procedure TWinCursorService.SetCursorOverride(const Value: TCursor);
begin
  FCursorOverride := Value;
  TWinCursorService.FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end.

主机：

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  TWinCursorService.CursorOverride := crHourGlass;
  try
    Sleep(2000);
  finally
    TWinCursorService.CursorOverride := crDefault;
  end;
end;

Answer 2

IFMXCursorService是FMX框架管理游标的方式。它不是供您使用的。您要使用的机制是表单的Cursor属性。

这意味着你需要记住每个表单的光标才能恢复它。我建议你用字典来做这件事。将功能封装到一个小类中，然后至少将痛苦局限于该类的实现。您可以使调用站点的代码合理。