windows对话框:如何给windows标准对话框加上时间限制来源: 发布时间:星期五, 2008年12月26日 浏览:2次 评论: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 & " this demo were compiled." End If ' ' Return value, after a timeout, is the same as ' 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.Pr 1 / 0 Compiled = True NotCompiled: End Function 0
相关文章
读者评论
发表评论 |