In folgendem Beispiel werden Ereignisse verwendet, um während einer Demonstration des schnellsten 100m-Laufs die Sekunden mitzuzählen. Der Code führt sämtliche ereignisbezogenen Methoden, Eigenschaften und Anweisungen vor, einschließlich der Event-Anweisung.
Die Klasse, die ein Ereignis hervorruft, ist die Ereignisquelle; die Klassen, die das Ereignis implementieren, werden als Ereignisziele (Sinks) bezeichnet. Die von einer Ereignisquelle ausgehenden Ereignisse können mehrere Ziele haben. Wenn die Klasse das Ereignis hervorruft, wird es bei jeder Klasse ausgelöst, die sich dazu bereit erklärt hat, Ereignisse für diese Instanz des Objekts abzufangen.
In dem Beispiel werden auch ein Formular (Form1) mit einer Schaltfläche (Command1), ein Bezeichnungsfeld (Label1), sowie zwei Textfelder (Text1 und Text2) verwendet. Wenn Sie auf die Schaltfläche klicken, wird im ersten Textfeld "Ab jetzt" angezeigt, und im zweiten Textfeld werden die Sekunden gezählt. Nach Ablauf der Gesamtzeit (9,84 Sekunden) wird im ersten Textfeld "Bis jetzt" und im zweiten "9,84" angezeigt.
Der Code für Form1 legt den Anfangs- und den Endzustand des Formulars fest. Er enthält außerdem den Code, der ausgeführt wird, wenn Ereignisse ausgelöst werden.
Option Explicit
Private WithEvents mText As TimerState
Private Sub Command1_Click()
Text1.Text = "Ab jetzt"
Text1.Refresh
Text2.Text = "0"
Text2.Refresh
Call mText.TimerTask(9.84)
End Sub
Private Sub Form_Load()
Command1.Caption = "Klicken zum Start des Zeitgebers"
Text1.Text = ""
Text2.Text = ""
Label1.Caption = "Der schnellste 100m-Lauf dauerte so lange:"
Set mText = New TimerState
End Sub
Private Sub mText_ChangeText()
Text1.Text = "Bis jetzt"
Text2.Text = "9,84"
End Sub
Private Sub mText_UpdateTime(ByVal dblJump As Double)
Text2.Text = Str(Format(dblJump, "0"))
DoEvents
End Sub
Der restliche Code befindet sich in einem Klassenmodul namens TimerState. Die Event-Anweisungen deklarieren die Prozeduren, die bei der Auslösung von Ereignissen gestartet werden.
Option Explicit
Public Event UpdateTime(ByVal dblJump As Double)
Public Event ChangeText()
Public Sub TimerTask(ByVal Duration As Double)
Dim dblStart As Double
Dim dblSecond As Double
Dim dblSoFar As Double
dblStart = Timer
dblSoFar = dblStart
Do While Timer < dblStart + Duration
If Timer - dblSoFar >= 1 Then
dblSoFar = dblSoFar + 1
RaiseEvent UpdateTime(Timer - dblStart)
End If
Loop
RaiseEvent ChangeText
End Sub