Tipp 0353 MessageBox automatisch schließen
Autor/Einsender:
Datum:
  Detlev Schubert
20.08.2003
Entwicklungsumgebung:   VB 6
Sicherlich kennen Sie die Windows-Meldung, dass ein Dokument nicht gedruckt werden konnte und der Vorgang automatisch nach einigen Sekunden wiederholt wird. Dies lässt sich auch mit VB unter Zuhilfenahme der API-Funktionen SetTimer, KillTimer, FindWindow und SetForegroundWindow realisieren.
Statt des VB-Timers, wird in diesem Beispiel die API-Funktion SetTimer verwendet, da nicht nur die Zeitspanne als Parameter übergeben werden kann, sondern zusätzlich auch noch das Handle der aktuellen Form sowie optional eine EventID. Ist die Zeit des Timers abgelaufen, wird mittels AddressOf die Funktion TimerProc als CallBack-Funktion aufgerufen, zuerst der gesetzte Timer gelöscht, und dann die gewünschte Aktion ausgeführt.
Um nun die MessageBox automatisch schließen zu können, wird mit der Api-Funktion FindWindow nach der geöffneten MessageBox (Klassen-ID = #32770) gesucht, und mit SetForegroundWindow in den Vordergrund geholt. Als letztes wird mit SendKeys das entsprechende Kommando an die MessageBox gesendet.
Mit diesem Beispiel sind auch mehrere timergesteuerten MessageBoxen möglich. Dazu brauchen nur eigene unterschiedliche EventID's definiert und z.B. mittels Select Case in die Callback-Funktion TimerProc eingefügt werden.
Code im Codebereich des Moduls
 
Option Explicit

Public 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 FindWindow Lib "user32" Alias _
      "FindWindowA" (ByVal lpClassName As String, ByVal _
      lpWindowName As String) As Long

Private Declare Function SetForegroundWindow Lib "user32" ( _
      ByVal hWnd As Long) As Long

Public Const IDT_Timer1 As Long = &H10000
Public Const MSGBOX_TITLE As String = "Auto Close MessageBox"

Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
      ByVal IdEvent As Long, ByVal dwTime As Long)

  Dim hMsgBox As Long

  KillTimer hWnd, IdEvent

  Select Case IdEvent
    Case IDT_Timer1
      hMsgBox = FindWindow("#32770", MSGBOX_TITLE)
      If hMsgBox <> 0 Then
        SetForegroundWindow hMsgBox
        If Form1.Option2(1).Value = True Then SendKeys "{TAB}"
        SendKeys "{enter}"
      End If
  End Select

End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Command1_Click()
  Dim lngZeit      As Long
  Dim lngTimerID   As Long
  Dim intX         As Integer

  For intX = 0 To 2
    If Option1(0).Value = True Then
      lngZeit = 5000
    ElseIf Option1(1).Value = True Then
      lngZeit = 8000
    Else
      lngZeit = 10000
    End If
  Next

  lngTimerID = SetTimer(Me.hWnd, IDT_Timer1, lngZeit, _
        AddressOf TimerProc)

  If lngTimerID <> 0 Then
    If MsgBox("Soll das Programm beendet werden ?" & _
          vbCrLf & vbCrLf & "Nach Ablauf der angegeben " & _
          "Zeit wird das Programm" & vbCrLf & _
          "automatisch beendet.", vbQuestion + vbYesNo + _
          vbDefaultButton1, MSGBOX_TITLE) = vbYes Then

      MsgBox "Programm ist beendet.", vbInformation
      Unload Me
    Else
      MsgBox "Aktion wurde abgebrochen.", vbInformation
    End If

  Else
    MsgBox "Timer konnte nicht gesetzt werden.", vbCritical
 End If
End Sub
 
Weitere Links zum Thema
MessageBox frei positionieren

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4 kB) Downloads bisher: [ 2111 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Donnerstag, 15. September 2011