FireMonkeyアプリケーションでマウスカーソルを砂時計にする

時間のかかる処理を実行している間、マウスカーソルを砂時計に変更する方法です。

FireMonkeyアプリケーションはマルチプラットフォームで動作するため、実行環境がマウスカーソルをサポートしているかどうかを調べる必要があります。

マウスカーソルをサポートしているかどうかはを調べるには、TPlatformServicesクラスSupportsPlatformServiceメソッドの引数にIFMXCursorServiceを与えます。
返値がTrueならマウスカーソルをサポートしています。Falseならマウスカーソルをサポートしていません。

uses FMX.Platform;

// マウスカーソルをサポートしているかどうかを調べる
if not TPlatformServices.Current.SupportsPlatformService(IFMXCursorService) then
begin
  // マウスカーソルをサポートしていないときはふつうに処理を実行する
  Sleep(2000);  //時間のかかる処理
  Exit;
end;

実行環境がマウスカーソルをサポートしているときはIFMXCursorServiceを取得します。

var
  CursorService: IFMXCursorService;

CursorService := TPlatformServices.Current.GetPlatformService
  (IFMXCursorService) as IFMXCursorService;

現在のマウスカーソルを変数に保存します。

var
  Cursor: TCursor;

// 現在のマウスカーソルを変数に保存する
Cursor := CursorService.GetCursor;

マウスカーソルを砂時計に変更します。

// マウスカーソルを砂時計に変更する
CursorService.SetCursor(crHourGlass);

時間のかかる処理が終わったら、マウスカーソルを元に戻します。

try
  Sleep(2000) // 時間のかかる処理
finally
  // マウスカーソルを元に戻す
  CursorService.SetCursor(Cursor);
end;

全体のコードは次のようになります。

procedure TForm1.Button1Click(Sender: TObject);
var
  CursorService: IFMXCursorService;
  Cursor: TCursor;
begin
  // マウスカーソルをサポートしているかどうかを調べる
  if not TPlatformServices.Current.SupportsPlatformService(IFMXCursorService)
  then
  begin
    // マウスカーソルをサポートしていないときはふつうに処理を実行する
    Sleep(2000); // 時間のかかる処理
    Exit;
  end;

  CursorService := TPlatformServices.Current.GetPlatformService
    (IFMXCursorService) as IFMXCursorService;

  // 現在のマウスカーソルを変数に保存する
  Cursor := CursorService.GetCursor;
  // マウスカーソルを砂時計に変更する
  CursorService.SetCursor(crHourGlass);
  try
    Sleep(2000) // 時間のかかる処理
  finally
    // マウスカーソルを元に戻す
    CursorService.SetCursor(Cursor);
  end;
end;

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です