7,765
社区成员
发帖
与我相关
我的任务
分享有时间限制的对话框－－－－－－－－－－－－有时间限制的对话框
如何写有时间限制的对话框
我记得十一个很老的话题，大家帮忙
就是用msgbox弹出对话框以后，在规定得时间里面使对话框消失
我记得使用了2个api函数！
...全文
请发表友善的回复…
发表回复
freeda 2002-01-29
- 打赏
- 举报
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Const NV_CLOSEMSGBOX As Long = &H5000&
Private sLastTitle As String
Public Function Mymsgbox(AutoCloseSeconds As Long, prompt As String, Optional buttons As Long, _
Optional title As String, Optional helpfile As String, _
Optional context As Long) As Long
sLastTitle = title
SetTimer Screen.ActiveForm.hWnd, NV_CLOSEMSGBOX, AutoCloseSeconds * 1000, AddressOf TimerProc
Mymsgbox = MsgBox(prompt, buttons, title, helpfile, context)
End Function
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim hMessageBox As Long
KillTimer hWnd, idEvent
Select Case idEvent
Case NV_CLOSEMSGBOX
hMessageBox = FindWindow("#32770", sLastTitle)
If hMessageBox Then
Call SetForegroundWindow(hMessageBox)
SendKeys "{enter}"
End If
sLastTitle = vbNullString
End Select
End Sub
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Const NV_CLOSEMSGBOX As Long = &H5000&
Private sLastTitle As String
Public Function Mymsgbox(AutoCloseSeconds As Long, prompt As String, Optional buttons As Long, _
Optional title As String, Optional helpfile As String, _
Optional context As Long) As Long
sLastTitle = title
SetTimer Screen.ActiveForm.hWnd, NV_CLOSEMSGBOX, AutoCloseSeconds * 1000, AddressOf TimerProc
Mymsgbox = MsgBox(prompt, buttons, title, helpfile, context)
End Function
Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim hMessageBox As Long
KillTimer hWnd, idEvent
Select Case idEvent
Case NV_CLOSEMSGBOX
hMessageBox = FindWindow("#32770", sLastTitle)
If hMessageBox Then
Call SetForegroundWindow(hMessageBox)
SendKeys "{enter}"
End If
sLastTitle = vbNullString
End Select
End Sub
dbcontrols 2002-01-29
- 打赏
- 举报
我记得没这么麻烦.很简单的.
zyl910 2002-01-29
- 打赏
- 举报
倒……
比http://www.csdn.net/expert/topic/505/505168.shtm还复杂了！
比http://www.csdn.net/expert/topic/505/505168.shtm还复杂了！
uguess 2002-01-29
- 打赏
- 举报
Creating a VB-Timed Message Box with SetWindowsHookEx
Posted: Saturday March 24, 2001
Updated: Monday October 29, 2001
Applies to: VB5, VB6
Developed with: VB6, Windows 2000
OS restrictions: None
Author: VBnet - Randy Birch
Related:
Using Win32's MessageBoxEx API
Modifying a Message Box with SetWindowsHookEx
Creating a VB-Timed Message Box with SetWindowsHookEx
Creating an API-Timed Message Box with SetWindowsHookEx
Prerequisites
VB5 / VB6.
--------------------------------------------------------------------------------
Using a window hook to control display of an API-generated message box is not a difficult task in VB, as Modifying a Message Box with SetWindowsHookEx has shown. This code shows how to use the above methods to present a message box that performs in a non-standard fashion.
Like the above example, this code uses a hook procedure created with SetWindowsHookEx to catch the creation of the message box and perform changes to its interface prior to display -- the captions of the messagebox buttons are changed to better reflect the purpose of the dialog. The hook is then terminated. But the code goes further-- it also starts a timer on the form whose Timer event changes the text displayed once per interval - in this case once per second - creating a "countdown" message box.
In calling the initial code, the developer specifies which of the buttons presented represents the 'default' action to be taken in case the timer elapses without user intervention. When this occurs, the Timer event uses GetDlgItem to retrieve the handle of the 'default action' button specified through the dwTimerExpireButton flag, calling PostMessage to send that button a pair of WM_LBUTTONDOWN and WM_LBUTTONUP messages. The effect is to dismiss the dialog through code as if the user had pressed the button specified, thereby executing any code in the app conditional on a button press. Should the user press a button during the messagebox display, the timer is stopped and the button pressed is returned as usual.
This demo uses three buttons on the dialog -- I chose to use the About-Retry-Ignore set for no specific reason, so the Yes-No-Cancel set could have been used instead. But in order for the working code to accurately reflect the purpose of the altered buttons (read "to avoid confusion"), I defined three new constants - IDSELECT, IDBEGIN and IDSKIP - and assigned the Windows-defined constant values for IDABORT, IDRETRY and IDIGNORE to them. You'll see the use in the Command1_Click event and the hook proc. Debugging the app will be easier - especially in the future - when encountering the line "dwTimerExpireButton = IDBEGIN" rather than the line "dwTimerExpireButton = IDRETRY".
To show how little code is needed to actually perform this demo, I have only provided the declares for functions and constants actually used. You can grab the complete set from the API viewer, or from the MessageBoxEx example page here in the sample Using Win32's MessageBoxEx API.
BAS Module Code
Place the following code into the general declarations area of a bas module:
--------------------------------------------------------------------------------
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'needed public for the Timer event
Public hwndMsgBox As Long
'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
Public Type CUSTOM_MSG_PARAMS
hOwnerThread As Long
hOwnerWindow As Long
dwStyle As Long
bUseTimer As Boolean
dwTimerDuration As Long
dwTimerInterval As Long
dwTimerExpireButton As Long
dwTimerCountDown As Long
sTitle As String
sPrompt As String
End Type
Public cmp As CUSTOM_MSG_PARAMS
'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
'Windows-defined MessageBox return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Public Const IDSELECT = IDABORT
Public Const IDBEGIN = IDRETRY
Public Const IDSKIP = IDIGNORE
Public Const IDPROMPT = &HFFFF&
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'When the message box is about to be shown,
'we'll change the titlebar text, prompt message
'and button captions
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox - save that
'for the timer event
hwndMsgBox = wParam
'the ID's of the buttons on the message box
'correspond exactly to the values they return,
'so the same values can be used to identify
'specific buttons in a SetDlgItemText call.
SetDlgItemText wParam, IDSELECT, "Select.."
SetDlgItemText wParam, IDBEGIN, "Begin"
SetDlgItemText wParam, IDSKIP, "Skip"
'we're done with the dialog, so release the hook
UnhookWindowsHookEx MHP.hHook
End If
'return False to let normal processing continue
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'Set up the hook
hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MHP
.hwndOwner = cmp.hOwnerWindow
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
'(re)set the countdown value to 0
cmp.dwTimerCountDown = 0
'if bUseTimer, enable the timer. Because the
'MessageBox API acts just as the MsgBox function
'does (that is, creates a modal dialog), control
'won't return to the next line until the dialog
'is closed. This necessitates our starting the
'timer before making the call.
'
'However, timer events will execute once the
'modal dialog is shown, allowing us to use the
'timer to dynamically modify the on-screen message!
With Form1.Timer1
.Interval = cmp.dwTimerInterval
.Enabled = cmp.bUseTimer
End With
'call the MessageBox API and return the
'value as the result of the function
TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
cmp.sPrompt, _
cmp.sTitle, _
cmp.dwStyle)
'in case the timer event didn't
'suspend the timer, do it now
Form1.Timer1.Enabled = False
End Function
'--end block--'
Form Code
Add a text box (Text1), a command button (Command1) and a Timer control (Timer1) to a form, along with the following code:
--------------------------------------------------------------------------------
Option Explicit
Private Sub Command1_Click()
'Display wrapper message box,
'passing the CUSTOM_MSG_PARAMS
'struct as the parameter.
With cmp
.sTitle = "VBnet Timed MessageBox Hook Demo"
.sPrompt = "To start searching C: immediately, select Begin." & vbCrLf & _
"To select a different drive, press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in 10 seconds." & Space$(20)
.dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
.bUseTimer = True 'if True the Timer will update once per dwTimerInterval
.dwTimerDuration = 10 'time to wait seconds
.dwTimerInterval = 1000 'countdown interval in milliseconds
.dwTimerExpireButton = IDBEGIN 'message to return if timeout occurs
.dwTimerCountDown = 0 '(re)set to 0
.hOwnerThread = Me.hwnd 'handle of form owning the thread on which
'execution is proceeding.
'The thread owner is always the calling form.
.hOwnerWindow = Me.hwnd 'who owns the dialog (me.hwnd or desktop).
'GetDesktopWindow allows user-interaction
'with the form while the dialog is displayed.
'This may not be desirable, so set accordingly.
End With
Select Case TimedMessageBoxH(cmp)
Case IDSELECT: Text1.Text = "Select button pressed before timeout"
Case IDBEGIN: Text1.Text = "Begin button pressed or message timed out"
Case IDSKIP: Text1.Text = "Skip button pressed before timeout"
End Select
End Sub
Private Sub Timer1_Timer()
Dim hWndTargetBtn As Long
If hwndMsgBox <> 0 Then
'increment the counter
cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1
'update the prompt message with the countdown value
SetDlgItemText hwndMsgBox, IDPROMPT, _
"To start searching C: immediately, select Begin." & vbCrLf & _
"To select a different drive, press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds."
'if the timer has 'expired' (the
'count=duration), we need to
'programmatically 'press' the button
'specified as the default on timeout
If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
'we can kill this timer
Timer1.Enabled = False
'obtain the handle to the
'button designated as default
'if the timer expires
hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
If hWndTargetBtn <> 0 Then
'set the focus to the target button and
'simulate a click to close the dialog and
'return the correct value
Call PutFocus(hWndTargetBtn)
'need a DoEvents to allow PutFocus
'to actually put focus
DoEvents
'simulate a mouse click on the button
Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
End If
End If
End If
End Sub
'--end block--'
Comments
See the Comments section at Modifying a Message Box with SetWindowsHookEx for more info on window hook types.
Posted: Saturday March 24, 2001
Updated: Monday October 29, 2001
Applies to: VB5, VB6
Developed with: VB6, Windows 2000
OS restrictions: None
Author: VBnet - Randy Birch
Related:
Using Win32's MessageBoxEx API
Modifying a Message Box with SetWindowsHookEx
Creating a VB-Timed Message Box with SetWindowsHookEx
Creating an API-Timed Message Box with SetWindowsHookEx
Prerequisites
VB5 / VB6.
--------------------------------------------------------------------------------
Using a window hook to control display of an API-generated message box is not a difficult task in VB, as Modifying a Message Box with SetWindowsHookEx has shown. This code shows how to use the above methods to present a message box that performs in a non-standard fashion.
Like the above example, this code uses a hook procedure created with SetWindowsHookEx to catch the creation of the message box and perform changes to its interface prior to display -- the captions of the messagebox buttons are changed to better reflect the purpose of the dialog. The hook is then terminated. But the code goes further-- it also starts a timer on the form whose Timer event changes the text displayed once per interval - in this case once per second - creating a "countdown" message box.
In calling the initial code, the developer specifies which of the buttons presented represents the 'default' action to be taken in case the timer elapses without user intervention. When this occurs, the Timer event uses GetDlgItem to retrieve the handle of the 'default action' button specified through the dwTimerExpireButton flag, calling PostMessage to send that button a pair of WM_LBUTTONDOWN and WM_LBUTTONUP messages. The effect is to dismiss the dialog through code as if the user had pressed the button specified, thereby executing any code in the app conditional on a button press. Should the user press a button during the messagebox display, the timer is stopped and the button pressed is returned as usual.
This demo uses three buttons on the dialog -- I chose to use the About-Retry-Ignore set for no specific reason, so the Yes-No-Cancel set could have been used instead. But in order for the working code to accurately reflect the purpose of the altered buttons (read "to avoid confusion"), I defined three new constants - IDSELECT, IDBEGIN and IDSKIP - and assigned the Windows-defined constant values for IDABORT, IDRETRY and IDIGNORE to them. You'll see the use in the Command1_Click event and the hook proc. Debugging the app will be easier - especially in the future - when encountering the line "dwTimerExpireButton = IDBEGIN" rather than the line "dwTimerExpireButton = IDRETRY".
To show how little code is needed to actually perform this demo, I have only provided the declares for functions and constants actually used. You can grab the complete set from the API viewer, or from the MessageBoxEx example page here in the sample Using Win32's MessageBoxEx API.
BAS Module Code
Place the following code into the general declarations area of a bas module:
--------------------------------------------------------------------------------
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'needed public for the Timer event
Public hwndMsgBox As Long
'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
Public Type CUSTOM_MSG_PARAMS
hOwnerThread As Long
hOwnerWindow As Long
dwStyle As Long
bUseTimer As Boolean
dwTimerDuration As Long
dwTimerInterval As Long
dwTimerExpireButton As Long
dwTimerCountDown As Long
sTitle As String
sPrompt As String
End Type
Public cmp As CUSTOM_MSG_PARAMS
'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
'Windows-defined MessageBox return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Public Const IDSELECT = IDABORT
Public Const IDBEGIN = IDRETRY
Public Const IDSKIP = IDIGNORE
Public Const IDPROMPT = &HFFFF&
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'When the message box is about to be shown,
'we'll change the titlebar text, prompt message
'and button captions
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox - save that
'for the timer event
hwndMsgBox = wParam
'the ID's of the buttons on the message box
'correspond exactly to the values they return,
'so the same values can be used to identify
'specific buttons in a SetDlgItemText call.
SetDlgItemText wParam, IDSELECT, "Select.."
SetDlgItemText wParam, IDBEGIN, "Begin"
SetDlgItemText wParam, IDSKIP, "Skip"
'we're done with the dialog, so release the hook
UnhookWindowsHookEx MHP.hHook
End If
'return False to let normal processing continue
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'Set up the hook
hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MHP
.hwndOwner = cmp.hOwnerWindow
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
'(re)set the countdown value to 0
cmp.dwTimerCountDown = 0
'if bUseTimer, enable the timer. Because the
'MessageBox API acts just as the MsgBox function
'does (that is, creates a modal dialog), control
'won't return to the next line until the dialog
'is closed. This necessitates our starting the
'timer before making the call.
'
'However, timer events will execute once the
'modal dialog is shown, allowing us to use the
'timer to dynamically modify the on-screen message!
With Form1.Timer1
.Interval = cmp.dwTimerInterval
.Enabled = cmp.bUseTimer
End With
'call the MessageBox API and return the
'value as the result of the function
TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
cmp.sPrompt, _
cmp.sTitle, _
cmp.dwStyle)
'in case the timer event didn't
'suspend the timer, do it now
Form1.Timer1.Enabled = False
End Function
'--end block--'
Form Code
Add a text box (Text1), a command button (Command1) and a Timer control (Timer1) to a form, along with the following code:
--------------------------------------------------------------------------------
Option Explicit
Private Sub Command1_Click()
'Display wrapper message box,
'passing the CUSTOM_MSG_PARAMS
'struct as the parameter.
With cmp
.sTitle = "VBnet Timed MessageBox Hook Demo"
.sPrompt = "To start searching C: immediately, select Begin." & vbCrLf & _
"To select a different drive, press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in 10 seconds." & Space$(20)
.dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
.bUseTimer = True 'if True the Timer will update once per dwTimerInterval
.dwTimerDuration = 10 'time to wait seconds
.dwTimerInterval = 1000 'countdown interval in milliseconds
.dwTimerExpireButton = IDBEGIN 'message to return if timeout occurs
.dwTimerCountDown = 0 '(re)set to 0
.hOwnerThread = Me.hwnd 'handle of form owning the thread on which
'execution is proceeding.
'The thread owner is always the calling form.
.hOwnerWindow = Me.hwnd 'who owns the dialog (me.hwnd or desktop).
'GetDesktopWindow allows user-interaction
'with the form while the dialog is displayed.
'This may not be desirable, so set accordingly.
End With
Select Case TimedMessageBoxH(cmp)
Case IDSELECT: Text1.Text = "Select button pressed before timeout"
Case IDBEGIN: Text1.Text = "Begin button pressed or message timed out"
Case IDSKIP: Text1.Text = "Skip button pressed before timeout"
End Select
End Sub
Private Sub Timer1_Timer()
Dim hWndTargetBtn As Long
If hwndMsgBox <> 0 Then
'increment the counter
cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1
'update the prompt message with the countdown value
SetDlgItemText hwndMsgBox, IDPROMPT, _
"To start searching C: immediately, select Begin." & vbCrLf & _
"To select a different drive, press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds."
'if the timer has 'expired' (the
'count=duration), we need to
'programmatically 'press' the button
'specified as the default on timeout
If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
'we can kill this timer
Timer1.Enabled = False
'obtain the handle to the
'button designated as default
'if the timer expires
hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
If hWndTargetBtn <> 0 Then
'set the focus to the target button and
'simulate a click to close the dialog and
'return the correct value
Call PutFocus(hWndTargetBtn)
'need a DoEvents to allow PutFocus
'to actually put focus
DoEvents
'simulate a mouse click on the button
Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
End If
End If
End If
End Sub
'--end block--'
Comments
See the Comments section at Modifying a Message Box with SetWindowsHookEx for more info on window hook types.
uguess 2002-01-29
- 打赏
- 举报
Creating an API-Timed Message Box with SetWindowsHookEx
Posted: Saturday March 24, 2001
Updated: Monday October 29, 2001
Applies to: VB5, VB6
Developed with: VB6, Windows 2000
OS restrictions: None
Author: VBnet - Randy Birch
Related:
Using Win32's MessageBoxEx API
Modifying a Message Box with SetWindowsHookEx
Creating a VB-Timed Message Box with SetWindowsHookEx
Creating an API-Timed Message Box with SetWindowsHookEx
Prerequisites
None.
--------------------------------------------------------------------------------
This code is identical to the code in Creating a VB-Timed Message Box with SetWindowsHookEx with one exception - it performs its duties using an API-created timer via SetTimer and a TimerProc callback, rather than a VB Timer control. For explanations please see the VB-Timed page.
BAS Module Code
Place the following code into the general declarations area of a bas module:
--------------------------------------------------------------------------------
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'needed public for the Timer event
Public hwndMsgBox As Long
'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
Public Type CUSTOM_MSG_PARAMS
hOwnerThread As Long
hOwnerWindow As Long
dwStyle As Long
bUseTimer As Boolean
dwTimerDuration As Long
dwTimerInterval As Long
dwTimerExpireButton As Long
dwTimerCountDown As Long
dwTimerID As Long
sTitle As String
sPrompt As String
End Type
Public cmp As CUSTOM_MSG_PARAMS
'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
'a const we define to identify our timer
Private Const MBTIMERID = 999
'Windows-defined MessageBox return values
Private Const IDOK As Long = 1
Private Const IDCANCEL As Long = 2
Private Const IDABORT As Long = 3
Private Const IDRETRY As Long = 4
Private Const IDIGNORE As Long = 5
Private Const IDYES As Long = 6
Private Const IDNO As Long = 7
'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Public Const IDSELECT As Long = IDABORT
Public Const IDBEGIN As Long = IDRETRY
Public Const IDSKIP As Long = IDIGNORE
Public Const IDPROMPT As Long = &HFFFF&
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE As Long = (-6)
Private Const HCBT_ACTIVATE As Long = 5
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_TIMER As Long = &H113
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'When the message box is about to be shown
'change the button captions
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox - save that
'for the timer event
hwndMsgBox = wParam
'the ID's of the buttons on the message box
'correspond exactly to the values they return,
'so the same values can be used to identify
'specific buttons in a SetDlgItemText call.
SetDlgItemText wParam, IDSELECT, "Select.."
SetDlgItemText wParam, IDBEGIN, "Begin"
SetDlgItemText wParam, IDSKIP, "Skip"
'we're done with the dialog, so release the hook
UnhookWindowsHookEx mhp.hHook
End If
'return False to let normal processing continue
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'Set up the hook
hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With mhp
.hwndOwner = cmp.hOwnerWindow
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
'(re) set the countdown (or rather 'count-up') value to 0
cmp.dwTimerCountDown = 0
'if bUseTimer, enable the timer. Because the
'MessageBox API acts just as the MsgBox function
'does (that is, creates a modal dialog), control
'won't return to the next line until the dialog
'is closed. This necessitates our starting the
'timer before making the call.
'
'However, timer events will execute once the
'modal dialog is shown, allowing us to use the
'timer to dynamically modify the on-screen message!
'
'The handle passed to SetTimer is the form hwnd.
'The event ID is set to the const we defined.
'The interval is 1000 milliseconds, and the
'callback is TimerProc
If cmp.bUseTimer Then
cmp.dwTimerID = SetTimer(cmp.hOwnerThread, _
MBTIMERID, _
1000, _
AddressOf TimerProc)
End If
'call the MessageBox API and return the
'value as the result of the function
TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
cmp.sPrompt, _
cmp.sTitle, _
cmp.dwStyle)
'in case the timer event didn't
'suspend the timer, do it now
If cmp.bUseTimer Then
Call KillTimer(cmp.hOwnerThread, MBTIMERID)
End If
End Function
Public Function TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long) As Long
Dim hWndTargetBtn As Long
'watch for the WM_TIMER message
Select Case uMsg
Case WM_TIMER
'compare to our event ID of '999'
If idEvent = MBTIMERID Then
'assure that there is messagebox to update
If hwndMsgBox <> 0 Then
'increment the counter
cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1
'update the prompt message with the countdown value
SetDlgItemText hwndMsgBox, IDPROMPT, _
"To start searching C: " & vbCrLf & _
"immediately, select Begin." & vbCrLf & _
"To select a different drive," & vbCrLf & _
" press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds."
'if the timer has 'expired' (the
'count=duration), we need to
'programmatically 'press' the button
'specified as the default on timeout
If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
'nothing more to do, so
'we can kill this timer
Call KillTimer(cmp.hOwnerThread, MBTIMERID)
'now obtain the handle to the
'button designated as default
'if the timer expires
hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
If hWndTargetBtn <> 0 Then
'set the focus to the target button and
'simulate a click to close the dialog and
'return the correct value
Call PutFocus(hWndTargetBtn)
'need a DoEvents to allow PutFocus
'to actually put focus
DoEvents
'pretend a rodent pushed the button
Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
End If 'If hWndTargetBtn
End If 'If cmp.dwTimerCountDown
End If 'If hwndMsgBox
End If 'If idEvent
Case Else
End Select
End Function
'--end block--'
Form Code
Add a text box (Text1), a command button (Command1) to a form, along with the following code:
--------------------------------------------------------------------------------
Option Explicit
Private Sub Command1_Click()
'Display wrapper message box,
'passing the CUSTOM_MSG_PARAMS
'struct as the parameter.
With cmp
.sTitle = "VBnet API-Timed MessageBox Hook Demo"
.sPrompt = "To start searching C: " & vbCrLf & _
"immediately, select Begin." & vbCrLf & _
"To select a different drive, " & vbCrLf & _
"press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds." & Space$(20)
.dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
.bUseTimer = True 'True = update once per dwTimerInterval
.dwTimerDuration = 10 'time to wait seconds
.dwTimerInterval = 1000 'countdown interval in milliseconds
.dwTimerExpireButton = IDBEGIN 'message to return if timeout occurs
.dwTimerCountDown = 0 '(re)set to 0
.hOwnerThread = Me.hwnd 'handle of form owning the thread on which
'execution is proceeding.
'The thread owner is always the calling form.
.hOwnerWindow = Me.hwnd 'who owns the dialog (me.hwnd or desktop).
'GetDesktopWindow allows user-interaction
'with the form while the dialog is displayed.
'This may not be desirable, so set accordingly.
End With
Select Case TimedMessageBoxH(cmp)
Case IDSELECT: Text1.Text = "Select button pressed before timeout"
Case IDBEGIN: Text1.Text = "Begin button pressed or message timed out"
Case IDSKIP: Text1.Text = "Skip button pressed before timeout"
End Select
End Sub
'--end block--'
Posted: Saturday March 24, 2001
Updated: Monday October 29, 2001
Applies to: VB5, VB6
Developed with: VB6, Windows 2000
OS restrictions: None
Author: VBnet - Randy Birch
Related:
Using Win32's MessageBoxEx API
Modifying a Message Box with SetWindowsHookEx
Creating a VB-Timed Message Box with SetWindowsHookEx
Creating an API-Timed Message Box with SetWindowsHookEx
Prerequisites
None.
--------------------------------------------------------------------------------
This code is identical to the code in Creating a VB-Timed Message Box with SetWindowsHookEx with one exception - it performs its duties using an API-created timer via SetTimer and a TimerProc callback, rather than a VB Timer control. For explanations please see the VB-Timed page.
BAS Module Code
Place the following code into the general declarations area of a bas module:
--------------------------------------------------------------------------------
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'needed public for the Timer event
Public hwndMsgBox As Long
'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
Public Type CUSTOM_MSG_PARAMS
hOwnerThread As Long
hOwnerWindow As Long
dwStyle As Long
bUseTimer As Boolean
dwTimerDuration As Long
dwTimerInterval As Long
dwTimerExpireButton As Long
dwTimerCountDown As Long
dwTimerID As Long
sTitle As String
sPrompt As String
End Type
Public cmp As CUSTOM_MSG_PARAMS
'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
'a const we define to identify our timer
Private Const MBTIMERID = 999
'Windows-defined MessageBox return values
Private Const IDOK As Long = 1
Private Const IDCANCEL As Long = 2
Private Const IDABORT As Long = 3
Private Const IDRETRY As Long = 4
Private Const IDIGNORE As Long = 5
Private Const IDYES As Long = 6
Private Const IDNO As Long = 7
'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Public Const IDSELECT As Long = IDABORT
Public Const IDBEGIN As Long = IDRETRY
Public Const IDSKIP As Long = IDIGNORE
Public Const IDPROMPT As Long = &HFFFF&
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE As Long = (-6)
Private Const HCBT_ACTIVATE As Long = 5
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_TIMER As Long = &H113
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'When the message box is about to be shown
'change the button captions
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox - save that
'for the timer event
hwndMsgBox = wParam
'the ID's of the buttons on the message box
'correspond exactly to the values they return,
'so the same values can be used to identify
'specific buttons in a SetDlgItemText call.
SetDlgItemText wParam, IDSELECT, "Select.."
SetDlgItemText wParam, IDBEGIN, "Begin"
SetDlgItemText wParam, IDSKIP, "Skip"
'we're done with the dialog, so release the hook
UnhookWindowsHookEx mhp.hHook
End If
'return False to let normal processing continue
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'Set up the hook
hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With mhp
.hwndOwner = cmp.hOwnerWindow
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
'(re) set the countdown (or rather 'count-up') value to 0
cmp.dwTimerCountDown = 0
'if bUseTimer, enable the timer. Because the
'MessageBox API acts just as the MsgBox function
'does (that is, creates a modal dialog), control
'won't return to the next line until the dialog
'is closed. This necessitates our starting the
'timer before making the call.
'
'However, timer events will execute once the
'modal dialog is shown, allowing us to use the
'timer to dynamically modify the on-screen message!
'
'The handle passed to SetTimer is the form hwnd.
'The event ID is set to the const we defined.
'The interval is 1000 milliseconds, and the
'callback is TimerProc
If cmp.bUseTimer Then
cmp.dwTimerID = SetTimer(cmp.hOwnerThread, _
MBTIMERID, _
1000, _
AddressOf TimerProc)
End If
'call the MessageBox API and return the
'value as the result of the function
TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
cmp.sPrompt, _
cmp.sTitle, _
cmp.dwStyle)
'in case the timer event didn't
'suspend the timer, do it now
If cmp.bUseTimer Then
Call KillTimer(cmp.hOwnerThread, MBTIMERID)
End If
End Function
Public Function TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long) As Long
Dim hWndTargetBtn As Long
'watch for the WM_TIMER message
Select Case uMsg
Case WM_TIMER
'compare to our event ID of '999'
If idEvent = MBTIMERID Then
'assure that there is messagebox to update
If hwndMsgBox <> 0 Then
'increment the counter
cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1
'update the prompt message with the countdown value
SetDlgItemText hwndMsgBox, IDPROMPT, _
"To start searching C: " & vbCrLf & _
"immediately, select Begin." & vbCrLf & _
"To select a different drive," & vbCrLf & _
" press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds."
'if the timer has 'expired' (the
'count=duration), we need to
'programmatically 'press' the button
'specified as the default on timeout
If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
'nothing more to do, so
'we can kill this timer
Call KillTimer(cmp.hOwnerThread, MBTIMERID)
'now obtain the handle to the
'button designated as default
'if the timer expires
hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
If hWndTargetBtn <> 0 Then
'set the focus to the target button and
'simulate a click to close the dialog and
'return the correct value
Call PutFocus(hWndTargetBtn)
'need a DoEvents to allow PutFocus
'to actually put focus
DoEvents
'pretend a rodent pushed the button
Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
End If 'If hWndTargetBtn
End If 'If cmp.dwTimerCountDown
End If 'If hwndMsgBox
End If 'If idEvent
Case Else
End Select
End Function
'--end block--'
Form Code
Add a text box (Text1), a command button (Command1) to a form, along with the following code:
--------------------------------------------------------------------------------
Option Explicit
Private Sub Command1_Click()
'Display wrapper message box,
'passing the CUSTOM_MSG_PARAMS
'struct as the parameter.
With cmp
.sTitle = "VBnet API-Timed MessageBox Hook Demo"
.sPrompt = "To start searching C: " & vbCrLf & _
"immediately, select Begin." & vbCrLf & _
"To select a different drive, " & vbCrLf & _
"press Select." & vbCrLf & vbCrLf & _
"Automatic searching of C: will begin in " & _
CStr(10 - cmp.dwTimerCountDown) & " seconds." & Space$(20)
.dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
.bUseTimer = True 'True = update once per dwTimerInterval
.dwTimerDuration = 10 'time to wait seconds
.dwTimerInterval = 1000 'countdown interval in milliseconds
.dwTimerExpireButton = IDBEGIN 'message to return if timeout occurs
.dwTimerCountDown = 0 '(re)set to 0
.hOwnerThread = Me.hwnd 'handle of form owning the thread on which
'execution is proceeding.
'The thread owner is always the calling form.
.hOwnerWindow = Me.hwnd 'who owns the dialog (me.hwnd or desktop).
'GetDesktopWindow allows user-interaction
'with the form while the dialog is displayed.
'This may not be desirable, so set accordingly.
End With
Select Case TimedMessageBoxH(cmp)
Case IDSELECT: Text1.Text = "Select button pressed before timeout"
Case IDBEGIN: Text1.Text = "Begin button pressed or message timed out"
Case IDSKIP: Text1.Text = "Skip button pressed before timeout"
End Select
End Sub
'--end block--'
playyuer 2002-01-29
- 打赏
- 举报
问题: 如何使 Msgbox 在等待数秒后自动关闭?
解答: Msgbox 本身无此功能,但 Windows Script Host Model 提供了这样的信息框:
'引用 Windows Script Host Object Model
'Dim x As New IWshRuntimeLibrary.WshShell '用于 5.6 版本
Dim x As New IWshRuntimeLibrary.IWshShell_Class
x.Popup "Please wait for 3 seconds!", 3, "Hello", 64
相关简体中文帮助文档下载:
http://download.microsoft.com/download/winscript56/Install/5.6/W982KMe/CN/scd56chs.exe
解答: Msgbox 本身无此功能,但 Windows Script Host Model 提供了这样的信息框:
'引用 Windows Script Host Object Model
'Dim x As New IWshRuntimeLibrary.WshShell '用于 5.6 版本
Dim x As New IWshRuntimeLibrary.IWshShell_Class
x.Popup "Please wait for 3 seconds!", 3, "Hello", 64
相关简体中文帮助文档下载:
http://download.microsoft.com/download/winscript56/Install/5.6/W982KMe/CN/scd56chs.exe
shawls 2002-01-28
- 打赏
- 举报
： TBBT(谁能读懂我的心)
怎么个传递法！
怎么个传递法！
TBBT 2002-01-28
- 打赏
- 举报
向对话框传递消息
shawls 2002-01-28
- 打赏
- 举报
没有别的吗？
hhdsq 2002-01-28
- 打赏
- 举报
自己做一下窗体吧
再加一个Timer不就行了
再加一个Timer不就行了
shawls 2002-01-28
- 打赏
- 举报
up一下！
zyl910 2002-01-28
- 打赏
- 举报
那是绝对的高手！
它是上帝的什么人？
它是上帝的什么人？
feihong0233 2002-01-28
- 打赏
- 举报
费那劲干吗，
自己用窗体做一个。
自己用窗体做一个。
shawls 2002-01-28
- 打赏
- 举报
有位老兄说：只要timer控件就可以得，
愿闻其祥！！！
zyl910 2002-01-28
- 打赏
- 举报
试一试把 MsgBox的标题 多加几个空格，那不会关错其它的。
