delphi实现延时自动关闭对话框

1、delphi实现延时自动关闭对话框*一种自动关闭对话框的简单方法使用方法：打开对话框前调用SetDlgAutoClose参数1:设定多长时间后关闭参数2:是否在对话框标题栏进行倒计时提示取消自动关闭调用ResetDlgAutoCloseunit*TimerDlg;interfaceusesWindows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,ExtCtrls;/如果指定的时间没有操作对话框，则自动关闭procedureResetDlgAutoClose;procedureSetDlgAutoClose(nTime:

2、Integer;ADoHint:Boolean=False);implementation*如果对话框被打开，贝U在指定时间后关闭，并在标题栏进行提示varnWndCount:Integer=0;SavWnds,SavWnds2:arrayofTHandle;hDlgWnd:THandle=0;hTimerk:Integer=0;nTimerTick:Integer=0;nLastTrk:Integer=0;nDoHint:Integer=0;nCapCt:Integer=0;nSavCapt:String=''fTimer1:TTimer=nil;functionMyEnum

3、Proc(hWnd:THandle;lParam:Integer):Boolean;stdcall;varn:Integer;beginResult:=True;iflParam=0thenbeginifnotIsWindowEnabled(hWnd)thenExit;ifnotIsWindowVisible(hWnd)thenExit;end;n:=(nWndCount+10)div10*10;SetLength(SavWnds,n);SavWndsnWndCount:=hWnd;Inc(nWndCount);end;procedureMyTimerProc(hWnd:THandle;uMs

4、g:Integer;idEvent:Integer;dwTime:Integer);vari,t:Integer;functionFindInArray(ar:arrayofTHandle;hd:THandle):Boolean;vart:Integer;beginResult:=False;fort:=Low(ar)toHigh(ar)dobeginResult:=art=hd;ifResultthenBreak;end;end;beginif(hDlgWnd=0)and(SavWnds=nil)and(SavWnds2nil)thenbeginnWndCount:=0;EnumThread

5、Windows(GetCurrentThreadId,MyEnumProc,0);SetLength(SavWnds,nWndCount);fori:=Low(SavWnds)toHigh(SavWnds)dobeginifnotFindInArray(SavWnds2,SavWndsi)thenbeginifSavWndsi=GetActiveWindowthenbeginhDlgWnd:=SavWndsi;end;end;end;ifhDlgWnd=0thenResetDlgAutoClose;nLastTrk:=GetTickCount;SetLength(nSavCapt,500);t

6、:=GetWindowText(hDlgWnd,PChar(nSavCapt),500);SetLength(nSavCapt,t);nCapCt:=0;endelseif(hDlgWnd0)thenifnotIsWindow(hDlgWnd)ornotIsWindowVisible(hDlgWnd)ornotIsWindowEnabled(hDlgWnd)thenbeginResetDlgAutoClose;Exit;end;t:=GetTickCount;t:=(nTimerTick-(t-nLastTrk)-1);ift0)thenbegint:=(t+1000)div1000;ifnC

7、apCttthenbeginSetWindowText(hDlgWnd,PChar(Format('(%d)%2s%s',t,'',nSavCapt);nCapCt:=t;end;end;end;end;procedureTimerFunc(Sender:TObject);MyTimerProc(0,0,0,0);end;procedureSetDlgAutoClose(nTime:Integer;ADoHint:Boolean=False);varFakeEvt:TNotifyEvent;Ptrs:array1.2ofPointerabsoluteFakeEv

8、t;beginResetDlgAutoClose;nWndCount:=0;EnumThreadWindows(GetCurrentThreadId,MyEnumProc,1);SetLength(SavWnds,nWndCount);SavWnds2:=SavWnds;SavWnds:=nil;ifnotAssigned(fTimer1)thenbeginfTimer1:=TTimer.Create(Application);Ptrs2:=nil;Ptrs1:=TimerFunc;fTimer1.OnTimer:=FakeEvt;fTimer1.Interval:=100;fTimer1.E

9、nabled:=True;end;nLastTrk:=GetTickCount;nDoHint:=Ord(ADoHint);nTimerTick:=nTime;end;procedureResetDlgAutoClose;beginifhDlgWnd0thenbeginSetWindowText(hDlgWnd,PChar(nSavCapt);end;ifAssigned(fTimer1)thenFreeAndNil(fTimer1);nWndCount:=0;hDlgWnd:=0;SavWnds:=nil;SavWnds2:=nil;nTimerTick:=0;end;end.测试proce

10、dureTForm1.Button1Click(Sender:TObject);beginSetDlgAutoClose(15*1000,True);ShowMessage('Thismessageboxwillcloseautomatically,+#13#10+'afterfifteenseconds.');end;procedureTForm1.Button3Click(Sender:TObject);beginSetDlgAutoClose(8000,Sender=Button3);MessageBox(Handle,PChar('这是一个测试例子'+#13#10+'此消息框将在8秒钟后自动关闭'+#13#10+'只需要在调用消息框和对话框之前调用一个函数+#13#10+'就可以方便的实现这种效果'),'定时自动关闭的消息框',MB_ICONINFORMATIONorMB_OKCANCEL);end;procedureTForm1.Button2Click(Sender:TObject);vardlg:TDlgTest;beginSetD