Screen. Cursor in Firemonkey

Question

In Delphi 6, I can change the mouse cursor for all forms using Screen.Cursor :

 procedure TForm1.Button1Click(Sender: TObject); begin Screen.Cursor := crHourglass; end; 

I am looking for the equivalent in Firemonkey.

The 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 Sleep(2000); At the end of the procedure, I see the cursor for 2 seconds. But the interface is probably freed, and therefore the cursor is automatically set 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 from freeing up. But that didn't help either.

The following code works, 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 will need to iterate over all forms, but rolling back to previous cursors is difficult, since I need to know the previous cursor for each 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 will have to implement your own cursor service, which allows you to force the use of a specific 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

IFMXCursorService is how the FMX framework handles cursors. It is not intended for your use. The mechanism you are going to use is a Cursor form property.

This means that you will need to remember the cursor for each shape in order to restore it. I suggest you use a dictionary for this. Wrap the functionality in a small class, and then at least the pain will be localized to implement this class. You can make the code on the call site reasonable.