EventHandlerAdd

 (Available in 01 TS COM - TS_COM_DelegateIUnknown)

Purpose

Install a installed event handler.

Syntax

? oDIUnknown:EventHandlerAdd( symDelegateISink )

Arguments

symDelegateISink
 SYMBOL

Description

Install a installed event handler. The application provides the name of the event handler class to instantiate, when the event handler is instantiated successfuly the method returns a reference to the handler created.

Returns

OBJECT, Instantiated event handler class

Example

CLASS TS_HOutlookApplicationEvents INHERIT TS_DelegateISink

ACCESS IID AS _WinGUID PTR PASCAL CLASS TS_HOutlookApplicationEvents
LOCAL STATIC pstruIID AS _WinGUID
   IF pstruIID==NULL_PTR
      pstruIID:=MemAlloc( _SIZEOF( _WinGUID ) )
      IF pstruIID<>NULL_PTR
         pstruIID.Data1:=0x0006304EU
         pstruIID.Data2:=0x0000
         pstruIID.Data3:=0x0000
         pstruIID.Data4[ 1 ]:=0xC0
         pstruIID.Data4[ 2 ]:=0x00
         pstruIID.Data4[ 3 ]:=0x00
         pstruIID.Data4[ 4 ]:=0x00
         pstruIID.Data4[ 5 ]:=0x00
         pstruIID.Data4[ 6 ]:=0x00
         pstruIID.Data4[ 7 ]:=0x00
         pstruIID.Data4[ 8 ]:=0x46
      ELSE
         TSTrace Fatal "Can not allocate memory for GUID"
         pstruIID:=TS_GUID_NULL( )
      END
   END
RETURN pstruIID

METHOD INIT( uoOwner, uoInvokeHandler, uloSelfDestruct ) CLASS TS_HOutlookApplicationEvents
   SUPER:INIT( uoOwner, uoInvokeHandler, uloSelfDestruct  ; ...
  ... )
   IF SELF:IsValidObject
      SELF:CreateClassMember( #OnApplicationItemSend, 0x0000F002  ; ...
     ... )
      SELF:CreateClassMember( #OnApplicationNewMail, 0x0000F003  ; ...
     ... )
      SELF:CreateClassMember( #OnApplicationReminder, 0x0000F004  ; ...
     ... )
      SELF:CreateClassMember( #OnApplicationOptionsPagesAdd,  ; ...
     ... 0x0000F005 )
      SELF:CreateClassMember( #OnApplicationStartup, 0x0000F006  ; ...
     ... )
      SELF:CreateClassMember( #OnApplicationQuit, 0x0000F007  ; ...
     ... )
   END
RETURN SELF

METHOD OnApplicationItemSend( oIItem, rlCancel ) CLASS TS_HOutlookApplicationEvents
// Do something in responce to the event
RETURN NIL

ACCESS Application CLASS TS_OutLook
   DO CASE
   CASE SELF:_OutlookApplicationFatal
      TSTrace Warning "SELF:_OutlookApplicationFatal"
   CASE SELF:_OutlookApplicationObj==NULL_OBJECT
      SELF:_OutlookApplicationObj:=TS_OutLookApplication{ SELF ; ...
     ... , NIL }
      IF SELF:_OutlookApplicationObj:IsValidObject
         SELF:_OutlookApplicationObj:EventHandlerAdd ; ...
        ... ( #TS_HOutlookApplicationEvents )
      ELSE
         SELF:_OutlookApplicationFatal:=TRUE
         SELF:_OutlookApplicationObj:Axit( )
         SELF:_OutlookApplicationObj:=NULL_OBJECT
         TSTrace Warning "!SELF:_OutlookApplicationObj:IsValidObject"
      END
   CASE SELF:_OutlookApplicationObj:IsValidObject
//    Do nothing
   OTHERWISE
      SELF:_OutlookApplicationFatal:=TRUE
      SELF:_OutlookApplicationObj:=NULL_OBJECT
      TSTrace Warning "!SELF:_OutlookApplicationObj:IsValidObject"
   END
RETURN SELF:_OutlookApplicationObj

Source

METHOD EventHandlerAdd( symDelegateISink AS SYMBOL, uoInvokeHandler:=NIL AS USUAL  ; ...
...) AS TS_DelegateISink PASCAL CLASS TS_DelegateIUnknown
LOCAL oDelegateISink AS TS_DelegateISink
   TSTrace Enter
   IF SELF:FInit
      IF IsSymbol( symDelegateISink ) .AND. symDelegateISink<>NULL_SYMBOL
         IF IsClass( symDelegateISink )
            IF IsClassOf( symDelegateISink, #TS_DelegateISink )
               oDelegateISink:=CreateInstance( symDelegateISink, SELF, uoInvokeHandler  ; ...
              ... )
               TSTrace SetCreatedAt oDelegateISink
               IF !oDelegateISink:FInit
                  TSTrace Warning "!oDelegateISink:FInit"
                  oDelegateISink:UnRegisterAxit( )
                  oDelegateISink:Destroy( )
                  oDelegateISink:=NULL_OBJECT
               END
            ELSE
               TSTrace Warning "!IsClassOf(symDelegateISink,#TS_DelegateISink)"
               oDelegateISink:=NULL_OBJECT
            END
         ELSE
            TSTrace Warning "!IsClass(symDelegateISink)"
            oDelegateISink:=NULL_OBJECT
         END
      ELSE
         TSTrace Warning "!(IsSymbol(symDelegateISink) .AND. symDelegateISink<>NULL_SYMBOL)"
         oDelegateISink:=NULL_OBJECT
      END
   ELSE
      TSTrace Warning "!SELF:FInit"
      oDelegateISink:=NULL_OBJECT
   END
   TSTrace Leave
RETURN oDelegateISink