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 
ScVbaUserForm(uno::Sequence<uno::Any> const & aArgs,uno::Reference<uno::XComponentContext> const & xContext)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 
~ScVbaUserForm()56 ScVbaUserForm::~ScVbaUserForm()
57 {
58 }
59 
60 void SAL_CALL
Show()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
getCaption()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
setCaption(const::rtl::OUString & _caption)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 
getInnerWidth()116 double SAL_CALL ScVbaUserForm::getInnerWidth() throw (uno::RuntimeException)
117 {
118     return mpGeometryHelper->getInnerWidth();
119 }
120 
setInnerWidth(double fInnerWidth)121 void SAL_CALL ScVbaUserForm::setInnerWidth( double fInnerWidth ) throw (uno::RuntimeException)
122 {
123     mpGeometryHelper->setInnerWidth( fInnerWidth );
124 }
125 
getInnerHeight()126 double SAL_CALL ScVbaUserForm::getInnerHeight() throw (uno::RuntimeException)
127 {
128     return mpGeometryHelper->getInnerHeight();
129 }
130 
setInnerHeight(double fInnerHeight)131 void SAL_CALL ScVbaUserForm::setInnerHeight( double fInnerHeight ) throw (uno::RuntimeException)
132 {
133     mpGeometryHelper->setInnerHeight( fInnerHeight );
134 }
135 
136 void SAL_CALL
Hide()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
RePaint()145 ScVbaUserForm::RePaint(  ) throw (uno::RuntimeException)
146 {
147 	// do nothing
148 }
149 
150 void SAL_CALL
UnloadObject()151 ScVbaUserForm::UnloadObject(  ) throw (uno::RuntimeException)
152 {
153 	mbDispose = true;
154 	if ( m_xDialog.is() )
155 		m_xDialog->endExecute();
156 }
157 
158 rtl::OUString&
getServiceImplName()159 ScVbaUserForm::getServiceImplName()
160 {
161 	static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("ScVbaUserForm") );
162 	return sImplName;
163 }
164 
165 uno::Sequence< rtl::OUString >
getServiceNames()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
getIntrospection()178 ScVbaUserForm::getIntrospection(  ) throw (uno::RuntimeException)
179 {
180 	return uno::Reference< beans::XIntrospectionAccess >();
181 }
182 
183 uno::Any SAL_CALL
invoke(const::rtl::OUString &,const uno::Sequence<uno::Any> &,uno::Sequence<::sal_Int16> &,uno::Sequence<uno::Any> &)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
setValue(const::rtl::OUString & aPropertyName,const uno::Any & aValue)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
getValue(const::rtl::OUString & aPropertyName)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
hasMethod(const::rtl::OUString &)228 ScVbaUserForm::hasMethod( const ::rtl::OUString& /*aName*/ ) throw (uno::RuntimeException)
229 {
230 	return sal_False;
231 }
232 uno::Any SAL_CALL
Controls(const uno::Any & index)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
hasProperty(const::rtl::OUString & aName)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