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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése