Tweet
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.
Ron
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
Comment