在消息窗口中显示进度条

 

动态创建消息窗口，并在窗口中显示一个进度条，在进度条范围内选择按钮

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  AMsgDialog: TForm;
  AProgressBar: TProgressBar;
  ATimer: TTimer;
begin
  AMsgDialog := CreateMessageDialog('Quickly! Answer Yes or No!', mtWarning, [mbYes, mbNo]);
  AProgressBar := TProgressBar.Create(AMsgDialog);
  ATimer := TTimer.Create(AMsgDialog);
  with AMsgDialog do
  try
    Tag := 10; //seconds!

    Caption := 'You have 10 seconds';
    Height := 150;

    with AProgressBar do begin
      Name := 'Progress';
      Parent := AMsgDialog;
      Max := AMsgDialog.Tag; //seconds
      Step := 1;
      Top := 95;
      Left := 8;
      Width := AMsgDialog.ClientWidth - 16;
    end;

    with ATimer do
    begin
      Interval := 1000;
      OnTimer := DialogTimer;
    end;

    case ShowModal of
      ID_YES: ShowMessage('Answered "Yes".');
      ID_NO: ShowMessage('Answered "No".');
      ID_CANCEL: ShowMessage('Time up!')
    end; //case
  finally
    ATimer.OnTimer := nil;
    Free;
  end;
end;

procedure TForm1.DialogTimer(Sender: TObject);
var
  aPB: TProgressBar;
begin
  if not (Sender is TTimer) then Exit;

  if ((Sender as TTimer).Owner) is TForm then
    with ((Sender as TTimer).Owner) as TForm do
    begin
      aPB := TProgressBar(FindComponent('Progress'));

      if aPB.Position >= aPB.Max then
        ModalResult := mrNo
      else
        aPB.StepIt;
    end;
end;

end.