有时间限制的对话框

[shawls]

如何写有时间限制的对话框

我记得十一个很老的话题，大家帮忙

就是用msgbox弹出对话框以后，在规定得时间里面使对话框消失

我记得使用了2个api函数！

[lovercat]

timer控件就可以

[zyl910]

复制到记事本。保存为“TimedMsg.frm”。双击打开！
================================================================================
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Timed MsgBox"
ClientHeight = 2805
ClientLeft = 45
ClientTop = 330
ClientWidth = 3015
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2805
ScaleWidth = 3015
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox Combo1
Height = 315
Left = 300
Style = 2 'Dropdown List
TabIndex = 1
Top = 420
Width = 2415
End
Begin VB.TextBox txtReturn
BackColor = &H8000000F&
Height = 315
Left = 300
Locked = -1 'True
TabIndex = 5
Text = "Text1"
Top = 1680
Width = 2415
End
Begin VB.HScrollBar HScroll1
Height = 255
LargeChange = 2
Left = 300
Max = 10
Min = 1
TabIndex = 3
Top = 1080
Value = 2
Width = 2355
End
Begin VB.CommandButton cmdTest
Caption = "Test 2-Second MsgBox"
Height = 435
Left = 300
TabIndex = 6
Top = 2160
Width = 2415
End
Begin VB.Timer Timer1
Enabled = 0 'False
Left = 2340
Top = 1920
End
Begin VB.Label Labels
AutoSize = -1 'True
Caption = "MsgBox Type:"
Height = 195
Index = 0
Left = 300
TabIndex = 0
Top = 180
Width = 1020
End
Begin VB.Label Labels
AutoSize = -1 'True
Caption = "Return Value:"
Height = 195
Index = 2
Left = 300
TabIndex = 4
Top = 1440
Width = 975
End
Begin VB.Label Labels
AutoSize = -1 'True
Caption = "Timeout:"
Height = 195
Index = 1
Left = 300
TabIndex = 2
Top = 840
Width = 615
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' *********************************************************************
' Copyright ?998 Karl E. Peterson, All Rights Reserved
' http://www.mvps.org/vb
' *********************************************************************
' Warning: This computer program is protected by copyright law and
' international treaties. Unauthorized reproduction or distribution
' of this program, or any portion of it, may result in severe civil
' and criminal penalties, and will be prosecuted to the maximum
' extent possible under the law.
' *********************************************************************
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

[jett]

记得斑竹说过一个办法很好，用了一个对象
一时想不起来了

[zyl910]

顺便说一句：
shawls(小山(坚持VB,学Delphi和C#))，你好像不喜欢开QQ吧！

[shawls]

这个其实是我最开始想到的办法，但是，有缺点，主要是关闭窗体得时候容易关闭别的窗体

[shawls]

不是不喜欢开qq，主要是：我一般隐身

[shawls]

我解决了，最笨的办法：新开一个窗体！！

[leonnet]

不需要，只要timer就可以呀