How to create a MessageBox with a timeout (Views: 29)
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; |