一种自动关闭对话框的简单方法

{******************************************************

{                                                                                                 

{       一种自动关闭对话框的简单方法                                                       

{                                                                                                  

{   使用方法：打开对话框前调用 SetDlgAutoClose                                      

{             参数1： 设定多长时间后关闭                                                   

{             参数2： 是否在对话框标题栏进行倒计时提示                                 

{             取消自动关闭调用 ResetDlgAutoClose                                       

{                                                                                                   

{       任何转载请保留此文件的完整，如果进行修改请                                     

{   通知作者，谢谢合作。                                                                      

{                                                                                                   

{   作者: lichaohui  2004-03-03                                                            

{   Email: mastercn@163.com                                                                                           

{                                                                                                           

{*******************************************************

 

unit TimerDlg;

 

interface

 

uses

   Windows, Messages, SysUtils, Classes, Forms, ExtCtrls;

 

 

// 如果指定的时间没有操作对话框,则自动关闭

procedure ResetDlgAutoClose;

procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);

   

implementation

 

 

{** 如果对话框被打开,则在指定时间后关闭,并在标题栏进行提示 }

var

   nWndCount:  Integer  =  0 ;

   SavWnds, SavWnds2:  array  of  THandle;

   hDlgWnd: THandle =  0 ;

   hTimerk:  Integer  =  0 ;

   nTimerTick:  Integer  =  0 ;

   nLastTrk:  Integer  =  0 ;

   nDoHint:  Integer  =  0 ;

   nCapCt:  Integer  =  0 ;

   nSavCapt:  String  =  '' ;

   fTimer1: TTimer =  nil ;

 

function  MyEnumProc(hWnd: THandle; lParam:  Integer ):  Boolean ; stdcall;

var

   n:  Integer ;

begin

   Result :=  True ;

   if  lParam =  0  then

   begin

     if  not  IsWindowEnabled(hWnd)  then  Exit;

     if  not  IsWindowVisible(hWnd)  then  Exit;

   end ;

   n := (nWndCount +  10 )  div  10  *  10 ;

   SetLength(SavWnds, n);

   SavWnds[nWndCount] := hWnd;

   Inc(nWndCount);

end ;

 

procedure  MyTimerProc(hWnd: THandle; uMsg:  Integer ;

   idEvent:  Integer ; dwTime:  Integer );

var

   i, t:  Integer ;

   function  FindInArray(ar:  array  of  THandle; hd: THandle):  Boolean ;

   var

     t:  Integer ;

   begin

     Result :=  False ;

     for  t := Low(ar)  to  High(ar)  do

     begin

       Result := ar[t] = hd;

       if  Result  then  Break;

     end ;

   end ;

begin

   if  (hDlgWnd =  0 )  and  (SavWnds =  nil )  and  (SavWnds2 <>  nil )  then

   begin

     nWndCount :=  0 ;

     EnumThreadWindows(GetCurrentThreadId, @MyEnumProc,  0 );

     SetLength(SavWnds, nWndCount);

     for  i := Low(SavWnds)  to  High(SavWnds)  do

     begin

       if  not  FindInArray(SavWnds2, SavWnds[i])  then

       begin

         if  SavWnds[i] = GetActiveWindow  then

         begin

           hDlgWnd := SavWnds[i];

         end ;

       end ;

     end ;

     if  hDlgWnd =  0  then  ResetDlgAutoClose;

     nLastTrk := GetTickCount;

     SetLength(nSavCapt,  500 );

     t := GetWindowText(hDlgWnd,  PChar (nSavCapt),  500 );

     SetLength(nSavCapt, t);

     nCapCt :=  0 ;

   end

   else

   if  (hDlgWnd <>  0 )  then

   begin

     if  not  IsWindow(hDlgWnd)  or

       not  IsWindowVisible(hDlgWnd)  or

       not  IsWindowEnabled(hDlgWnd)  then

     begin

       ResetDlgAutoClose;

       Exit;

     end ;

     t := GetTickCount;

     t := (nTimerTick - (t - nLastTrk) -  1 );

     if  t <=  0  then

     begin

       // try to use SendMessge instead using PostMessage

       PostMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE,  0 );

//      SendMessage(hDlgWnd, WM_SYSCOMMAND,SC_CLOSE, 0);

     (* 2 lines added by jiatao

       SetForegroundWindow(hDlgWnd);

       PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN,0);

     *)

       SetForegroundWindow(hDlgWnd);

       PostMessage(hDlgWnd, WM_KEYDOWN,VK_RETURN, 0 );

 

       ResetDlgAutoClose;

     end

     else

     if  (nDoHint >  0 )  then

     begin

       t := (t +  1000 )  div  1000 ;

       if  nCapCt <> t  then

       begin

         SetWindowText(hDlgWnd,

           PChar (Format( '(%d)%2s%s' , [t,  ' ' , nSavCapt])));

         nCapCt := t;

       end ;

     end ;

   end ;

end ;

 

procedure  TimerFunc(Sender: TObject);

begin

   MyTimerProc( 0 ,  0 ,  0 ,  0 );

end ;

 

procedure  SetDlgAutoClose(nTime:  Integer ; ADoHint:  Boolean  =  False );

var

   FakeEvt: TNotifyEvent;

   Ptrs:  array [ 1..2 ]  of  Pointer  absolute FakeEvt;

begin

   ResetDlgAutoClose;

   nWndCount :=  0 ;

   EnumThreadWindows(GetCurrentThreadId, @MyEnumProc,  1 );

   SetLength(SavWnds, nWndCount);

   SavWnds2 := SavWnds;

   SavWnds :=  nil ;

   if  not  Assigned(fTimer1)  then

   begin

     fTimer1 := TTimer . Create(Application);

     Ptrs[ 2 ] :=  nil ;

     Ptrs[ 1 ] := @TimerFunc;

     fTimer1 . OnTimer := FakeEvt;

     fTimer1 . Interval :=  100 ;

     fTimer1 . Enabled :=  True ;

   end ;

   nLastTrk := GetTickCount;

   nDoHint := Ord(ADoHint);

   nTimerTick := nTime;

end ;

 

procedure  ResetDlgAutoClose;

begin

   if  hDlgWnd <>  0  then

   begin

     SetWindowText(hDlgWnd,  PChar (nSavCapt));

   end ;

   if  Assigned(fTimer1)  then

     FreeAndNil(fTimer1);

   nWndCount :=  0 ;

   hDlgWnd :=  0 ;

   SavWnds :=  nil ;

   SavWnds2 :=  nil ;

   nTimerTick :=  0 ;

end ;

 

end .