vbahelper/source/msforms/vbauserform.cxx

   1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
   2 /*
   3  * This file is part of the LibreOffice project.
   4  *
   5  * This Source Code Form is subject to the terms of the Mozilla Public
   6  * License, v. 2.0. If a copy of the MPL was not distributed with this
   7  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
   8  *
   9  * This file incorporates work covered by the following license notice:
  10  *
  11  *   Licensed to the Apache Software Foundation (ASF) under one or more
  12  *   contributor license agreements. See the NOTICE file distributed
  13  *   with this work for additional information regarding copyright
  14  *   ownership. The ASF licenses this file to you under the Apache
  15  *   License, Version 2.0 (the "License"); you may not use this file
  16  *   except in compliance with the License. You may obtain a copy of
  17  *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  18  */
  19 #include <vbahelper/helperdecl.hxx>
  20 #include "service.hxx"
  21 #include "vbauserform.hxx"
  22 #include <com/sun/star/awt/XControl.hpp>
  23 #include <com/sun/star/awt/XControlContainer.hpp>
  24 #include <com/sun/star/awt/XWindow2.hpp>
  25 #include <com/sun/star/awt/PosSize.hpp>
  26 #include <com/sun/star/beans/PropertyConcept.hpp>
  27 #include <com/sun/star/container/XNameContainer.hpp>
  28 #include <com/sun/star/util/MeasureUnit.hpp>
  29 #include <com/sun/star/frame/XController.hpp>
  30 #include <com/sun/star/frame/XModel.hpp>
  31 #include <basic/sbx.hxx>
  32 #include <basic/sbstar.hxx>
  33 #include <basic/sbmeth.hxx>
  34 #include "vbacontrols.hxx"
  35 #include <sal/log.hxx>
  36
  37 using namespace ::ooo::vba;
  38 using namespace ::com::sun::star;
  39
  40 // some little notes
  41 // XDialog implementation has the following interesting bits
  42 // a Controls property ( which is an array of the container controls )
  43 //   each item in the controls array is a XControl, where the model is
  44 //   basically a property bag
  45 // additionally the XDialog instance has itself a model
  46 //     this model has a ControlModels ( array of models ) property
  47 //     the models in ControlModels can be accessed by name
  48 // also the XDialog is a XControl ( to access the model above
  49
  50 ScVbaUserForm::ScVbaUserForm( uno::Sequence< uno::Any > const& aArgs, uno::Reference< uno::XComponentContext >const& xContext )
  51     :  ScVbaUserForm_BASE( getXSomethingFromArgs< XHelperInterface >( aArgs, 0 ), xContext, getXSomethingFromArgs< uno::XInterface >( aArgs, 1 ), getXSomethingFromArgs< frame::XModel >( aArgs, 2 ), nullptr ),
  52        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( std::make_unique<UserFormGeometryHelper>( xControl, 0.0, 0.0 ) );
  58     if ( aArgs.getLength() >= 4 )
  59         aArgs[ 3 ] >>= m_sLibName;
  60 }
  61
  62 ScVbaUserForm::~ScVbaUserForm()
  63 {
  64 }
  65
  66 void SAL_CALL
  67 ScVbaUserForm::Show(  )
  68 {
  69     SAL_INFO("vbahelper", "ScVbaUserForm::Show(  )");
  70     short aRet = 0;
  71     mbDispose = true;
  72
  73     if ( m_xDialog.is() )
  74     {
  75         // try to center dialog on model window
  76         if( m_xModel.is() ) try
  77         {
  78             uno::Reference< frame::XController > xController( m_xModel->getCurrentController(), uno::UNO_SET_THROW );
  79             uno::Reference< frame::XFrame > xFrame( xController->getFrame(), uno::UNO_SET_THROW );
  80             uno::Reference< awt::XWindow > xWindow( xFrame->getContainerWindow(), uno::UNO_SET_THROW );
  81             awt::Rectangle aPosSize = xWindow->getPosSize();    // already in pixel
  82
  83             uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY_THROW );
  84             uno::Reference< awt::XWindow > xControlWindow( xControl->getPeer(), uno::UNO_QUERY_THROW );
  85             xControlWindow->setPosSize(static_cast<sal_Int32>((aPosSize.Width - getWidth()) / 2.0), static_cast<sal_Int32>((aPosSize.Height - getHeight()) / 2.0), 0, 0, awt::PosSize::POS );
  86         }
  87         catch( uno::Exception& )
  88         {
  89         }
  90
  91         aRet = m_xDialog->execute();
  92     }
  93     SAL_INFO("vbahelper", "ScVbaUserForm::Show() execute returned " << aRet);
  94     if ( mbDispose )
  95     {
  96         try
  97         {
  98             uno::Reference< lang::XComponent > xComp( m_xDialog, uno::UNO_QUERY_THROW );
  99             m_xDialog = nullptr;
 100             xComp->dispose();
 101             mbDispose = false;
 102         }
 103         catch( uno::Exception& )
 104         {
 105         }
 106     }
 107 }
 108
 109 OUString SAL_CALL
 110 ScVbaUserForm::getCaption()
 111 {
 112     OUString sCaption;
 113     m_xProps->getPropertyValue( "Title" ) >>= sCaption;
 114     return sCaption;
 115 }
 116 void
 117 ScVbaUserForm::setCaption( const OUString& _caption )
 118 {
 119     m_xProps->setPropertyValue( "Title", uno::makeAny( _caption ) );
 120 }
 121
 122 sal_Bool SAL_CALL
 123 ScVbaUserForm::getVisible()
 124 {
 125     uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY_THROW );
 126     uno::Reference< awt::XWindow2 > xControlWindow( xControl->getPeer(), uno::UNO_QUERY_THROW );
 127     return xControlWindow->isVisible();
 128 }
 129
 130 void SAL_CALL
 131 ScVbaUserForm::setVisible( sal_Bool bVis )
 132 {
 133     if ( bVis )
 134         Show();
 135     else
 136         Hide();
 137 }
 138
 139 double SAL_CALL ScVbaUserForm::getInnerWidth()
 140 {
 141     return mpGeometryHelper->getInnerWidth();
 142 }
 143
 144 void SAL_CALL ScVbaUserForm::setInnerWidth( double fInnerWidth )
 145 {
 146     mpGeometryHelper->setInnerWidth( fInnerWidth );
 147 }
 148
 149 double SAL_CALL ScVbaUserForm::getInnerHeight()
 150 {
 151     return mpGeometryHelper->getInnerHeight();
 152 }
 153
 154 void SAL_CALL ScVbaUserForm::setInnerHeight( double fInnerHeight )
 155 {
 156     mpGeometryHelper->setInnerHeight( fInnerHeight );
 157 }
 158
 159 void SAL_CALL
 160 ScVbaUserForm::Hide(  )
 161 {
 162     mbDispose = false;  // hide not dispose
 163     if ( m_xDialog.is() )
 164         m_xDialog->endExecute();
 165 }
 166
 167 void SAL_CALL
 168 ScVbaUserForm::RePaint(  )
 169 {
 170     // #STUB
 171     // do nothing
 172 }
 173
 174 void SAL_CALL
 175 ScVbaUserForm::UnloadObject(  )
 176 {
 177     mbDispose = true;
 178     if ( m_xDialog.is() )
 179         m_xDialog->endExecute();
 180 }
 181
 182 OUString
 183 ScVbaUserForm::getServiceImplName()
 184 {
 185     return OUString("ScVbaUserForm");
 186 }
 187
 188 uno::Sequence< OUString >
 189 ScVbaUserForm::getServiceNames()
 190 {
 191     static uno::Sequence< OUString > const aServiceNames
 192     {
 193         "ooo.vba.excel.UserForm"
 194     };
 195     return aServiceNames;
 196 }
 197
 198 uno::Reference< beans::XIntrospectionAccess > SAL_CALL
 199 ScVbaUserForm::getIntrospection(  )
 200 {
 201     return uno::Reference< beans::XIntrospectionAccess >();
 202 }
 203
 204 uno::Any SAL_CALL
 205 ScVbaUserForm::invoke( const OUString& /*aFunctionName*/, const uno::Sequence< uno::Any >& /*aParams*/, uno::Sequence< ::sal_Int16 >& /*aOutParamIndex*/, uno::Sequence< uno::Any >& /*aOutParam*/ )
 206 {
 207     throw uno::RuntimeException(); // unsupported operation
 208 }
 209
 210 void SAL_CALL
 211 ScVbaUserForm::setValue( const OUString& aPropertyName, const uno::Any& aValue )
 212 {
 213     uno::Any aObject = getValue( aPropertyName );
 214
 215     // in case the dialog is already closed the VBA implementation should not throw exceptions
 216     if ( aObject.hasValue() )
 217     {
 218         // The Object *must* support XDefaultProperty here because getValue will
 219         // only return properties that are Objects ( e.g. controls )
 220         // e.g. Userform1.aControl = something
 221         // 'aControl' has to support XDefaultProperty to make sense here
 222         uno::Reference< script::XDefaultProperty > xDfltProp( aObject, uno::UNO_QUERY_THROW );
 223         OUString aDfltPropName = xDfltProp->getDefaultPropertyName();
 224         uno::Reference< beans::XIntrospectionAccess > xUnoAccess( getIntrospectionAccess( aObject ) );
 225         uno::Reference< beans::XPropertySet > xPropSet( xUnoAccess->queryAdapter( cppu::UnoType<beans::XPropertySet>::get()), uno::UNO_QUERY_THROW );
 226         xPropSet->setPropertyValue( aDfltPropName, aValue );
 227     }
 228 }
 229
 230 uno::Reference< awt::XControl >
 231 ScVbaUserForm::nestedSearch( const OUString& aPropertyName, uno::Reference< awt::XControlContainer > const & xContainer )
 232 {
 233     uno::Reference< awt::XControl > xControl = xContainer->getControl( aPropertyName );
 234     if ( !xControl.is() )
 235     {
 236         uno::Sequence< uno::Reference< awt::XControl > > aControls = xContainer->getControls();
 237         const uno::Reference< awt::XControl >* pCtrl = aControls.getConstArray();
 238         const uno::Reference< awt::XControl >* pCtrlsEnd = pCtrl + aControls.getLength();
 239
 240         for ( ; pCtrl < pCtrlsEnd; ++pCtrl )
 241         {
 242             uno::Reference< awt::XControlContainer > xC( *pCtrl, uno::UNO_QUERY );
 243             if ( xC.is() )
 244             {
 245                 xControl.set( nestedSearch( aPropertyName, xC ) );
 246                 if ( xControl.is() )
 247                     break;
 248             }
 249         }
 250     }
 251     return xControl;
 252 }
 253
 254 uno::Any SAL_CALL
 255 ScVbaUserForm::getValue( const OUString& aPropertyName )
 256 {
 257     uno::Any aResult;
 258
 259     // in case the dialog is already closed the VBA implementation should not throw exceptions
 260     if ( m_xDialog.is() )
 261     {
 262         uno::Reference< awt::XControl > xDialogControl( m_xDialog, uno::UNO_QUERY_THROW );
 263         uno::Reference< awt::XControlContainer > xContainer( m_xDialog, uno::UNO_QUERY_THROW );
 264         uno::Reference< awt::XControl > xControl = nestedSearch( aPropertyName, xContainer );
 265         xContainer->getControl( aPropertyName );
 266         if ( xControl.is() )
 267         {
 268             uno::Reference< msforms::XControl > xVBAControl = ScVbaControlFactory::createUserformControl( mxContext, xControl, xDialogControl, m_xModel, mpGeometryHelper->getOffsetX(), mpGeometryHelper->getOffsetY() );
 269             ScVbaControl* pControl  = dynamic_cast< ScVbaControl* >( xVBAControl.get() );
 270             if (pControl && !m_sLibName.isEmpty())
 271                 pControl->setLibraryAndCodeName( m_sLibName.concat( "." ).concat( getName() ) );
 272             aResult <<= xVBAControl;
 273         }
 274     }
 275
 276     return aResult;
 277 }
 278
 279 sal_Bool SAL_CALL
 280 ScVbaUserForm::hasMethod( const OUString& /*aName*/ )
 281 {
 282     return false;
 283 }
 284 uno::Any SAL_CALL
 285 ScVbaUserForm::Controls( const uno::Any& index )
 286 {
 287     // if the dialog already closed we should do nothing, but the VBA will call methods of the Controls objects
 288     // thus we have to provide a dummy object in this case
 289     uno::Reference< awt::XControl > xDialogControl( m_xDialog, uno::UNO_QUERY );
 290     uno::Reference< XCollection > xControls( new ScVbaControls( this, mxContext, xDialogControl, m_xModel, mpGeometryHelper->getOffsetX(), mpGeometryHelper->getOffsetY() ) );
 291     if ( index.hasValue() )
 292         return xControls->Item( index, uno::Any() );
 293     return uno::makeAny( xControls );
 294 }
 295
 296 sal_Bool SAL_CALL
 297 ScVbaUserForm::hasProperty( const OUString& aName )
 298 {
 299     uno::Reference< awt::XControl > xControl( m_xDialog, uno::UNO_QUERY );
 300
 301     SAL_INFO("vbahelper", "ScVbaUserForm::hasProperty(" << aName << ") " << xControl.is() );
 302     if ( xControl.is() )
 303     {
 304         uno::Reference< beans::XPropertySet > xDlgProps( xControl->getModel(), uno::UNO_QUERY );
 305         if ( xDlgProps.is() )
 306         {
 307             uno::Reference< container::XNameContainer > xAllChildren( xDlgProps->getPropertyValue( "AllDialogChildren" ), uno::UNO_QUERY_THROW );
 308             bool bRes =  xAllChildren->hasByName( aName );
 309             SAL_INFO("vbahelper", "ScVbaUserForm::hasProperty(" << aName << ") " << xAllChildren.is() << " ---> " << bRes );
 310             return bRes;
 311         }
 312     }
 313     return false;
 314 }
 315
 316 namespace userform
 317 {
 318 namespace sdecl = comphelper::service_decl;
 319 sdecl::vba_service_class_<ScVbaUserForm, sdecl::with_args<true> > const serviceImpl;
 320 sdecl::ServiceDecl const serviceDecl(
 321     serviceImpl,
 322     "ScVbaUserForm",
 323     "ooo.vba.msforms.UserForm" );
 324 }
 325
 326 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */