不用HOOK实现倒计时对话框

    这里所说的倒计时对话框不是自定义对话框，自定义对话框很简单；也不是MessageBoxTimeout定时对话框，定时对话框是时间一到自动关闭。所谓倒计时对话框是由系统弹出的MsgBox对话框,是要在对话框上面动态地显示倒计时间,比如：10,9,8,7,6,5,4,3,2,1秒，然后自动关闭。实现的方法是用多媒体计时器API函数timeSetEvent，当模式对话框一弹出，像Timer这样的计时器都将被挂起，所以不能用Timer来实现，但timeSetEvent却可以，该API函数内部实现多线程，当用鼠标按住模式对话框的标题栏拖动对话框窗口时，不会影响回调的执行，不会影响倒计时间运行，也就是不会挂起timeSetEvent使用的回调函数TimeSetProc。从这一点来看，timeSetEvent比高精度频率计数器QueryPerformanceCounter、QueryPerformanceFrequency优越，前者会自动刷新界面，但后者不会（这里有一个例子可以对比：http://blog.youkuaiyun.com/chenjl1031/archive/2008/01/09/2032579.aspx）。
    程序首先在TimeSetProc回调中枚举所有顶级窗口和子窗口，找到模式对话框的句柄和对话框提示文本的句柄，然后发送消息WM_SETTEXT动态地更新时间，时间一到发送消息WM_CLOSE关闭该模式对话框，并关闭多媒体计时器对象；如果响应了鼠标按钮，则直接关闭多媒体计时器对象。
    非常遗憾的是，该程序只能编译成P代码才能正常运行。原因是TimeSetProc回调中调用了枚举顶级窗口和子窗口的回调，把这几行删除则可以编译成本地代码运行，但就不能实现该程序的功能了。

标准模块：

'标准模块：Module1.bas Option Explicit Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long Private Const TIME_PERIODIC As Long = 1 ' program for continuous periodic event Private Const TIME_ONESHOT As Long = 0 ' program timer for single event 'Public MediaCount As Double '累加量 Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long 'Public Const WM_GETTEXT As Long = &HD& Private Const WM_SETTEXT As Long = &HC& Private Const WM_CLOSE As Long = &H10& Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private TimeID As Long '返回多媒体记时器对象标识 Private Dlghwnd As Long '对话框句柄 Private Dlgtexthwnd As Long '对话框提示文本句柄 Private MsgboxClosetime As Long '设置对话框关闭时间 Private MsgboxPromtText As String '设置对话框提示文本 '枚举所有顶级窗口 Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim WindowCaption As String, CaptionLength As Long, WindowClassName As String * 256 CaptionLength = GetWindowTextLength(hWnd) WindowCaption = Space(CaptionLength) Call GetWindowText(hWnd, WindowCaption, CaptionLength + 1) If InStr(1, WindowCaption, MsgboxPromtText) > 0 Then Dlghwnd = hWnd End If EnumWindowsProc = 1 End Function '枚举所有子窗口 Private Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim WindowCaption As String, CaptionLength As Long, WindowClassName As String * 256 CaptionLength = GetWindowTextLength(hWnd) WindowCaption = Space(CaptionLength) Call GetWindowText(hWnd, WindowCaption, CaptionLength + 1) Call GetClassName(hWnd, WindowClassName, 256) If InStr(1, WindowClassName, "Static") > 0 Then Dlgtexthwnd = hWnd End If EnumChildWindowsProc = 1 End Function 'API函数timeSetEvent使用的回调函数 Private Function TimeSetProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long Dim cText As String Static MediaCount As Double ', Msghwnd1 As Long, Msghwnd2 As Long MediaCount = MediaCount + 0.5 If Dlgtexthwnd > 0 Then cText = CStr(MsgboxClosetime - Fix(MediaCount)) & "秒后自动关闭！" Call SendMessage(Dlgtexthwnd, WM_SETTEXT, Len(cText), ByVal cText) If Val(cText) = 0 Then MediaCount = 0 Call SendMessage(Dlghwnd, WM_CLOSE, 0, 0) '时间到，关闭对话框 Call timeKillEvent(TimeID) '删除多媒体计时器标识 End If Else Call EnumWindows(AddressOf EnumWindowsProc, 0) If Dlghwnd > 0 Then Call EnumChildWindows(Dlghwnd, AddressOf EnumChildWindowsProc, 0) End If End If TimeSetProc = 1 End Function '定时关闭对话框：Closetime参数设置对话框关闭时间；Msgboxtitle参数设置对话框提示文本；vbButtons参数是设置对话框按钮及图标。 Public Function Fixedtimeclosemsgbox(ByVal Closetime As Long, ByVal Msgboxtitle As String, Optional vbButtons As VbMsgBoxStyle = vbOKOnly) As Long Dim Information As Long Dlghwnd = 0: Dlgtexthwnd = 0 MsgboxClosetime = Closetime MsgboxPromtText = Msgboxtitle TimeID = timeSetEvent(500, 0, AddressOf TimeSetProc, 1, TIME_PERIODIC) '时间间隔为500毫秒 Information = MsgBox(Closetime & "秒后自动关闭！", vbButtons, Msgboxtitle) '定义msgbox对话框 Call timeKillEvent(TimeID) '删除多媒体计时器标识 Fixedtimeclosemsgbox = 1 End Function

 

测试窗体代码：

Option Explicit Private Sub Command1_Click() Call Fixedtimeclosemsgbox(10, "VB6倒计时对话框", vbYesNoCancel + vbInformation + vbSystemModal) End Sub