萤火虫在Firemonkey [英] Screen.Cursor in Firemonkey

问题描述

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

In Delphi 6, I could change the Mouse Cursor for all forms using Screen.Cursor:

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

我正在Firemonkey中搜索等价物。

I am searching the equivalent in 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 以防止接口被释放。但是它也没有帮助。

When I insert a Sleep(2000); at the end of the procedure, I can see the cursor for 2 seconds. But the Interface probably gets freed and therefore, the cursor gets automatically resetted at the end of the procedure. I also tried to define CS as a global variable, and add CS._AddRef at the end of the procedure to prevent the Interface to be freed. But it did not help either.

以下代码正常工作，但仅适用于主窗体：

Following code does work, but will only work for the main form:

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

由于我想要更改所有表单的游标，我需要遍历所有表单，但是那么回滚到以前的游标是棘手的，因为我需要知道每个窗体的以前的游标。

Since I want to change the cursor for all forms, I would need to iterate through all forms, but then the rollback to the previous cursors is tricky, as I need to know the previous cursor for every form.

我的意图：

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

推荐答案

您必须实现自己的游标服务可以执行某个游标。

You'd have to implement your own cursor service that makes it possible to enforce a certain cursor.

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;

这篇关于萤火虫在Firemonkey的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！