Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- uses
- FMX.Platform;
- type
- TWinCursorService = class(TInterfacedObject, IFMXCursorService)
- private
- class var FPreviousPlatformService: IFMXCursorService;
- class var FWinCursorService: TWinCursorService;
- public
- class var CursorOverride: TCursor;
- class constructor Create;
- procedure SetCursor(const ACursor: TCursor);
- function GetCursor: TCursor;
- end;
- { 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 CursorOverride = crDefault then
- begin
- FPreviousPlatformService.SetCursor(ACursor);
- end
- else
- begin
- FPreviousPlatformService.SetCursor(CursorOverride);
- end;
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- var
- i: integer;
- begin
- TWinCursorService.CursorOverride := crHourGlass;
- try
- Sleep(2000);
- finally
- TWinCursorService.CursorOverride := crDefault;
- end;
- end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement