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.

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.

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.

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.