简体   繁体   中英

How to load custom cursor in Firemonkey?

I need to use custom cursor in my Firemonkey desktop project. I can use LoadCursorFromFile in VCL project to load a custom cursor in my project. I have tried to do the same for Firemonkey but it is not loading the cursor. Is there any working way to achieve loading custom cursors in Firemonkey?

uses Winapi.Windows;

procedure Tform1.Button1Click(Sender: TObject);
const mycursor= 1;
begin
  Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
  Button1.Cursor := mycursor;
end;

I only did this for the Mac, but the general idea is that you implement your own IFMXCursorService. Keep in mind that this pretty much an all or nothing approach. You'll have to implement the default FMX cursors, too.

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;

It might be a necessary to add a flag to the TWinCursorService so that it will prevent the FMX framework to override your cursor.

Timing is important when registering your own cursor service. It will have to be done after FMX calls TPlatformServices.Current.AddPlatformService(IFMXCursorService, PlatformCocoa);

Unfortunately, FireMonkey does not support custom cursors. This has already been filed as a feature request in Quality Portal:

RSP-17651 Cannot load custom cursors in Firemonkey .

With that said, the code you showed would not work in VCL. LoadCursorFromFile() returns an HCURSOR handle, but the TControl.Cursor property expects an index value from the TCursor enum instead. They are not the same thing. When loading a custom cursor, you must add it to the TScreen.Cursors[] list. This is clearly stated in the documentation:

Vcl.Controls.TControl.Cursor

The value of Cursor is the index of the cursor in the list of cursors maintained by the global variable, Screen . In addition to the built-in cursors provided by TScreen, applications can add custom cursors to the list .

Vcl.Forms.TScreen.Cursors

Custom cursors can be added to the Cursors property for use by the application or any of its controls. To add a custom cursor to an application, you can ...:
...
2. Declare a cursor constant with a value that does not conflict with an existing cursor constant.
...
4. Set the Cursors property, indexed by the newly declared cursor constant, to the handle obtained from LoadCursor.

For example:

const
  mycursor: TCursor = 1; // built-in values are <= 0, user-defined values are > 0

procedure Tform1.Button1Click(Sender: TObject);
begin
  Screen.Cursors[mycursor] := LoadCursorFromFile('C:\...\Arrow.cur');
  Button1.Cursor := mycursor;
end;

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM