delphi – Firemonkey中的Screen.Cursor

在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;

当我插入睡眠(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;

解决方法

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

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;

delphi – Firemonkey中的Screen.Cursor

解决方法

猜你在找的Delphi相关文章