专注于互联网--专注于架构

最新标签
网站地图
文章索引
Rss订阅

首页 »VB教程 » windows对话框:如何给windows标准对话框加上时间限制 »正文

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条 分0页

发表评论

  • 昵称:
  • 内容: