[x] 秒后关闭 Delphi 对话框

Question

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

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

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

Answer 1

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

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

一个像这样的 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;

并对其进行测试。
当计时器结束 CountDown 时，表单会自动关闭。与此类似，您可以添加其他类型的组件。

问候。

Answer 3

试试这个：

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

我已经用了很长时间了；这是一种享受。

Answer 4

好的。您有 2 个选择：

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

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

我建议您使用自己的带有计时器的表单。它更清洁，更容易。

Answer 5

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

Answer 6

我考虑过使用单独的线程，但它可能会让你进入很多不必要的代码等。Windows 对话框根本不是为这件事而设计的。

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

Answer 7

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

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

Answer 8

你可以连接 Screen.OnActiveFormChange 事件并使用 Screen.ActiveCustomForm 如果它是你想要连接计时器以关闭它的感兴趣的表单

{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}

享受

Answer 9

这适用于 Windows 98 和更新版本...

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

这个新功能就像一个“CHARM”..

//添加这个过程

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 10

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

Answer 11

您可以使用WTSSendMessage 来做到这一点。

你可以在JWA libraries找到这个，或者自己打电话。