如何在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)之后完成;