Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年11月23日] [更新 2013年05月19日] Delphi サンプルプログラム集
   
700_一定時間だけ処理を中断
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
700_WaitSleep.zip [2,155 KB] 2013年05月19日版(EXE同梱)



  • 2011年05月19日
  • サンプルを追加
  • WaitTime 関数の修正.戻り値を動作時間のミリ秒にしてタイマー,ストップウォッチとしても利用可能とした
  • WaitTime 関数の修正.DateTime 型の精度は低いので,MMSystem の timeGetTime を使用
  • 動作確認環境の変更
  • 2012年04月29日
  • サンプルを 1 つだけにして,Delphi XE で動作確認.記事を修正
  • 2013年05月19日
  • ボタンの Enabled := False 関係のサンプルを追加




01_Sleep 関数とマルチメディアタイマーを使用したテスト


アプリケーションの実行中に,一定時間処理を中断したいことがあるとします.Sleep という関数を使用すれば可能ですが,この関数は実行したプロセスそのものを停止します.したがって,実行中は,フォームの移動などができなくなります.そのような場合,タイマー関係の関数を使用して,時間を計測し,Appliction の ProcessMessage を利用すると,この現象を避けることができます.このサンプルプログラムは,この現象を確認するためのものです.

ただし,Application.ProcessMaessage は,Windows がイベントに応答できるようアプリケーションの実行を一時的に停止する命令です.したがって,処理終了時にフォーム移動等,他の処理をしていると処理が戻ってきません.

このページには,タイマーコンポーネントを使用したサンプルもありましたが掲載を中止しました.
簡単なテストで使用するには十分なのですが,実用的なアプリで使用するには,スレッドによる処理が不可欠です.[004_タイマー] を参考にしてください.


図1
設計時画面
図2
Button1 クリック
  • Sleep(5000) による待ち時間開始
  • 途中,フォームの移動等はできない

設定した時間が経過しても,フォームを移動したりしていると,下図のように指定した時間になっても終了しません.


図3
Button2 をクリックしてフォームを移動
  • 表示はフォームの移動を中止した時間

リスト1
一定時間だけ処理を中断
Sleep 関数とマルチメディアタイマー使用
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    fgWaitBreak : boolean;
    function WaitTime(const t: Cardinal): Cardinal;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

//=============================================================================
//  Sleep関数を使用して指定時間処理を停止
//  この間,フォームの移動などはできなくなる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StartTime : Cardinal;
begin
  Panel1.Caption := '';
  Panel1.Update;

  StartTime := timeGetTime;
  Sleep(5000);
  Panel1.Caption := FormatFloat('# ミリ秒', timeGetTime - StartTime);
end;

//=============================================================================
//  Application.ProcessMessageを使用して指定時間処理を待つ
//  この間,フォームの移動,他のイベント操作も可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  StopTime : Cardinal;
begin
  Panel1.Caption := '';
  Panel1.Update;

  StopTime := WaitTime(5000);
  Panel1.Caption := FormatFloat('# ミリ秒', StopTime);
end;

//=============================================================================
//  引数のt(ミリ秒単位)で指定する時間だけ処理を待つ関数
//  (精度は1ミリ秒- 最大1ミリ秒のゆらぎがある)
//  戻り値は待った時間(ミリ秒).途中で処理を中断した場合は,中断までの時間
//  つまりストップウォッチとしても利用可能
//
//  処理中,このプログラムのどこかでfgWaitBreakをTrueにすると待つ処理を中断
//
//  [備考]
//、Application.ProcessMaessageは,Windowsがイベントに応答できるようアプリケー
//  ションの実行を一時的に停止する命令
//  したがって,処理終了時にフォーム移動等,他の処理をしているとこの関数の処理
//  は終了しない.それを避けるためには,スレッド処理等を使用する
//
//  usesにMMSystmeが必要
//=============================================================================
function TForm1.WaitTime(const t: Cardinal): Cardinal;
var
  StartTime : Cardinal;
  DisTime   : Cardinal;
begin
  fgWaitBreak := False;

  StartTime := timeGetTime;
  while True do begin
    DisTime := timeGetTime - StartTime;

    if DisTime >= t then break;
    if fgWaitBreak  then break;

    Application.ProcessMessages;
    Sleep(1);
  end;
  Result := DisTime;
end;

end.




02_TButton の Enabled := False の時の描画の問題


中断中に,ボタンの操作を禁止したい場合,TButton.Enabled := False にすることになります.そこで上のサンプルにこのコードを追加してテストしてみます.

