Закрыть диалоговое окно Delphi после [x] секунд

Ответ 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;

Обработка ошибок опущена, но это должно помочь вам начать.

Ответ 2

Вы можете попробовать сделать это с помощью стандартного диалогового окна сообщений. Создайте диалог с помощью процедуры 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. Аналогичным образом вы можете добавить другие типы компонентов.

С уважением.

Ответ 3

OK. У вас есть 2 варианта:

1 - Вы можете создать свою собственную форму MessageDialog. Затем вы можете использовать его и добавить TTimer, который закроет форму, когда захотите.

2. Вы можете продолжать использовать showmessage и создавать поток, который будет использовать FindWindow (чтобы найти окно messadialog) и затем закрыть его.

Я рекомендую вам использовать вашу собственную форму с таймером на ней. Его чище и проще.

Ответ 4

Попробуйте следующее:

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

Я использовал это довольно долгое время; это работает.

Ответ 5

Я думал об использовании отдельного потока, но, вероятно, вы получите много ненужного кода и т.д. Диалоги Windows просто не были сделаны для этой вещи.

Вы должны сделать свою собственную форму. С хорошей стороны вы можете иметь собственный код/​​пользовательский интерфейс с обратным отсчетом, например, по таймеру.

Ответ 6

Нет. ShowMessage и MessageDlg - это модальные окна, что означает, что ваше приложение в основном приостановлено, пока они отображаются.

Вы можете создать свой собственный диалог замены, на котором есть таймер. В событии FormShow включите таймер, а в событии FormClose отключите его. В событии OnTimer отключите таймер и закройте его.

Ответ 7

Вы можете подключить событие 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

Это отлично работает с 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;

////////////////////////////How Call It//////////////////

DialogBoxAutoClose ('Alert' ', "Это сообщение будет закрыто через 10 секунд", 10);

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

Ответ 9

MessageBox вызывает эту функцию внутренне и передает 0xFFFFFFFF в качестве параметра тайм-аута, поэтому вероятность его удаления минимальна (благодаря Маурицио для этого)

Ответ 10

Лучший способ - использовать форму Stayontop и управлять счетчиком, чтобы исчезнуть, используя свойство alfpha blend формы, в конце счета просто закройте форму, но элемент управления будет передан активному элементу управления, необходимому перед показом формы, таким образом, у пользователя появится сообщение, которое автоматически исчезнет и не будет препятствовать использованию следующей функции, очень классный трюк для меня.

Ответ 11

Вы можете сделать это с помощью WTSSendMessage.

Вы можете найти это в JWA-библиотеках или вызвать его самостоятельно.