如何在 Firemonkey 中加载自定义光标？

Question

我需要在我的 Firemonkey 桌面项目中使用自定义光标。 我可以在 VCL 项目中使用 LoadCursorFromFile 在我的项目中加载自定义光标。 我试图对 Firemonkey 做同样的事情，但它没有加载光标。 有没有什么可行的方法来实现在 Firemonkey 中加载自定义光标？

uses Winapi.Windows;

procedure Tform1.Button1Click(Sender: TObject);
const mycursor= 1;
begin
  Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
  Button1.Cursor := mycursor;
end;

Answer 1

我只为 Mac 做了这个，但总体思路是您实现自己的 IFMXCursorService。请记住，这几乎是一种全有或全无的方法。您还必须实现默认的 FMX 游标。

type
  TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  private
    class var FWinCursorService: TWinCursorService;
  public
    class constructor Create;
    procedure SetCursor(const ACursor: TCursor);
    function GetCursor: TCursor;
  end;

{ TWinCursorService }

class constructor TWinCursorService.Create;
begin
  FWinCursorService := TWinCursorService.Create;
  TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;

function TWinCursorService.GetCursor: TCursor;
begin
  // to be implemented
end;

procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
  Windows.SetCursor(Cursors[ACursor]); // you need to manage the Cursors list that contains the handles for all cursors
end;

可能需要向 TWinCursorService 添加一个标志，以防止 FMX 框架覆盖您的光标。

注册您自己的光标服务时，时间很重要。必须在 FMX 调用 TPlatformServices.Current.AddPlatformService(IFMXCursorService, PlatformCocoa);后完成；

Answer 2

很遗憾，FireMonkey 不支持自定义光标。这已在 Quality Portal 中作为功能请求提交：

RSP-17651 Cannot load custom cursors in Firemonkey.

话虽如此，您展示的代码在 VCL 中不起作用。 LoadCursorFromFile() 返回 HCURSOR 句柄，但 TControl.Cursor 属性需要来自 TCursor 枚举的索引值。它们不是同一件事。加载自定义光标时，必须将其添加到 TScreen.Cursors[] 列表中。这在文档中明确说明：

Vcl.Controls.TControl.Cursor

Cursor 的值是 光标在全局变量 Screen 维护的光标列表中的索引。除了 TScreen 提供的内置光标外，应用程序还可以将自定义光标添加到列表中。

Vcl.Forms.TScreen.Cursors

自定义光标可以添加到 Cursors 属性以供应用程序或其任何控件使用。要将自定义光标添加到应用程序，您可以...：
...
2. 声明一个游标常数，其值与现有游标常数不冲突。
...
4. 将由新声明的游标常量索引的 Cursors 属性设置为从 LoadCursor 获得的句柄。

例如：

const
  mycursor: TCursor = 1; // built-in values are <= 0, user-defined values are > 0

procedure Tform1.Button1Click(Sender: TObject);
begin
  Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
  Button1.Cursor := mycursor;
end;