在[x]秒后关闭Delphi对话框

Dan*_*lly 12 delphi timeout dialog

是否有可能让Delphi在一段时间后关闭ShowMessage或MessageDlg对话框?

我想在关闭应用程序时向用户显示一条消息,但不想让应用程序关闭超过10秒钟左右.

我可以在定义的时间后关闭默认对话框,还是需要编写自己的表单?

mgh*_*hie 12

当模态对话框或系统消息框或类似文件处于活动状态时(或菜单打开时),您的应用程序实际上仍在工作,只是正在运行一个辅助消息循环,它处理所有消息 - 发送或发送给它的所有消息,以及它还将在必要时合成(和处理)WM_TIMERWM_PAINT消息.

所以不需要创建一个线程或跳过任何其他的箍,你只需要安排关闭消息框的代码在这10秒后运行.一个简单的方法是在SetTimer()没有目标HWND但是回调函数的情况下调用:

procedure CloseMessageBox(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR;
  ATicks: DWORD); stdcall;
var
  Wnd: HWND;
begin
  KillTimer(AWnd, AIDEvent);
  // active window of the calling thread should be the message box
  Wnd := GetActiveWindow;
  if IsWindow(Wnd) then
    PostMessage(Wnd, WM_CLOSE, 0, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TimerId: UINT_PTR;
begin
  TimerId := SetTimer(0, 0, 10 * 1000, @CloseMessageBox);
  Application.MessageBox('Will auto-close after 10 seconds...', nil);
  // prevent timer callback if user already closed the message box
  KillTimer(0, TimerId);
end;
Run Code Online (Sandbox Code Playgroud)

错误处理已被省略,但这应该可以帮助您入门.


Ger*_*lí- 11

您可以尝试使用标准的"消息"对话框来执行此操作.使用Dialogs中的CreateMessageDialog过程创建对话框,然后添加所需的控件.

在具有TButton定义onClick的表单中:

procedure TForm1.Button1Click(Sender: TObject);
var
  tim:TTimer;
begin
  // create the message
  AMsgDialog := CreateMessageDialog('This is a test message.',mtWarning, [mbYes, mbNo]) ;
  lbl := TLabel.Create(AMsgDialog) ;
  tim := TTimer.Create(AMsgDialog);
  counter := 0;

  // Define and adding components
  with AMsgDialog do
   try
    Caption := 'Dialog Title' ;
    Height := 169;

    // Label
    lbl.Parent := AMsgDialog;
    lbl.Caption := 'Counting...';
    lbl.Top := 121;
    lbl.Left := 8;

    // Timer
    tim.Interval := 400;
    tim.OnTimer := myOnTimer;
    tim.Enabled := true;

    // result of Dialog
    if (ShowModal = ID_YES) then begin
      Button1.Caption := 'Press YES';
    end
    else begin
      Button1.Caption := 'Press NO';
    end;
   finally
    Free;
   end;
end;
Run Code Online (Sandbox Code Playgroud)

像这样的OnTimer属性:

procedure TForm1.MyOnTimer(Sender: TObject);
begin

  inc(counter);
  lbl.Caption := 'Counting: ' + IntToStr(counter);
  if (counter >= 5) then begin
    AMsgDialog.Close;
  end;
end;
Run Code Online (Sandbox Code Playgroud)

定义变量和过程:

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    AMsgDialog: TForm;
    lbl:TLabel;
    counter:integer;
    procedure MyOnTimer(Sender: TObject);
  end;
Run Code Online (Sandbox Code Playgroud)

并测试它.
当计时器最终CountDown时,表单自动关闭.与此类似,您可以添加其他类型的组件.

替代文字

问候.


Res*_*ess 8

试试这个:

function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
  uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer;
  stdcall; external user32 name 'MessageBoxTimeoutA';
Run Code Online (Sandbox Code Playgroud)

我已经用了很长时间了; 它是一种享受.


Raf*_*cci 7

好.你有2个选择:

1 - 您可以创建自己的MessageDialog表单.然后,您可以使用它并添加一个TTimer,它将在您需要时关闭表单.

2 - 您可以继续使用showmessage并创建一个将使用FindWindow(查找messadialog窗口)然后关闭它的线程.

我建议你使用自己的表格和计时器.它更干净,更容易.