2008. május 3., szombat

How to create a MessageBox with a timeout


Problem/Question/Abstract:

I need to create a messagebox asking the user to reply either Yes or No, but with a timeout. Is there a way to use a messagebox function with some timeout, like open messagebox with Yes or No, and after 20 seconds reply with other information to know that user is out?

Answer:

Solve 1:

Show the MessageBox in another thread and kill the thread when you want to remove the messagebox under program control:

{ ... }
var
  ThreadId: Integer;
  ThreadHandle: Integer;
  MsgResult: Integer;

function thread_proc(p: Pointer): integer; stdcall;
begin
  MsgResult := MessageBox(0, 'Some question?', 'Hey', MB_ICONQUESTION or MB_YESNO);
  ThreadHandle := 0;
  EndThread(0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  counter: integer;
begin
  MsgResult := IDNO; {default answer}
  {show MessageBox}
  ThreadHandle := BeginThread(nil, 0, @Thread_proc, nil, 0, ThreadID);
  counter := 20; {wait for 20 seconds}
  while (ThreadHandle <> 0) and (counter > 0) do
  begin
    Sleep(1000);
    counter := counter - 1;
  end;
  {if MessageBox is still visible after 20 seconds, remove it}
  if Counter = 0 then
    TerminateThread(ThreadHandle, 0);
  if MsgResult = IDYES then
    { ... }
  else
    { ... }
end;


Solve 2:

procedure TForm1.Button1Click(Sender: TObject);
var
  R: Integer;
begin
  Timer1.Interval := 20000;
  Timer1.Enabled := true;
  R := MessageDlg('Yes or no?', mtConfirmation, [mbYes, mbNo], 0);
  Caption := IntToStr(R);
  Timer1.Enabled := false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  F: TForm;
begin
  F := Screen.ActiveForm;
  if fsModal in F.FormState then
    F.ModalResult := mrYesToAll;
end;

Nincsenek megjegyzések:

Megjegyzés küldése