その結果が下図です.
下の Button2 では期待通りに動作しています.問題は Button1 の場合です.クリックすると,初回起動時と,2 回目以降とは違います.2 回目以降の動作は次のようになります.
  • Button1 は Disable な表示になる
  • Button2 は指定時間経過後,一瞬無効 (Disable) な表示となり,すぐに元に戻る
実際には,Button2 は無効にはなっています.表示つまり,描画が更新されないために,このようになります.Windows Vista 以降では,ランタイムテーマを有効にしていると,UI インターフェイスのレンダリング (描画) が複数のフレームを使用したものとなります.この描画の遅延のために発生します.事実,上のサンプルでも,ボタンをクリックする動作を観察していると,ボタン表面の描画の変化が少し緩慢であることが分かります.


図4
Button1 クリック
  • Button2 の表示が Enabled := False の描画状態となってくれない
図5
Button2 クリック
  • 期待通りになる

当然ランタイムテーマを無効にすれば,下図のように期待通りに動作します.また,ランタイムテーマが有効であっても,Windows XP であれば期待通りに動作します.


図6
ランタイムテーマが無効の場合
  • 期待通り動作する

リスト2
ボタンの Enabled := False のテスト
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

//=============================================================================
//  Sleep関数をで一定時間処理を停止
//  単なるEnabled := False のテスト用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  Sleep(3000);

  Button1.Enabled := True;
  Button2.Enabled := True;
end;

//=============================================================================
//  Application.ProcessMessageを使用して指定時間処理を待つ
//  実際のアプリに近いかもしれないコードでの Enabled := False の動作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  StartTime : Cardinal;
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  StartTime := TimeGetTime;
  //何かの処理の代わりとしてのループ
  while True do begin
    if (timeGetTime - StartTime) > 3000 then break;
    Application.ProcessMessages;
    Sleep(1);
  end;

  Button1.Enabled := True;
  Button2.Enabled := True;
end;

end.




03_TButton の Enabled := False の時に Repaint で再描画


上のサンプルの現象を回避するには,ボタンを Repaint 等で強制的に再描画することになります.
ただし,単に Repaint を実行しただけでは,描画の更新が間に合わないことがあります.そこでこのサンプルでは Sleep 関数でタイムラグを持たせ,その間に Windows にボタンの描画の内部処理をさせるようにしています.下図は,150 ms だけ Sleep 関数でタイムラグを設定した場合です.


図7
Sleep と Repaint 関数を使用して再描画

短いタイムラグだと,再描画が完全に完了しないこともあります.下図は 100 ms の場合です.


図8
Sleep(100) の場合

リスト3
Sleep 関数と Repaint 関数を使用して,ボタンの再描画を実行
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  Sleep関数をで一定時間処理を停止
//  単なるEnabled := False のテスト用
//  Sleepでタイムラグを持たせてからRepaintで再描画する
//  Sleepの引数の値で状態が微妙に違ってくる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;
  Sleep(150);
  Button1.Repaint;
  Button2.Repaint;

  Sleep(3000);

  Button1.Enabled := True;
  Button2.Enabled := True;
end;

end.




04_ボタンの二重クリック防止


上のサンプルのように,ボタンの再描画を実行すれば,ボタンの表示も更新されます.
ただし,Sleep 関数はプロセスを一時的に停止するだけで,その間のキーやマウスの操作はバッファに蓄えられます.したがって,Sleep で設定した時間が経過すると,そのバッファに記録された内容が実行されてしまいます.正確な表現ではありませんが,Application.ProcessMessages を実行するとこのバッファの一部をクリアすることができます.そのテストです.以下の手順で確認できます.
  • (1) Button1 をクリック
  • (2) ダイアログが表示されるので,{OK] をクリックして閉じる
  • (3) 閉じたらすぐ Button1 をクリックする
  • (4) 指定時間経過すると,またダイアログが現れる
  • (5) 今度は,[二重クリック防止] にチェックを入れて同じテストを行う
この対策も,実は完全ではありません.このページの最初のサンプルの参考リンクにあるように,対処方法はケースバイケースとなるでしょう.
実際のアプリケーションでは,このサンプルのように,再描画が行われるようなコードが実行される状況であれば,再描画の処理コードは必要ないことになります.


図9
実行開始画面
図10
テスト中の画面

リスト4
ボタンの二重クリック防止のテスト
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  Sleep関数をで一定時間処理を停止
//  単なるEnabled := False のテスト用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;

  //ダイアログを表示すると再描画が行われるので以下の3行は不要
  //Sleep(100);
  //Button1.Repaint;
  //Button2.Repaint;

  MessageBox(Handle, '二重クリック防止テスト', 'テスト', MB_OK);

  Sleep(3000);

  if CheckBox1.Checked then Application.ProcessMessages;
  Button1.Enabled := True;
  Button2.Enabled := True;
end;

end.