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