Dan*_*lly 12 delphi timeout dialog
是否有可能让Delphi在一段时间后关闭ShowMessage或MessageDlg对话框?
我想在关闭应用程序时向用户显示一条消息,但不想让应用程序关闭超过10秒钟左右.
我可以在定义的时间后关闭默认对话框,还是需要编写自己的表单?
mgh*_*hie 12
当模态对话框或系统消息框或类似文件处于活动状态时(或菜单打开时),您的应用程序实际上仍在工作,只是正在运行一个辅助消息循环,它处理所有消息 - 发送或发送给它的所有消息,以及它还将在必要时合成(和处理)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;
Run Code Online (Sandbox Code Playgroud)
错误处理已被省略,但这应该可以帮助您入门.
Ger*_*lí- 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;
Run Code Online (Sandbox Code Playgroud)
像这样的OnTimer属性:
procedure TForm1.MyOnTimer(Sender: TObject);
begin
inc(counter);
lbl.Caption := 'Counting: ' + IntToStr(counter);
if (counter >= 5) then begin
AMsgDialog.Close;
end;
end;
Run Code Online (Sandbox Code Playgroud)
定义变量和过程:
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
AMsgDialog: TForm;
lbl:TLabel;
counter:integer;
procedure MyOnTimer(Sender: TObject);
end;
Run Code Online (Sandbox Code Playgroud)
并测试它.
当计时器最终CountDown时,表单自动关闭.与此类似,您可以添加其他类型的组件.

问候.
试试这个:
function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer;
stdcall; external user32 name 'MessageBoxTimeoutA';
Run Code Online (Sandbox Code Playgroud)
我已经用了很长时间了; 它是一种享受.
好.你有2个选择:
1 - 您可以创建自己的MessageDialog表单.然后,您可以使用它并添加一个TTimer,它将在您需要时关闭表单.
2 - 您可以继续使用showmessage并创建一个将使用FindWindow(查找messadialog窗口)然后关闭它的线程.
我建议你使用自己的表格和计时器.它更干净,更容易.
| 归档时间: |
|
| 查看次数: |
18646 次 |
| 最近记录: |