現在位置：  Delphiログ >  時間のかかる処理の書き方

時間のかかる処理の書き方

時間のかかる処理を行うときは、最低でも次のように書く。


Screen.Cursor := crHourGlass;
try
  //時間のかかる処理
  while True do
  begin
    .......
  end;
finally
  Screen.Cursor := crDefault;
end;

このように書けば、マウスカーソルが砂時計に変わって、ユーザーに処理中だと知らせることができる。私は、crDefaultでなく、crArrowをセットしてはまったことがあるので注意。

しかし、これだけだとアプリが反応しなくなってしまう。例えば、ユーザーが他のアプリに切り替え、再度このアプリに戻ったとき、まだ処理中だと、再描画が行われないので処理中なのか、ハングアップしたのかわからない。

この対策としてカンタンなのは、時間のかかる処理の中でApplication.ProcessMessagesを使うことだ。

以下の例を試すには、FormにButtonを貼り付け、onClickイベントに書く。


procedure Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    //時間のかかる処理
    while True do
    begin
      Application.ProcessMessages;
      .......
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

Application.ProcessMessagesを呼べば、Windowsのメッセージキューにたまっているメッセージを処理して戻ってくるため、アプリが固まることはない。｢中止ボタン｣などを用意して、処理を途中でキャンセルすることもできる。

ただ、Application.ProcessMessagesには大きな問題がある。Application.ProcessMessagesはすべてのメッセージを処理する。つまり、この例で言えば、Button1Clickの処理が終わっていないのに、他の処理が実行されることになる。例えば、Button1Clickの中でデータの更新作業をしているのに、他の処理で削除されたりすると、わけのわからないことになるかもしれない。

ネットで対策を探してみたが、定番の方法はないようだ。私の場合は、Application.ProcessMessagesの代わりに、以下の処理を入れている。


procedure Button1Click(Sender: TObject);
var
  Msg: TMsg;
begin
  Screen.Cursor := crHourGlass;
  try
    //時間のかかる処理
    while True do
    begin
      if PeekMessage(Msg, 0, WM_ACTIVATE, WM_ACTIVATE, PM_REMOVE) then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
      .......
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

WM_ACTIVATEだけを処理するようにしている。WM_ACTIVATEだけでは、完全に再描画されるわけではないが、少なくてもアプリがアクティブになったときには反応するので、固まるよりはましだと思う。ちなみに、WM_PAINTを使えばよさそうに思えるが、やってみるとメニューをクリックしたときにちらつく。

まだ問題がある。時間がかかる処理を実行中にButton1を連打されると、何度も実行されてしまう。この対策も難しいが、私はループの中に次のように書いている。


procedure Button1Click(Sender: TObject);
var
  Msg: TMsg;
begin
  Screen.Cursor := crHourGlass;
  try
    //時間のかかる処理
    while True do
    begin
      while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
        ;
      while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do
        ;
      if PeekMessage(Msg, 0, WM_ACTIVATE, WM_ACTIVATE, PM_REMOVE) then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
      .......
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

ループ中でキーボードメッセージとマウスメッセージを捨ててしまっている。

ただし、この方法だと、「中止」ボタンなどを付けた時に反応しなくなる。その場合はまた別の方法を考えなければならない。

もっとも素直な解決は、「中止」ボタンを持つモーダルダイアログを出して、そこに処理を書くことだろう。モーダルダイアログなら、Application.ProcessMessagesを入れても、メッセージを受け取るのはそのダイアログなので、今まで挙げた問題は発生しないからだ。

Tips

ブログ

リンク