Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

MS Word Class-Based Event Handler

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • MS Word Class-Based Event Handler

    This is an event handler for MS Word. The ApplicationEvents class wasn't receiving events with parameters. In a thread on the Programming With Objects forum, we found that events could be received with low-level VTable code. Unfortunately parameters weren't being passed properly. It seems that Microsoft doesn't play by the COM rules it made.

    I experimented with some forum code that handled events from Excel and other MS products. Cutting to the chase, my code appears to receive all events and parameters from a Word application object.

    Both personally and contractually, I'm a big fan of classes. They protect variables while clarifying relationships. So the result is a WordEvent class. Instantiate it, call ConnectWordEvents, and -- as the PB samples say -- "insert your code here". But as written, it requires PB 9.

    The single program file below includes the class and a testbed in PBMAIN. There's lots of logging. Probably it's more a starting point than a polished solution, but it meets my immediate needs. Thanks to the folks who contributed to the thread, and hopefully this may be useful to some other soul caught between Word and an event sink.

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "Win32Api.inc"
    
    ' Word Events is a class-based event handler for the Microsoft Word application object.
    ' Classes require PB 9.
    ' It has been tested on Word 2000, Word XP and Word 2007.
    ' But it should in no way be seen as fully-tested code.
    
    ' PBMAIN simulates a simple application which obtains a reference to an existing open Word application,
    '        or creates a reference by opening Word.
    ' The Word application object is referred to using the Int__Application interface,
    '     which is a great coding improvement over the previous DISPATCH interface.
    
    ' The PBMAIN testbed then instantiates the global WordEvents object.
    ' It is designed for use with a single instance of the Word application,
    '    and only 1 instance of the WordEvents class should be created.
    ' This can probably be modified, but is beyond my needs at this time.
    
    ' If you include the standard oWord.inc file from PB's WinAPI folder,
    '    you will make only 2 calls to the WordEvent object.
    ' Once the goWordEvent object exists,
    '      call goWordEvents.ConnectWordEvents passing the application object.
    ' Although you are passing an Int__Application interface,
    '          the WordEvent object stores it as a DISPATCH interface,
    '          because that's the only way Word will pass parameters to events.
    ' "For reasons known only to ms..." sez Bob Zale.
    ' I trust people whose last name has 4 letters and begins with a "Z".
    ' If ConnectWordEvents successfully connects with Word, %True is returned.
    
    ' Each Word event is passed to it's own class method in the goWordEvent object.
    ' Method names correspond to the Word event names.
    ' You may insert your own code for any event, and ignore all others.
    ' Unused events may be removed from the InvokeEvents method in the class,
    '        EXCEPT that the QUIT event should always be processed.
    ' The Quit event assures that should Word quit before you disconnect from Word,
    '     the event handler will automatically be disconnected from Word
    
    ' Macro code outside the class can validate passed parameters,
    '       then create Document, Window and/or Selection objects with the DISPATCH interface.
    ' You may remove the macros where you don't need a parameter,
    '     or you may copy them directly into the method and modify them.
    
    ' The NewDocument and OpenDocument events automatically store references to the documents,
    '     then create a DocClass object for each document.
    ' The WindowActivateEvent event demonstrates how the proper DocClass object may be referenced.
    ' When the Quit event is processed, or when goWordEvents is set to NOTHING (whichever comes first),
    '      the ReportDocActivity logs the number of times each document window was activated.
    ' All this code may be removed.
    
    ' You may terminate the connection at any time by calling goWordEvents.DisconnectWordEvents.
    ' No parameters are required. Upon return, the goWordEvents object should be set to NOTHING.
    ' If the Quit event is called first,
    '    it will automatically invoke DisconnectWordEvents and release the object.
    
    ' Since this is a testbed, it has numerous log calls.
    ' The log is re-created each time the app starts,
    '     in a file called "Word Events.log" in the app folder.
    ' If there are errors in connecting, disconnecting or handling passed parameters,
    '    the error's location and cause are logged.
    ' Otherwise ConnectWordEvents and DisconnectWordEvents
    '           generate a single log entry with the method name followed by "OK".
    
    ' Each called event generates a log entry with the event name.
    ' If parameters are passed, and if you keep in the code that processes them,
    '    additional information (document name, window caption and/or selection range)
    '    is appended to the event name.
    ' These log commands may be modified or removed.
    
    ' When making changes, keep in mind that some code is necessarily outside the class.
    ' Macros, UDTs and DECLARES must be defined outside.
    ' Callbacks must be outside.
    ' Because the event handler is designed to have only a single global instance,
    '         callbacks can safely call methods in the goWordEvents object.
    
    
    
    
    ' when %UseWord9 is set %True, app will use Word 9 definitions generated by PB COM browser
    ' otherwise app will use Word 11 definitions included in PB WinAPI folder
    ' if you generated your own definitions with the PB COM Browser or Jose's TypeLib Browser,
    '    you might want to change the include file name & change literals elsewhere, indicate by the #IF/#ELSE/#ENDIF conditional compile metastatements
    
    %UseWord9 = 0
    '%UseWord9 = 1
    #IF %UseWord9
        #INCLUDE "Word9.inc"
    #ELSE
        #INCLUDE "oWord.inc"
    #ENDIF
    
    ' debugging macros
    
    MACRO LIN(xNum) = FORMAT$(xNum)
    MACRO LIN2(xNum, yNum) = FORMAT$(xNum) & $TAB & FORMAT$(yNum)
    MACRO LIN3(xNum, yNum, zNum) = FORMAT$(xNum) & $TAB & FORMAT$(yNum) & $TAB & FORMAT$(zNum)
    MACRO LIN4(xNum, yNum, zNum, xyzNum) = FORMAT$(xNum) & $TAB & FORMAT$(yNum) & $TAB & FORMAT$(zNum) & $TAB & FORMAT$(xyzNum)
    MACRO LIN5(xNum, yNum, zNum, xyzNum, abcNum) = FORMAT$(xNum) & $TAB & FORMAT$(yNum) & $TAB & FORMAT$(zNum) & $TAB & FORMAT$(xyzNum) & $TAB & FORMAT$(abcNum)
    
    MACRO LogIt(zTextX)
    
        MACROTEMP lFile
        LOCAL lFile AS LONG
    
        lFile = FREEFILE
        OPEN EXE.PATH$ & "\" & EXE.NAME$ & ".log" FOR APPEND AS #lFile
    
        PRINT #lFile, zTextX
    
        CLOSE #lFile
    
    END MACRO
    
    GLOBAL gzLogText AS STRING
    
    MACRO LogWE(zActionX, zResultX)
    
        gzLogText = SPACE$(256)
    
        LSET gzLogText = zActionX
    
        MID$(gzLogText, 31) = zResultX
    
        gzLogText = RTRIM$(gzLogText)
    
        LogIt(gzLogText)
    
    END MACRO
    
    MACRO LogClear()
    
        MACROTEMP lFile
        LOCAL lFile AS LONG
    
        lFile = FREEFILE
        OPEN EXE.PATH$ & "\" & EXE.NAME$ & ".log" FOR OUTPUT AS #lFile
    
        CLOSE #lFile
    
    END MACRO
    
    ' global Word app event handler - app will never handle more than 1 instance of Word
    ' routines not in the class can safely call this object & know it is the proper instance
    
    GLOBAL goWordEvents AS WordEventsInterface
    
    ' type definitions
    
    TYPE EXCEPINFO                  ' generated by PB COM Browser from stdole2.tlb
        wCode AS WORD
        wReserved AS WORD
        bstrSource AS STRING PTR
        bstrDescription AS STRING PTR
        bstrHelpFile AS STRING PTR
        dwHelpContext AS DWORD
        pvReserved AS DWORD PTR
        pfnDeferredFillIn AS DWORD
        scode AS LONG
    END TYPE
    
    TYPE IDispatchVtbl
       QueryInterface AS DWORD     ' Returns pointers to supported interfaces
       AddRef AS DWORD             ' Increments reference count
       Release AS DWORD            ' Decrements reference count
       GetTypeInfoCount AS DWORD   ' Retrieves the number of type descriptions
       GetTypeInfo AS DWORD        ' Retrieves a description of object's programmable interface
       GetIDsOfNames AS DWORD      ' Maps name of method or property to DispId
       Invoke AS DWORD             ' Calls one of the object's methods, or gets/sets one of its properties
       pVtblAddr AS DWORD          ' Address of the virtual table
       cRef AS DWORD               ' Reference counter
       poApp AS DWORD              ' IUnknown or IDispatch of the control that fires the events
    END TYPE
    
    ' declarations for CALL DWORD calls to various COM object pointers
    
    DECLARE FUNCTION IUnknown_QueryInterface(BYVAL poApp AS DWORD PTR, guidInterface AS GUID, poInterfacePtr AS DWORD) AS LONG
    DECLARE FUNCTION IUnknown_Release(BYVAL poApp AS DWORD PTR) AS DWORD
    
    DECLARE FUNCTION IConnectionPointContainer_FindConnectionPoint(BYVAL poInterfacePtr AS DWORD PTR, guidInterface AS GUID, pdwConnectionPoint AS DWORD) AS LONG
    
    DECLARE FUNCTION IConnectionPoint_Advise(BYVAL pdwConnectionPoint AS DWORD PTR, BYVAL pdwClientSink AS DWORD, pdwCookie AS DWORD) AS LONG
    DECLARE FUNCTION IConnectionPoint_Unadvise(BYVAL pdwConnectionPoint AS DWORD PTR, BYVAL dwCookie AS DWORD) AS LONG
    
    ' Interface IDs for implemented COM interfaces
    
    $IID_StdOLE_IUnknown = GUID$("{00000000-0000-0000-C000-000000000046}")
    $IID_StdOLE_IDispatch = GUID$("{00020400-0000-0000-C000-000000000046}")
    
    ' Interface IDs for UNimplemented COM interfaces which Word will query for an interface
    
    $IID_IMarshal = GUID$("{00000003-0000-0000-c000-000000000046}") ' requires us to create theoretically more optimized implementations than COM defaults: no thanks
    $IID_IStdMarshalInfo = GUID$("{00000018-0000-0000-c000-000000000046}") ' requires us to return a class handle to replace standard marshalling at destination (i.e. mostly for servers supporting class emulation): no thanks
    $IID_IExternalConnection = GUID$("{00000019-0000-0000-c000-000000000046}") ' must manage own reference count; object does not automatically shut down when count reaches 0: we know that Word app will shut down, or user end our app, which forces shutdown
    $IID_ICallFactory = GUID$("{1C733A30-2A1C-11CE-ADE5-00AA0044773D}") ' interface to process asynchronous calls: no thanks
    
    $IID_MarshallUnknown = GUID$("{0000001B-0000-0000-C000-000000000046}") ' unknown marshalling
    $IID_MarshallUnknown2 = GUID$("{4C1E39E1-E3E3-4296-AA86-EC938D896E92}") ' unknown marshalling
    
    ' callback functions expected by implemented COM interfaces
    ' they most be outside the class because multiple objects could be based on the class, and CODEPTR rightfully won't know what to do
    
    FUNCTION QueryInterface(BYVAL pCookie AS IDispatchVtbl PTR, guidInterface AS GUID, poInterfacePtr AS DWORD) AS LONG
    
        ' if we handle this interface
    
        IF (guidInterface = $IID_StdOLE_IUnknown) _
        OR (guidInterface = $IID_StdOLE_IDispatch) _
        OR (ISOBJECT(goWordEvents) AND (guidInterface = goWordEvents.ApplicationEventsInterfaceID)) THEN
    
            ' increment reference count
    
            AddRef pCookie
    
            ' return pointer to interface & success
    
            poInterfacePtr = pCookie
            FUNCTION = %S_OK
    
            ' still checking to see if $IID_StdOLE_IDispatch is requested
    
            IF (ISNOTHING(goWordEvents) OR (guidInterface <> goWordEvents.ApplicationEventsInterfaceID)) AND (guidInterface <> $IID_StdOLE_IUnknown) THEN
                LogWE("QueryInterface", "FOUND: " &  GUIDTXT$(guidInterface))
            END IF
    
        ' else return no interface
    
        ELSE
            poInterfacePtr = %NULL
            FUNCTION = %E_NOINTERFACE
    
            ' still checking to see if an unknown interface is requested
    
            IF (guidInterface <> $IID_IMarshal) AND (guidInterface <> $IID_IStdMarshalInfo) AND (guidInterface <> $IID_IExternalConnection) _
            AND (guidInterface <> $IID_ICallFactory) AND (guidInterface <> $IID_MarshallUnknown) AND (guidInterface <> $IID_MarshallUnknown2) THEN
                LogWE("QueryInterface", "NOT found: " &  GUIDTXT$(guidInterface))
            END IF
        END IF
    
    END FUNCTION
    
    FUNCTION AddRef(BYVAL pCookie AS IDispatchVtbl PTR) AS DWORD
        ' increment reference count & return count
        INCR @@pCookie.cRef
        FUNCTION = @@pCookie.cRef
    END FUNCTION
    
    FUNCTION ReleaseRef(BYVAL pCookie AS IDispatchVtbl PTR) AS DWORD
    
        ' decrements reference count & return count
    
        LOCAL pVtblAddr AS DWORD
    
        ' if last reference, release class
    
        IF @@pCookie.cRef = 1 THEN
            pVtblAddr = @@pCookie.pVtblAddr
    
            IF ISTRUE HeapFree(GetProcessHeap(), 0, BYVAL pVtblAddr) THEN
                EXIT FUNCTION
    
            ELSE
                FUNCTION = @@pCookie.cRef
                EXIT FUNCTION
            END IF
        END IF
    
        DECR @@pCookie.cRef
        FUNCTION = @@pCookie.cRef
    
    END FUNCTION
    
    FUNCTION GetTypeInfoCount(BYVAL pCookie AS IDispatchVtbl PTR, pctInfo AS DWORD) AS LONG
        ' returns the number of type information interfaces that an object provides (either 0 or 1)
        pctInfo = 0
        FUNCTION = %S_OK
    END FUNCTION
    
    FUNCTION GetTypeInfo(BYVAL pCookie AS IDispatchVtbl PTR, BYVAL itinfo AS DWORD, BYVAL lcid AS DWORD, pptinfo AS DWORD) AS LONG
        ' returns the type information for object, but we don't implement
        FUNCTION = %E_NOTIMPL
    END FUNCTION
    
    FUNCTION GetIDsOfNames(BYVAL pCookie AS IDispatchVtbl PTR, guidInterface AS GUID, BYVAL rgszNames AS DWORD, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, rgdispid AS LONG) AS LONG
        ' returns pointers to names & IDs, but we don't implement
        FUNCTION = %E_NOTIMPL
    END FUNCTION
    
    FUNCTION InvokeEvents(BYVAL pCookie AS IDispatchVtbl PTR, BYVAL dispidMember AS LONG, guidInterface AS GUID, _
        BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, pDispParams AS DISPPARAMS, pvarResult AS VARIANT, _
        pexcepinfo AS EXCEPINFO, puArgErr AS DWORD) AS LONG
    
        ' although this function must be outside a class to be called,
        ' it merely calls a method in the public goWordEvents object, passing only the arguments I will use (tho you can include others), & returns the method's result
    
        IF ISOBJECT(goWordEvents) THEN
            FUNCTION = goWordEvents.InvokeEvents(pCookie, dispidMember, pDispParams)
    
        ' unless, of course, the goWordEvents object doesn't exist,
    
        ELSE
            FUNCTION = %DISP_E_MEMBERNOTFOUND
        END IF
    
    END FUNCTION
    
    ' DocClass serves as a simple, if useless, demonstration of how multiple instances of a class can be controlled by a single event handler
    ' all it does is track the number of times each document's window gets activated & print a report
    ' you could similarly create objects from class specific to Word windows, or any other Word object which can be derived from passed documents/windows/selections
    
    CLASS DocClass
    
        INSTANCE moDoc AS Int__Document
    
        INSTANCE mlWindowActivated AS LONG
        INSTANCE mzDocName AS STRING
    
        CLASS METHOD CREATE()
        END METHOD
    
        CLASS METHOD Destroy()
            ' release object
            moDoc = NOTHING
        END METHOD
    
        INTERFACE DocClassInterface
            INHERIT CUSTOM
    
            METHOD RegisterDoc(oDoc AS DISPATCH)
                ' store Word doc reference & full name
                ' we really don't use the Word doc object afterwards, but a real app would
                moDoc = oDoc
                mzDocName = ACODE$(moDoc.FullName)
            END METHOD
    
            METHOD WindowActivated()
                ' increment count of window activations
                INCR mlWindowActivated
            END METHOD
    
            METHOD ReportActivations()
                ' report on window activations
                LogWE(FORMAT$(mlWindowActivated, "#,#") & " window activations", mzDocName)
            END METHOD
    
        END INTERFACE
    
    END CLASS
    
    ' all that follows, up until PBMAIN, is the event handler object & macros used by it
    
    ' the following macros are called from Word event handlers within the WordEvents class
    ' since this is still a testbed, errors are being logged, but you can display messages or otherwise degrade handling of event
    
    ' lIndexX = 0-based parameters index
    ' zEventX = name of event handler, used only to identify errors in log
    
    ' GetXxxPointer macros test that parameter is an DISPATCH pointer, retrieve pointer & test for non-zero pointer value
    ' if error, it is logged and we exit method handling event with an appropriate error code, but you can choose to continue
    ' if you don't need to refer to object, you need not call this macro, but then you cannot call the corresponding MakeXxxObject macro
    
    MACRO GetDocPointer(lIndexX, zEventX)
    
        ' retrieves pointer to an DISPATCH document
    
         REGISTER dwDocPointer AS DWORD
    
        ' if not a dispatch parameter, exit
    
        IF @pvArgs[lIndexX].vt <> %VT_DISPATCH THEN
            LogWE(zEventX, "NOT dispatch parameter: " & Lin(@pvArgs[lIndexX].vt))
            METHOD = %DISP_E_BADVARTYPE
            EXIT METHOD
        END IF
    
        ' get pointer to doc object
        ' if no pointer, exit
    
        dwDocPointer = @pvArgs[lIndexX].vd.pdispVal
    
        IF dwDocPointer = 0 THEN
            LogWE(zEventX, "NO document pointer")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
    END MACRO
    
    MACRO GetWinPointer(lIndexX, zEventX)
    
        ' retrieves pointer to an DISPATCH window
    
        REGISTER dwWinPointer AS DWORD
    
        ' if not a dispatch parameter, exit
    
        IF @pvArgs[lIndexX].vt <> %VT_DISPATCH THEN
            LogWE(zEventX, "NOT dispatch parameter: " & Lin(@pvArgs[lIndexX].vt))
            METHOD = %DISP_E_BADVARTYPE
            EXIT METHOD
        END IF
    
        ' get pointer to window object
        ' if no pointer, exit
    
        dwWinPointer = @pvArgs[lIndexX].vd.pdispVal
    
        IF dwWinPointer = 0 THEN
            LogWE(zEventX, "NO window pointer")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
    END MACRO
    
    MACRO GetSelPointer(lIndexX, zEventX)
    
        ' retrieves pointer to an DISPATCH selection
    
        REGISTER dwSelPointer AS DWORD
    
        ' if not a dispatch parameter, exit
    
        IF @pvArgs[lIndexX].vt <> %VT_DISPATCH THEN
            LogWE(zEventX, "NOT dispatch parameter: " & Lin(@pvArgs[lIndexX].vt))
            METHOD = %DISP_E_BADVARTYPE
            EXIT METHOD
        END IF
    
        ' get pointer to selection object
        ' if no pointer, exit
    
        dwSelPointer = @pvArgs[lIndexX].vd.pdispVal
    
        IF dwSelPointer = 0 THEN
            LogWE(zEventX, "NO selection pointer")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
    END MACRO
    
    ' MakeXxxObject macros require that you called the corresponding GetXxxPointer, else you have no pointer to make object
    ' MakeXxxObject macros poke previously retrieved object pointer into a local DISPATCH, tests if it's an object
    ' if error, it is logged and we exit method handling event with an appropriate error code, but you can choose to continue
    ' if you don't need to refer to object, you need not call this macro, but then you cannot refer to the corresponding DISPATCH object
    ' once created, the DISPATCH object can call any valid object methods or properties, or pass object to another routine (even in another class)
    ' as an example, each macro gets a property or two from the object, but you can substitute your own object needs
    
    MACRO MakeDocObject(zEventX)
    
        ' instantiates a local DISPATCH document object
    
        LOCAL oDoc AS DISPATCH
    
        ' poke previously retrieved document pointer into local DISPATCH & tests if it's an object
        ' if not, exit
    
        POKE DWORD, VARPTR(oDoc), dwDocPointer
    
        IF ISNOTHING(oDoc) THEN
            LogWE(zEventX, "parameter does NOT point to document object")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
        ' increment object reference count (which happens automatically when DISPATCH is SET, but not by POKing)
        ' when object goes out of scope at end of SUB, object count automatically decrements
    
        oDoc.AddRef
    
        ' example: so let's get the document name
    
        LOCAL vName AS VARIANT
        OBJECT GET oDoc.FullName TO vName
    
    END MACRO
    
    MACRO MakeWinObject(zEventX)
    
        ' instantiates a local DISPATCH window object
    
        LOCAL oWin AS DISPATCH
    
        ' poke previously retrieved document pointer into local DISPATCH & tests if it's an object
        ' if not, exit
    
        POKE DWORD, VARPTR(oWin), dwWinPointer
    
        IF ISNOTHING(oWin) THEN
            LogWE(zEventX, "parameter does NOT point to window object")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
        ' increment object reference count (which happens automatically when DISPATCH is SET, but not by POKing)
        ' when object goes out of scope at end of SUB, object count automatically decrements
    
        oWin.AddRef
    
        ' example: so let's get the window caption
    
        LOCAL vcaption AS VARIANT
        OBJECT GET oWin.caption TO vcaption
    
    END MACRO
    
    MACRO MakeSelObject(zEventX)
    
        ' instantiates a local DISPATCH selection object
    
        LOCAL oSel AS DISPATCH
    
        ' poke previously retrieved document pointer into local DISPATCH & tests if it's an object
        ' if not, exit
    
        POKE DWORD, VARPTR(oSel), dwSelPointer
    
        IF ISNOTHING(oSel) THEN
            LogWE(zEventX, "parameter does NOT point to selection object")
            METHOD = %DISP_E_PARAMNOTOPTIONAL
            EXIT METHOD
        END IF
    
        ' increment object reference count (which happens automatically when DISPATCH is SET, but not by POKing)
        ' when object goes out of scope at end of SUB, object count automatically decrements
    
        oSel.AddRef
    
        ' example: so let's get the selection range
    
        LOCAL vStart, vEnd AS VARIANT
        OBJECT GET oSel.Start TO vStart
        OBJECT GET oSel.End TO vEnd
    
    END MACRO
    
    ' MakeXxxObjectFromSel macros require that you called the GetSelPointer & MakeSelObject macros, else you have no selection to get a reference to object
    ' MakeXxxObjectFromSel use standard object calls to create the local DISPATCH object, then tests if it's an object
    ' if error, it is logged and we exit method handling event, but you can choose to continue
    ' if you don't need to refer to object, you need not call this macro, but then you cannot refer to the corresponding DISPATCH object
    ' once created, the DISPATCH object can call any valid object methods or properties, or pass object to another routine (even in another class)
    ' as an example, each macro gets a property from the object, but you can substitute your own object needs
    ' for those events which only pass a selection parameter (WindowSelectionChange, WindowBeforeRightClick & WindowBeforeDoubleClick),
    ' you can obtain the corresponding document and/or window to process the event
    
    MACRO MakeDocObjectFromSel(zEventX)
    
        LOCAL vDoc, vName AS VARIANT
        LOCAL oDoc AS DISPATCH
    
        ' get the document from the selection
    
        OBJECT GET oSel.Document TO vDoc
        oDoc = vDoc
    
        ' if not an object, ext
    
        IF ISNOTHING(oDoc) THEN
            LogWE(zEventX, "parameter does NOT point to document object")
            EXIT METHOD
        END IF
    
        ' example: so let's get the full name (to distinguish from caption)
    
        OBJECT GET oDoc.FullName TO vName
    
    END MACRO
    
    MACRO MakeWinObjectFromSel(zEventX)
    
        LOCAL vWin, vCaption AS VARIANT
        LOCAL oWin AS DISPATCH
    
        ' get the window from the selection
    
        OBJECT GET oSel.Document.ActiveWindow TO vWin
        oWin = vWin
    
        ' if not an object, ext
    
        IF ISNOTHING(oWin) THEN
            LogWE(zEventX, "parameter does NOT point to window object")
            EXIT METHOD
        END IF
    
        ' example: so let's get the caption
    
        OBJECT GET oWin.Caption TO vCaption
    
    END MACRO
    
    ' ParamCheck is called by events with parameters (all but Start, Quit & DocumentChange)
    
    MACRO ParamCheck()
    
        LOCAL pvArgs AS VARIANTAPI PTR
    
        ' if there is no pointer to parameters, exit
    
        IF VARPTR(pDispParams) = 0 THEN
            METHOD = %DISP_E_BADPARAMCOUNT
            EXIT METHOD
        END IF
    
        ' else default to return OK to Word
    
        METHOD = %S_OK
    
        ' get pointer to parameter(s)
    
        pvArgs = pDispParams.VariantArgs
    
    END MACRO
    
    
    CLASS WordEvents
    
        ' Word wants to deal with IDispatch interface, although that makes for more complex & less readable code
        ' we accomodate them by storing a reference to the Int__Application object we use for coding in a local DISPATCH object we use only to connect & disconnect our event sink
    
        INSTANCE moAppDispatch AS DISPATCH
    
        ' this cookie hold our connection, which we'll need later to terminate it
    
        INSTANCE mdwCookie AS DWORD
    
        ' since I'm using a special version of oWord.inc, this allows customizing the events interface ID as generated by you
    
        INSTANCE mzApplicationEventsInterfaceID AS STRING
    
        ' arrays & counter used to store information in the silly demo of referencing other objects
    
        INSTANCE mdwDocPtr() AS DWORD
        INSTANCE moDocCls() AS DocClassInterface
        INSTANCE mlDocs AS DWORD
    
        CLASS METHOD CREATE()
    
            ' init arrays
    
            REDIM mdwDocPtr(1 TO 3) AS INSTANCE DWORD
            REDIM moDocCls(1 TO 3) AS INSTANCE DocClassInterface
    
        END METHOD
    
        CLASS METHOD Destroy()
    
            ' this object is going down, so no more events
    
            me.DisconnectWordEvents2
    
            ' release object
    
            moAppDispatch = NOTHING
    
            ' if the Quit event hasn't generate the report, do it now
    
            me.ReportDocActivity
    
        END METHOD
    
        CLASS METHOD ReportDocActivity()
    
            REGISTER lDoc AS LONG
    
            ' if static flag set that report has run (and moDocCls objects released), exit
    
            STATIC bReported AS LONG
    
            IF bReported THEN
                EXIT METHOD
            END IF
    
            ' header
    
            LogIt("Window Activation Report ==================================")
    
            ' for each app document class object, print it's report line & release object
    
            FOR lDoc = 1 TO mlDocs
                IF ISOBJECT(moDocCls(lDoc)) THEN
                    moDocCls(lDoc).ReportActivations
                    moDocCls(lDoc) = NOTHING
                END IF
            NEXT
    
            ' footer
    
            LogIt("Report Done ==================================")
    
            ' set flag to prevent recurrence
    
            bReported = %True
    
        END METHOD
    
        CLASS METHOD AddDoc(BYVAL oDoc AS DISPATCH) AS LONG
    
            ' add a new or opened document to parallel arrays of Word document object pointers & app document class instance pointers
    
            REGISTER lDoc AS LONG, dwDocPtr AS DWORD
    
            ' get Word doc object pointer
    
            dwDocPtr = OBJPTR(oDoc)
    
            ' if this document already in list, return index & exit
    
            ARRAY SCAN mdwDocPtr(), = dwDocPtr, TO lDoc
    
            IF lDoc > 0 THEN
                METHOD = lDoc
                EXIT METHOD
            END IF
    
            ' increment doc count
            ' if arrays too small, redim
    
            INCR mlDocs
    
            IF mlDocs > UBOUND(mdwDocPtr) THEN
                REDIM PRESERVE mdwDocPtr(1 TO mlDocs + 3) AS INSTANCE DWORD
            END IF
    
            IF mlDocs > UBOUND(moDocCls) THEN
                REDIM PRESERVE moDocCls(1 TO mlDocs + 3) AS INSTANCE DocClassInterface
            END IF
    
            ' find empty element, or exit
    
            ' as coded, it will always be the same as the mlDocs count
            ' in a real app, you would want to remove closed documents by zeroing mdwDocPtr and setting moDocCls to nothing
            ' unfortunately, BeforeDocumentClose is useless because after it is raised the user could cancel a save document prompt & the document would still be there
            ' note that while objects can be store in arrays, they do not like ARRAY INSERT or ARRAY DELETE (nor, would I imagine, ARRAY SORT)
    
            ARRAY SCAN mdwDocPtr(), = 0, TO lDoc
    
            IF lDoc = 0 THEN
                EXIT METHOD
            END IF
    
            ' store document pointer in mdwDocPtr array
            ' this can be compared with the pointer to a document passed as a parameter in an event, and then used to call the corresponding moDocCls object
    
            mdwDocPtr(lDoc) = dwDocPtr
    
            ' create app's doc class & register document
            ' just to show how it might be done
    
            moDocCls(lDoc) = CLASS "DocClass"
            moDocCls(lDoc).RegisterDoc(oDoc)
    
            ' return index
    
            METHOD = lDoc
    
        END METHOD
    
        CLASS METHOD GetDocIndex(BYVAL oDoc AS DISPATCH) AS LONG
    
            ' check if document already has an moDocCls object, and if so, returns an index to the array element
    
            REGISTER lDoc AS LONG, dwDocPtr AS DWORD
    
            ' get Word doc object pointer
    
            dwDocPtr = OBJPTR(oDoc)
    
            ' if this document already in array, return index & exit
    
            ARRAY SCAN mdwDocPtr(), = dwDocPtr, TO lDoc
    
            IF lDoc > 0 THEN
                METHOD = lDoc
            END IF
    
        END METHOD
    
        CLASS METHOD WordEventsInit(BYVAL poApp AS DWORD PTR, dwConnectionPoint AS DWORD, zAction AS STRING) AS LONG
    
            ' initialization code common to both connecting & disconnecting Word & our event handler
    
            REGISTER lReturnCode AS LONG
            LOCAL poInterfacePtr, pdwConnectionPoint AS DWORD PTR
            LOCAL guidConnectionPointContainer, guidInterface AS GUID
    
            ' if no application pointer, exit
    
            IF poApp = 0 THEN
                LogWE("WordEventsInit_" & zAction, "FAILED: no App pointer")
                EXIT METHOD
            END IF
    
            ' set GUIDs
    
            guidConnectionPointContainer = GUID$("{B196B284-BAB4-101A-B69C-00AA00341D07}")  '   per MSDN, IID_IConnectionPointContainer
            guidInterface = mzApplicationEventsInterfaceID                                  '   whatever your oWord.inc file calls the interface ID
    
            ' get interface pointer, or exit
    
            CALL DWORD @@poApp[0] USING IUnknown_QueryInterface(poApp, guidConnectionPointContainer, poInterfacePtr) TO lReturnCode
    
            IF lReturnCode <> %S_OK THEN
                LogWE("WordEventsInit_" & zAction, "FAILED: no interface pointer: " & Lin(lReturnCode))
                EXIT METHOD
            END IF
    
            ' get connection point
    
            CALL DWORD @@poApp[4] USING IConnectionPointContainer_FindConnectionPoint(poInterfacePtr, guidInterface, pdwConnectionPoint) TO lReturnCode
    
            ' release interface pointer
    
            CALL DWORD @@poInterfacePtr[2] USING IUnknown_Release(poInterfacePtr)
    
            ' if no connection point, exit
    
            IF lReturnCode <> %S_OK THEN
                LogWE("WordEventsInit_" & zAction, "FAILED: no connection point: " & Lin(lReturnCode))
                EXIT METHOD
            END IF
    
            ' return connection point & success
    
            dwConnectionPoint = pdwConnectionPoint
    
            METHOD = %True
    
        END METHOD
    
        CLASS METHOD BuildVTable(BYVAL poApp AS DWORD) AS DWORD
    
            ' build the IDispatch Virtual Table which Word will use to communication with our handler
            ' Invoke is where events get sent
    
            LOCAL ptVtbl AS IDispatchVtbl PTR
            LOCAL ptClientSink AS IDispatchVtbl PTR
    
            ' get non-moveable memory for vTable, or exit
    
            ptVtbl = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, SIZEOF(@ptVtbl))
            IF ptVtbl = 0 THEN
                EXIT METHOD
            END IF
    
            ' store addresses of the code (outside the class) to be called by Word
    
            @ptVtbl.QueryInterface = CODEPTR(QueryInterface)
            @ptVtbl.AddRef = CODEPTR(AddRef)
            @ptVtbl.Release = CODEPTR(ReleaseRef)
            @ptVtbl.GetTypeInfoCount = CODEPTR(GetTypeInfoCount)
            @ptVtbl.GetTypeInfo = CODEPTR(GetTypeInfo)
            @ptVtbl.GetIDsOfNames = CODEPTR(GetIDsOfNames)
            @ptVtbl.Invoke = CODEPTR(InvokeEvents)
    
            ' store pointers to the VTable memory block & our IDispatch copy of the Word app object
    
            @ptVtbl.pVtblAddr = ptVtbl
    
            @ptVtbl.poApp = poApp
    
            ' get & return the client sink (pointer to location of VTable in memory)
    
            ptClientSink = VARPTR(@ptVtbl.pVtblAddr)
    
            METHOD = ptClientSink
    
        END METHOD
    
        CLASS METHOD DisconnectWordEvents2() AS LONG
    
            ' release the events connection identified with the cookie returned by the ConnectEvents method
    
            REGISTER lReturnCode AS LONG, dwConnectionPoint AS DWORD
            LOCAL poApp, pdwConnectionPoint AS DWORD PTR
    
            ' static variable to flag if we've already disconnected
            ' (this disconnect routine could be called by the Quit event handler, the app or the Destructor)
    
            STATIC bDisconnected AS LONG
    
            ' if no cookie, exit (but log error is not yet disconnected)
    
            IF mdwCookie = 0 THEN
                IF ISFALSE(bDisconnected) THEN
                    LogWE("DisconnectWordEvents", "FAILED: no cookie")
                END IF
                EXIT METHOD
            END IF
    
            ' get current pointer to app object, or exit
    
            poApp = OBJPTR(moAppDispatch)
    
            IF poApp = 0 THEN
                LogWE("DisconnectWordEvents", "FAILED: poApp = 0")
                EXIT METHOD
            END IF
    
            ' initialize & get connection point, or exit
    
            IF ISFALSE(me.WordEventsInit(poApp, dwConnectionPoint, "Disconnect")) THEN
                EXIT METHOD
            END IF
    
            pdwConnectionPoint = dwConnectionPoint
    
            ' disconnect client sink
    
            CALL DWORD @@pdwConnectionPoint[6] USING IConnectionPoint_Unadvise(pdwConnectionPoint, mdwCookie) TO lReturnCode
    
            ' release connection point
    
            CALL DWORD @@pdwConnectionPoint[2] USING IUnknown_Release(pdwConnectionPoint)
    
            ' if unable to disconnect client sink, exit
    
            IF lReturnCode <> %S_OK THEN
                LogWE("DisconnectWordEvents", "FAILED: unable to disconnect client sink: " & Lin(lReturnCode))
                EXIT METHOD
            END IF
    
            ' zero cookie
    
            mdwCookie = 0
            bDisconnected = %True
    
            ' return success
    
            LogWE("DisconnectWordEvents", "OK")
    
            METHOD = %True
    
        END METHOD
    
        CLASS METHOD StartupEvent(BYVAL pCookie AS IDispatchVtbl PTR) AS LONG
    
            ' no parameters for this event
    
            ' default to return OK to Word
    
            METHOD = %S_OK
    
            ' this event will only be called if a COM add-in or startup template with an AutoExec macro calls this app to create event sink
    
            ' this event will never be called when the app itself starts a new instance of Word or connects with an existing instance of Word,
            '      since by the time we create event sink to connect with Word, Word has already started
            ' under those circumstances, it is possible that 1 or more documents are already open, never to receive the NewDocument or OpenDocument event
            '       if your app was creating instances of a class for each doc, you would need to create them manually at the time this object was instantiated
    
            LogIt("Startup")
    
        END METHOD
    
        CLASS METHOD QuitEvent(BYVAL pCookie AS IDispatchVtbl PTR) AS LONG
    
            ' this event should NOT be deleted, although the LogIt and ReportDocActivity calls may be removed
            ' this event assures that should Word quit, the event handler will automatically be disconnected from Word
    
            ' no parameters for this event
    
            ' default to return OK to Word
    
            METHOD = %S_OK
    
            LogIt("Quit")
    
            ' let's do that silly report showing how to use multiple instances of our own objects
    
            me.ReportDocActivity
    
            ' if still connected to event sink, disconnect
            ' DisconnectWordEvents will do nothing if it has previously disconnected
            ' in theory, the goWordEvents object doesn't exist in that case, which means this event should never have been invoked, but let's check
    
            IF ISOBJECT(goWordEvents) THEN
                me.DisconnectWordEvents2
                goWordEvents = NOTHING
            END IF
    
        END METHOD
    
        CLASS METHOD DocumentChangeEvent(BYVAL pCookie AS IDispatchVtbl PTR) AS LONG
    
            ' default to return OK to Word
    
            METHOD = %S_OK
    
            ' no parameters for this event
    
            ' you could check the Word app object for the current document,
            '     but this report is always accompanied by one or more NewDocument, OpenDocument, WindowActivate or WindowDeactivate events
            '     (and in fact this event could be called more than once in all that)
            ' which makes the event somewhat less than useful
    
            LogIt("DocumentChange")
    
        END METHOD
    
        CLASS METHOD DocumentOpenEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "DocumentOpen")
    
            ' make doc object
    
            MakeDocObject("DocumentOpen")
    
            ' add opened doc to array & create a corresponding DocClass object
            ' then when other events pass a document, you can find the proper object to use
    
            IF ISOBJECT(oDoc) THEN
                LogWE("DocumentOpen", VARIANT$(vName) & ": array index: " & Lin(me.AddDoc(oDoc)))
            ELSE
                LogIt("DocumentOpen")
            END IF
    
        END METHOD
    
        CLASS METHOD DocumentBeforeCloseEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' we don't care about parameter 2: Cancel
            ' but you could set it prevent the close
    
            ' remember this event does NOT mean that the document actually closed, because the user could cancel a save document prompt
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "DocumentBeforeClose")
    
            ' make doc object
    
            MakeDocObject("DocumentBeforeClose")
    
            IF ISOBJECT(oDoc) THEN
                LogWE("DocumentBeforeClose", VARIANT$(vName))
            ELSE
                LogIt("DocumentBeforeClose")
            END IF
    
        END METHOD
    
        CLASS METHOD DocumentBeforePrintEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' we don't care about parameter 2: Cancel
            ' but you could set it prevent printing
    
            ' remember this event does NOT mean that the document actually gets printed, because the user could cancel the print prompt
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "DocumentBeforePrint")
    
            ' make doc object
    
            MakeDocObject("DocumentBeforePrint")
    
            IF ISOBJECT(oDoc) THEN
                LogWE("DocumentBeforePrint", VARIANT$(vName))
            ELSE
                LogIt("DocumentBeforePrint")
            END IF
    
        END METHOD
    
        CLASS METHOD DocumentBeforeSaveEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            REGISTER bSaveAsUI AS LONG
    
            ' we don't care about parameter 3: Cancel
            ' but you could set it prevent saving
    
            ' remember that if bSaveAsUI = %True,
            '          this event does NOT mean that the document was actually saved, because the user could cancel the save document prompt
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "DocumentBeforeSave")
    
            ' make doc object
    
            MakeDocObject("DocumentBeforeSave")
    
            ' if not a boolean SaveAsUI parameter, exit
            ' (ORed with %VT_BYREF because value is passed by reference)
    
            IF @pvArgs[1].vt <> (%VT_BOOL OR %VT_BYREF) THEN
                METHOD = %DISP_E_BADVARTYPE
                LogWE("DocumentBeforeSave", "NOT boolean parameter: " & Lin(@pvArgs[1].vt))
                EXIT METHOD
            END IF
    
            ' get SaveAsUI boolean (using pointer to integer with boolean value)
    
            bSaveAsUI = @pvArgs[1][email protected]
    
            IF ISOBJECT(oDoc) THEN
                LogWE("DocumentBeforeSave", VARIANT$(vName) & IIF$(bSaveAsUI, " :SaveAsUI",""))
            ELSE
                LogWE("DocumentBeforeSave", IIF$(bSaveAsUI, " :SaveAsUI",""))
            END IF
    
        END METHOD
    
        CLASS METHOD NewDocumentEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "NewDocument")
    
            ' make doc object
    
            MakeDocObject("NewDocument")
    
            ' add new doc to array & create a corresponding DocClass object
            ' then when other events pass a document, you can find the proper object to use
    
            IF ISOBJECT(oDoc) THEN
                LogWE("NewDocument", VARIANT$(vName) & ": array index: " & Lin(me.AddDoc(oDoc)))
            ELSE
                LogIt("NewDocument")
            END IF
    
        END METHOD
    
        CLASS METHOD WindowActivateEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            REGISTER lDoc AS LONG
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "WindowActivate")
    
            ' make doc object
    
            MakeDocObject("WindowActivate")
    
            ' get pointer to window object
    
            GetWinPointer(1, "WindowActivate")
    
            ' make window object
    
            MakeWinObject("WindowActivate")
    
            lDoc = me.GetDocIndex(oDoc)
            IF lDoc > 0 THEN
                IF ISOBJECT(moDocCls(lDoc)) THEN
                    moDocCls(lDoc).WindowActivated
                END IF
            END IF
    
            IF ISOBJECT(oDoc) AND ISOBJECT(oWin) THEN
                LogWE("WindowActivate", VARIANT$(vName) & "  ::  " & VARIANT$(vCaption))
            ELSE
                LogIt("WindowActivate")
            END IF
    
        END METHOD
    
        CLASS METHOD WindowDeactivateEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to doc object
    
            GetDocPointer(0, "WindowDeactivate")
    
            ' make doc object
    
            MakeDocObject("WindowDeactivate")
    
            ' get pointer to window object
    
            GetWinPointer(1, "WindowDeactivate")
    
            ' make window object
    
            MakeWinObject("WindowDeactivate")
    
            IF ISOBJECT(oDoc) AND ISOBJECT(oWin) THEN
                LogWE("WindowDeactivate", VARIANT$(vName) & "  ::  " & VARIANT$(vCaption))
            ELSE
                LogIt("WindowDeactivate")
            END IF
    
        END METHOD
    
        CLASS METHOD WindowSelectionChangeEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to selection object
    
            GetSelPointer(0, "WindowSelectionChange")
    
            ' make selection object
    
            MakeSelObject("WindowSelectionChange")
    
            ' make doc object from selection
    
            MakeDocObjectFromSel("WindowSelectionChange")
    
            ' make window object from selection
    
            MakeWinObjectFromSel("WindowSelectionChange")
    
            IF ISOBJECT(oDoc) AND ISOBJECT(oWin) AND ISOBJECT(oSel) THEN
                LogWE("WindowSelectionChange", VARIANT$(vName) & "  ::  " & VARIANT$(vCaption) & "  ::  " & Lin2(VARIANT#(vStart), VARIANT#(vEnd)))
            ELSE
                LogIt("WindowSelectionChange")
            END IF
    
        END METHOD
    
        CLASS METHOD WindowBeforeRightClickEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' we don't care about parameter 2: Cancel
            ' but you could set it prevent the context menu
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to selection object
    
            GetSelPointer(0, "WindowBeforeRightClick")
    
            ' make selection object
    
            MakeSelObject("WindowBeforeRightClick")
    
            ' make doc object from selection
    
            MakeDocObjectFromSel("WindowBeforeRightClick")
    
            ' make window object from selection
    
            MakeWinObjectFromSel("WindowBeforeRightClick")
    
            IF ISOBJECT(oDoc) AND ISOBJECT(oWin) AND ISOBJECT(oSel) THEN
                LogWE("WindowBeforeRightClick", VARIANT$(vName) & "  ::  " & VARIANT$(vCaption) & "  ::  " & Lin2(VARIANT#(vStart), VARIANT#(vEnd)))
            ELSE
                LogIt("WindowBeforeRightClick")
            END IF
    
        END METHOD
    
        CLASS METHOD WindowBeforeDoubleClickEvent(BYVAL pCookie AS IDispatchVtbl PTR, pDispParams AS DISPPARAMS) AS LONG
    
            ' we don't care about parameter 2: Cancel
            ' but you could set it prevent the selection
    
            ' get parameter pointers, or exit
    
            ParamCheck
    
            ' get pointer to selection object
    
            GetSelPointer(0, "WindowBeforeDoubleClick")
    
            ' make selection object
    
            MakeSelObject("WindowBeforeDoubleClick")
    
            ' make doc object from selection
    
            MakeDocObjectFromSel("WindowBeforeDoubleClick")
    
            ' make window object from selection
    
            MakeWinObjectFromSel("WindowBeforeDoubleClick")
    
            IF ISOBJECT(oDoc) AND ISOBJECT(oWin) AND ISOBJECT(oSel) THEN
                LogWE("WindowBeforeDoubleClick", VARIANT$(vName) & "  ::  " & VARIANT$(vCaption) & "  ::  " & Lin2(VARIANT#(vStart), VARIANT#(vEnd)))
            ELSE
                LogIt("WindowBeforeDoubleClick")
            END IF
    
        END METHOD
    
        INTERFACE WordEventsInterface
            INHERIT CUSTOM
    
            ' depending on whether you use the standard oWord.inc file, or generate your own definitions with the PB COM Browser or Jose's TypeLib Browser,
            '           the Word application events interface ID could be stored in a literal of unknown name
            ' you can set this property after instantiating the object but before calling ConnectWordEvents
    
            PROPERTY GET ApplicationEventsInterfaceID() AS STRING
                PROPERTY = mzApplicationEventsInterfaceID
            END PROPERTY
            PROPERTY SET ApplicationEventsInterfaceID(BYVAL zApplicationEventsInterfaceID AS STRING)
                mzApplicationEventsInterfaceID = zApplicationEventsInterfaceID
            END PROPERTY
    
            METHOD InvokeEvents(BYVAL pCookie AS IDispatchVtbl PTR, BYVAL dispidMember AS LONG, pDispParams AS DISPPARAMS) AS LONG
    
                ' this routine is called by the function (outside the class) actually invoke by Word
                ' that function then calls this routine & passes the parameters I'm interested in
                ' you can, of course, add other parameters
    
                ' call routine to handle invoked event
    
                ' in real app, remove events you don't care about
                '              sequence in likely order of frequency (i.e. WindowSelectionChange happens more often than NewDocument)
    
                ' each event routine returns a code, which this method then returns to the calling function, which the function then returns to Word
    
                SELECT CASE AS LONG dispidMember
                    CASE 1
                        METHOD = me.StartupEvent(pCookie)
                    CASE 2
                        METHOD = me.QuitEvent(pCookie)
                        ' QuitEvent should NOT be deleted, nor should this call be ignored when it is invoked
                        ' QuitEvent assures that should Word quit, the event handler will automatically be disconnected from Word
                    CASE 3
                        METHOD = me.DocumentChangeEvent(pCookie)
                    CASE 4
                        METHOD = me.DocumentOpenEvent(pCookie, pDispParams)
                    CASE 6
                        METHOD = me.DocumentBeforeCloseEvent(pCookie, pDispParams)
                    CASE 7
                        METHOD = me.DocumentBeforePrintEvent(pCookie, pDispParams)
                    CASE 8
                        METHOD = me.DocumentBeforeSaveEvent(pCookie, pDispParams)
                    CASE 9
                        METHOD = me.NewDocumentEvent(pCookie, pDispParams)
                    CASE 10
                        METHOD = me.WindowActivateEvent(pCookie, pDispParams)
                    CASE 11
                        METHOD = me.WindowDeactivateEvent(pCookie, pDispParams)
                    CASE 12
                        METHOD = me.WindowSelectionChangeEvent(pCookie, pDispParams)
                    CASE 13
                        METHOD = me.WindowBeforeRightClickEvent(pCookie, pDispParams)
                    CASE 14
                        METHOD = me.WindowBeforeDoubleClickEvent(pCookie, pDispParams)
                    CASE ELSE
                        METHOD = %DISP_E_MEMBERNOTFOUND
                END SELECT
    
            END METHOD
    
            METHOD ConnectWordEvents(oApp AS Int__Application) AS LONG
    
                ' establishes connection between the connection point object and the client's sink
                ' store a token (mdwCookie) that uniquely identifies this connection so we can later terminate it
    
                REGISTER lReturnCode AS LONG, dwConnectionPoint AS DWORD, pdwClientSink AS DWORD
                LOCAL poApp, pdwConnectionPoint AS DWORD PTR
    
                ' create dispatch object from app, or exit
    
                moAppDispatch = oApp
    
                IF ISNOTHING(moAppDispatch) THEN
                    LogWE("ConnectWordEvents", "FAILED: moAppDispatch is not an object")
                    EXIT METHOD
                END IF
    
                ' get pointer to app object, or exit
    
                poApp = OBJPTR(moAppDispatch)
    
                IF poApp = 0 THEN
                    LogWE("ConnectWordEvents", "FAILED: poApp = 0")
                    EXIT METHOD
                END IF
    
                ' initialize & get connection point, or exit
    
                IF ISFALSE(me.WordEventsInit(poApp, dwConnectionPoint, "Connect")) THEN
                    EXIT METHOD
                END IF
    
                pdwConnectionPoint = dwConnectionPoint
    
                ' build VTable & get pointer to client sink
    
                pdwClientSink = me.BuildVTable(poApp)
    
                ' if no pointer to client sink, exit
    
                IF pdwClientSink = 0 THEN
                    LogWE("ConnectWordEvents", "FAILED: no pointer to client sink")
                    EXIT METHOD
                END IF
    
                ' connect client sink to connection point
    
                CALL DWORD @@poApp[5] USING IConnectionPoint_Advise(pdwConnectionPoint, pdwClientSink, mdwCookie) TO lReturnCode
    
                ' release connection point
    
                CALL DWORD @@pdwConnectionPoint[2] USING IUnknown_Release(pdwConnectionPoint)
    
                ' if unable to connect client sink, exit
    
                IF lReturnCode <> %S_OK THEN
                    LogWE("ConnectWordEvents", "FAILED to connect client sink: " & Lin(lReturnCode))
                    mdwCookie = 0
                    EXIT METHOD
                END IF
    
                ' return success
    
                LogWE("ConnectWordEvents", "OK: cookie = " & Lin(mdwCookie))
    
                METHOD = %True
    
            END METHOD
    
            METHOD DisconnectWordEvents() AS LONG
                ' pass to class method, which might also be called by quit event or Destructor
                METHOD = me.DisconnectWordEvents2
            END METHOD
    
        END INTERFACE
    
    END CLASS
    
    
    FUNCTION PBMAIN
    
        ' this is just a sample app to show how the WordEvents class is used to handle Word events
    
        LOCAL bWeCreated AS LONG
        LOCAL oApp AS Int__Application
        LOCAL oDoc AS Int__Document
    
        ON ERROR RESUME NEXT
    
        ' clear the log
    
        LogClear
    
        ' if Word already open, use it
        ' or create a new instance of Word
    
        ' if you're using the standard oWord.inc file, set %UseWord9 to %False
        ' otherwise, you might want to change the name of the literal holding the program ID, or just use "Word.Application"
    
        #IF %UseWord9
            oApp = GETCOM $PROGID_Word_Application
            IF ISNOTHING(oApp) THEN
                oApp = NEWCOM $PROGID_Word_Application
                bWeCreated = %True
            END IF
    
        #ELSE
            oApp = GETCOM $PROGID_Application
            IF ISNOTHING(oApp) THEN
                oApp = NEWCOM $PROGID_Application
                bWeCreated = %True
            END IF
        #ENDIF
    
        ' if not a valid Word app reference, exit & return failure code
    
        IF ISNOTHING(oApp) THEN
            FUNCTION = %False
            EXIT FUNCTION
        END IF
    
        ' if NEWCOM opened Word (defaulting to not visible), show Word
    
        IF bWeCreated THEN
            oApp.Visible = %True
        END IF
    
        ' create event handler object
        ' if failure to create, you may want to exit app or just not handle events
    
        goWordEvents = CLASS "WordEvents"
    
        IF ISNOTHING(goWordEvents) THEN
            LogWE("PBMAIN", "App could not create goWordEvents")
    
        ELSE
            ' if you use the standard oWord.inc file, set %UseWord9 to %False
    
            ' if you generate your own definitions with the PB COM Browser or Jose's TypeLib Browser,
            '    the Word application events interface ID could be stored in a literal of unknown name
            '    so set the ApplicationEventsInterfaceID property after instantiating the object but before calling ConnectWordEvents
    
            #IF %UseWord9
                goWordEvents.ApplicationEventsInterfaceID = $IID_Word_ApplicationEvents2
            #ELSE
                goWordEvents.ApplicationEventsInterfaceID = $IID_ApplicationEvents2
            #ENDIF
    
            ' connect event handler object to Word
            ' if failure to connect, you may want to exit app or just not handle events
    
            IF ISFALSE(goWordEvents.ConnectWordEvents(oApp)) THEN
                LogWE("PBMAIN", "goWordEvents could not connect with Word")
            END IF
        END IF
    
        ' add a new document
    
        oDoc = oApp.Documents.Add
    
        ' if not a valid document reference, well we're just playing here
    
        IF ISNOTHING(oDoc) THEN
    '        FUNCTION = %False
    '        GOTO CleanUp
        END IF
    
        ' since this app doesn't really do anything, force it to remain open while playing with Word
    
        MSGBOX "Play with Word"
    
    CleanUp:
    
        ' if still connected to event handler object, disconnect
    
        IF ISOBJECT(goWordEvents) THEN
            goWordEvents.DisconnectWordEvents
            goWordEvents = NOTHING
        END IF
    
        ' if NEWCOM opened Word, close Word
    
        IF bWeCreated THEN
            oApp.Quit
        END IF
    
        ' release objects
    
        oDoc = NOTHING
        oApp = NOTHING
    
    END FUNCTION
    Ron

  • #2
    A Simpler Approach

    José Roca demonstrates a better solution in the Word Event Handler & Event Parameters thread at the Programming with Objects forum.

    He maintains the ApplicationEvents class and interface, but modifies it to INHERIT from IUnknown. Then you need only process 4 calls to the IDispatch interface. GetTypeInfoCount, GetTypeInfo and GetIDsOfNames require no code. Invoke does the heavy lifting by receiving all events, with parameters.

    I learned more than I wanted to know about COM event handling writing the source code above. Save time and check out José's work.

    Ron

    Comment

    Working...
    X