Content Supported by Sourcelens Consulting
VERSION 5.00
Begin VB.Form frmEvents
BorderStyle = 1 'Fixed Single
Caption = "Raising and Handling Events"
ClientHeight = 4245
ClientLeft = 45
ClientTop = 330
ClientWidth = 4710
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4245
ScaleWidth = 4710
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdAddForm
Caption = "Add &Receiver"
Height = 375
Left = 2880
TabIndex = 3
Top = 3360
Width = 1695
End
Begin VB.TextBox txtMessage
Height = 285
Left = 120
TabIndex = 2
Top = 3000
Width = 4455
End
Begin VB.CommandButton cmdPercentDone
Caption = "&Start a long task that uses an event to report progress"
Height = 615
Left = 240
TabIndex = 0
Top = 120
Width = 4215
End
Begin VB.Label Label2
Caption = "Message after all recipients have handled it:"
Height = 375
Left = 120
TabIndex = 6
Top = 3360
Width = 2295
End
Begin VB.Label lblPercentDone
Height = 255
Left = 360
TabIndex = 5
Top = 960
Width = 4095
End
Begin VB.Label lblEcho
Height = 255
Left = 120
TabIndex = 4
Top = 3840
Width = 4455
End
Begin VB.Label Label1
Caption = $"PWOEvent.frx":0000
Height = 1335
Left = 120
TabIndex = 1
Top = 1560
Width = 4455
End
Begin VB.Line Line1
X1 = 120
X2 = 4560
Y1 = 1440
Y2 = 1440
End
End
Attribute VB_Name = "frmEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ========================================
' Declarations for Broadcast Demo
'
' The Broadcast event has one argument,
' the message to be sent. The argument
' is ByRef, so recipients can change it.
Event Broadcast(Message As String)
' Collection of receivers.
Private mcolReceivers As New Collection
' ========================================
' Declarations and Code for
' Percent Done Demo
'
Private WithEvents mWidget As Widget
Attribute mWidget.VB_VarHelpID = -1
Private mblnCancel As Boolean
Private Sub mWidget_PercentDone(ByVal Percent As Double, Cancel As Boolean)
lblPercentDone.Caption = CInt(100 * Percent) & " percent complete"
DoEvents
If mblnCancel Then Cancel = True
End Sub
Private Sub cmdPercentDone_Click()
Static blnProcessing As Boolean
If blnProcessing Then
mblnCancel = True
Else
blnProcessing = True
cmdPercentDone.Caption = "&Cancel Task"
mblnCancel = False
lblPercentDone.Caption = "0 percent complete"
lblPercentDone.Refresh
' Create a Widget and start the
' long-running task.
Set mWidget = New Widget
On Error Resume Next
Call mWidget.LongTask(14.4, 0.9)
'
' See if the call ended because it
' was canceled (can't just test
' mblnCancel for this, because
' it might have been set just as
' LongTask was returning).
If Err.Number = 0 Then
lblPercentDone.Caption = "Task Complete"
ElseIf Err.Number = vbObjectError + wdgERRTaskCanceled Then
lblPercentDone.Caption = "Task Canceled"
Else
' (Handling for other errors omitted.)
lblPercentDone.Caption = "Something bad happened"
End If
Set mWidget = Nothing
cmdPercentDone.Caption = "&Start a long task that uses an event to report progress"
blnProcessing = False
End If
End Sub
' ========================================
' Code for Broadcast Demo
'
Private Sub cmdAddForm_Click()
Dim frm As New frmReceiver
' Keep track of the receivers.
mcolReceivers.Add frm
frm.Show vbModeless, Me
Me.SetFocus
txtMessage.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim frm As frmReceiver
On Error Resume Next
Do While mcolReceivers.Count > 0
Unload mcolReceivers(1)
mcolReceivers.Remove 1
Loop
End Sub
Private Sub txtMessage_Change()
Dim strMessage As String
strMessage = txtMessage.Text
'
' Raise the Broadcast event. Note that
' there's no way of knowing if there
' are any receivers handling the
' event.
RaiseEvent Broadcast(strMessage)
'
' Display the message after all
' receivers (if any) have handled
' it. Note that there's no way
' to know which receiver altered the
' message, or what interim values
' the message may have had.
lblEcho = strMessage
End Sub