Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/vbof/vbofevnt.cls

Text File | 1996-11-20 | 6.1 KB | 213 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
END
Attribute VB_Name = "VBOFEventObject"
Attribute VB_Creatable = True
Attribute VB_Exposed = False
Option Explicit

' (c) Copyright 1995 Ken Fitzpatrick
'     All Rights Reserved
'     Cannot be distributed or sold without permission
'
' VBObjectFrameworkEventObject is a supplemental
'   Event Object for Microsoft Visual Basic 4.0.
'   It is valid only in conjunction with the
'   following Classes Modules:
'       VBOFCollection
'       VBOFObjectLink
'       VBOFObjectManager
'       VBOFEventManager
'
' See Class Module "VBOFObjectManager" for
'     documentation details
'
' VBOFEventObject contains a registered Event
'   and the registrant to receive the notification.
'
' VBOFEventObject is a privately managed object
'   within the VBOFEventManager solution.

Private pvtRegisterObject As Object
Private pvtRegisterType As String
Private pvtTriggerObject As Object
Private pvtTriggerEvent As String
Private pvtTriggerObjectType As String
Private pvtTriggerCollection As VBOFCollection

Private pvtVBOFObjectManager As VBOFObjectManager

Public Function Describe() As String
Attribute Describe.VB_Description = "Private"

    Dim tempString As String

    tempString = _
        TypeName(Me) & ".Describe: " & _
        "TypeName(RegisterObject)='" & TypeName(pvtRegisterObject) & _
        "', RegisterType='" & pvtRegisterType & _
        "', TypeName(TriggerObject)='" & pvtTriggerObjectType & _
        "', TriggerEvent='" & pvtTriggerEvent

    Describe = tempString
End Function

Public Property Get ObjectManager() As VBOFObjectManager
Attribute ObjectManager.VB_Description = "Private"
    Set ObjectManager = pvtVBOFObjectManager
End Property


Public Property Set ObjectManager(anObjectManager As VBOFObjectManager)
    Set pvtVBOFObjectManager = anObjectManager
End Property


Public Property Get RegisterObject() As Variant
Attribute RegisterObject.VB_Description = "Private"
    Set RegisterObject = pvtRegisterObject
End Property

Public Property Set RegisterObject(anObject As Variant)
    Set pvtRegisterObject = anObject
End Property



Public Property Get RegisterType() As String
Attribute RegisterType.VB_Description = "Private"
    RegisterType = pvtRegisterType
End Property

Public Property Let RegisterType(aRegisterType As String)
    pvtRegisterType = UCase$(RegisterType)
End Property

Public Property Get TriggerObject() As Variant
Attribute TriggerObject.VB_Description = "Private"
    Set TriggerObject = pvtTriggerObject
End Property

Public Property Set TriggerObject(aTriggerObject As Variant)
    Set pvtTriggerObject = aTriggerObject
End Property

Public Property Get TriggerEvent() As String
Attribute TriggerEvent.VB_Description = "Private"
    TriggerEvent = pvtTriggerEvent
End Property

Public Property Let TriggerEvent(aTriggerEvent As String)
    pvtTriggerEvent = aTriggerEvent
End Property

Public Property Get TriggerObjectType() As String
Attribute TriggerObjectType.VB_Description = "Private"
    TriggerObjectType = pvtTriggerObjectType
End Property

Public Property Let TriggerObjectType(aTriggerObjectType As String)
    pvtTriggerObjectType = UCase$(aTriggerObjectType)
End Property

Public Function IsRegisteredForEvent(Optional Object As Variant, Optional Event As Variant, Optional Collection As Variant, Optional IsCollectionEvent As Variant) As Boolean
Attribute IsRegisteredForEvent.VB_Description = "Private"
' Returns True or False, depending on whether or not
'   this EventObject pertains to the specified
'   TriggerEvent

    Dim tempUCaseEvent As String

    On Local Error Resume Next

    tempUCaseEvent = UCase$(Event)

' check for Collections notifying one another
    If Not IsMissing(IsCollectionEvent) Then
        If IsCollectionEvent Then
            If TypeName(Me.RegisterObject) = "VBOFCollection" Then
                IsRegisteredForEvent = True
                Exit Function
            End If
        End If
    End If

' check for general-purpose registrations
'   based on Event
    If pvtTriggerEvent <> "" _
    And pvtTriggerEvent <> "ALL" _
    And pvtTriggerEvent <> "ANY" _
    And UCase$(pvtTriggerEvent) <> tempUCaseEvent _
    Then
        IsRegisteredForEvent = False
        Exit Function
    End If

' check for general-purpose registrations
'   based on TypeName()
    If pvtTriggerObjectType <> "" _
    And pvtTriggerObjectType <> "ALL" _
    And pvtTriggerObjectType <> "ANY" _
    And UCase$(pvtTriggerObjectType) <> UCase$(TypeName(Object)) _
    Then
        IsRegisteredForEvent = False
        Exit Function
    End If

' check for specific registrations
'   based on Object
    If Not pvtTriggerObject Is Nothing Then
        If pvtTriggerObject.ObjectID <> Object.ObjectID _
        Or TypeName(pvtTriggerObject) <> TypeName(Object) _
        Then
            IsRegisteredForEvent = False
            Exit Function
        End If
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & " Event Notification to ObjectType=" & _
            TypeName(Object) & _
            ", ObjectID=" & _
            Object.ObjectID
    End If
#End If

    IsRegisteredForEvent = True
End Function

Public Property Get ObjectEventManager() As VBOFEventManager
Attribute ObjectEventManager.VB_Description = "Private"
    Set ObjectEventManager = _
        pvtVBOFObjectManager.ObjectEventManager
End Property


Private Sub Class_Initialize()
Attribute Class_Initialize.VB_Description = "Private"
    pvtTriggerEvent = ""
    pvtTriggerObjectType = ""

    Set pvtTriggerObject = _
        Nothing
    Set pvtTriggerCollection = _
        Nothing
End Sub



Public Property Get Collection() As VBOFCollection
Attribute Collection.VB_Description = "Private"
    Set Collection = _
        pvtTriggerCollection
End Property


Public Property Set Collection(aCollection As VBOFCollection)
    Set pvtTriggerCollection = _
        aCollection
End Property