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