Question

在Delphi 6中，我可以使用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.

MainUnit：

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属性。

这意味着您需要记住每个表单的光标才能还原它。我建议你用字典来做那件事。将功能包装到一个小类中，然后至少将痛苦本地化为该类的实现。您可以使呼叫站点的代码合理。

Firemonkey中的Screen.Cursor

2 个答案: