Можно ли заставить Delphi закрыть диалоговое окно ShowMessage или MessageDlg через определенный промежуток времени?
Я хочу показать сообщение пользователю, когда приложение закрыто, но не хотите, чтобы приложение прекратило работу более 10 секунд.
Можно ли закрыть диалоговое окно по умолчанию через определенное время или мне нужно будет написать свою собственную форму?
Ваше приложение по-прежнему работает, пока модальное диалоговое окно или системное сообщение или аналогичное приложение активны (или пока открыто меню), просто выполняется цикл вторичного сообщения, который обрабатывает все сообщения - все сообщения, отправленные или отправленные в он, и он будет синтезировать (и обрабатывать) сообщения 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;
Обработка ошибок опущена, но это должно помочь вам начать.
Вы можете попробовать сделать это с помощью стандартного диалогового окна сообщений. Создайте диалог с помощью процедуры 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. Аналогичным образом вы можете добавить другие типы компонентов.
С уважением.
OK. У вас есть 2 варианта:
1 - Вы можете создать свою собственную форму MessageDialog. Затем вы можете использовать его и добавить TTimer, который закроет форму, когда захотите.
2. Вы можете продолжать использовать showmessage и создавать поток, который будет использовать FindWindow (чтобы найти окно messadialog) и затем закрыть его.
Я рекомендую вам использовать вашу собственную форму с таймером на ней. Его чище и проще.
Попробуйте следующее:
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer;
stdcall; external user32 name 'MessageBoxTimeoutA';
Я использовал это довольно долгое время; это работает.
Я думал об использовании отдельного потока, но, вероятно, вы получите много ненужного кода и т.д. Диалоги Windows просто не были сделаны для этой вещи.
Вы должны сделать свою собственную форму. С хорошей стороны вы можете иметь собственный код/пользовательский интерфейс с обратным отсчетом, например, по таймеру.
Нет. ShowMessage и MessageDlg - это модальные окна, что означает, что ваше приложение в основном приостановлено, пока они отображаются.
Вы можете создать свой собственный диалог замены, на котором есть таймер. В событии FormShow включите таймер, а в событии FormClose отключите его. В событии OnTimer отключите таймер и закройте его.
Вы можете подключить событие 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}
пользоваться
Это отлично работает с 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);
/////////////////////////////////////////////////////////
MessageBox вызывает эту функцию внутренне и передает 0xFFFFFFFF в качестве параметра тайм-аута, поэтому вероятность его удаления минимальна (благодаря Маурицио для этого)
Лучший способ - использовать форму Stayontop и управлять счетчиком, чтобы исчезнуть, используя свойство alfpha blend формы, в конце счета просто закройте форму, но элемент управления будет передан активному элементу управления, необходимому перед показом формы, таким образом, у пользователя появится сообщение, которое автоматически исчезнет и не будет препятствовать использованию следующей функции, очень классный трюк для меня.
Вы можете сделать это с помощью WTSSendMessage.
Вы можете найти это в JWA-библиотеках или вызвать его самостоятельно.