• 软件测试技术
  • 软件测试博客
  • 软件测试视频
  • 开源软件测试技术
  • 软件测试论坛
  • 软件测试沙龙
  • 软件测试资料下载
  • 软件测试杂志
  • 软件测试人才招聘
    暂时没有公告

字号: | 推荐给好友 上一篇 | 下一篇

如何给windows标准对话框加上时间限制

发布: 2007-7-14 20:28 | 作者: 佚名    | 来源: 网络转载     | 查看: 10次 | 进入软件测试论坛讨论

领测软件测试网 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

延伸阅读

文章来源于领测软件测试网 https://www.ltesting.net/


关于领测软件测试网 | 领测软件测试网合作伙伴 | 广告服务 | 投稿指南 | 联系我们 | 网站地图 | 友情链接
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备10010545号-5
技术支持和业务联系:info@testage.com.cn 电话:010-51297073

软件测试 | 领测国际ISTQBISTQB官网TMMiTMMi认证国际软件测试工程师认证领测软件测试网