[x] 秒后关闭 Delphi 对话框

Question

是否可以让 Delphi 在一定时间后关闭 ShowMessage 或 MessageDlg 对话框？

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

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

Answer 1

如果您想连接计时器以关闭它，您可以连接 Screen.OnActiveFormChange 事件并使用

{code}
procedure abz.ActiveFormChange(Sender: TObject);
var
   Timer: TTimer;
begin
  if (Screen.ActiveCutomForm <> nil) and //valid form
     (Screen.ActiveCutomForm.Tag = 0) and //not attached a timer yet
     (Screen.ActiveCutomForm.ClassName = 'TMessageForm') //any interested form type check
    then 
  begin
    Timer := TTimer.Create(Screen.ActiveCutomForm); // let the form owned so it will be freed
    Timer.Enabled := False;
    Timer.Tag := Integer(Screen.ActiveCutomForm); // keep track to be used in timer event
    .... setup any timer interval + event
    Screen.ActiveCutomForm.Tag := Integer(Timer);
    Timer.Enabled := True; 
  end;
end;
{code}

Screen.ActiveCustomForm

Answer 2

最好的方法是使用stayontop表单并使用表单的alpha混合属性管理计数器消失，在计数结束时只需关闭表单，但是
该控件将在显示表单之前传递给所需的活动控件，这样，用户将收到一条自动消失的消息，并且不会阻止使用下一个功能，这对我来说非常酷的技巧。

Answer 3

您可以使用 WTSSendMessage 来执行此操作。

您可以在 中找到此内容JWA 库，或者您自己调用它。

Answer 4

当模式对话框或系统消息框或类似活动（或打开菜单）时，您的应用程序实际上仍在工作，只是正在运行一个辅助消息循环来处理所有消息 - 发送或发布到它的所有消息，以及必要时它也会合成（并处理）WM_TIMER 和 WM_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;

忽略了错误处理，但这应该可以帮助您开始。

Answer 5

您可以尝试使用标准消息对话框来完成此操作。使用对话框中的 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;

OnTimer 属性如下：

procedure TForm1.MyOnTimer(Sender: TObject);
begin

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

定义变量和过程：

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

并测试它。
当计时器倒计时结束时，窗体自动关闭。与此类似，您可以添加其他类型的组件。

问候。

Answer 6

试试这个：

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

我已经使用这个有一段时间了；它是一种享受。

Answer 7

好的。您有 2 个选择：

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

2 - 您可以继续使用 showmessage 并创建一个将使用 FindWindow （查找消息对话框窗口）的线程，然后将其关闭。

我建议您使用自己的带有计时器的表格。它更干净、更容易。

Answer 8

这在 Windows 98 和更新版本中工作得很好...

我不使用“MessageBoxTimeOut”，因为旧的 Windows 98 ME 没有它...

这个新函数的工作方式就像“CHARM”..

//add this过程

procedure DialogBoxAutoClose(const ACaption, APrompt: string; DuracaoEmSegundos: Integer);
var
  Form: TForm;
  Prompt: TLabel;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  nX, Lines: Integer;

  function GetAveCharSize(Canvas: TCanvas): TPoint;
    var
      I: Integer;
      Buffer: array[0..51] of Char;
    begin
      for I := 0 to 25 do Buffer[I]          := Chr(I + Ord('A'));
      for I := 0 to 25 do Buffer[I + 26]    := Chr(I + Ord('a'));
      GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
      Result.X := Result.X div 52;
    end;

begin
  Form       := TForm.Create(Application);
  Lines   := 0;

  For nX := 1 to Length(APrompt) do
     if APrompt[nX]=#13 then Inc(Lines);

  with Form do
    try
      Font.Name:='Arial';     //mcg
      Font.Size:=10;          //mcg
      Font.Style:=[fsBold];
      Canvas.Font    := Font;
      DialogUnits    := GetAveCharSize(Canvas);
      //BorderStyle    := bsDialog;
      BorderStyle    := bsToolWindow;
      FormStyle         := fsStayOnTop;
      BorderIcons      := [];
      Caption          := ACaption;
      ClientWidth    := MulDiv(Screen.Width div 4, DialogUnits.X, 4);
      ClientHeight    := MulDiv(23 + (Lines*10), DialogUnits.Y, 8);
      Position          := poScreenCenter;

      Prompt             := TLabel.Create(Form);
      with Prompt do
      begin
        Parent          := Form;
        AutoSize       := True;
        Left             := MulDiv(8, DialogUnits.X, 4);
        Top             := MulDiv(8, DialogUnits.Y, 8);
        Caption       := APrompt;
      end;

      Form.Width:=Prompt.Width+Prompt.Left+50;  //mcg fix

      Show;
      Application.ProcessMessages;
    finally
       Sleep(DuracaoEmSegundos*1000);
      Form.Free;
    end;
end;

/////////////////////////////如何调用///////////////////

DialogBoxAutoClose('Alert'', "此消息将在 10 秒后关闭',10);

/////////////////////////////// ///////////////////////////////////////////////////////

Answer 9

MessageBox 在内部调用此函数并传递 0xFFFFFFFF 作为超时参数，因此它被删除的可能性很小（感谢 Maurizio）

Answer 10

我考虑过使用单独的线程，但它可能会让您陷入许多不必要的代码等。Windows 对话框根本不是为此而设计的。

你应该做你自己的表格。从好的方面来说，您可以使用带有倒计时功能的自定义代码/UI，就像定时对话框一样。

Answer 11

不会。ShowMessage 和MessageDlg 都是模态窗口，这意味着您的应用程序在显示它们时基本上处于暂停状态。

您可以设计自己的带有计时器的替换对话框。在 FormShow 事件中启用计时器，并在 FormClose 事件中禁用计时器。在 OnTimer 事件中，禁用计时器，然后关闭窗体本身。