Закрыть диалог Delphi через [x] секунд - PullRequest
12 голосов
/ 17 декабря 2010

Можно ли заставить Delphi закрыть диалог ShowMessage или MessageDlg по истечении определенного промежутка времени?

Я хочу показать сообщение пользователю, когда приложение закрыто, но не хочуостановка закрытия приложения более чем на 10 секунд или около того.

Можно ли закрыть диалоговое окно по умолчанию через определенное время или мне нужно написать свою собственную форму?

Ответы [ 11 ]

12 голосов
/ 17 декабря 2010

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

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

11 голосов
/ 17 декабря 2010

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

И проверьте это.
Форма закрывается автоматически, когда таймер завершает отсчет времени.Подобным образом вы можете добавить другой тип компонентов.

alt text

С уважением.

8 голосов
/ 17 декабря 2010

Попробуйте это:

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

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

7 голосов
/ 17 декабря 2010

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

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

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

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

1 голос
/ 03 февраля 2015

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

0 голосов
/ 15 февраля 2017

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

0 голосов
/ 14 января 2011

Это прекрасно работает с 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);

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

0 голосов
/ 18 декабря 2010

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

наслаждаться

0 голосов
/ 17 декабря 2010

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

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

0 голосов
/ 17 декабря 2010

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

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...