请教一个关于MsgBox()自动消失的方法?

Question

能不能实现用MsgBox()弹出一个提示框,在不用鼠标和键盘的情况下让其在5秒钟之后自动消失呢?我用一个窗体模拟一个MsgBox()能实现这个目的，但是有点麻烦，不知道用MsgBox()能否实现，怎么实现？参与者有分!谢谢先

Answer 1

MsgBox不行,因为这个函数会挂起当前的程序,其它代码不会响应的.

Answer 2

那你试着用sendmessage向他发送wm_close消息或者鼠标单击的消息呢。

Answer 3

当然可以。
' 窗体代码
Option ExplicitPrivate Sub cmdExit_Click()
    ' End the application
    End
End SubPrivate Sub cmdShowMessage_Click()
    Dim sStr As String
    Dim lRet As VbMsgBoxResult
    
    If Val(txtWait) >= 1 Then
        sStr = "This Message is displayed only for " & txtWait & " Sec."
        sStr = sStr & vbCrLf & " After Time out Cancel will be selectecd automatically "
        lRet = MsgBoxEx(sStr, Val(txtWait), vbAbortRetryIgnore)
        If lRet = 0 Then
            lblInfo = "Time out occurs. Cancel Selected."
        Else
            lblInfo = lRet & " Selected"
        End If
    Else
        sStr = "For demonstration please enter value grater than zero."
        MsgBox sStr, vbOKOnly + vbInformation
    End If
End Sub
' 模块代码
Option Explicit' IMPORTANT NOTE:
' Demo project showing how to use the Timed MessageBox
' by Anirudha Vengurlekar [email protected](http://domaindlx.com/anirudha)
' this demo is released into the public domain "as is" without
' warranty or guaranty of any kind.  In other words, use at your own risk.
' Please send me you comments or suggestions at [email protected]
' Thanks in advance.Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) 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 Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As LongPrivate Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const WM_CLOSE = &H10
Private Const BN_CLICKED = 0
Private Const WM_COMMAND = &H111' Used for storing information
Private m_lMsgHandle As Long
Private m_lNoHandle As Long
Private m_lhHook As Long
Private bTimedOut As Boolean
Private sMsgText As String
Private lCount As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPrivate Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim lRet As Long
    Dim sClassName As String    sClassName = Space(100)
    lRet = GetClassName(hWnd, sClassName, 100)
    sClassName = Left$(sClassName, lRet)    Debug.Print sClassName
    If UCase$(sClassName) = UCase$("Button") Then
        m_lNoHandle = hWnd
        EnumChildWindowsProc = 0
    Else
        EnumChildWindowsProc = 1
    End IfEnd Function' *********************************************************************************************************
