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

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

{                                                                                                 

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

{                                                                                                  

{   使用方法：打开对话框前调用 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.