Firemonkey扩展增强：自定义Cursor

在VCL中很容易通过Screen.Cursors加载自定义cursor，但在FMX中，cursor是通过IFMXCursorService管理的，只支持系统默认的cursor。如果要加载自定义的cursor，我们需要替换平台默认实现的IFMXCursorService。

Windows平台源码如下：

unit uWinCursorService;

interface

uses FMX.Platform, System.UITypes, FMX.Types, Winapi.Windows, System.Generics.Collections;

type
  TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  private class var
    FWinCursorService: TWinCursorService;
    FOldCursorService: IFMXCursorService;
    FCursors: TList<HCURSOR>;
  protected
    class constructor Create;
    class destructor Destroy;
    procedure SetCursor(const ACursor: TCursor);
    function GetCursor: TCursor;
  public
    class function AddCursor(const AFileName: string): Integer;
  end;

implementation

uses System.SysUtils;
{ TWinCursorService }

class constructor TWinCursorService.Create;
begin
  FOldCursorService := TPlatformServices.Current.GetPlatformService(IFMXCursorService)
    as IFMXCursorService;
  TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  FWinCursorService := TWinCursorService.Create;
  TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
  FCursors := TList<HCURSOR>.Create;
end;

class destructor TWinCursorService.Destroy;
begin
  FOldCursorService := nil;
  //DestoryCursor
  FCursors.Free;
end;

class function TWinCursorService.AddCursor(const AFileName: string): Integer;
var
  hCur: HCURSOR;
begin
  Result := 0;
  hCur := LoadCursorFromFile(PCHAR(AFileName));
  if hCur>0 then
    Result := FCursors.Add(hCur) + 1;
end;

function TWinCursorService.GetCursor: TCursor;
begin
  Result := FOldCursorService.GetCursor;
end;

procedure TWinCursorService.SetCursor(const ACursor: TCursor);
var
  NewCursor: HCURSOR;
begin
  if ACursor<=crDefault then
    FOldCursorService.SetCursor(ACursor)
  else begin
    if ACursor>FCursors.Count then
      FOldCursorService.SetCursor(crDefault)
    else Winapi.Windows.SetCursor(FCursors[ACursor-1]);
  end;
end;

end.

使用上只需一句即可：

procedure TForm1.FormCreate(Sender: TObject);
begin
  Cursor := TWinCursorService.AddCursor('.\bin\Res\2.cur');
end;

TWinCursorService.AddCursor方法加载指定光标资源，返回光标索引，程序中只要保存这个索引，之后窗体或控件需要显示该光标直接设置其cursor为这个索引就可以了。