Msgbox顯示窗口

Question

我現在用Msgbox方法來顯示提示窗口，但是我希望可以通過時鐘Timer控件來控制提示顯示窗口顯示1秒鐘后自動關閉，不知道能用什么方法來實現？最好有一點代碼！感激感激！！！！
謝謝各位大虾！

Answer 1

自己定义一个窗体来实现，否则是没有办法来实现的。定义一个frmMSG窗体，然后在此窗体中放一个标签来提示用户正在从事的事务的信息，譬如“备份数据库”为例：Private Sub Form_Load()
Me.Lable1.Caption="正在备份数据库...请稍候"Dim StartTm as Single,DelayTm as integer  //DelayTm是间隔的秒数
StartTm=Timer          //当前时间
Do Timer-StartTm< DelayTm
   DoEvents   
LoopUnload me
End Sub

Answer 2

請問Timer是指系統的時間嗎？Timer-StartTm是指用系統實時的時間減去窗體顯示時候的系統時間嗎？
但是這樣減能得到秒數嗎？

Answer 3

'模块部分Option Explicit
Public Const MAX_PATH As Long = 260&
Public Const API_TRUE As Long = 1&
Public Const API_FALSE As Long = 0&
Public g_hBoldFont As Long
Public Const MSGBOXTEXT As String = "Have you ever seen a standard message box with a different font than all the others on the system?"
Public Const WM_SETFONT As Long = &H30
Public Const NV_CLOSEMSGBOX As Long = &H5000&
Public Const NV_MOVEMSGBOX As Long = &H5001&
Public Const NV_MSGBOXCHNGFONT As Long = &H5002&
Public Const MB_ICONQUESTION As Long = &H20&
Public Const MB_TASKMODAL As Long = &H2000&
Public Const SWP_NOSIZE As Long = &H1&
Public Const SWP_NOZORDER As Long = &H4&
Public Const HWND_TOP As Long = 0&
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Declare Function LockWindowUpdate& Lib "user32" (ByVal hwndLock&)
Public Declare Function GetActiveWindow& Lib "user32" ()
Public Declare Function GetDesktopWindow& Lib "user32" ()
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, _
                        ByVal lpWindowName$)
Public Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent&, _
                        ByVal hWndChildAfter&, ByVal lpClassName$, ByVal lpWindowName$)
Public Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal _
                        wMsg&, ByVal wParam&, lParam As Any)
Public Declare Function MoveWindow& Lib "user32" (ByVal hWnd&, ByVal x&, ByVal y&, _
                        ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&)
Public Declare Function ScreenToClientLong& Lib "user32" Alias "ScreenToClient" (ByVal hWnd&, _
                        lpPoint&)
Public Declare Function GetDC& Lib "user32" (ByVal hWnd&)
Public Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hDC&)
Public Const DT_WORDBREAK As Long = &H10&
Public Const DT_CALCRECT As Long = &H400&
Public Const DT_EDITCONTROL As Long = &H2000&
Public Const DT_END_ELLIPSIS As Long = &H8000&
Public Const DT_MODIFYSTRING As Long = &H10000
Public Const DT_PATH_ELLIPSIS As Long = &H4000&
Public Const DT_RTLREADING As Long = &H20000
Public Const DT_WORD_ELLIPSIS As Long = &H40000
Public Declare Function DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC&, ByVal lpsz$, _
                        ByVal cchText&, lpRect As RECT, ByVal dwDTFormat&)
Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hWnd&)
Public Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hWnd&, _
                        ByVal lpClassName$, ByVal nMaxCount&)
Public Declare Function GetWindowRect& Lib "user32" (ByVal hWnd&, lpRect As RECT)
Public Declare Function SetWindowPos& Lib "user32" (ByVal hWnd&, ByVal hWndInsertAfter&, _
                        ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
Public Declare Function MessageBox& Lib "user32" Alias "MessageBoxA" (ByVal hWnd&, _
                        ByVal lpText$, ByVal lpCaption$, ByVal wType&)
Public Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&, ByVal uElapse&, _
                        ByVal lpTimerFunc&)