' THIS IS CALLBACK procedure. Will called by Hook procedure
Private Function GetMessageBoxHandle(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' AV get the message box handle
    If lMsg = HCBT_ACTIVATE Then
        'Release the CBT hook
        m_lMsgHandle = wParam  ' Msg Box Window Handle
        UnhookWindowsHookEx m_lhHook
        m_lhHook = 0
        ' enumerate all the children so we can send a number
        ' button message to the No button if our box has one
        ' this avoids the Microsoft error in the message box
        ' Added by Daniels, Michael A (KPMG Group)
        EnumChildWindows m_lMsgHandle, AddressOf EnumChildWindowsProc, 0
    End If
    GetMessageBoxHandle = False
End Function' *********************************************************************************************************
' THIS IS CALLBACK procedure. Will called by timer procedure
' This function is called when time out occurs by the timer
Private Sub MessageBoxTimerUpdateEvent(hWnd As Long, uiMsg As Long, idEvent As Long, dwTime As Long)
    Dim lRet As Long
    Dim sStr As String
    If m_lMsgHandle = 0 Then Exit Sub    lCount = lCount + 1
    If sMsgText = "" Then
        sStr = Space(255)
        lRet = GetWindowText(m_lMsgHandle, sStr, 255)
        sStr = Left$(sStr, lRet)
        sMsgText = sStr
    End If
    sStr = sMsgText & " " & "(Time elapsed:" & lCount & ")"
    SetWindowText m_lMsgHandle, sStr
End Sub
' *********************************************************************************************************
' THIS IS CALLBACK procedure. Will called by timer procedure
' This function is called when time out occurs by the timer
Private Sub MessageBoxTimerEvent(hWnd As Long, uiMsg As Long, idEvent As Long, dwTime As Long)
    ' Close the message box    'Debug.Print "Sending close message"    If m_lNoHandle = 0 Then
        SendMessage m_lMsgHandle, WM_CLOSE, 0, 0
    Else
        Dim lButtonCommand        lButtonCommand = (BN_CLICKED * (2 ^ 16)) And &HFFFF
        lButtonCommand = lButtonCommand Or GetDlgCtrlID(m_lNoHandle)        SendMessage m_lMsgHandle, WM_COMMAND, lButtonCommand, m_lNoHandle
    End If    m_lMsgHandle = 0  ' Set handle to ZERO
    m_lNoHandle = 0   ' Set handle to ZERO
    bTimedOut = True  ' Set flag to True
End Sub
' *********************************************************************************************************
Public Function MsgBoxEx(sMsgText As String, dwWait As Long, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional sTitle As String = "Timed MessageBox Demo") As VbMsgBoxResult
    Dim lTimer As Long
    Dim lTimerUpdate As Long    ' SET CBT hook
    m_lhHook = SetWindowsHookEx(WH_CBT, AddressOf GetMessageBoxHandle, App.hInstance, GetCurrentThreadId())
    ' set the timer
    lTimer = SetTimer(0, 0, dwWait * 1000, AddressOf MessageBoxTimerEvent) ' Set timer
    lTimerUpdate = SetTimer(0, 0, 1 * 1000, AddressOf MessageBoxTimerUpdateEvent)  ' Set timer
    ' Set the flag to false
    bTimedOut = False
    ' Display the message Box
    MsgBoxEx = MsgBox(sMsgText, Buttons, sTitle)
    ' Kill the timer
    Call KillTimer(0, lTimer)
    Call KillTimer(0, lTimerUpdate)
    ' Return ZERO so that caller routine will decide what to do
    sMsgText = ""
    lCount = 0
    If bTimedOut = True Then MsgBoxEx = 0
End Function
' *********************************************************************************************************完整的工整例子下载:
http://www.vb99.com/code.asp?findmode=9&id=16

Answer 4

'建议楼主用MessageBox Private Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As LongPrivate Sub Form_Load()
MessageBox Me.hwnd, "这是对话框", "提示", 0
End Sub

Answer 5

关于定时关闭询问对话框的一点体会
http://dev.csdn.net/develop/article/24/24855.shtm

Answer 6

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 Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Const WM_CLOSE = &H10Private Sub Command1_Click()
    Timer1.Interval = 3000
    MessageBox Me.hwnd, "三秒钟后自动关闭本消息框", "MsgBox标题", 64
End SubPrivate Sub Timer1_Timer()
    SendMessage FindWindow(vbNullString, "MsgBox标题"), WM_CLOSE, 0&, 0&
    Timer1.Interval = 0
End Sub

Answer 7

用MessageBox函数简单些。
BlueBeer(1win)的方法可以。

Answer 8

Option ExplicitConst MB_DEFBUTTON1 = &H0&
Const MB_DEFBUTTON2 = &H100&
Const MB_DEFBUTTON3 = &H200&
Const MB_ICONASTERISK = &H40&
Const MB_ICONEXCLAMATION = &H30&
Const MB_ICONHAND = &H10&
Const MB_ICONINFORMATION = MB_ICONASTERISK
Const MB_ICONQUESTION = &H20&
Const MB_ICONSTOP = MB_ICONHAND
Const MB_OK = &H0&
Const MB_OKCANCEL = &H1&
Const MB_YESNO = &H4&
Const MB_YESNOCANCEL = &H3&
Const MB_ABORTRETRYIGNORE = &H2&
Const MB_RETRYCANCEL = &H5&
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) 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 BM_CLICK = &HF5
Dim i As Long
Private Sub Command1_Click()
     Timer1.Enabled = True
     MessageBox Me.hwnd, "时秒钟将关闭", App.Title, MB_OK
     Timer1.Enabled = False
End SubPrivate Sub Form_Load()
    Timer1.Enabled = False
    Timer1.Interval = 1000
End SubPrivate Sub Timer1_Timer()    i = i + 1
    If i >= 10 Then
        Dim dlghwnd As Long
        Dim buttonhwnd As Long
        dlghwnd = FindWindow("#32770", App.Title)
        buttonhwnd = GetDlgItem(dlghwnd, 2) '其中的2，用spy++获得
        SendMessage buttonhwnd, BM_CLICK, 0&, ByVal 0&
    End If
    
End Sub