vb@rchiv · Tipps & Tricks · MessageBox mit neuen Funktionen

Rubrik: Oberfläche · MessageBox | VB-Versionen: VB5, VB6

27.11.03

MessageBox mit neuen Funktionen In diesem Tipp verraten wir Ihnen, wie man eine MessageBox immer im Vordergrund anzeigt oder auch wie man die MessageBox nach x Sekunden autom. schließt.
Autor: Dieter Otter	Bewertung:	Views: 49.818
www.tools4vb.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Heute verraten wir Ihnen, wie man eine MessageBox immer im Vordergrund anzeigt, so dass diese nicht von einem anderen Fenster verdeckt werden kann. Zudem zeigen wir, wie sich die MessageBox nach einer frei festlegbaren Zeit wieder schließen lässt, so als hätte der Anwender auf das Schließen-Symbol geklickt.

Hierzu müssen wir allerdings auf die MessageBox-Funktion aus dem Windows-API zurückgreifen. Vor dem Aufruf der MessageBox-Funktion wird ein Timer gestartet, über den das Fensterhandle der API-MessageBox ermittelt wird. In Verbindung mit der SetWindowPos-Funktion wird die MessageBox dann "always on top" angezeigt - sofern dies gewünscht ist. Um die MessageBox nach einer bestimmten Zeit autom. schließen zu können, benötigen wir wieder einen Timer, wobei wir dies in ein- und derselben Ereignis-Prozedur erledigen

Und damit Sie Ihren bestehenden Code nicht umschreiben müssen, nennen wir unsere neue MessageBox-Funktion MsgBox Die Parameter zum Aufruf der Funktion sind identisch mit denen der VB-MsgBox-Funktion, außer dass es jetzt noch zwei weitere optionale Parameter gibt:

bOnTop: Legt fest, ob die MessageBox normal oder immer im Vordergrund angezeigt werden soll
nTime: Legt die Zeit in Sekunden fest, nach der die MsgBox autom. geschlossen werden soll.

Hinweis: Das autom. Schließen funktioniert allerdings nicht, wenn für "Buttons" das Attribut "vbYesNo" gesetzt ist. In diesem Fall muss der Anwender selbst eine Auswahl treffen.

Fügen Sie nachfolgenden Code in ein MODUL:

Option Explicit
 
' Benötigte API's für die Timer-Steuerung
Private Declare Function SetTimer Lib "user32" ( _
  ByVal hwnd As Long, _
  ByVal nIDEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimer As Long) As Long
 
Private Declare Function KillTimer Lib "user32" ( _
  ByVal hwnd As Long, _
  ByVal nIDEvent As Long) As Long
 
Private Const MY_NID = 88
Private Const MY_ELAPSE = 25 ' Wartezeit: 25 MSek.
 
' Benötigte API's für das Manipulieren der MsgBox
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 GetActiveWindow Lib "user32" () As Long
 
' WindowHandle des aktiven Fensters
Private m_hWnd As Long
 
' MsgBox OnTop anzeigen
Private m_OnTop As Boolean
 
' Schließen nach x-Millisekunden
Private m_Time As Long
 
' Flag für Timer-Ereignis
Private bClose As Boolean
 
' Benötigte API's für das Anzeigen eines Fenster im Vordergrund
Private Declare Function SetWindowPos Lib "user32" ( _
  ByVal hwnd As Long, _
  ByVal hWndInsertAfter As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal cx As Long, _
  ByVal cy As Long, _
  ByVal wFlags As Long) As Long
 
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
 
' API für Senden eines Fenster-Commands
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
' Konstante - Fenster schliessen
Private Const WM_CLOSE = &H10

' Unsere neue MsgBox-Funktion
Public Function MsgBox(ByVal sPrompt As String, _
  Optional ByVal nButtons As VbMsgBoxStyle = vbOKOnly, _
  Optional ByVal sTitle As String = "", _
  Optional ByVal sHelpFile As String = "", _
  Optional ByVal nContext As Long = 0, _
  Optional ByVal nTime As Long = 0, _
  Optional ByVal bOnTop As Boolean = False)
 
  Dim nResult As Long
 
  ' Falls MsgBox "OnTop" angezeigt oder nach
  ' x Millisekunden geschlossen werden soll...
  If bOnTop Or nTime > 0 Then
    ' Fensterhandle
    bClose = False
    m_OnTop = True
    m_hWnd = GetActiveWindow()
    m_Time = nTime * 1000
 
    ' API-Timer starten
    nResult = SetTimer(m_hWnd, MY_NID, MY_ELAPSE, AddressOf MsgBox_TimerEvent)
 
    ' MsgBox anzeigen
    nResult = MessageBox(m_hWnd, sPrompt, sTitle, nButtons)
 
    ' Timer deaktivieren (falls noch aktiviert)
    KillTimer m_hWnd, MY_NID
  Else
    ' andernfalls Standard-MsgBox anzeigen
    nResult = VBA.MsgBox(sPrompt, nButtons, sTitle, sHelpFile, nContext)
  End If
 
  ' Rückgabewert
  MsgBox = nResult
End Function

' Timer-Event!
Sub MsgBox_TimerEvent()
  Static nWnd As Long
 
  ' API-Timer deaktivieren
  KillTimer m_hWnd, MY_NID
 
  ' MsgBox schließen?
  If bClose Then
    SendMessage nWnd, WM_CLOSE, 0&, 0&
    bClose = False
  Else
 
    ' Fensterhandle der MsgBox
    nWnd = GetActiveWindow()
 
    ' MsgBox On Top setzen
    If m_OnTop Then
      SetWindowPos nWnd, HWND_TOPMOST, 0, 0, 0, 0, _
        SWP_NOMOVE Or SWP_NOSIZE
    End If
 
    ' Timer neu aktivieren
    If m_Time > 0 Then
      bClose = True
      SetTimer m_hWnd, MY_NID, m_Time, AddressOf MsgBox_TimerEvent
    End If
  End If
End Sub

Der Aufruf erfolgt wie bisher...

' "normale" MsgBox anzeigen
MsgBox "Text", vbCritical + vbOKOnly, "Hinweis"

... oder neu: MsgBox "always on top"...

' MsgBox "always on top"
MsgBox "Text", vbCritical + vbOKOnly, "Hinweis", , , , True

... oder MsgBox autom. nach 5 Sekunden schließen

' MsgBox nach 5 Sekunden schließen
MsgBox "Text", vbCritical + vbOKOnly, "Hinweis", , , 5