Screen.Cursor in Firemonkey - delphi

Question

In Delphi 6, I could change the Mouse Cursor for all forms using Screen.Cursor:
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourglass;
end;
I am searching the equivalent in Firemonkey.
Following function does not work:
procedure SetCursor(ACursor: TCursor);
var
CS: IFMXCursorService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
begin
CS := TPlatformServices.Current.GetPlatformService(IFMXCursorService) as IFMXCursorService;
end;
if Assigned(CS) then
begin
CS.SetCursor(ACursor);
end;
end;
When I insert a Sleep(2000); at the end of the procedure, I can see the cursor for 2 seconds. But the Interface probably gets freed and therefore, the cursor gets automatically resetted at the end of the procedure. I also tried to define CS as a global variable, and add CS._AddRef at the end of the procedure to prevent the Interface to be freed. But it did not help either.
Following code does work, but will only work for the main form:
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.MainForm.Cursor := crHourGlass;
end;
Since I want to change the cursor for all forms, I would need to iterate through all forms, but then the rollback to the previous cursors is tricky, as I need to know the previous cursor for every form.
My intention:
procedure TForm1.Button1Click(Sender: TObject);
var
prevCursor: TCursor;
begin
prevCursor := GetCursor;
SetCursor(crHourglass); // for all forms
try
Work;
finally
SetCursor(prevCursor);
end;
end;

Answer 1

You'd have to implement your own cursor service that makes it possible to enforce a certain cursor.
unit Unit2;
interface
uses
FMX.Platform, FMX.Types, System.UITypes;
type
TWinCursorService = class(TInterfacedObject, IFMXCursorService)
private
class var FPreviousPlatformService: IFMXCursorService;
class var FWinCursorService: TWinCursorService;
class var FCursorOverride: TCursor;
class procedure SetCursorOverride(const Value: TCursor); static;
public
class property CursorOverride: TCursor read FCursorOverride write SetCursorOverride;
class constructor Create;
procedure SetCursor(const ACursor: TCursor);
function GetCursor: TCursor;
end;
implementation
{ TWinCursorService }
class constructor TWinCursorService.Create;
begin
FWinCursorService := TWinCursorService.Create;
FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned
TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
end;
function TWinCursorService.GetCursor: TCursor;
begin
result := FPreviousPlatformService.GetCursor;
end;
procedure TWinCursorService.SetCursor(const ACursor: TCursor);
begin
if FCursorOverride = crDefault then
begin
FPreviousPlatformService.SetCursor(ACursor);
end
else
begin
FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end;
class procedure TWinCursorService.SetCursorOverride(const Value: TCursor);
begin
FCursorOverride := Value;
TWinCursorService.FPreviousPlatformService.SetCursor(FCursorOverride);
end;
end.
MainUnit:
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
TWinCursorService.CursorOverride := crHourGlass;
try
Sleep(2000);
finally
TWinCursorService.CursorOverride := crDefault;
end;
end;

Answer 2

The IFMXCursorService is how the FMX framework manages cursors. It is not intended for your use. The mechanism that you are meant to use is the form's Cursor property.
This means that you will need to remember the cursor for each form in order to restore it. I suggest that you use a dictionary to do that. Wrap the functionality up into a small class and then at least the pain is localized to the implementation of that class. You can make the code at the call site reasonable.