Advertisement
Guest User

Untitled

a guest
Mar 24th, 2015
509
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 1.41 KB | None | 0 0
  1. uses
  2.   FMX.Platform;
  3.  
  4. type
  5.   TWinCursorService = class(TInterfacedObject, IFMXCursorService)
  6.   private
  7.     class var FPreviousPlatformService: IFMXCursorService;
  8.     class var FWinCursorService: TWinCursorService;
  9.   public
  10.     class var CursorOverride: TCursor;
  11.  
  12.     class constructor Create;
  13.     procedure SetCursor(const ACursor: TCursor);
  14.     function GetCursor: TCursor;
  15.   end;
  16.  
  17. { TWinCursorService }
  18.  
  19. class constructor TWinCursorService.Create;
  20. begin
  21.   FWinCursorService := TWinCursorService.Create;
  22.  
  23.   FPreviousPlatformService := TPlatformServices.Current.GetPlatformservice(IFMXCursorService) as IFMXCursorService; // TODO: if not assigned
  24.  
  25.   TPlatformServices.Current.RemovePlatformService(IFMXCursorService);
  26.   TPlatformServices.Current.AddPlatformService(IFMXCursorService, FWinCursorService);
  27. end;
  28.  
  29. function TWinCursorService.GetCursor: TCursor;
  30. begin
  31.   result :=  FPreviousPlatformService.GetCursor;
  32. end;
  33.  
  34. procedure TWinCursorService.SetCursor(const ACursor: TCursor);
  35. begin
  36.   if CursorOverride = crDefault then
  37.   begin
  38.     FPreviousPlatformService.SetCursor(ACursor);
  39.   end
  40.   else
  41.   begin
  42.     FPreviousPlatformService.SetCursor(CursorOverride);
  43.   end;
  44. end;
  45.  
  46.  
  47. procedure TForm1.Button1Click(Sender: TObject);
  48. var
  49.   i: integer;
  50. begin
  51.   TWinCursorService.CursorOverride := crHourGlass;
  52.   try
  53.     Sleep(2000);
  54.   finally
  55.     TWinCursorService.CursorOverride := crDefault;
  56.   end;
  57. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement