1 /************************************************************** 2 * 3 * Licensed to the Apache Software Foundation (ASF) under one 4 * or more contributor license agreements. See the NOTICE file 5 * distributed with this work for additional information 6 * regarding copyright ownership. The ASF licenses this file 7 * to you under the Apache License, Version 2.0 (the 8 * "License"); you may not use this file except in compliance 9 * with the License. You may obtain a copy of the License at 10 * 11 * http://www.apache.org/licenses/LICENSE-2.0 12 * 13 * Unless required by applicable law or agreed to in writing, 14 * software distributed under the License is distributed on an 15 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16 * KIND, either express or implied. See the License for the 17 * specific language governing permissions and limitations 18 * under the License. 19 * 20 *************************************************************/ 21 22 23 #include <vbahelper/helperdecl.hxx> 24 #include "vbauserform.hxx" 25 #include <com/sun/star/awt/XControl.hpp> 26 #include <com/sun/star/awt/XControlContainer.hpp> 27 #include <com/sun/star/awt/PosSize.hpp> 28 #include <com/sun/star/beans/PropertyConcept.hpp> 29 #include <com/sun/star/util/MeasureUnit.hpp> 30 #include <basic/sbx.hxx> 31 #include <basic/sbstar.hxx> 32 #include <basic/sbmeth.hxx> 33 #include "vbacontrols.hxx" 34 35 using namespace ::ooo::vba; 36 using namespace ::com::sun::star; 37 38 // some little notes 39 // XDialog implementation has the following interesting bits 40 // a Controls property ( which is an array of the container controls ) 41 // each item in the controls array is a XControl, where the model is 42 // basically a property bag 43 // additionally the XDialog instance has itself a model 44 // this model has a ControlModels ( array of models ) property 45 // the models in ControlModels can be accessed by name 46 // also the XDialog is a XControl ( to access the model above 47 48 ScVbaUserForm::ScVbaUserForm( uno::Sequence< uno::Any > const& aArgs, uno::Reference< uno::XComponentContext >const& xContext ) throw ( lang::IllegalArgumentException ) : ScVbaUserForm_BASE( getXSomethingFromArgs< XHelperInterface >( aArgs, 0 ), xContext, getXSomethingFromArgs< uno::XInterface >( aArgs, 1 ), getXSomethingFromArgs< frame::XModel >( aArgs, 2 ), static_cast< ooo::vba::AbstractGeometryAttributes* >(0) ), mbDispose( true ) 49 { 50 m_xDialog.set( m_xControl, uno::UNO_QUERY_THROW ); 51 uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY_THROW ); 52 m_xProps.set( xControl->getModel(), uno::UNO_QUERY_THROW ); 53 setGeometryHelper( new UserFormGeometryHelper( xContext, xControl, 0.0, 0.0 ) ); 54 } 55 56 ScVbaUserForm::~ScVbaUserForm() 57 { 58 } 59 60 void SAL_CALL 61 ScVbaUserForm::Show( ) throw (uno::RuntimeException) 62 { 63 OSL_TRACE("ScVbaUserForm::Show( )"); 64 short aRet = 0; 65 mbDispose = true; 66 67 if ( m_xDialog.is() ) 68 { 69 // try to center dialog on model window 70 if( m_xModel.is() ) try 71 { 72 uno::Reference< frame::XController > xController( m_xModel->getCurrentController(), uno::UNO_SET_THROW ); 73 uno::Reference< frame::XFrame > xFrame( xController->getFrame(), uno::UNO_SET_THROW ); 74 uno::Reference< awt::XWindow > xWindow( xFrame->getContainerWindow(), uno::UNO_SET_THROW ); 75 awt::Rectangle aPosSize = xWindow->getPosSize(); // already in pixel 76 77 uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY_THROW ); 78 uno::Reference< awt::XWindow > xControlWindow( xControl->getPeer(), uno::UNO_QUERY_THROW ); 79 xControlWindow->setPosSize( (aPosSize.Width - getWidth()) / 2.0, (aPosSize.Height - getHeight()) / 2.0, 0, 0, awt::PosSize::POS ); 80 } 81 catch( uno::Exception& ) 82 { 83 } 84 85 aRet = m_xDialog->execute(); 86 } 87 OSL_TRACE("ScVbaUserForm::Show() execute returned %d", aRet); 88 if ( mbDispose ) 89 { 90 try 91 { 92 uno::Reference< lang::XComponent > xComp( m_xDialog, uno::UNO_QUERY_THROW ); 93 m_xDialog = NULL; 94 xComp->dispose(); 95 mbDispose = false; 96 } 97 catch( uno::Exception& ) 98 { 99 } 100 } 101 } 102 103 rtl::OUString SAL_CALL 104 ScVbaUserForm::getCaption() throw (uno::RuntimeException) 105 { 106 rtl::OUString sCaption; 107 m_xProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Title") ) ) >>= sCaption; 108 return sCaption; 109 } 110 void 111 ScVbaUserForm::setCaption( const ::rtl::OUString& _caption ) throw (uno::RuntimeException) 112 { 113 m_xProps->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Title") ), uno::makeAny( _caption ) ); 114 } 115 116 double SAL_CALL ScVbaUserForm::getInnerWidth() throw (uno::RuntimeException) 117 { 118 return mpGeometryHelper->getInnerWidth(); 119 } 120 121 void SAL_CALL ScVbaUserForm::setInnerWidth( double fInnerWidth ) throw (uno::RuntimeException) 122 { 123 mpGeometryHelper->setInnerWidth( fInnerWidth ); 124 } 125 126 double SAL_CALL ScVbaUserForm::getInnerHeight() throw (uno::RuntimeException) 127 { 128 return mpGeometryHelper->getInnerHeight(); 129 } 130 131 void SAL_CALL ScVbaUserForm::setInnerHeight( double fInnerHeight ) throw (uno::RuntimeException) 132 { 133 mpGeometryHelper->setInnerHeight( fInnerHeight ); 134 } 135 136 void SAL_CALL 137 ScVbaUserForm::Hide( ) throw (uno::RuntimeException) 138 { 139 mbDispose = false; // hide not dispose 140 if ( m_xDialog.is() ) 141 m_xDialog->endExecute(); 142 } 143 144 void SAL_CALL 145 ScVbaUserForm::RePaint( ) throw (uno::RuntimeException) 146 { 147 // do nothing 148 } 149 150 void SAL_CALL 151 ScVbaUserForm::UnloadObject( ) throw (uno::RuntimeException) 152 { 153 mbDispose = true; 154 if ( m_xDialog.is() ) 155 m_xDialog->endExecute(); 156 } 157 158 rtl::OUString& 159 ScVbaUserForm::getServiceImplName() 160 { 161 static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("ScVbaUserForm") ); 162 return sImplName; 163 } 164 165 uno::Sequence< rtl::OUString > 166 ScVbaUserForm::getServiceNames() 167 { 168 static uno::Sequence< rtl::OUString > aServiceNames; 169 if ( aServiceNames.getLength() == 0 ) 170 { 171 aServiceNames.realloc( 1 ); 172 aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.excel.UserForm" ) ); 173 } 174 return aServiceNames; 175 } 176 177 uno::Reference< beans::XIntrospectionAccess > SAL_CALL 178 ScVbaUserForm::getIntrospection( ) throw (uno::RuntimeException) 179 { 180 return uno::Reference< beans::XIntrospectionAccess >(); 181 } 182 183 uno::Any SAL_CALL 184 ScVbaUserForm::invoke( const ::rtl::OUString& /*aFunctionName*/, const uno::Sequence< uno::Any >& /*aParams*/, uno::Sequence< ::sal_Int16 >& /*aOutParamIndex*/, uno::Sequence< uno::Any >& /*aOutParam*/ ) throw (lang::IllegalArgumentException, script::CannotConvertException, reflection::InvocationTargetException, uno::RuntimeException) 185 { 186 throw uno::RuntimeException(); // unsupported operation 187 } 188 189 void SAL_CALL 190 ScVbaUserForm::setValue( const ::rtl::OUString& aPropertyName, const uno::Any& aValue ) throw (beans::UnknownPropertyException, script::CannotConvertException, reflection::InvocationTargetException, uno::RuntimeException) 191 { 192 uno::Any aObject = getValue( aPropertyName ); 193 194 // in case the dialog is already closed the VBA implementation should not throw exceptions 195 if ( aObject.hasValue() ) 196 { 197 // The Object *must* support XDefaultProperty here because getValue will 198 // only return properties that are Objects ( e.g. controls ) 199 // e.g. Userform1.aControl = something 200 // 'aControl' has to support XDefaultProperty to make sense here 201 uno::Reference< script::XDefaultProperty > xDfltProp( aObject, uno::UNO_QUERY_THROW ); 202 rtl::OUString aDfltPropName = xDfltProp->getDefaultPropertyName(); 203 uno::Reference< beans::XIntrospectionAccess > xUnoAccess( getIntrospectionAccess( aObject ) ); 204 uno::Reference< beans::XPropertySet > xPropSet( xUnoAccess->queryAdapter( ::getCppuType( (const uno::Reference< beans::XPropertySet > *)0 ) ), uno::UNO_QUERY_THROW ); 205 xPropSet->setPropertyValue( aDfltPropName, aValue ); 206 } 207 } 208 209 uno::Any SAL_CALL 210 ScVbaUserForm::getValue( const ::rtl::OUString& aPropertyName ) throw (beans::UnknownPropertyException, uno::RuntimeException) 211 { 212 uno::Any aResult; 213 214 // in case the dialog is already closed the VBA implementation should not throw exceptions 215 if ( m_xDialog.is() ) 216 { 217 uno::Reference< awt::XControl > xDialogControl( m_xDialog, uno::UNO_QUERY_THROW ); 218 uno::Reference< awt::XControlContainer > xContainer( m_xDialog, uno::UNO_QUERY_THROW ); 219 uno::Reference< awt::XControl > xControl = xContainer->getControl( aPropertyName ); 220 if ( xControl.is() ) 221 aResult <<= ScVbaControlFactory::createUserformControl( mxContext, xControl, xDialogControl, m_xModel, mpGeometryHelper->getOffsetX(), mpGeometryHelper->getOffsetY() ); 222 } 223 224 return aResult; 225 } 226 227 ::sal_Bool SAL_CALL 228 ScVbaUserForm::hasMethod( const ::rtl::OUString& /*aName*/ ) throw (uno::RuntimeException) 229 { 230 return sal_False; 231 } 232 uno::Any SAL_CALL 233 ScVbaUserForm::Controls( const uno::Any& index ) throw (uno::RuntimeException) 234 { 235 // if the dialog already closed we should do nothing, but the VBA will call methods of the Controls objects 236 // thus we have to provide a dummy object in this case 237 uno::Reference< awt::XControl > xDialogControl( m_xDialog, uno::UNO_QUERY ); 238 uno::Reference< XCollection > xControls( new ScVbaControls( this, mxContext, xDialogControl, m_xModel, mpGeometryHelper->getOffsetX(), mpGeometryHelper->getOffsetY() ) ); 239 if ( index.hasValue() ) 240 return uno::makeAny( xControls->Item( index, uno::Any() ) ); 241 return uno::makeAny( xControls ); 242 } 243 244 ::sal_Bool SAL_CALL 245 ScVbaUserForm::hasProperty( const ::rtl::OUString& aName ) throw (uno::RuntimeException) 246 { 247 uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY ); 248 OSL_TRACE("ScVbaUserForm::hasProperty(%s) %d", rtl::OUStringToOString( aName, RTL_TEXTENCODING_UTF8 ).getStr(), xControl.is() ); 249 if ( xControl.is() ) 250 { 251 uno::Reference< container::XNameAccess > xNameAccess( xControl->getModel(), uno::UNO_QUERY_THROW ); 252 sal_Bool bRes = xNameAccess->hasByName( aName ); 253 OSL_TRACE("ScVbaUserForm::hasProperty(%s) %d ---> %d", rtl::OUStringToOString( aName, RTL_TEXTENCODING_UTF8 ).getStr(), xControl.is(), bRes ); 254 return bRes; 255 } 256 return sal_False; 257 } 258 259 namespace userform 260 { 261 namespace sdecl = comphelper::service_decl; 262 sdecl::vba_service_class_<ScVbaUserForm, sdecl::with_args<true> > serviceImpl; 263 extern sdecl::ServiceDecl const serviceDecl( 264 serviceImpl, 265 "ScVbaUserForm", 266 "ooo.vba.msforms.UserForm" ); 267 } 268 269