Content Supported by Sourcelens Consulting
VERSION 5.00
Begin VB.Form frmEvents
BorderStyle = 1
Caption = "Raising and Handling Events"
ClientHeight = 4245
ClientLeft = 45
ClientTop = 330
ClientWidth = 4710
LinkTopic = "Form1"
MaxButton = 0
MinButton = 0
ScaleHeight = 4245
ScaleWidth = 4710
StartUpPosition = 3
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
Event Broadcast(Message As String)
Private mcolReceivers As New Collection
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
Set mWidget = New Widget
On Error Resume Next
Call mWidget.LongTask(14.4, 0.9)
If Err.Number = 0 Then
lblPercentDone.Caption = "Task Complete"
ElseIf Err.Number = vbObjectError + wdgERRTaskCanceled Then
lblPercentDone.Caption = "Task Canceled"
Else
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
Private Sub cmdAddForm_Click()
Dim frm As New frmReceiver
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
RaiseEvent Broadcast(strMessage)
lblEcho = strMessage
End Sub