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

时间:2010-12-17 15:52:57

标签: delphi dialog timeout

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

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

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

11 个答案:

答案 0 :(得分:12)

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

因此无需创建线程或跳过其他任何环节,您只需安排关闭消息框的代码在经过10秒后运行。一种简单的方法是在没有目标HWND的情况下调用SetTimer(),但调用回调函数:

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;

错误处理已被忽略,但这应该让你开始。

答案 1 :(得分: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;

这样的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时,表单自动关闭。与此类似,您可以添加其他类型的组件。

alt text

问候。

答案 2 :(得分:8)

试试这个:

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

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

答案 3 :(得分:7)

行。你有两个选择:

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

2 - 你可以继续使用showmessage并创建一个使用FindWindow的线程(找到messadialog窗口),然后关闭它。

我建议你使用自己的表格,上面有计时器。它更干净,更容易。

答案 4 :(得分:1)

MessageBox在内部调用此函数并传递0xFFFFFFFF作为超时参数,因此删除它的概率很小(感谢Maurizio)

答案 5 :(得分:0)

我考虑过使用一个单独的线程,但它可能会让你进入许多不必要的代码等等。对话框根本就没有针对这个东西制作。

你应该做自己的表格。从好的方面来说,您可以使用自定义代码/ UI进行倒计时,例如定时对话框。

答案 6 :(得分:0)

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

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

答案 7 :(得分:0)

您可以连接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}

享受

答案 8 :(得分:0)

这适用于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);

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

答案 9 :(得分:0)

最好的方法是使用一个stayontop形式并使用表单的alfpha blend属性管理一个计数器消失,在计数结束时关闭表单,但是 在显示表单之前,控件将被传递给所需的主动控件,这样,用户将有一条消息自动消失并且不会阻止使用下一个功能,这对我来说非常酷。

答案 10 :(得分:-1)

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

您可以在JWA libraries中找到,或自行调用。