给windows标准对话框加上时间限制
4628 点击·0 回帖
灯火互联
楼主
 |  | |
 | 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 | |
 |  |