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爲這個索引就可以了。