如何在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 无法在 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;

Answer 3

如果您使用的是 Delphi 12（或者可能是几个早期版本），您可以使用我编写的一些代码来替换光标获取/设置函数，而无需修改任何 Delphi 源代码。

在dpk的应用程序代码中，在uses子句中引用单元

FMX.CustomCursors.pas，并在Application.Initialize;之前添加行ReplaceCursorHandler;

在加载游标的单元中的 use 子句中，也引用相同的文件，然后使用以下语法从 .RES 文件在 VCL 中加载游标：

ScreenCursors.loadCursor(CursorIdent,资源名称);

获取代码：

https://github.com/TheOriginalBytePlayer/FireMonkeyCustomCursors