如何给windows标准对话框加上时间限制
【打印文章】
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"
Private Sub cmdTest_Click()
Dim msg As String
Dim nRet As Long
'
' Adjust timeout to match user's spec.
'
With Timer1
.Interval = HScroll1.Value * 1000
.Enabled = True
End With
'
' Message should reflect whether compiled.
'
If Compiled Then
msg = "I should disappear in " & HScroll1.Value & " seconds."
Else
msg = "I whould disappear in " & HScroll1.Value & _
" seconds," & vbCrLf & "if this demo were compiled."
End If
'
' Return value, after a timeout, is the same as if
' the user had pressed the Close (X) button.
'
nRet = MsgBox(msg, Combo1.ItemData(Combo1.ListIndex), MsgTitle)
Select Case nRet
Case vbOK: msg = "vbOK ["
Case vbCancel: msg = "vbCancel ["
Case vbAbort: msg = "vbAbort ["
Case vbRetry: msg = "vbRetry ["
Case vbIgnore: msg = "vbIgnore ["
Case vbYes: msg = "vbYes ["
Case vbNo: msg = "vbNo ["
Case Else: msg = "Unknown ["
End Select
txtReturn.Text = msg & nRet & "]"
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
With Combo1
.AddItem "vbAbortRetryIgnore"
.ItemData(.NewIndex) = 2
.AddItem "vbOKCancel"
.ItemData(.NewIndex) = 1
.AddItem "vbOKOnly"
.ItemData(.NewIndex) = 0
.AddItem "vbRetryCancel"
.ItemData(.NewIndex) = 5
.AddItem "vbYesNo"
.ItemData(.NewIndex) = 4
.AddItem "vbYesNoCancel"
.ItemData(.NewIndex) = 3
.ListIndex = .NewIndex
End With
txtReturn.Text = ""
Set Me.Icon = Nothing
End Sub
Private Sub HScroll1_Change()
cmdTest.Caption = "Test " & HScroll1.Value & _
" Second MsgBox"
End Sub
Private Sub Timer1_Timer()
Dim hWnd As Long
'
' The following works for all *except*
' vbAbortRetryIgnore, which any responsible
' programmer must let the user answer.
'
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub
Private Function Compiled() As Boolean
On Error GoTo NotCompiled
Debug.Print 1 / 0
Compiled = True
NotCompiled:
End Function
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"
Private Sub cmdTest_Click()
Dim msg As String
Dim nRet As Long
'
' Adjust timeout to match user's spec.
'
With Timer1
.Interval = HScroll1.Value * 1000
.Enabled = True
End With
'
' Message should reflect whether compiled.
'
If Compiled Then
msg = "I should disappear in " & HScroll1.Value & " seconds."
Else
msg = "I whould disappear in " & HScroll1.Value & _
" seconds," & vbCrLf & "if this demo were compiled."
End If
'
' Return value, after a timeout, is the same as if
' the user had pressed the Close (X) button.
'
nRet = MsgBox(msg, Combo1.ItemData(Combo1.ListIndex), MsgTitle)
Select Case nRet
Case vbOK: msg = "vbOK ["
Case vbCancel: msg = "vbCancel ["
Case vbAbort: msg = "vbAbort ["
Case vbRetry: msg = "vbRetry ["
Case vbIgnore: msg = "vbIgnore ["
Case vbYes: msg = "vbYes ["
Case vbNo: msg = "vbNo ["
Case Else: msg = "Unknown ["
End Select
txtReturn.Text = msg & nRet & "]"
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
With Combo1
.AddItem "vbAbortRetryIgnore"
.ItemData(.NewIndex) = 2
.AddItem "vbOKCancel"
.ItemData(.NewIndex) = 1
.AddItem "vbOKOnly"
.ItemData(.NewIndex) = 0
.AddItem "vbRetryCancel"
.ItemData(.NewIndex) = 5
.AddItem "vbYesNo"
.ItemData(.NewIndex) = 4
.AddItem "vbYesNoCancel"
.ItemData(.NewIndex) = 3
.ListIndex = .NewIndex
End With
txtReturn.Text = ""
Set Me.Icon = Nothing
End Sub
Private Sub HScroll1_Change()
cmdTest.Caption = "Test " & HScroll1.Value & _
" Second MsgBox"
End Sub
Private Sub Timer1_Timer()
Dim hWnd As Long
'
' The following works for all *except*
' vbAbortRetryIgnore, which any responsible
' programmer must let the user answer.
'
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub
Private Function Compiled() As Boolean
On Error GoTo NotCompiled
Debug.Print 1 / 0
Compiled = True
NotCompiled:
End Function
本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】