warn on load when a document binds an event to a macro
[LibreOffice.git] / sc / source / ui / vba / vbasheetobject.cxx
blob469e67027d6c7e7e962dda223dd78dd9b7028d4d
1 /* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
2 /*
3 * This file is part of the LibreOffice project.
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/.
9 * This file incorporates work covered by the following license notice:
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 .
20 #include "vbasheetobject.hxx"
21 #include <com/sun/star/awt/TextAlign.hpp>
22 #include <com/sun/star/beans/XPropertySet.hpp>
23 #include <com/sun/star/container/XIndexContainer.hpp>
24 #include <com/sun/star/drawing/XControlShape.hpp>
25 #include <com/sun/star/frame/XModel.hpp>
26 #include <com/sun/star/script/ScriptEventDescriptor.hpp>
27 #include <com/sun/star/script/XEventAttacherManager.hpp>
28 #include <com/sun/star/style/VerticalAlignment.hpp>
29 #include <comphelper/documentinfo.hxx>
30 #include <ooo/vba/excel/Constants.hpp>
31 #include <ooo/vba/excel/XlOrientation.hpp>
32 #include <ooo/vba/excel/XlPlacement.hpp>
33 #include <filter/msfilter/msvbahelper.hxx>
34 #include "vbafont.hxx"
36 using namespace ::com::sun::star;
37 using namespace ::ooo::vba;
39 constexpr OUStringLiteral gaListenerType = "XActionListener";
40 constexpr OUStringLiteral gaEventMethod = "actionPerformed";
43 ScVbaButtonCharacters::ScVbaButtonCharacters(
44 const uno::Reference< XHelperInterface >& rxParent,
45 const uno::Reference< uno::XComponentContext >& rxContext,
46 const uno::Reference< beans::XPropertySet >& rxPropSet,
47 const ScVbaPalette& rPalette,
48 const uno::Any& rStart,
49 const uno::Any& rLength ) :
50 ScVbaButtonCharacters_BASE( rxParent, rxContext ),
51 maPalette( rPalette ),
52 mxPropSet( rxPropSet, uno::UNO_SET_THROW )
54 // extract optional start parameter (missing or invalid -> from beginning)
55 if( !(rStart >>= mnStart) || (mnStart < 1) )
56 mnStart = 1;
57 --mnStart; // VBA is 1-based, rtl string is 0-based
59 // extract optional length parameter (missing or invalid -> to end)
60 if( !(rLength >>= mnLength) || (mnLength < 1) )
61 mnLength = SAL_MAX_INT32;
64 ScVbaButtonCharacters::~ScVbaButtonCharacters()
68 // XCharacters attributes
70 OUString SAL_CALL ScVbaButtonCharacters::getCaption()
72 // ignore invalid mnStart and/or mnLength members
73 OUString aString = getFullString();
74 sal_Int32 nStart = ::std::min( mnStart, aString.getLength() );
75 sal_Int32 nLength = ::std::min( mnLength, aString.getLength() - nStart );
76 return aString.copy( nStart, nLength );
79 void SAL_CALL ScVbaButtonCharacters::setCaption( const OUString& rCaption )
81 /* Replace the covered text with the passed text, ignore invalid mnStart
82 and/or mnLength members. This operation does not affect the mnLength
83 parameter. If the inserted text is longer than mnLength, the additional
84 characters are not covered by this object. If the inserted text is
85 shorter than mnLength, other uncovered characters from the original
86 string will be covered now, thus may be changed with subsequent
87 operations. */
88 OUString aString = getFullString();
89 sal_Int32 nStart = ::std::min( mnStart, aString.getLength() );
90 sal_Int32 nLength = ::std::min( mnLength, aString.getLength() - nStart );
91 setFullString( aString.replaceAt( nStart, nLength, rCaption ) );
94 sal_Int32 SAL_CALL ScVbaButtonCharacters::getCount()
96 // always return the total length of the caption
97 return getFullString().getLength();
100 OUString SAL_CALL ScVbaButtonCharacters::getText()
102 // Text attribute same as Caption attribute?
103 return getCaption();
106 void SAL_CALL ScVbaButtonCharacters::setText( const OUString& rText )
108 // Text attribute same as Caption attribute?
109 setCaption( rText );
112 uno::Reference< excel::XFont > SAL_CALL ScVbaButtonCharacters::getFont()
114 return new ScVbaFont( this, mxContext, maPalette, mxPropSet, nullptr, true );
117 void SAL_CALL ScVbaButtonCharacters::setFont( const uno::Reference< excel::XFont >& /*rxFont*/ )
119 // TODO
122 // XCharacters methods
124 void SAL_CALL ScVbaButtonCharacters::Insert( const OUString& rString )
126 /* The Insert() operation is in fact "replace covered characters", at
127 least for buttons... It seems there is no easy way to really insert a
128 substring. This operation does not affect the mnLength parameter. */
129 setCaption( rString );
132 void SAL_CALL ScVbaButtonCharacters::Delete()
134 /* The Delete() operation is nothing else than "replace with empty string".
135 This does not affect the mnLength parameter, multiple calls of Delete()
136 will remove characters as long as there are some more covered by this
137 object. */
138 setCaption( OUString() );
141 // XHelperInterface
143 VBAHELPER_IMPL_XHELPERINTERFACE( ScVbaButtonCharacters, "ooo.vba.excel.Characters" )
145 // private
147 OUString ScVbaButtonCharacters::getFullString() const
149 return mxPropSet->getPropertyValue( "Label" ).get< OUString >();
152 void ScVbaButtonCharacters::setFullString( const OUString& rString )
154 mxPropSet->setPropertyValue( "Label", uno::Any( rString ) );
157 ScVbaSheetObjectBase::ScVbaSheetObjectBase(
158 const uno::Reference< XHelperInterface >& rxParent,
159 const uno::Reference< uno::XComponentContext >& rxContext,
160 const uno::Reference< frame::XModel >& rxModel,
161 const uno::Reference< drawing::XShape >& rxShape ) :
162 ScVbaSheetObject_BASE( rxParent, rxContext ),
163 maPalette( rxModel ),
164 mxModel( rxModel, uno::UNO_SET_THROW ),
165 mxShape( rxShape, uno::UNO_SET_THROW ),
166 mxShapeProps( rxShape, uno::UNO_QUERY_THROW )
170 // XSheetObject attributes
172 double SAL_CALL ScVbaSheetObjectBase::getLeft()
174 return HmmToPoints( mxShape->getPosition().X );
177 void SAL_CALL ScVbaSheetObjectBase::setLeft( double fLeft )
179 if( fLeft < 0.0 )
180 throw uno::RuntimeException();
181 mxShape->setPosition( awt::Point( PointsToHmm( fLeft ), mxShape->getPosition().Y ) );
184 double SAL_CALL ScVbaSheetObjectBase::getTop()
186 return HmmToPoints( mxShape->getPosition().Y );
189 void SAL_CALL ScVbaSheetObjectBase::setTop( double fTop )
191 if( fTop < 0.0 )
192 throw uno::RuntimeException();
193 mxShape->setPosition( awt::Point( mxShape->getPosition().X, PointsToHmm( fTop ) ) );
196 double SAL_CALL ScVbaSheetObjectBase::getWidth()
198 return HmmToPoints( mxShape->getSize().Width );
201 void SAL_CALL ScVbaSheetObjectBase::setWidth( double fWidth )
203 if( fWidth <= 0.0 )
204 throw uno::RuntimeException();
205 mxShape->setSize( awt::Size( PointsToHmm( fWidth ), mxShape->getSize().Height ) );
208 double SAL_CALL ScVbaSheetObjectBase::getHeight()
210 return HmmToPoints( mxShape->getSize().Height );
213 void SAL_CALL ScVbaSheetObjectBase::setHeight( double fHeight )
215 if( fHeight <= 0.0 )
216 throw uno::RuntimeException();
217 mxShape->setSize( awt::Size( mxShape->getSize().Width, PointsToHmm( fHeight ) ) );
220 OUString SAL_CALL ScVbaSheetObjectBase::getName()
222 return mxShapeProps->getPropertyValue( "Name" ).get< OUString >();
225 void SAL_CALL ScVbaSheetObjectBase::setName( const OUString& rName )
227 mxShapeProps->setPropertyValue( "Name", uno::Any( rName ) );
230 sal_Int32 SAL_CALL ScVbaSheetObjectBase::getPlacement()
232 sal_Int32 const nRet = excel::XlPlacement::xlMoveAndSize;
233 #if 0 // TODO: not working at the moment.
234 SvxShape* pShape = comphelper::getUnoTunnelImplementation<SvxShape>( mxShape );
235 if(pShape)
237 SdrObject* pObj = pShape->GetSdrObject();
238 if (pObj)
240 ScAnchorType eType = ScDrawLayer::GetAnchor(pObj);
241 if (eType == SCA_PAGE)
242 nRet = excel::XlPlacement::xlFreeFloating;
245 #endif
246 return nRet;
249 void SAL_CALL ScVbaSheetObjectBase::setPlacement( sal_Int32 /*nPlacement*/ )
251 #if 0 // TODO: not working at the moment.
252 SvxShape* pShape = comphelper::getUnoTunnelImplementation<SvxShape>( mxShape );
253 if(pShape)
255 SdrObject* pObj = pShape->GetSdrObject();
256 if (pObj)
258 ScAnchorType eType = SCA_CELL;
259 if ( nPlacement == excel::XlPlacement::xlFreeFloating )
260 eType = SCA_PAGE;
262 // xlMove is not supported, treated as SCA_CELL (xlMoveAndSize)
264 ScDrawLayer::SetAnchor(pObj, eType);
267 #endif
270 sal_Bool SAL_CALL ScVbaSheetObjectBase::getPrintObject()
272 // not supported
273 return true;
276 void SAL_CALL ScVbaSheetObjectBase::setPrintObject( sal_Bool /*bPrintObject*/ )
278 // not supported
281 // private
283 void ScVbaSheetObjectBase::setDefaultProperties( sal_Int32 nIndex )
285 OUString aName = implGetBaseName() + OUStringLiteral1(' ') + OUString::number( nIndex + 1 );
286 setName( aName );
287 implSetDefaultProperties();
290 void ScVbaSheetObjectBase::implSetDefaultProperties()
294 ScVbaControlObjectBase::ScVbaControlObjectBase(
295 const uno::Reference< XHelperInterface >& rxParent,
296 const uno::Reference< uno::XComponentContext >& rxContext,
297 const uno::Reference< frame::XModel >& rxModel,
298 const uno::Reference< container::XIndexContainer >& rxFormIC,
299 const uno::Reference< drawing::XControlShape >& rxControlShape ) :
300 ScVbaControlObject_BASE( rxParent, rxContext, rxModel, uno::Reference< drawing::XShape >( rxControlShape, uno::UNO_QUERY_THROW ) ),
301 mxFormIC( rxFormIC, uno::UNO_SET_THROW ),
302 mxControlProps( rxControlShape->getControl(), uno::UNO_QUERY_THROW ),
303 mbNotifyMacroEventRead(false)
307 // XSheetObject attributes
309 OUString SAL_CALL ScVbaControlObjectBase::getName()
311 return mxControlProps->getPropertyValue( "Name" ).get< OUString >();
314 void SAL_CALL ScVbaControlObjectBase::setName( const OUString& rName )
316 mxControlProps->setPropertyValue( "Name", uno::Any( rName ) );
319 OUString SAL_CALL ScVbaControlObjectBase::getOnAction()
321 uno::Reference< script::XEventAttacherManager > xEventMgr( mxFormIC, uno::UNO_QUERY_THROW );
322 sal_Int32 nIndex = getModelIndexInForm();
323 const uno::Sequence< script::ScriptEventDescriptor > aEvents = xEventMgr->getScriptEvents( nIndex );
324 if( aEvents.hasElements() )
326 const OUString aScriptType = "Script";
327 const script::ScriptEventDescriptor* pEvent = std::find_if(aEvents.begin(), aEvents.end(),
328 [&aScriptType](const script::ScriptEventDescriptor& rEvent) {
329 return (rEvent.ListenerType == gaListenerType)
330 && (rEvent.EventMethod == gaEventMethod)
331 && (rEvent.ScriptType == aScriptType);
333 if (pEvent != aEvents.end())
334 return extractMacroName( pEvent->ScriptCode );
336 return OUString();
339 void ScVbaControlObjectBase::NotifyMacroEventRead()
341 if (mbNotifyMacroEventRead)
342 return;
343 comphelper::DocumentInfo::notifyMacroEventRead(mxModel);
344 mbNotifyMacroEventRead = true;
347 void SAL_CALL ScVbaControlObjectBase::setOnAction( const OUString& rMacroName )
349 uno::Reference< script::XEventAttacherManager > xEventMgr( mxFormIC, uno::UNO_QUERY_THROW );
350 sal_Int32 nIndex = getModelIndexInForm();
352 // first, remove a registered event (try/catch just in case implementation throws)
353 try { xEventMgr->revokeScriptEvent( nIndex, gaListenerType, gaEventMethod, OUString() ); } catch( uno::Exception& ) {}
355 // if a macro name has been passed, try to attach it to the event
356 if( !rMacroName.isEmpty() )
358 MacroResolvedInfo aResolvedMacro = resolveVBAMacro( getSfxObjShell( mxModel ), rMacroName );
359 if( !aResolvedMacro.mbFound )
360 throw uno::RuntimeException();
361 script::ScriptEventDescriptor aDescriptor;
362 aDescriptor.ListenerType = gaListenerType;
363 aDescriptor.EventMethod = gaEventMethod;
364 aDescriptor.ScriptType = "Script";
365 aDescriptor.ScriptCode = makeMacroURL( aResolvedMacro.msResolvedMacro );
366 NotifyMacroEventRead();
367 xEventMgr->registerScriptEvent( nIndex, aDescriptor );
371 sal_Bool SAL_CALL ScVbaControlObjectBase::getPrintObject()
373 return mxControlProps->getPropertyValue( "Printable" ).get<bool>();
376 void SAL_CALL ScVbaControlObjectBase::setPrintObject( sal_Bool bPrintObject )
378 mxControlProps->setPropertyValue( "Printable", uno::Any( bPrintObject ) );
381 // XControlObject attributes
383 sal_Bool SAL_CALL ScVbaControlObjectBase::getAutoSize()
385 // not supported
386 return false;
389 void SAL_CALL ScVbaControlObjectBase::setAutoSize( sal_Bool /*bAutoSize*/ )
391 // not supported
394 // private
396 sal_Int32 ScVbaControlObjectBase::getModelIndexInForm() const
398 for( sal_Int32 nIndex = 0, nCount = mxFormIC->getCount(); nIndex < nCount; ++nIndex )
400 uno::Reference< beans::XPropertySet > xProps( mxFormIC->getByIndex( nIndex ), uno::UNO_QUERY_THROW );
401 if( mxControlProps.get() == xProps.get() )
402 return nIndex;
404 throw uno::RuntimeException();
407 ScVbaButton::ScVbaButton(
408 const uno::Reference< XHelperInterface >& rxParent,
409 const uno::Reference< uno::XComponentContext >& rxContext,
410 const uno::Reference< frame::XModel >& rxModel,
411 const uno::Reference< container::XIndexContainer >& rxFormIC,
412 const uno::Reference< drawing::XControlShape >& rxControlShape ) :
413 ScVbaButton_BASE( rxParent, rxContext, rxModel, rxFormIC, rxControlShape )
417 // XButton attributes
419 OUString SAL_CALL ScVbaButton::getCaption()
421 return mxControlProps->getPropertyValue( "Label" ).get< OUString >();
424 void SAL_CALL ScVbaButton::setCaption( const OUString& rCaption )
426 mxControlProps->setPropertyValue( "Label", uno::Any( rCaption ) );
429 uno::Reference< excel::XFont > SAL_CALL ScVbaButton::getFont()
431 return new ScVbaFont( this, mxContext, maPalette, mxControlProps, nullptr, true );
434 void SAL_CALL ScVbaButton::setFont( const uno::Reference< excel::XFont >& /*rxFont*/ )
436 // TODO
439 sal_Int32 SAL_CALL ScVbaButton::getHorizontalAlignment()
441 switch( mxControlProps->getPropertyValue( "Align" ).get< sal_Int16 >() )
443 case awt::TextAlign::LEFT: return excel::Constants::xlLeft;
444 case awt::TextAlign::RIGHT: return excel::Constants::xlRight;
445 case awt::TextAlign::CENTER: return excel::Constants::xlCenter;
447 return excel::Constants::xlCenter;
450 void SAL_CALL ScVbaButton::setHorizontalAlignment( sal_Int32 nAlign )
452 sal_Int32 nAwtAlign = awt::TextAlign::CENTER;
453 switch( nAlign )
455 case excel::Constants::xlLeft: nAwtAlign = awt::TextAlign::LEFT; break;
456 case excel::Constants::xlRight: nAwtAlign = awt::TextAlign::RIGHT; break;
457 case excel::Constants::xlCenter: nAwtAlign = awt::TextAlign::CENTER; break;
459 // form controls expect short value
460 mxControlProps->setPropertyValue( "Align", uno::Any( static_cast< sal_Int16 >( nAwtAlign ) ) );
463 sal_Int32 SAL_CALL ScVbaButton::getVerticalAlignment()
465 switch( mxControlProps->getPropertyValue( "VerticalAlign" ).get< style::VerticalAlignment >() )
467 case style::VerticalAlignment_TOP: return excel::Constants::xlTop;
468 case style::VerticalAlignment_BOTTOM: return excel::Constants::xlBottom;
469 case style::VerticalAlignment_MIDDLE: return excel::Constants::xlCenter;
470 default:;
472 return excel::Constants::xlCenter;
475 void SAL_CALL ScVbaButton::setVerticalAlignment( sal_Int32 nAlign )
477 style::VerticalAlignment eAwtAlign = style::VerticalAlignment_MIDDLE;
478 switch( nAlign )
480 case excel::Constants::xlTop: eAwtAlign = style::VerticalAlignment_TOP; break;
481 case excel::Constants::xlBottom: eAwtAlign = style::VerticalAlignment_BOTTOM; break;
482 case excel::Constants::xlCenter: eAwtAlign = style::VerticalAlignment_MIDDLE; break;
484 mxControlProps->setPropertyValue( "VerticalAlign", uno::Any( eAwtAlign ) );
487 sal_Int32 SAL_CALL ScVbaButton::getOrientation()
489 // not supported
490 return excel::XlOrientation::xlHorizontal;
493 void SAL_CALL ScVbaButton::setOrientation( sal_Int32 /*nOrientation*/ )
495 // not supported
498 uno::Any SAL_CALL ScVbaButton::getValue()
500 return mxControlProps->getPropertyValue( "State" );
503 void SAL_CALL ScVbaButton::setValue( const uno::Any &nValue )
505 return mxControlProps->setPropertyValue( "State", nValue );
508 OUString SAL_CALL ScVbaButton::getText()
510 return mxControlProps->getPropertyValue( "Label" ).get< OUString >();
513 void SAL_CALL ScVbaButton::setText( const OUString &aText )
515 return mxControlProps->setPropertyValue( "Label", uno::Any( aText ) );
518 // XButton methods
520 uno::Reference< excel::XCharacters > SAL_CALL ScVbaButton::Characters( const uno::Any& rStart, const uno::Any& rLength )
522 return new ScVbaButtonCharacters( this, mxContext, mxControlProps, maPalette, rStart, rLength );
525 // XHelperInterface
527 VBAHELPER_IMPL_XHELPERINTERFACE( ScVbaButton, "ooo.vba.excel.Button" )
529 // private
531 OUString ScVbaButton::implGetBaseName() const
533 return "Button";
536 void ScVbaButton::implSetDefaultProperties()
538 setCaption( getName() );
541 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */