#i102261# OLE control event handler support

oovbaapi/ooo/vba/XVBAToOOEventDescGen.idl

@@ -41,8 +41,8 @@
 module ooo {  module vba {
 interface XVBAToOOEventDescGen : com::sun::star::uno::XInterface
 {
-    sequence< com::sun::star::script::ScriptEventDescriptor >  getEventDescriptions( [in] com::sun::star::uno::XInterface xControl, [in] string sLibModName, [in] sequence< string > handlerExts );
-    com::sun::star::script::XScriptEventsSupplier getEventSupplier( [in] com::sun::star::uno::XInterface xControl );
+    sequence< com::sun::star::script::ScriptEventDescriptor >  getEventDescriptions( [in] com::sun::star::uno::XInterface xControl, [in] string sCodeName );
+    com::sun::star::script::XScriptEventsSupplier getEventSupplier( [in] com::sun::star::uno::XInterface xControl, [in] string sCodeName );
 };
 
 }; };

scripting/prj/build.lst

-tc	scripting	:	bridges rdbmaker vcl xmlscript basic sfx2 rhino BSH:beanshell javaunohelper NULL
+tc	scripting	:	oovbaapi bridges rdbmaker vcl xmlscript basic sfx2 rhino BSH:beanshell javaunohelper NULL
 tc	scripting									usr1	-	all	tc1_mkout NULL
 tc	scripting\inc								nmake	-	all	tc1_inc NULL
 tc	scripting\source\provider				nmake	-	all	tc1_scriptingprovider tc1_inc NULL
 tc	scripting\source\basprov				nmake	-	all	tc1_scriptingbasprov tc1_inc NULL
+tc	scripting\source\vbaevents				nmake	-	all	tc1_scriptingvbaevents tc1_inc NULL
 tc	scripting\source\dlgprov				nmake	-	all	tc1_scriptingdlgprov tc1_inc NULL
 tc	scripting\source\stringresource			nmake	-	all	tc1_scriptingstringresource tc1_inc NULL
 tc	scripting\source\pyprov				nmake	-	all	tc1_scriptingpyprov tc1_inc NULL
@@ -10,4 +11,4 @@ tc	scripting\source\protocolhandler			nmake	-	all	tc1_scriptingprotocolhandler t
 tc	scripting\java						nmake	-	all	tc1_scriptingjava tc1_scriptingprovider tc1_scriptingprotocolhandler NULL
 tc	scripting\examples\java				nmake	-	all	tc1_scriptingexamplesjava tc1_scriptingjava  NULL
 tc	scripting\examples				nmake	-	all	tc1_scriptingexamples tc1_scriptingexamplesjava  tc1_inc NULL
-tc	scripting\util						nmake	-	all	tc1_scriptingutil tc1_scriptingprovider tc1_scriptingprotocolhandler tc1_scriptingbasprov tc1_scriptingstringresource tc1_scriptingpyprov tc1_scriptingjava tc1_scriptingexamplesjava tc1_scriptingexamples NULL
+tc	scripting\util						nmake	-	all	tc1_scriptingutil tc1_scriptingprovider tc1_scriptingprotocolhandler tc1_scriptingbasprov tc1_scriptingstringresource tc1_scriptingvbaevents tc1_scriptingpyprov tc1_scriptingjava tc1_scriptingexamplesjava tc1_scriptingexamples NULL

scripting/source/dlgprov/dlgevtatt.cxx

@@ -121,18 +121,20 @@ namespace dlgprov
     DialogVBAScriptListenerImpl::DialogVBAScriptListenerImpl( const Reference< XComponentContext >& rxContext, const Reference< awt::XControl >& rxControl, const Reference< frame::XModel >& xModel ) : DialogScriptListenerImpl( rxContext )
     {
         Reference< XMultiComponentFactory > xSMgr( m_xContext->getServiceManager() );
+        Sequence< Any > args(1);
         if ( xSMgr.is() )
         {
-            Sequence< Any > args(1);
             args[0] <<= xModel;
             mxListener = Reference< XScriptListener >( xSMgr->createInstanceWithArgumentsAndContext( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.EventListener" ) ), args, m_xContext ), UNO_QUERY );
         }
         if ( rxControl.is() )
         {
-            Reference< XPropertySet > xProps( rxControl->getModel(), UNO_QUERY );
             try
             {
+                Reference< XPropertySet > xProps( rxControl->getModel(), UNO_QUERY_THROW );
                 xProps->getPropertyValue( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Name") ) ) >>= msDialogCodeName;
+                xProps.set( mxListener, UNO_QUERY_THROW );
+                xProps->setPropertyValue( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Model") ), args[ 0 ] );
             }
             catch ( Exception&  ) {}
         }
@@ -193,7 +195,7 @@ namespace dlgprov
         return it->second;
     }
 #ifdef FAKE_VBA_EVENT_SUPPORT
-    Reference< XScriptEventsSupplier > DialogEventsAttacherImpl::getFakeVbaEventsSupplier( const Reference< XControl >& xControl )
+    Reference< XScriptEventsSupplier > DialogEventsAttacherImpl::getFakeVbaEventsSupplier( const Reference< XControl >& xControl, rtl::OUString& sControlName )
     {
         Reference< XScriptEventsSupplier > xEventsSupplier;
         Reference< XMultiComponentFactory > xSMgr( m_xContext->getServiceManager() );
@@ -201,7 +203,7 @@ namespace dlgprov
         {
             Reference< ooo::vba::XVBAToOOEventDescGen > xVBAToOOEvtDesc( xSMgr->createInstanceWithContext( ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.VBAToOOEventDesc" ) ), m_xContext ), UNO_QUERY );
             if ( xVBAToOOEvtDesc.is() )
-                xEventsSupplier.set( xVBAToOOEvtDesc->getEventSupplier( xControl ), UNO_QUERY );
+                xEventsSupplier.set( xVBAToOOEvtDesc->getEventSupplier( xControl, sControlName ), UNO_QUERY );
 
         }
         return xEventsSupplier;
@@ -324,6 +326,20 @@ namespace dlgprov
         // go over all objects
         const Reference< XInterface >* pObjects = Objects.getConstArray();
         sal_Int32 nObjCount = Objects.getLength();
+#ifdef FAKE_VBA_EVENT_SUPPORT
+        Reference< awt::XControl > xDlgControl( Objects[ nObjCount - 1 ], uno::UNO_QUERY ); // last object is the dialog
+        rtl::OUString sDialogCodeName;
+        if ( xDlgControl.is() )
+        {
+            Reference< XPropertySet > xProps( xDlgControl->getModel(), UNO_QUERY );
+            try
+            {
+                xProps->getPropertyValue( rtl::OUString(RTL_CONSTASCII_USTRINGPARAM("Name") ) ) >>= sDialogCodeName;
+            }
+            catch( Exception& ){}
+        }
+#endif
+
         for ( sal_Int32 i = 0; i < nObjCount; ++i )
         {
             // We know that we have to do with instances of XControl.
@@ -338,7 +354,7 @@ namespace dlgprov
             Reference< XScriptEventsSupplier > xEventsSupplier( xControlModel, UNO_QUERY );
             attachEventsToControl( xControl, xEventsSupplier, Helper );
 #ifdef FAKE_VBA_EVENT_SUPPORT
-            xEventsSupplier.set( getFakeVbaEventsSupplier( xControl ) );
+            xEventsSupplier.set( getFakeVbaEventsSupplier( xControl, sDialogCodeName ) );
             attachEventsToControl( xControl, xEventsSupplier, Helper );
 #endif
         }

scripting/source/dlgprov/dlgevtatt.hxx

@@ -46,6 +46,9 @@
 #include <com/sun/star/script/XScriptEventsSupplier.hpp>
 
 #include <hash_map>
+
+#define FAKE_VBA_EVENT_SUPPORT 1
+
 //.........................................................................
 namespace dlgprov
 {
@@ -71,7 +74,7 @@ namespace dlgprov
         ::com::sun::star::uno::Reference< ::com::sun::star::script::XEventAttacher > m_xEventAttacher;
         ::com::sun::star::uno::Reference< ::com::sun::star::script::XScriptListener > getScriptListenerForKey( const rtl::OUString& sScriptName ) throw ( ::com::sun::star::uno::RuntimeException );
 #ifdef FAKE_VBA_EVENT_SUPPORT
-        ::com::sun::star::uno::Reference< ::com::sun::star::script::XScriptEventsSupplier > getFakeVbaEventsSupplier( const ::com::sun::star::uno::Reference< ::com::sun::star::awt::XControl>& xControl );
+        ::com::sun::star::uno::Reference< ::com::sun::star::script::XScriptEventsSupplier > getFakeVbaEventsSupplier( const ::com::sun::star::uno::Reference< ::com::sun::star::awt::XControl>& xControl, rtl::OUString& sCodeName );
 #endif
         void  SAL_CALL attachEventsToControl( const ::com::sun::star::uno::Reference< ::com::sun::star::awt::XControl>& xControl, const ::com::sun::star::uno::Reference< ::com::sun::star::script::XScriptEventsSupplier >& events, const ::com::sun::star::uno::Any& Helper  );
     public:

scripting/source/vbaevents/eventhelper.cxx

+// MARKER(update_precomp.py): autogen include statement, do not remove
+#include "precompiled_scripting.hxx"
+#include <comphelper/processfactory.hxx>
+#include <comphelper/uno3.hxx>
+#include <comphelper/proparrhlp.hxx>
+#include <comphelper/propertycontainer.hxx>
+
+#include <ooo/vba/XVBAToOOEventDescGen.hpp>
+
+#include <com/sun/star/beans/XPropertySet.hpp>
+#include <com/sun/star/beans/XIntrospection.hpp>
+#include <com/sun/star/beans/PropertyAttribute.hpp>
+
+#include <com/sun/star/lang/XMultiComponentFactory.hpp>
+#include <com/sun/star/lang/XServiceName.hpp>
+#include <com/sun/star/lang/XServiceInfo.hpp>
+#include <com/sun/star/lang/XInitialization.hpp>
+
+#include <com/sun/star/frame/XModel.hpp>
+
+#include <com/sun/star/script/XLibraryContainer.hpp>
+#include <com/sun/star/script/ScriptEventDescriptor.hpp>
+#include <com/sun/star/script/provider/XScriptProviderSupplier.hpp>
+
+#include <com/sun/star/drawing/XControlShape.hpp>
+
+#include <com/sun/star/awt/XControl.hpp>
+#include <com/sun/star/awt/XDialog.hpp>
+#include <com/sun/star/awt/KeyEvent.hpp>
+#include <com/sun/star/awt/MouseEvent.hpp>
+
+#include <msforms/ReturnInteger.hpp>
+
+#include <sfx2/objsh.hxx>
+#include <basic/sbstar.hxx>
+#include <basic/basmgr.hxx>
+#include <basic/sbmeth.hxx>
+#include <basic/sbmod.hxx>
+#include <basic/sbx.hxx>
+
+
+
+
+// for debug
+#include <comphelper/anytostring.hxx>
+
+
+#include <com/sun/star/lang/XMultiComponentFactory.hpp>
+#include <com/sun/star/script/XScriptListener.hpp>
+#include <cppuhelper/implbase1.hxx>
+#include <cppuhelper/implbase2.hxx>
+#include <comphelper/evtmethodhelper.hxx>
+
+#include <set>
+#include <list>
+#include <hash_map>
+
+using namespace ::com::sun::star;
+using namespace ::com::sun::star::script;
+using namespace ::com::sun::star::uno;
+using namespace ::ooo::vba;
+
+
+// Some constants
+const static rtl::OUString DELIM = rtl::OUString::createFromAscii( "::" );
+const static sal_Int32 DELIMLEN = DELIM.getLength();
+
+#if 0
+void dumpListeners( const Reference< beans::XIntrospection >& xIntrospection, const Reference<XInterface>& xIfc)
+{
+    Reference< beans::XIntrospectionAccess > xIntrospectionAccess;
+    if ( xIntrospection.is() )
+    {
+        xIntrospectionAccess = xIntrospection->inspect(
+            makeAny( xIfc ) );
+        Sequence< Type > aControlListeners =
+            xIntrospectionAccess->getSupportedListeners();
+        sal_Int32 nLength = aControlListeners.getLength();
+
+        for ( sal_Int32 i = 0; i< nLength; ++i )
+        {
+            Type& listType = aControlListeners[ i ];
+            rtl::OUString sFullTypeName = listType.getTypeName();
+            rtl::OUString sTypeName = listType.getTypeName();
+            sal_Int32 lastDotIndex = -1;
+            if ( ( lastDotIndex = sFullTypeName.lastIndexOf( '.' ) ) > -1 )
+            {
+                sTypeName = sFullTypeName.copy( lastDotIndex + 1 );
+            }
+            Sequence< ::rtl::OUString > sMeths = comphelper::getEventMethodsForType( listType );
+            sal_Int32 sMethLen = sMeths.getLength();
+            for ( sal_Int32 j=0 ; j < sMethLen; ++j )
+            {
+                OSL_TRACE("**Listener [%d] Type[%s] Method[%s]",j,
+                    rtl::OUStringToOString( sTypeName,
+                        RTL_TEXTENCODING_UTF8 ).getStr(),
+                    rtl::OUStringToOString( sMeths[ j ],
+                        RTL_TEXTENCODING_UTF8 ).getStr() );
+            }
+        }
+
+    }
+}
+
+void dumpEvent( const ScriptEvent& evt )
+{
+    OSL_TRACE("dumpEvent: Source %s",
+        rtl::OUStringToOString( comphelper::anyToString( makeAny(evt.Source)),
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    OSL_TRACE("dumpEvent: ScriptType %s",
+        rtl::OUStringToOString( evt.ScriptType,
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    OSL_TRACE("dumpEvent: ScriptCode %s",
+        rtl::OUStringToOString( evt.ScriptCode,
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    OSL_TRACE("dumpEvent: ListenerType %s",
+        rtl::OUStringToOString( evt.ListenerType.getTypeName(),
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    OSL_TRACE("dumpEvent: Listener methodname %s",
+        rtl::OUStringToOString( evt.MethodName,
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    OSL_TRACE("dumpEvent: arguments;");
+    sal_Int32 nLen = evt.Arguments.getLength();
+    for ( sal_Int32 index=0; index < nLen; ++index )
+    {
+        OSL_TRACE("\t [%d] %s", index,
+        rtl::OUStringToOString( comphelper::anyToString( evt.Arguments[ index ] ),
+            RTL_TEXTENCODING_UTF8 ).getStr() );
+
+    }
+}
+
+#endif
+
+bool isKeyEventOk( awt::KeyEvent& evt, const Sequence< Any >& params )
+{
+    if ( !( params.getLength() > 0 ) ||
+        !( params[ 0 ] >>= evt ) )
+        return false;
+    return true;
+}
+
+bool isMouseEventOk( awt::MouseEvent& evt, const Sequence< Any >& params )
+{
+    if ( !( params.getLength() > 0 ) ||
+        !( params[ 0 ] >>= evt ) )
+        return false;
+    return true;
+}
+
+Sequence< Any > ooMouseEvtToVBADblClick( const Sequence< Any >& params )
+{
+    Sequence< Any > translatedParams;
+    awt::MouseEvent evt;
+
+    if ( !( isMouseEventOk(evt, params)) ||
+        (evt.ClickCount != 2) )
+        return Sequence< Any >();
+    // give back orig params, this will signal that the event is good
+    return params;
+}
+
+Sequence< Any > ooMouseEvtToVBAMouseEvt( const Sequence< Any >& params )
+{
+    Sequence< Any > translatedParams;
+    awt::MouseEvent evt;
+
+    if ( !isMouseEventOk(evt, params) )
+        return Sequence< Any >();
+
+    translatedParams.realloc(4);
+
+    // Buttons
+    translatedParams[ 0 ] <<= evt.Buttons;
+    // Shift
+    translatedParams[ 1 ] <<= evt.Modifiers;
+    // X
+    translatedParams[ 2 ] <<= evt.X;
+    // Y
+    translatedParams[ 3 ] <<= evt.Y;
+    return translatedParams;
+}
+
+Sequence< Any > ooKeyPressedToVBAKeyPressed( const Sequence< Any >& params )
+{
+    Sequence< Any > translatedParams;
+    awt::KeyEvent evt;
+
+    if ( !isKeyEventOk( evt, params ) )
+        return Sequence< Any >();
+
+    translatedParams.realloc(1);
+
+    msforms::ReturnInteger keyCode;
+    keyCode.Value = evt.KeyCode;
+    translatedParams[0] <<= keyCode;
+    return  translatedParams;
+}
+
+Sequence< Any > ooKeyPressedToVBAKeyUpDown( const Sequence< Any >& params )
+{
+    Sequence< Any > translatedParams;
+    awt::KeyEvent evt;
+
+    if ( !isKeyEventOk( evt, params ) )
+        return Sequence< Any >();
+
+    translatedParams.realloc(2);
+
+    msforms::ReturnInteger keyCode;
+    sal_Int8 shift = sal::static_int_cast<sal_Int8>( evt.Modifiers );
+
+    // #TODO check whether values from OOO conform to values generated from vba
+    keyCode.Value = evt.KeyCode;
+    translatedParams[0] <<= keyCode;
+    translatedParams[1] <<= shift;
+    return  translatedParams;
+}
+
+typedef Sequence< Any > (*Translator)(const Sequence< Any >&);
+
+struct TranslateInfo
+{
+    rtl::OUString sVBAName;
+    Translator toVBA;
+};
+
+
+typedef std::hash_map< rtl::OUString,
+std::list< TranslateInfo >,
+::rtl::OUStringHash,
+::std::equal_to< ::rtl::OUString > > EventInfoHash;
+
+
+EventInfoHash& getEventTransInfo()
+{
+    static bool initialised = false;
+    static EventInfoHash eventTransInfo;
+    if ( !initialised )
+    {
+        TranslateInfo  info;
+        // actionPerformed ooo event
+        std::list< TranslateInfo > actionInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_Click");
+        info.toVBA = NULL;
+        actionInfos.push_back( info );
+        info.sVBAName = rtl::OUString::createFromAscii("_Change");
+        info.toVBA = NULL;
+        actionInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("actionPerformed") ] = actionInfos;
+        // changed ooo event
+        std::list< TranslateInfo > changeInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_Change");
+        info.toVBA = NULL;
+        changeInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("changed") ] = changeInfos;
+        // focusGained ooo event
+        std::list< TranslateInfo > focusGainedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_GotFocus");
+        info.toVBA = NULL;
+        focusGainedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("focusGained") ] = focusGainedInfos;
+        // focusLost ooo event
+        std::list< TranslateInfo > focusLostInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_LostFocus");
+        info.toVBA = NULL;
+        focusLostInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("focusGained") ] = focusLostInfos;
+        // adjustmentValueChanged ooo event
+        std::list< TranslateInfo > adjustInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_Scroll");
+        info.toVBA = NULL;
+        adjustInfos.push_back( info );
+        info.sVBAName = rtl::OUString::createFromAscii("_Change");
+        info.toVBA = NULL;
+        adjustInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("adjustmentValueChanged") ] = adjustInfos;
+        // textChanged ooo event
+        std::list< TranslateInfo > txtChangedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_Change");
+        info.toVBA = NULL;
+        txtChangedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("textChanged") ] = txtChangedInfos;
+
+        // keyReleased ooo event
+        std::list< TranslateInfo > keyReleasedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_KeyUp");
+        info.toVBA = ooKeyPressedToVBAKeyUpDown;
+        keyReleasedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("keyReleased") ] = keyReleasedInfos;
+        // mouseReleased ooo event
+        std::list< TranslateInfo > mouseReleasedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_MouseUp");
+        info.toVBA = ooMouseEvtToVBAMouseEvt;
+        mouseReleasedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("mouseReleased") ] = mouseReleasedInfos;
+        // mousePressed ooo event
+        std::list< TranslateInfo > mousePressedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_MouseDown");
+        info.toVBA = ooMouseEvtToVBAMouseEvt;
+        mousePressedInfos.push_back( info );
+        info.sVBAName = rtl::OUString::createFromAscii("_DblClick");
+        // emulate double click event
+        info.toVBA = ooMouseEvtToVBADblClick;
+        mousePressedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("mousePressed") ] = mousePressedInfos;
+        // mouseMoved ooo event
+        std::list< TranslateInfo > mouseMovedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_MouseMove");
+        info.toVBA = ooMouseEvtToVBAMouseEvt;
+        mouseMovedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("mouseMoved") ] = mouseMovedInfos;
+        // keyPressed ooo event
+        std::list< TranslateInfo > keyPressedInfos;
+        info.sVBAName = rtl::OUString::createFromAscii("_KeyDown");
+        info.toVBA = ooKeyPressedToVBAKeyUpDown;
+        keyPressedInfos.push_back( info );
+        info.sVBAName = rtl::OUString::createFromAscii("_KeyPress");
+        info.toVBA = ooKeyPressedToVBAKeyPressed;
+        keyPressedInfos.push_back( info );
+        eventTransInfo[ rtl::OUString::createFromAscii("keyPressed") ] = keyPressedInfos;
+        initialised = true;
+    }
+    return eventTransInfo;
+}
+
+// Helper class
+
+class ScriptEventHelper
+{
+public:
+    ScriptEventHelper( const Reference< XInterface >& xControl );
+    Sequence< ScriptEventDescriptor > createEvents( const rtl::OUString& sCodeName );
+    Sequence< rtl::OUString > getEventListeners();
+private:
+    Reference< XComponentContext > m_xCtx;
+    Reference< XInterface > m_xControl;
+};
+
+bool
+eventMethodToDescriptor( const ::rtl::OUString& rEventMethod, ScriptEventDescriptor& evtDesc, const ::rtl::OUString& sCodeName )
+{
+    // format of ControlListener is TypeName::methodname e.g.
+    // "com.sun.star.awt.XActionListener::actionPerformed" or
+    // "XActionListener::actionPerformed
+
+    ::rtl::OUString sMethodName;
+    ::rtl::OUString sTypeName;
+    sal_Int32 nDelimPos = rEventMethod.indexOf( DELIM );
+    if ( nDelimPos == -1 )
+    {
+        return false;
+    }
+    sMethodName = rEventMethod.copy( nDelimPos + DELIMLEN );
+    sTypeName = rEventMethod.copy( 0, nDelimPos );
+
+    EventInfoHash& infos = getEventTransInfo();
+
+    // Only create an ScriptEventDescriptor for an event we can translate
+    // or emulate
+    if ( sMethodName.getLength()
+         && sTypeName.getLength()
+         && ( infos.find( sMethodName ) != infos.end() ) )
+    {
+        // just fill in CodeName, when the event fires the other
+    // info is gathered from the event source to determine what
+    // event handler we try to call
+        evtDesc.ScriptCode = sCodeName;
+        evtDesc.ListenerType = sTypeName;
+        evtDesc.EventMethod = sMethodName;
+
+        // set this it VBAInterop, ensures that it doesn't
+        // get persisted or shown in property editors
+        evtDesc.ScriptType = rtl::OUString::createFromAscii(
+            "VBAInterop" );
+        return true;
+    }
+    return false;
+
+}
+
+ScriptEventHelper::ScriptEventHelper( const Reference< XInterface >& xControl ) : m_xControl( xControl )
+{
+    Reference < beans::XPropertySet > xProps(
+        ::comphelper::getProcessServiceFactory(), UNO_QUERY_THROW );
+    m_xCtx.set( xProps->getPropertyValue( rtl::OUString(
+        RTL_CONSTASCII_USTRINGPARAM( "DefaultContext" ))),
+        uno::UNO_QUERY_THROW );
+}
+
+Sequence< rtl::OUString >
+ScriptEventHelper::getEventListeners()
+{
+    Reference< lang::XMultiComponentFactory > xMFac(
+        m_xCtx->getServiceManager(), UNO_QUERY );
+    std::list< rtl::OUString > eventMethods;
+
+    if ( xMFac.is() )
+    {
+        Reference< beans::XIntrospection > xIntrospection(
+            xMFac->createInstanceWithContext( rtl::OUString(
+                RTL_CONSTASCII_USTRINGPARAM( "com.sun.star.beans.Introspection"  ) ), m_xCtx ), UNO_QUERY );
+#if 0
+        dumpListeners( xIntrospection, m_xControl );
+        dumpListeners( xIntrospection, m_xControl->getModel() );
+#endif
+        Reference< beans::XIntrospectionAccess > xIntrospectionAccess;
+    if  ( xIntrospection.is() )
+    {
+            xIntrospectionAccess = xIntrospection->inspect(
+                makeAny( m_xControl ) );
+            Sequence< Type > aControlListeners =
+                xIntrospectionAccess->getSupportedListeners();
+            sal_Int32 nLength = aControlListeners.getLength();
+            for ( sal_Int32 i = 0; i< nLength; ++i )
+            {
+                Type& listType = aControlListeners[ i ];
+                rtl::OUString sFullTypeName = listType.getTypeName();
+                Sequence< ::rtl::OUString > sMeths =
+                    comphelper::getEventMethodsForType( listType );
+                sal_Int32 sMethLen = sMeths.getLength();
+                for ( sal_Int32 j=0 ; j < sMethLen; ++j )
+                {
+                    rtl::OUString sEventMethod = sFullTypeName;
+                    sEventMethod += DELIM;
+                    sEventMethod += sMeths[ j ];
+                    eventMethods.push_back( sEventMethod );
+                }
+            }
+
+        }
+    }
+
+    Sequence< rtl::OUString > sEventMethodNames( eventMethods.size() );
+    std::list< rtl::OUString >::const_iterator it = eventMethods.begin();
+    rtl::OUString* pDest = sEventMethodNames.getArray();
+
+    for ( ; it != eventMethods.end(); ++it, ++pDest )
+        *pDest = *it;
+
+    return sEventMethodNames;
+}
+
+Sequence< ScriptEventDescriptor >
+ScriptEventHelper::createEvents( const rtl::OUString& sCodeName )
+{
+    Sequence< rtl::OUString > aControlListeners = getEventListeners();
+    rtl::OUString* pSrc = aControlListeners.getArray();
+    sal_Int32 nLength = aControlListeners.getLength();
+
+    Sequence< ScriptEventDescriptor > aDest( nLength );
+    sal_Int32 nEvts = 0;
+    for ( sal_Int32 i = 0; i< nLength; ++i, ++pSrc )
+    {
+        // from getListeners eventName is of form
+        // "com.sun.star.awt.XActionListener::actionPerformed"
+        // we need to strip "com.sun.star.awt." from that for form
+        // controls
+        ScriptEventDescriptor evtDesc;
+        if ( eventMethodToDescriptor( *pSrc, evtDesc, sCodeName ) )
+        {
+            sal_Int32 dIndex = nEvts;
+            ++nEvts;
+            if ( nEvts > aDest.getLength() )
+                aDest.realloc( nEvts );// should never happen
+            aDest[ dIndex ] = evtDesc;
+        }
+    }
+    aDest.realloc( nEvts );
+
+    return aDest;
+}
+
+
+typedef ::cppu::WeakImplHelper1< container::XNameContainer > NameContainer_BASE;
+
+class ReadOnlyEventsNameContainer : public NameContainer_BASE
+{
+public:
+    ReadOnlyEventsNameContainer( const Sequence< rtl::OUString >& eventMethods, const rtl::OUString& sCodeName );
+    // XNameContainer
+
+    virtual void SAL_CALL insertByName( const ::rtl::OUString&, const Any& ) throw (lang::IllegalArgumentException, container::ElementExistException, lang::WrappedTargetException, RuntimeException)
+    {
+        throw RuntimeException( rtl::OUString::createFromAscii( "ReadOnly container" ), Reference< XInterface >() );
+
+    }
+    virtual void SAL_CALL removeByName( const ::rtl::OUString& ) throw (::com::sun::star::container::NoSuchElementException, lang::WrappedTargetException, RuntimeException)
+    {
+        throw RuntimeException( rtl::OUString::createFromAscii( "ReadOnly container" ), Reference< XInterface >() );
+    }
+
+    // XNameReplace
+    virtual void SAL_CALL replaceByName( const ::rtl::OUString&, const Any& ) throw (lang::IllegalArgumentException, container::NoSuchElementException, lang::WrappedTargetException, RuntimeException)
+    {
+        throw RuntimeException( rtl::OUString::createFromAscii( "ReadOnly container" ), Reference< XInterface >() );
+
+    }
+
+    // XNameAccess
+    virtual Any SAL_CALL getByName( const ::rtl::OUString& aName ) throw (container::NoSuchElementException, lang::WrappedTargetException, RuntimeException);
+    virtual Sequence< ::rtl::OUString > SAL_CALL getElementNames(  ) throw (RuntimeException);
+    virtual ::sal_Bool SAL_CALL hasByName( const ::rtl::OUString& aName ) throw (RuntimeException);
+
+    // XElementAccess
+    virtual Type SAL_CALL getElementType(  ) throw (RuntimeException)
+    { return getCppuType(static_cast< const rtl::OUString * >(0) ); }
+    virtual ::sal_Bool SAL_CALL hasElements(  ) throw (RuntimeException)
+    { return ( ( m_hEvents.size() > 0 ? sal_True : sal_False ) ); }
+private:
+
+typedef std::hash_map< rtl::OUString, Any, ::rtl::OUStringHash,
+::std::equal_to< ::rtl::OUString > > EventSupplierHash;
+
+    EventSupplierHash m_hEvents;
+};
+
+ReadOnlyEventsNameContainer::ReadOnlyEventsNameContainer( const Sequence< rtl::OUString >& eventMethods, const rtl::OUString& sCodeName )
+{
+    const rtl::OUString* pSrc = eventMethods.getConstArray();
+    sal_Int32 nLen = eventMethods.getLength();
+    for ( sal_Int32 index = 0; index < nLen; ++index, ++pSrc )
+    {
+        Any aDesc;
+        ScriptEventDescriptor evtDesc;
+        if (  eventMethodToDescriptor( *pSrc, evtDesc, sCodeName ) )
+        {
+            aDesc <<= evtDesc;
+            m_hEvents[ *pSrc ] = aDesc;
+        }
+    }
+}
+
+Any SAL_CALL
+ReadOnlyEventsNameContainer::getByName( const ::rtl::OUString& aName ) throw (container::NoSuchElementException, lang::WrappedTargetException, RuntimeException){
+    EventSupplierHash::const_iterator it = m_hEvents.find( aName );
+    if ( it == m_hEvents.end() )
+        throw container::NoSuchElementException();
+    return it->second;
+}
+
+Sequence< ::rtl::OUString > SAL_CALL
+ReadOnlyEventsNameContainer::getElementNames(  ) throw (RuntimeException)
+{
+    Sequence< ::rtl::OUString > names(m_hEvents.size());
+    rtl::OUString* pDest = names.getArray();
+    EventSupplierHash::const_iterator it = m_hEvents.begin();
+    EventSupplierHash::const_iterator it_end = m_hEvents.end();
+    for ( sal_Int32 index = 0; it != it_end; ++index, ++pDest, ++it )
+        *pDest = it->first;
+    return names;
+}
+
+sal_Bool SAL_CALL
+ReadOnlyEventsNameContainer::hasByName( const ::rtl::OUString& aName ) throw (RuntimeException)
+{
+    EventSupplierHash::const_iterator it = m_hEvents.find( aName );
+    if ( it == m_hEvents.end() )
+        return sal_False;
+    return sal_True;
+}
+
+typedef ::cppu::WeakImplHelper1< XScriptEventsSupplier > EventsSupplier_BASE;
+
+class ReadOnlyEventsSupplier : public EventsSupplier_BASE
+{
+public:
+    ReadOnlyEventsSupplier( const Sequence< ::rtl::OUString >& eventMethods, const rtl::OUString& sCodeName )
+    { m_xNameContainer = new ReadOnlyEventsNameContainer( eventMethods, sCodeName ); }
+
+    // XScriptEventSupplier
+    virtual Reference< container::XNameContainer > SAL_CALL getEvents(  ) throw (RuntimeException){ return m_xNameContainer; }
+private:
+    Reference< container::XNameContainer > m_xNameContainer;
+};
+
+typedef ::cppu::WeakImplHelper2< XScriptListener, lang::XInitialization > EventListener_BASE;
+
+#define EVENTLSTNR_PROPERTY_ID_MODEL         1
+#define EVENTLSTNR_PROPERTY_MODEL            ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Model" ) )
+
+class EventListener : public EventListener_BASE
+    ,public ::comphelper::OMutexAndBroadcastHelper
+    ,public ::comphelper::OPropertyContainer
+    ,public ::comphelper::OPropertyArrayUsageHelper< EventListener >
+
+{
+
+public:
+    EventListener( const Reference< XComponentContext >& rxContext );
+    // XEventListener
+    virtual void SAL_CALL disposing(const lang::EventObject& Source) throw( RuntimeException );
+
+    // XScriptListener
+    virtual void SAL_CALL firing(const ScriptEvent& evt) throw(RuntimeException);
+    virtual Any SAL_CALL approveFiring(const ScriptEvent& evt) throw(reflection::InvocationTargetException, RuntimeException);
+    // XPropertySet
+    virtual ::com::sun::star::uno::Reference< ::com::sun::star::beans::XPropertySetInfo > SAL_CALL getPropertySetInfo(  ) throw (::com::sun::star::uno::RuntimeException);
+    // XInitialization
+    virtual void SAL_CALL initialize( const Sequence< Any >& aArguments ) throw (Exception, RuntimeException);
+    // XInterface
+    DECLARE_XINTERFACE()
+
+    // XTypeProvider
+    DECLARE_XTYPEPROVIDER()
+    virtual void SAL_CALL setFastPropertyValue( sal_Int32 nHandle, const ::com::sun::star::uno::Any& rValue ) throw(::com::sun::star::beans::UnknownPropertyException, ::com::sun::star::beans::PropertyVetoException, ::com::sun::star::lang::IllegalArgumentException, ::com::sun::star::lang::WrappedTargetException, ::com::sun::star::uno::RuntimeException)
+    {
+        OPropertyContainer::setFastPropertyValue( nHandle, rValue );
+    if ( nHandle == EVENTLSTNR_PROPERTY_ID_MODEL )
+            setShellFromModel();
+    }
+
+protected:
+    // OPropertySetHelper
+    virtual ::cppu::IPropertyArrayHelper& SAL_CALL getInfoHelper(  );
+
+    // OPropertyArrayUsageHelper
+    virtual ::cppu::IPropertyArrayHelper* createArrayHelper(  ) const;
+
+private:
+    void setShellFromModel();
+    void firing_Impl( const  ScriptEvent& evt, Any *pSyncRet=NULL ) throw( RuntimeException );
+
+    Reference< XComponentContext > m_xContext;
+    Reference< frame::XModel > m_xModel;
+    SfxObjectShell* mpShell;
+
+};
+
+EventListener::EventListener( const Reference< XComponentContext >& rxContext ) :
+OPropertyContainer(GetBroadcastHelper()), m_xContext( rxContext ), mpShell( 0 )
+{
+    registerProperty( EVENTLSTNR_PROPERTY_MODEL, EVENTLSTNR_PROPERTY_ID_MODEL,
+        beans::PropertyAttribute::TRANSIENT, &m_xModel, ::getCppuType( &m_xModel ) );
+
+}
+
+void
+EventListener::setShellFromModel()
+{
+    // reset mpShell
+    mpShell = 0;
+    SfxObjectShell* pShell = SfxObjectShell::GetFirst();
+    while ( m_xModel.is() && pShell )
+    {
+        if ( pShell->GetModel() == m_xModel )
+        {
+            mpShell = pShell;
+            break;
+        }
+        pShell = SfxObjectShell::GetNext( *pShell );
+    }
+}
+
+//XEventListener
+void
+EventListener::disposing(const lang::EventObject&)  throw( RuntimeException )
+{
+}
+
+//XScriptListener
+
+void SAL_CALL
+EventListener::firing(const ScriptEvent& evt) throw(RuntimeException)
+{
+    firing_Impl( evt );
+}
+
+Any SAL_CALL
+EventListener::approveFiring(const ScriptEvent& evt) throw(reflection::InvocationTargetException, RuntimeException)
+{
+    Any ret;
+    firing_Impl( evt, &ret );
+    return ret;
+}
+
+// XInitialization
+void SAL_CALL
+EventListener::initialize( const Sequence< Any >& aArguments ) throw (Exception, RuntimeException)
+{
+    if ( aArguments.getLength() == 1 )
+        aArguments[0] >>= m_xModel;
+    OSL_TRACE("EventListener::initialize() args %d m_xModel %d", aArguments.getLength(), m_xModel.is() );
+}
+
+// XInterface
+
+IMPLEMENT_FORWARD_XINTERFACE2( EventListener, EventListener_BASE, OPropertyContainer )
+
+// XTypeProvider
+
+IMPLEMENT_FORWARD_XTYPEPROVIDER2( EventListener, EventListener_BASE, OPropertyContainer )
+
+// OPropertySetHelper
+
+::cppu::IPropertyArrayHelper&
+EventListener::getInfoHelper(  )
+{
+    return *getArrayHelper();
+}
+
+// OPropertyArrayUsageHelper
+
+::cppu::IPropertyArrayHelper*
+EventListener::createArrayHelper(  ) const
+{
+    Sequence< beans::Property > aProps;
+    describeProperties( aProps );
+    return new ::cppu::OPropertyArrayHelper( aProps );
+}
+
+// XPropertySet
+Reference< beans::XPropertySetInfo >
+EventListener::getPropertySetInfo(  ) throw (RuntimeException)
+{
+    Reference< beans::XPropertySetInfo > xInfo( createPropertySetInfo( getInfoHelper() ) );
+    return xInfo;
+}
+
+
+// EventListener
+
+void
+EventListener::firing_Impl(const ScriptEvent& evt, Any* /*pRet*/ ) throw(RuntimeException)
+{
+    OSL_TRACE("EventListener::firing_Impl( FAKE VBA_EVENTS )");
+    static const ::rtl::OUString vbaInterOp =
+        ::rtl::OUString::createFromAscii("VBAInterop");
+
+    // let default handlers deal with non vba stuff
+    if ( !evt.ScriptType.equals( vbaInterOp ) )
+        return;
+    lang::EventObject aEvent;
+    evt.Arguments[ 0 ] >>= aEvent;
+    OSL_TRACE("Argument[0] is  %s", rtl::OUStringToOString( comphelper::anyToString( evt.Arguments[0] ), RTL_TEXTENCODING_UTF8 ).getStr() );
+    OSL_TRACE("Getting Control");
+    uno::Reference< awt::XControl > xControl( aEvent.Source, uno::UNO_QUERY_THROW );
+    OSL_TRACE("Getting properties");
+    uno::Reference< beans::XPropertySet > xProps( xControl->getModel(), uno::UNO_QUERY_THROW );
+
+    rtl::OUString sName = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("UserForm") );
+    OSL_TRACE("Getting Name");
+
+    uno::Reference< awt::XDialog > xDlg( aEvent.Source, uno::UNO_QUERY );
+    if ( !xDlg.is() )
+        xProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Name") ) ) >>= sName;
+    //dumpEvent( evt );
+    EventInfoHash& infos = getEventTransInfo();
+    EventInfoHash::const_iterator eventInfo_it = infos.find( evt.MethodName );
+    EventInfoHash::const_iterator it_end = infos.end();
+    if ( eventInfo_it == it_end )
+    {
+        OSL_TRACE("Bogus event for %s",
+            rtl::OUStringToOString( evt.ScriptType, RTL_TEXTENCODING_UTF8 ).getStr() );
+        return;
+    }
+
+    uno::Reference< script::provider::XScriptProviderSupplier > xSPS( m_xModel, uno::UNO_QUERY );
+    uno::Reference< script::provider::XScriptProvider > xScriptProvider;
+    if ( xSPS.is() )
+        xScriptProvider =  xSPS->getScriptProvider();
+    if ( xScriptProvider.is() && mpShell )
+    {
+        std::list< TranslateInfo > matchingMethods;
+        std::list< TranslateInfo >::const_iterator txInfo =
+            eventInfo_it->second.begin();
+        std::list< TranslateInfo >::const_iterator txInfo_end = eventInfo_it->second.end();
+        rtl::OUString sMacroLoc = rtl::OUString::createFromAscii("Standard.").concat( evt.ScriptCode ).concat( rtl::OUString::createFromAscii(".") );
+
+        StarBASIC* pBasic = mpShell->GetBasic();
+        SbModule* pModule = pBasic->FindModule( evt.ScriptCode );
+        for ( ; pModule && txInfo != txInfo_end; ++txInfo )
+        {
+            // see if we have a match for the handlerextension
+            // where ScriptCode is methodname_handlerextension
+            rtl::OUString sTemp = sName.concat( (*txInfo).sVBAName );
+
+            OSL_TRACE("*** trying to invoke %s ",
+                rtl::OUStringToOString( sTemp, RTL_TEXTENCODING_UTF8 ).getStr() );
+            SbMethod* pMeth = static_cast< SbMethod* >( pModule->Find( sTemp, SbxCLASS_METHOD ) );
+            if ( pMeth )
+            {
+                // !! translate arguments & emulate events where necessary
+                Sequence< Any > aArguments;
+                if  ( (*txInfo).toVBA )
+                    aArguments = (*txInfo).toVBA( evt.Arguments );
+                else
+                    aArguments = evt.Arguments;
+                if ( aArguments.getLength() )
+                {
+                    // call basic event handlers for event
+
+                    static rtl::OUString part1 = rtl::OUString::createFromAscii( "vnd.sun.star.script:");
+                    static rtl::OUString part2 = rtl::OUString::createFromAscii("?language=Basic&location=document");
+
+                    // create script url
+                    rtl::OUString url = part1 + sMacroLoc + sTemp + part2;
+
+                    OSL_TRACE("script url = %s",
+                        rtl::OUStringToOString( url,
+                            RTL_TEXTENCODING_UTF8 ).getStr() );
+                    Sequence< sal_Int16 > aOutArgsIndex;
+                    Sequence< Any > aOutArgs;
+                    try
+                    {
+                        uno::Reference< script::provider::XScript > xScript = xScriptProvider->getScript( url );
+                        if ( xScript.is() )
+                           xScript->invoke( aArguments, aOutArgsIndex, aOutArgs  );
+                    }
+                    catch ( uno::Exception& e )
+                    {
+                        OSL_TRACE("event script raised %s", rtl::OUStringToOString( e.Message, RTL_TEXTENCODING_UTF8 ).getStr() );
+                    }
+               }
+           }
+       }
+    }
+}
+
+typedef ::cppu::WeakImplHelper1< XVBAToOOEventDescGen > VBAToOOEventDescGen_BASE;
+
+
+class VBAToOOEventDescGen : public VBAToOOEventDescGen_BASE
+{
+public:
+    VBAToOOEventDescGen( const Reference< XComponentContext >& rxContext );
+
+    // XVBAToOOEventDescGen
+    virtual Sequence< ScriptEventDescriptor > SAL_CALL getEventDescriptions( const Reference< XInterface >& control, const rtl::OUString& sCodeName ) throw (RuntimeException);
+    virtual Reference< XScriptEventsSupplier > SAL_CALL getEventSupplier( const Reference< XInterface >& xControl,  const rtl::OUString& sCodeName ) throw (::com::sun::star::uno::RuntimeException);
+private:
+    Reference< XComponentContext > m_xContext;
+
+};
+
+VBAToOOEventDescGen::VBAToOOEventDescGen( const Reference< XComponentContext >& rxContext ):m_xContext( rxContext ) {}
+
+Sequence< ScriptEventDescriptor > SAL_CALL
+VBAToOOEventDescGen::getEventDescriptions( const Reference< XInterface >& xControl, const rtl::OUString& sCodeName ) throw (RuntimeException)
+{
+    ScriptEventHelper evntHelper( xControl );
+    return evntHelper.createEvents( sCodeName );
+}
+
+Reference< XScriptEventsSupplier > SAL_CALL
+VBAToOOEventDescGen::getEventSupplier( const Reference< XInterface >& xControl, const rtl::OUString& sCodeName  ) throw (::com::sun::star::uno::RuntimeException)
+{
+    ScriptEventHelper evntHelper( xControl );
+    Reference< XScriptEventsSupplier > xSupplier =
+        new ReadOnlyEventsSupplier(
+            evntHelper.getEventListeners(), sCodeName ) ;
+    return xSupplier;
+}
+
+// Component related
+
+namespace evtlstner
+{
+    ::rtl::OUString SAL_CALL getImplementationName()
+    {
+        static ::rtl::OUString* pImplName = 0;
+        if ( !pImplName )
+        {
+            ::osl::MutexGuard aGuard( ::osl::Mutex::getGlobalMutex() );
+            if ( !pImplName )
+            {
+                static ::rtl::OUString aImplName( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.EventListener" ) );
+                pImplName = &aImplName;
+            }
+        }
+        return *pImplName;
+    }
+
+    uno::Reference< XInterface > SAL_CALL create(
+    Reference< XComponentContext > const & xContext )
+    SAL_THROW( () )
+    {
+        return static_cast< lang::XTypeProvider * >( new EventListener( xContext ) );
+    }
+
+    Sequence< ::rtl::OUString > SAL_CALL getSupportedServiceNames()
+    {
+        const ::rtl::OUString strName( ::evtlstner::getImplementationName() );
+        return Sequence< ::rtl::OUString >( &strName, 1 );
+    }
+}
+namespace ooevtdescgen
+{
+    ::rtl::OUString SAL_CALL getImplementationName()
+    {
+        static ::rtl::OUString* pImplName = 0;
+        if ( !pImplName )
+        {
+            ::osl::MutexGuard aGuard( ::osl::Mutex::getGlobalMutex() );
+            if ( !pImplName )
+            {
+                static ::rtl::OUString aImplName( RTL_CONSTASCII_USTRINGPARAM( "ooo.vba.VBAToOOEventDesc" ) );
+                pImplName = &aImplName;
+            }
+        }
+        return *pImplName;
+    }
+
+    uno::Reference< XInterface > SAL_CALL create(
+        Reference< XComponentContext > const & xContext )
+        SAL_THROW( () )
+    {
+        return static_cast< lang::XTypeProvider * >( new VBAToOOEventDescGen( xContext ) );
+    }
+
+    Sequence< ::rtl::OUString > SAL_CALL getSupportedServiceNames()
+    {
+        const ::rtl::OUString strName( ::ooevtdescgen::getImplementationName() );
+        return Sequence< ::rtl::OUString >( &strName, 1 );
+    }
+}

scripting/source/vbaevents/makefile.mk

+PRJ=..$/..
+
+PRJNAME=scripting
+TARGET=vbaevents
+.IF "$(ENABLE_VBA)"!="YES"
+dummy:
+        @echo "not building vbaevents..."
+.ENDIF
+
+VISIBILITY_HIDDEN=TRUE
+NO_BSYMBOLIC=	TRUE
+ENABLE_EXCEPTIONS=TRUE
+COMP1TYPELIST=$(TARGET)
+COMPRDB=$(SOLARBINDIR)$/types.rdb
+
+# --- Settings -----------------------------------------------------
+
+.INCLUDE :  settings.mk
+DLLPRE =
+
+# ------------------------------------------------------------------
+
+#.INCLUDE :  ..$/cppumaker.mk
+
+SLOFILES= \
+        $(SLO)$/service.obj \
+        $(SLO)$/eventhelper.obj
+
+SHL1TARGET= $(TARGET)$(DLLPOSTFIX).uno
+SHL1IMPLIB=     i$(TARGET)
+
+SHL1VERSIONMAP=$(TARGET).map
+SHL1DEF=$(MISC)$/$(SHL1TARGET).def
+DEF1NAME=$(SHL1TARGET)
+                                                                              
+SHL1STDLIBS= \
+                $(CPPUHELPERLIB) \
+        $(BASICLIB) \
+        $(COMPHELPERLIB) \
+        $(SFXLIB) \
+                $(CPPULIB) \
+                $(TOOLSLIB) \
+                $(SALLIB)
+                                                                              
+SHL1DEPN=
+SHL1LIBS=$(SLB)$/$(TARGET).lib
+
+# --- Targets ------------------------------------------------------
+
+.INCLUDE :	target.mk
+
+# ------------------------------------------------------------------
+
+ALLTAR : \
+        $(MISC)$/$(TARGET).don \
+        $(SLOTARGET)
+
+$(MISC)$/$(TARGET).don : $(SOLARBINDIR)$/oovbaapi.rdb
+        +$(CPPUMAKER) -O$(OUT)$/inc -BUCR $(SOLARBINDIR)$/oovbaapi.rdb -X$(SOLARBINDIR)$/types.rdb && echo > $@
+        echo $@

scripting/source/vbaevents/service.cxx

+// MARKER(update_precomp.py): autogen include statement, do not remove
+#include "precompiled_scripting.hxx"
+#include "cppuhelper/implementationentry.hxx"
+#include "com/sun/star/lang/XMultiServiceFactory.hpp"
+#include "com/sun/star/registry/XRegistryKey.hpp"
+
+// =============================================================================
+// component exports
+// =============================================================================
+using namespace ::com::sun::star;
+using namespace ::com::sun::star::uno;
+
+namespace evtlstner
+{
+    // =============================================================================
+    // component operations
+    // =============================================================================
+
+    uno::Reference< XInterface > SAL_CALL create(
+        Reference< XComponentContext > const & xContext )
+        SAL_THROW( () );
+
+    // -----------------------------------------------------------------------------
+
+    ::rtl::OUString SAL_CALL getImplementationName();
+
+    Sequence< ::rtl::OUString > SAL_CALL getSupportedServiceNames();
+
+    Reference<XInterface> SAL_CALL create(
+        Sequence<Any> const &, Reference<XComponentContext> const & );
+} // end evtlstner
+
+namespace ooevtdescgen
+{
+    // =============================================================================
+    // component operations
+    // =============================================================================
+
+    uno::Reference< XInterface > SAL_CALL create(
+        Reference< XComponentContext > const & xContext )
+        SAL_THROW( () );
+
+    // -----------------------------------------------------------------------------
+
+    ::rtl::OUString SAL_CALL getImplementationName();
+
+    Sequence< ::rtl::OUString > SAL_CALL getSupportedServiceNames();
+
+    Reference<XInterface> SAL_CALL create(
+        Sequence<Any> const &, Reference<XComponentContext> const & );
+} // end ooevtdescgen
+
+
+
+    // =============================================================================
+
+    const ::cppu::ImplementationEntry s_component_entries [] =
+    {
+        {
+            ::evtlstner::create, ::evtlstner::getImplementationName,
+            ::evtlstner::getSupportedServiceNames,
+            ::cppu::createSingleComponentFactory,
+            0, 0
+        },
+        {
+            ::ooevtdescgen::create, ::ooevtdescgen::getImplementationName,
+            ::ooevtdescgen::getSupportedServiceNames,
+            ::cppu::createSingleComponentFactory,
+            0, 0
+        },
+        { 0, 0, 0, 0, 0, 0 }
+    };
+
+extern "C"
+{
+    void SAL_CALL component_getImplementationEnvironment(
+        const sal_Char ** ppEnvTypeName, uno_Environment ** )
+    {
+        OSL_TRACE("In component_getImplementationEnv");
+        *ppEnvTypeName = CPPU_CURRENT_LANGUAGE_BINDING_NAME;
+    }
+
+    sal_Bool SAL_CALL component_writeInfo(
+        lang::XMultiServiceFactory * pServiceManager, registry::XRegistryKey * pRegistryKey )
+    {
+        OSL_TRACE("In component_writeInfo");
+        if ( ::cppu::component_writeInfoHelper(
+            pServiceManager, pRegistryKey, s_component_entries ) )
+            return sal_True;
+        return sal_False;
+    }
+
+    void * SAL_CALL component_getFactory(
+        const sal_Char * pImplName, lang::XMultiServiceFactory * pServiceManager,
+        registry::XRegistryKey * pRegistryKey )
+    {
+        OSL_TRACE("In component_getFactory");
+        return ::cppu::component_getFactoryHelper(
+            pImplName, pServiceManager, pRegistryKey, s_component_entries );
+    }
+}

scripting/source/vbaevents/vbaevents.map

+OOO_1.1 {
+    global:
+        component_getImplementationEnvironment;
+        component_getFactory;
+        component_writeInfo;
+
+    local:
+        *;
+};

scripting/source/vbaevents/vbaevents.xml

+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE module-description PUBLIC "-//StarOffice//DTD ComponentDescription 1.0//EN" "module-description.dtd">
+<module-description xmlns:xlink="http://www.w3.org/1999/xlink">
+
+    <module-name>vbaevents</module-name>
+
+    <component-description>
+        <author>Noel Power </author>
+        <name>ooo.vba.EventListener</name>
+        <description>Event listener to handle ooo events and to translate them to calls to basic macros ala Button_Click etc.</description>
+        <loader-name>com.sun.star.loader.SharedLibrary</loader-name>
+        <language>c++</language>
+        <status value="drafts"/>
+        <supported-service>ooo.vba.EventListener</supported-service>
+        <type>com.sun.star.uno.XComponentContext</type>
+    </component-description>
+
+    <project-build-dependency>cppuhelper</project-build-dependency>
+    <project-build-dependency>cppu</project-build-dependency>
+    <project-build-dependency>sal</project-build-dependency>
+
+    <runtime-module-dependency>cppuhelper3$(COM)</runtime-module-dependency>
+    <runtime-module-dependency>cppu3</runtime-module-dependency>
+    <runtime-module-dependency>sal3</runtime-module-dependency>
+
+</module-description>

svx/source/form/fmscriptingenv.cxx

@@ -236,6 +236,11 @@ namespace svxform
     void SAL_CALL FormScriptListener::firing( const ScriptEvent& _rEvent ) throw (RuntimeException)
     {
         ::osl::ClearableMutexGuard aGuard( m_aMutex );
+       static const ::rtl::OUString vbaInterOp =
+           ::rtl::OUString::createFromAscii("VBAInterop");
+       if ( _rEvent.ScriptType.equals(vbaInterOp) )
+           return; // not handled here
+
         if ( impl_isDisposed_nothrow() )
             return;
 

svx/source/form/fmtools.cxx

@@ -105,6 +105,7 @@
 #include <comphelper/uno3.hxx>
 #include <connectivity/dbexception.hxx>
 #include <comphelper/extract.hxx>
+#include <comphelper/evtmethodhelper.hxx>
 #include <cppuhelper/typeprovider.hxx>
 #include <algorithm>
 
@@ -718,36 +719,6 @@ sal_Int16 getControlTypeByObject(const Reference< ::com::sun::star::lang::XServi
     }
     return ::rtl::OUString();
 }
-//------------------------------------------------------------------------------
-Sequence< ::rtl::OUString> getEventMethods(const Type& type)
-{
-    typelib_InterfaceTypeDescription *pType=0;
-    type.getDescription( (typelib_TypeDescription**)&pType);
-
-    if(!pType)
-        return Sequence< ::rtl::OUString>();
-
-    Sequence< ::rtl::OUString> aNames(pType->nMembers);
-    ::rtl::OUString* pNames = aNames.getArray();
-    for(sal_Int32 i=0;i<pType->nMembers;i++,++pNames)
-    {
-        // the decription reference
-        typelib_TypeDescriptionReference* pMemberDescriptionReference = pType->ppMembers[i];
-        // the description for the reference
-        typelib_TypeDescription* pMemberDescription = NULL;
-        typelib_typedescriptionreference_getDescription(&pMemberDescription, pMemberDescriptionReference);
-        if (pMemberDescription)
-        {
-            typelib_InterfaceMemberTypeDescription* pRealMemberDescription =
-                reinterpret_cast<typelib_InterfaceMemberTypeDescription*>(pMemberDescription);
-            *pNames = pRealMemberDescription->pMemberName;
-        }
-    }
-    typelib_typedescription_release( (typelib_TypeDescription *)pType );
-    return aNames;
-}
-
-
 //------------------------------------------------------------------------------
 void TransferEventScripts(const Reference< ::com::sun::star::awt::XControlModel>& xModel, const Reference< ::com::sun::star::awt::XControl>& xControl,
     const Sequence< ::com::sun::star::script::ScriptEventDescriptor>& rTransferIfAvailable)
@@ -821,7 +792,8 @@ void TransferEventScripts(const Reference< ::com::sun::star::awt::XControlModel>
                     continue;
 
                 // now check the methods
-                Sequence< ::rtl::OUString> aMethodsNames = getEventMethods(*pCurrentListeners);
+                Sequence< ::rtl::OUString> aMethodsNames = ::comphelper::getEventMethodsForType(*pCurrentListeners);
+
                 const ::rtl::OUString* pMethodsNames = aMethodsNames.getConstArray();
                 for (k=0; k<aMethodsNames.getLength(); ++k, ++pMethodsNames)
                 {

svx/source/form/fmundo.cxx

@@ -86,6 +86,90 @@ using namespace ::com::sun::star::reflection;
 using namespace ::com::sun::star::form::binding;
 using namespace ::svxform;
 
+
+#include <com/sun/star/script/XScriptListener.hdl>
+#include <comphelper/processfactory.hxx>
+#include <cppuhelper/implbase1.hxx>
+
+typedef cppu::WeakImplHelper1< XScriptListener > ScriptEventListener_BASE;
+class ScriptEventListenerWrapper : public ScriptEventListener_BASE
+{
+public:
+    ScriptEventListenerWrapper( FmFormModel& _rModel) throw ( RuntimeException ) : pModel(&_rModel)
+    {
+        Reference < XPropertySet > xProps(
+            ::comphelper::getProcessServiceFactory(), UNO_QUERY );
+        if ( xProps.is() )
+        {
+            Reference< XComponentContext > xCtx( xProps->getPropertyValue(
+                rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "DefaultContext" ))), UNO_QUERY );
+            if ( xCtx.is() )
+            {
+                Reference< XMultiComponentFactory > xMFac(
+                    xCtx->getServiceManager(), UNO_QUERY );
+                if ( xMFac.is() )
+                {
+                    m_vbaListener.set( xMFac->createInstanceWithContext(
+                        rtl::OUString( RTL_CONSTASCII_USTRINGPARAM(
+                            "ooo.vba.EventListener"  ) ), xCtx ),
+                                UNO_QUERY_THROW );
+                }
+            }
+        }
+    }
+    // XEventListener
+    virtual void SAL_CALL disposing(const EventObject& ) throw( RuntimeException ){}
+
+    // XScriptListener
+    virtual void SAL_CALL firing(const  ScriptEvent& evt) throw(RuntimeException)
+    {
+        setModel();
+        if ( m_vbaListener.is() )
+        {
+            m_vbaListener->firing( evt );
+        }
+    }
+
+    virtual Any SAL_CALL approveFiring(const ScriptEvent& evt) throw( com::sun::star::reflection::InvocationTargetException, RuntimeException)
+    {
+        setModel();
+        if ( m_vbaListener.is() )
+        {
+            return m_vbaListener->approveFiring( evt );
+        }
+        return Any();
+    }
+
+private:
+    void setModel()
+    {
+        Reference< XPropertySet > xProps( m_vbaListener, UNO_QUERY );
+        if ( xProps.is() )
+        {
+            try
+            {
+                SfxObjectShellRef xObjSh = pModel->GetObjectShell();
+                if ( xObjSh.Is() && m_vbaListener.is() )
+                {
+                    Any aVal;
+                    aVal <<= xObjSh->GetModel();
+                    xProps->setPropertyValue(
+                        ::rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Model" ) ),
+                        aVal );
+                }
+            }
+            catch( Exception& )
+            {
+                //swallow any errors
+            }
+        }
+    }
+    FmFormModel* pModel;
+    Reference< XScriptListener > m_vbaListener;
+
+
+};
+
 //------------------------------------------------------------------------------
 // some helper structs for caching property infos
 //------------------------------------------------------------------------------
@@ -128,6 +212,13 @@ FmXUndoEnvironment::FmXUndoEnvironment(FmFormModel& _rModel)
                    ,m_bDisposed( false )
 {
     DBG_CTOR(FmXUndoEnvironment,NULL);
+    try
+    {
+        m_vbaListener =  new ScriptEventListenerWrapper( _rModel );
+    }
+    catch( Exception& )
+    {
+    }
 }
 
 //------------------------------------------------------------------------------
@@ -752,9 +843,17 @@ void FmXUndoEnvironment::switchListening( const Reference< XIndexContainer >& _r
         if ( xManager.is() )
         {
             if ( _bStartListening )
+            {
                 m_pScriptingEnv->registerEventAttacherManager( xManager );
+                if ( m_vbaListener.is() )
+                    xManager->addScriptListener( m_vbaListener );
+            }
             else
+            {
                 m_pScriptingEnv->revokeEventAttacherManager( xManager );
+                if ( m_vbaListener.is() )
+                    xManager->removeScriptListener( m_vbaListener );
+            }
         }
 
         // also handle all children of this element

svx/source/form/makefile.mk

@@ -43,6 +43,10 @@ ENABLE_EXCEPTIONS=TRUE
 
 # --- Files --------------------------------------------------------
 
+.IF "$(ENABLE_VBA)"=="YES"
+    CDEFS+=-DENABLE_VBA
+.ENDIF
+
 SRS1NAME=form
 SRC1FILES= \
     fmexpl.src 		\

svx/source/inc/fmundo.hxx

@@ -213,7 +213,7 @@ private:
 
     void    switchListening( const ::com::sun::star::uno::Reference< ::com::sun::star::container::XIndexContainer >& _rxContainer, bool _bStartListening ) SAL_THROW(());
     void    switchListening( const ::com::sun::star::uno::Reference< ::com::sun::star::uno::XInterface >& _rxObject, bool _bStartListening ) SAL_THROW(());
-
+    ::com::sun::star::uno::Reference< com::sun::star::script::XScriptListener > m_vbaListener;
 public:
     // Methoden zur Zuordnung von Controls zu Forms,
     // werden von der Seite und der UndoUmgebung genutzt