Public Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal nIDEvent&)
Public Sub TimerProc(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
    KillTimer hWnd, idEvent
    Select Case idEvent
      Case NV_CLOSEMSGBOX
        Dim hMessageBox&
        hMessageBox = FindWindow("#32770", "Self Closing Message Box")
        If hMessageBox Then
            Call SetForegroundWindow(hMessageBox)
            SendKeys "{enter}"
        End If
      Case NV_MOVEMSGBOX
        Dim hMsgBox&, xPoint&, yPoint&
        Dim stMsgBoxRect As RECT, stParentRect As RECT
        hMsgBox = FindWindow("#32770", "Position A Message Box")
        If hMsgBox Then
            Call GetWindowRect(hMsgBox, stMsgBoxRect)
            Call GetWindowRect(hWnd, stParentRect)
            xPoint = stParentRect.Left + (((stParentRect.Right - stParentRect.Left) \ 2) - _
                     ((stMsgBoxRect.Right - stMsgBoxRect.Left) \ 2))
            yPoint = stParentRect.Top + (((stParentRect.Bottom - stParentRect.Top) \ 2) - _
                     ((stMsgBoxRect.Bottom - stMsgBoxRect.Top) \ 2))
            If xPoint < 0 Then xPoint = 0
            If yPoint < 0 Then yPoint = 0
            If (xPoint + (stMsgBoxRect.Right - stMsgBoxRect.Left)) > _
               (Screen.Width \ Screen.TwipsPerPixelX) Then
                xPoint = (Screen.Width \ Screen.TwipsPerPixelX) - (stMsgBoxRect.Right - stMsgBoxRect.Left)
            End If
            If (yPoint + (stMsgBoxRect.Bottom - stMsgBoxRect.Top)) > _
               (Screen.Height \ Screen.TwipsPerPixelY) Then
                yPoint = (Screen.Height \ Screen.TwipsPerPixelY) - (stMsgBoxRect.Bottom - stMsgBoxRect.Top)
            End If
            Call SetWindowPos(hMsgBox, HWND_TOP, xPoint, yPoint, _
                 API_FALSE, API_FALSE, SWP_NOZORDER Or SWP_NOSIZE)
        End If
        Call LockWindowUpdate(API_FALSE)      Case NV_MSGBOXCHNGFONT
        hMsgBox = FindWindow("#32770", "Change The Message Box Font")
        If hMsgBox Then
            Dim hStatic&, hButton&, stMsgBoxRect2 As RECT
            Dim stStaticRect As RECT, stButtonRect As RECT
            hStatic = FindWindowEx(hMsgBox, API_FALSE, "Static", MSGBOXTEXT)
            hButton = FindWindowEx(hMsgBox, API_FALSE, "Button", "OK")
            If hStatic Then
                Call GetWindowRect(hMsgBox, stMsgBoxRect2)
                Call GetWindowRect(hStatic, stStaticRect)
                Call GetWindowRect(hButton, stButtonRect)
                Call SendMessage(hStatic, WM_SETFONT, g_hBoldFont, ByVal API_TRUE)
                With stStaticRect
                    Call ScreenToClientLong(hMsgBox, .Left)
                    Call ScreenToClientLong(hMsgBox, .Right)
                    Dim nRectHeight&, nHeightDifference&, hStaticDC&
                    nHeightDifference = .Bottom - .Top
                    hStaticDC = GetDC(hStatic)
                    nRectHeight = DrawText(hStaticDC, MSGBOXTEXT, (-1&), stStaticRect, _
                                  DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK)
                    Call ReleaseDC(hStatic, hStaticDC)
                    nHeightDifference = nRectHeight - nHeightDifference
                    Call MoveWindow(hStatic, .Left, .Top, .Right - .Left, nRectHeight, API_TRUE)
                End With
                With stButtonRect
                    Call ScreenToClientLong(hMsgBox, .Left)
                    Call ScreenToClientLong(hMsgBox, .Right)
                    Call MoveWindow(hButton, .Left, .Top + nHeightDifference, .Right - .Left, .Bottom - .Top, API_TRUE)
                End With
                With stMsgBoxRect2
                    Call MoveWindow(hMsgBox, .Left, .Top - (nHeightDifference \ 2), .Right - .Left, (.Bottom - .Top) + nHeightDifference, API_TRUE)
                End With
            End If
        End If
        Call LockWindowUpdate(API_FALSE)
    End Select
End Sub

Answer 4

'窗体调用
Option ExplicitPrivate Sub Command1_Click()
  SetTimer hWnd, NV_CLOSEMSGBOX, 1000&, AddressOf TimerProc
  Call MessageBox(hWnd, "1 秒钟后自动关闭！", _
      "Self Closing Message Box", MB_ICONQUESTION Or MB_TASKMODAL)
End Sub