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

{------------------------------------------------------------------------------

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

   使用方法：打开对话框前调用 SetDlgAutoClose
             参数1： 设定多长时间后关闭
             参数2： 是否在对话框标题栏进行倒计时提示
             取消自动关闭调用 ResetDlgAutoClose

       任何转载请保留此文件的完整，如果进行修改请
   通知作者，谢谢合作。

   作者: lichaohui  2004-03-03
   Email: mastercn@163.com


   改进说明：对于原版无法关闭标题栏关闭按钮无效的窗口
             如MessageBox(...mb_YesNo...)的问题进行改进
   使用方法：打开对话框前调用 SetDlgAutoClose
             参数1： 设定多长时间后关闭
             参数2： 是否在对话框标题栏进行倒计时提示
             参数3： 默认false，若是ture则才可关闭标题
                     栏关闭按钮无效的窗口
             取消自动关闭调用 ResetDlgAutoClose

-------------------------------------------------------------------------------}

unit  TimerDlg ;

interface

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

{ 如果指定的时间没有操作对话框,则自动关闭 }
procedure  ResetDlgAutoClose ;

procedure  SetDlgAutoClose ( nTime :  Integer ;  ADoHint :  Boolean ;  AReturn :  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 ;
   bReturn :  Boolean  =  false ;

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
       if  ( not  bReturn )  then
         PostMessage ( hDlgWnd ,  WM_CLOSE ,  0 ,  0 )
       else
       begin
         //主要用于关闭那些关闭按钮为灰的窗口
         PostMessage ( hDlgWnd ,  wm_KeyDown ,  vk_Return ,  0 );
         PostMessage ( hDlgWnd ,  wm_KeyUp ,  vk_Return ,  0 );
       end ;
       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 ;  AReturn :  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 ;
   bReturn  :=  AReturn ;
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 .