能自動關閉的訊息視窗

加到common.pas內

procedure ShowMsg(const STitle,SText:String; const ITimeOut:Integer);
var
  aFrm:TForm2;
begin
  aFrm:=TForm2.Create(nil);
  aFrm.Caption := STitle;
  aFrm.Label1.Caption := SText;
  aFrm.Timer1.Interval := ITimeOut;
  try
    aFrm.ShowModal;
  finally
    aFrm.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMsg('訊息測試','訊息內容................',4000);
end;

新增1個TButton，1個TLabel，2個Timer(1個顯示用interval用1000，2個enabled用false，並都加入事件)

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    i : integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  i := Timer1.Interval div 1000;
  Button1.Caption := 'OK ('+inttostr(i)+')';
  Timer2.Enabled := true;
  Timer1.Enabled := true;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer2.Enabled := false;
  Timer1.Enabled := false;
  self.close;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  self.close;
end;

procedure TForm2.Timer2Timer(Sender: TObject);
begin
  Dec(i);
  Button1.Caption := 'OK ('+inttostr(i)+')';
end;

end.