|
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
|
|
|
|
|
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 ]
|
|
|