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 "vbaformat.hxx"
24 #include <ooo/vba/excel/XStyle.hpp>
25 #include <ooo/vba/excel/XlVAlign.hpp>
26 #include <ooo/vba/excel/XlHAlign.hpp>
27 #include <ooo/vba/excel/XlOrientation.hpp>
28 #include <ooo/vba/excel/Constants.hpp>
29 #include <ooo/vba/excel/XRange.hpp>
30 #include <com/sun/star/table/CellVertJustify.hpp>
31 #include <com/sun/star/table/CellHoriJustify.hpp>
32 #include <com/sun/star/table/CellOrientation.hpp>
33 #include <com/sun/star/table/XCellRange.hpp>
34 #include <com/sun/star/text/WritingMode.hpp>
35 #include <com/sun/star/util/CellProtection.hpp>
36
37 #include <rtl/math.hxx>
38
39 #include "excelvbahelper.hxx"
40 #include "vbaborders.hxx"
41 #include "vbapalette.hxx"
42 #include "vbafont.hxx"
43 #include "vbainterior.hxx"
44
45 #include <unonames.hxx>
46 #include <cellsuno.hxx>
47 #include <scitems.hxx>
48 #include <attrib.hxx>
49
50 using namespace ::ooo::vba;
51 using namespace ::com::sun::star;
52
53 #define FORMATSTRING "FormatString"
54 #define LOCALE "Locale"
55
56 template< typename Ifc1 >
ScVbaFormat(const uno::Reference<XHelperInterface> & xParent,const uno::Reference<uno::XComponentContext> & xContext,const uno::Reference<beans::XPropertySet> & _xPropertySet,const uno::Reference<frame::XModel> & xModel,bool bCheckAmbiguoity)57 ScVbaFormat< Ifc1 >::ScVbaFormat( const uno::Reference< XHelperInterface >& xParent, const uno::Reference< uno::XComponentContext > & xContext, const uno::Reference< beans::XPropertySet >& _xPropertySet, const uno::Reference< frame::XModel >& xModel, bool bCheckAmbiguoity ) throw ( script::BasicErrorException ) : ScVbaFormat_BASE( xParent, xContext ), m_aDefaultLocale( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("en") ), rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "US") ), rtl::OUString() ), mxPropertySet( _xPropertySet ), mxModel( xModel ), mbCheckAmbiguoity( bCheckAmbiguoity ), mbAddIndent( sal_False )
58 {
59 try
60 {
61 if ( !mxModel.is() )
62 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "XModel Interface could not be retrieved") ) );
63 // mxServiceInfo is unused,
64 // mxNumberFormatsSupplier is initialized when needed in initializeNumberFormats.
65 }
66 catch (uno::Exception& )
67 {
68 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
69 }
70 }
71
72 template< typename Ifc1 >
73 void SAL_CALL
setVerticalAlignment(const uno::Any & _oAlignment)74 ScVbaFormat<Ifc1>::setVerticalAlignment( const uno::Any& _oAlignment) throw (script::BasicErrorException, uno::RuntimeException)
75 {
76 try
77 {
78 uno::Any aVal;
79 sal_Int32 nAlignment = 0;
80 if ( !(_oAlignment >>= nAlignment ))
81 throw uno::RuntimeException();
82 switch (nAlignment)
83 {
84 case excel::XlVAlign::xlVAlignBottom :
85 aVal = uno::makeAny( table::CellVertJustify_BOTTOM );
86 break;
87 case excel::XlVAlign::xlVAlignCenter :
88 aVal = uno::makeAny( table::CellVertJustify_CENTER );
89 break;
90 case excel::XlVAlign::xlVAlignDistributed:
91 case excel::XlVAlign::xlVAlignJustify:
92 aVal = uno::makeAny( table::CellVertJustify_STANDARD );
93 break;
94
95 case excel::XlVAlign::xlVAlignTop:
96 aVal = uno::makeAny( table::CellVertJustify_TOP);
97 break;
98 default:
99 aVal = uno::makeAny( table::CellVertJustify_STANDARD );
100 break;
101 }
102 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLVJUS ) ), aVal );
103 }
104 catch (uno::Exception& )
105 {
106 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
107 }
108 }
109
110 template< typename Ifc1 >
111 uno::Any SAL_CALL
getVerticalAlignment()112 ScVbaFormat<Ifc1>::getVerticalAlignment( ) throw (script::BasicErrorException, uno::RuntimeException)
113 {
114 uno::Any aResult = aNULL();
115 try
116 {
117 if (!isAmbiguous( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLVJUS ) ) ) )
118 {
119 table::CellVertJustify aAPIAlignment;
120 mxPropertySet->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLVJUS ) ) ) >>= aAPIAlignment;
121 switch( aAPIAlignment )
122 {
123 case table::CellVertJustify_BOTTOM:
124 aResult = uno::makeAny( excel::XlVAlign::xlVAlignBottom );
125 break;
126 case table::CellVertJustify_CENTER:
127 aResult = uno::makeAny( excel::XlVAlign::xlVAlignCenter );
128 break;
129 case table::CellVertJustify_STANDARD:
130 aResult = uno::makeAny( excel::XlVAlign::xlVAlignBottom );
131 break;
132 case table::CellVertJustify_TOP:
133 aResult = uno::makeAny( excel::XlVAlign::xlVAlignTop );
134 break;
135 default:
136 break;
137 }
138 }
139 }
140 catch (uno::Exception& )
141 {
142 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
143 }
144 return aResult;
145 }
146
147 template< typename Ifc1 >
148 void SAL_CALL
setHorizontalAlignment(const uno::Any & HorizontalAlignment)149 ScVbaFormat<Ifc1>::setHorizontalAlignment( const uno::Any& HorizontalAlignment ) throw (script::BasicErrorException, uno::RuntimeException)
150 {
151 try
152 {
153 uno::Any aVal;
154 sal_Int32 nAlignment = 0;
155 if ( !( HorizontalAlignment >>= nAlignment ) )
156 throw uno::RuntimeException();
157 switch ( nAlignment )
158 {
159 case excel::XlHAlign::xlHAlignJustify:
160 aVal = uno::makeAny( table::CellHoriJustify_BLOCK);
161 break;
162 case excel::XlHAlign::xlHAlignCenter:
163 aVal = uno::makeAny( table::CellHoriJustify_CENTER );
164 break;
165 case excel::XlHAlign::xlHAlignDistributed:
166 aVal = uno::makeAny( table::CellHoriJustify_BLOCK);
167 break;
168 case excel::XlHAlign::xlHAlignLeft:
169 aVal = uno::makeAny( table::CellHoriJustify_LEFT);
170 break;
171 case excel::XlHAlign::xlHAlignRight:
172 aVal = uno::makeAny( table::CellHoriJustify_RIGHT);
173 break;
174 }
175 // #FIXME what about the default case above?
176 // shouldn't need the test below
177 if ( aVal.hasValue() )
178 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLHJUS ) ), aVal );
179 }
180 catch (uno::Exception& )
181 {
182 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
183 }
184
185 }
186
187 template< typename Ifc1 >
188 uno::Any SAL_CALL
getHorizontalAlignment()189 ScVbaFormat<Ifc1>::getHorizontalAlignment( ) throw (script::BasicErrorException, uno::RuntimeException)
190 {
191 uno::Any NRetAlignment = aNULL();
192 try
193 {
194 rtl::OUString sHoriJust( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLHJUS ) );
195 if (!isAmbiguous(sHoriJust))
196 {
197 table::CellHoriJustify aAPIAlignment = table::CellHoriJustify_BLOCK;
198
199 if ( mxPropertySet->getPropertyValue(sHoriJust) >>= aAPIAlignment )
200 {
201 switch( aAPIAlignment )
202 {
203 case table::CellHoriJustify_BLOCK:
204 NRetAlignment = uno::makeAny( excel::XlHAlign::xlHAlignJustify );
205 break;
206 case table::CellHoriJustify_CENTER:
207 NRetAlignment = uno::makeAny( excel::XlHAlign::xlHAlignCenter );
208 break;
209 case table::CellHoriJustify_LEFT:
210 NRetAlignment = uno::makeAny( excel::XlHAlign::xlHAlignLeft );
211 break;
212 case table::CellHoriJustify_RIGHT:
213 NRetAlignment = uno::makeAny( excel::XlHAlign::xlHAlignRight );
214 break;
215 default: // handle those other cases with a NULL return
216 break;
217 }
218 }
219 }
220 }
221 catch (uno::Exception& )
222 {
223 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
224 }
225 return NRetAlignment;
226 }
227
228 template< typename Ifc1 >
229 void SAL_CALL
setOrientation(const uno::Any & _aOrientation)230 ScVbaFormat<Ifc1>::setOrientation( const uno::Any& _aOrientation ) throw (script::BasicErrorException, uno::RuntimeException)
231 {
232 try
233 {
234 sal_Int32 nOrientation = 0;
235 if ( !( _aOrientation >>= nOrientation ) )
236 throw uno::RuntimeException();
237 uno::Any aVal;
238 switch( nOrientation )
239 {
240 case excel::XlOrientation::xlDownward:
241 aVal = uno::makeAny( table::CellOrientation_TOPBOTTOM);
242 break;
243 case excel::XlOrientation::xlHorizontal:
244 aVal = uno::makeAny( table::CellOrientation_STANDARD );
245 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_ROTANG ) ), uno::makeAny( sal_Int32(0) ) );
246 break;
247 case excel::XlOrientation::xlUpward:
248 aVal = uno::makeAny( table::CellOrientation_BOTTOMTOP);
249 break;
250 case excel::XlOrientation::xlVertical:
251 aVal = uno::makeAny( table::CellOrientation_STACKED);
252 break;
253 }
254 // #FIXME what about the default case above?
255 // shouldn't need the test below
256 if ( aVal.hasValue() )
257 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLORI ) ), aVal );
258
259 }
260 catch (uno::Exception& )
261 {
262 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
263 }
264 }
265 template< typename Ifc1 >
266 uno::Any SAL_CALL
getOrientation()267 ScVbaFormat<Ifc1>::getOrientation( ) throw (script::BasicErrorException, uno::RuntimeException)
268 {
269 uno::Any NRetOrientation = aNULL();
270 try
271 {
272 if (!isAmbiguous(rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLORI ) )))
273 {
274 table::CellOrientation aOrientation = table::CellOrientation_STANDARD;
275 if ( !( mxPropertySet->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLORI ) ) ) >>= aOrientation ) )
276 throw uno::RuntimeException();
277
278 switch(aOrientation)
279 {
280 case table::CellOrientation_STANDARD:
281 NRetOrientation = uno::makeAny( excel::XlOrientation::xlHorizontal );
282 break;
283 case table::CellOrientation_BOTTOMTOP:
284 NRetOrientation = uno::makeAny( excel::XlOrientation::xlUpward );
285 break;
286 case table::CellOrientation_TOPBOTTOM:
287 NRetOrientation = uno::makeAny( excel::XlOrientation::xlDownward );
288 break;
289 case table::CellOrientation_STACKED:
290 NRetOrientation = uno::makeAny( excel::XlOrientation::xlVertical );
291 break;
292 default:
293 NRetOrientation = uno::makeAny( excel::XlOrientation::xlHorizontal );
294 }
295 }
296 }
297 catch (uno::Exception& )
298 {
299 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
300 }
301 return NRetOrientation;
302 }
303
304 template< typename Ifc1 >
305 void SAL_CALL
setWrapText(const uno::Any & _aWrapText)306 ScVbaFormat<Ifc1>::setWrapText( const uno::Any& _aWrapText ) throw (script::BasicErrorException, uno::RuntimeException)
307 {
308 try
309 {
310 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_WRAP ) ), _aWrapText);
311 }
312 catch (uno::Exception& )
313 {
314 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
315 }
316 }
317
318 template< typename Ifc1 >
319 uno::Any SAL_CALL
getWrapText()320 ScVbaFormat<Ifc1>::getWrapText( ) throw (script::BasicErrorException, uno::RuntimeException)
321 {
322 uno::Any aWrap = aNULL();
323 try
324 {
325 rtl::OUString aPropName( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_WRAP ) ) );
326 if (!isAmbiguous( aPropName ))
327 {
328 aWrap = mxPropertySet->getPropertyValue(aPropName);
329 }
330 }
331 catch (uno::Exception& )
332 {
333 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
334 }
335 return aWrap;
336 }
337
338 template< typename Ifc1 >
339 uno::Any SAL_CALL
Borders(const uno::Any & Index)340 ScVbaFormat<Ifc1>::Borders( const uno::Any& Index ) throw (script::BasicErrorException, uno::RuntimeException )
341 {
342 ScVbaPalette aPalette( excel::getDocShell( mxModel ) );
343 uno::Reference< XCollection > xColl = new ScVbaBorders( thisHelperIface(), ScVbaFormat_BASE::mxContext, uno::Reference< table::XCellRange >( mxPropertySet, uno::UNO_QUERY_THROW ), aPalette );
344
345 if ( Index.hasValue() )
346 {
347 return xColl->Item( Index, uno::Any() );
348 }
349 return uno::makeAny( xColl );
350 }
351
352 template< typename Ifc1 >
353 uno::Reference< excel::XFont > SAL_CALL
Font()354 ScVbaFormat<Ifc1>::Font( ) throw (script::BasicErrorException, uno::RuntimeException)
355 {
356 ScVbaPalette aPalette( excel::getDocShell( mxModel ) );
357 return new ScVbaFont( thisHelperIface(), ScVbaFormat_BASE::mxContext, aPalette, mxPropertySet );
358 }
359
360 template< typename Ifc1 >
361 uno::Reference< excel::XInterior > SAL_CALL
Interior()362 ScVbaFormat<Ifc1>::Interior( ) throw (script::BasicErrorException, uno::RuntimeException)
363 {
364 return new ScVbaInterior( thisHelperIface(), ScVbaFormat_BASE::mxContext, mxPropertySet );
365 }
366
367 template< typename Ifc1 >
368 uno::Any SAL_CALL
getNumberFormatLocal()369 ScVbaFormat<Ifc1>::getNumberFormatLocal( ) throw (script::BasicErrorException, uno::RuntimeException)
370 {
371 uno::Any aRet = uno::makeAny( rtl::OUString() );
372 try
373 {
374 rtl::OUString sPropName( RTL_CONSTASCII_USTRINGPARAM( SC_UNO_NUMBERFO ) );
375 if (!isAmbiguous( sPropName ))
376 {
377
378 initializeNumberFormats();
379
380 sal_Int32 nFormat = 0;
381 if ( ! (mxPropertySet->getPropertyValue( sPropName ) >>= nFormat ) )
382 throw uno::RuntimeException();
383
384 rtl::OUString sFormat;
385 xNumberFormats->getByKey(nFormat)->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( FORMATSTRING ))) >>= sFormat;
386 aRet = uno::makeAny( sFormat.toAsciiLowerCase() );
387
388 }
389 }
390 catch (uno::Exception& )
391 {
392 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
393 }
394 return aRet;
395
396 }
397
398 template< typename Ifc1 >
399 void
setNumberFormat(lang::Locale _aLocale,const rtl::OUString & _sFormatString)400 ScVbaFormat<Ifc1>::setNumberFormat( lang::Locale _aLocale, const rtl::OUString& _sFormatString) throw( script::BasicErrorException )
401 {
402 try
403 {
404 initializeNumberFormats();
405 sal_Int32 nFormat = xNumberFormats->queryKey(_sFormatString, _aLocale , sal_True);
406 if (nFormat == -1)
407 {
408 xNumberFormats->addNew(_sFormatString, _aLocale);
409 }
410 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNO_NUMBERFO ) ), uno::makeAny( nFormat ) );
411 }
412 catch (uno::Exception& )
413 {
414 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
415 }
416 }
417
418 template< typename Ifc1 >
419 void SAL_CALL
setNumberFormatLocal(const uno::Any & _oLocalFormatString)420 ScVbaFormat<Ifc1>::setNumberFormatLocal( const uno::Any& _oLocalFormatString ) throw (script::BasicErrorException, uno::RuntimeException)
421 {
422 try
423 {
424 rtl::OUString sLocalFormatString;
425 sal_Int32 nFormat = -1;
426 rtl::OUString sNumFormat( RTL_CONSTASCII_USTRINGPARAM( SC_UNO_NUMBERFO ) );
427 if ( !(_oLocalFormatString >>= sLocalFormatString )
428 || !( mxPropertySet->getPropertyValue(sNumFormat) >>= nFormat ) )
429 throw uno::RuntimeException();
430
431 sLocalFormatString = sLocalFormatString.toAsciiUpperCase();
432 initializeNumberFormats();
433 lang::Locale aRangeLocale;
434 xNumberFormats->getByKey(nFormat)->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( LOCALE ) ) ) >>= aRangeLocale;
435 sal_Int32 nNewFormat = xNumberFormats->queryKey(sLocalFormatString, aRangeLocale, sal_True);
436
437 if (nNewFormat == -1)
438 nNewFormat = xNumberFormats->addNew(sLocalFormatString, aRangeLocale);
439 mxPropertySet->setPropertyValue(sNumFormat, uno::makeAny( nNewFormat ));
440 }
441 catch (uno::Exception& )
442 {
443 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
444 }
445 }
446
447 template< typename Ifc1 >
448 void SAL_CALL
setNumberFormat(const uno::Any & _oFormatString)449 ScVbaFormat<Ifc1>::setNumberFormat( const uno::Any& _oFormatString ) throw (script::BasicErrorException, uno::RuntimeException)
450 {
451 try
452 {
453 rtl::OUString sFormatString;
454 if ( !( _oFormatString >>= sFormatString ) )
455 throw uno::RuntimeException();
456
457 sFormatString = sFormatString.toAsciiUpperCase();
458
459 lang::Locale aDefaultLocale = m_aDefaultLocale;
460 initializeNumberFormats();
461 sal_Int32 nFormat = xNumberFormats->queryKey(sFormatString, aDefaultLocale, sal_True);
462
463 if (nFormat == -1)
464 nFormat = xNumberFormats->addNew(sFormatString, aDefaultLocale);
465
466 lang::Locale aRangeLocale;
467 xNumberFormats->getByKey(nFormat)->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( LOCALE ) ) ) >>= aRangeLocale;
468 sal_Int32 nNewFormat = xNumberFormatTypes->getFormatForLocale(nFormat, aRangeLocale);
469 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNO_NUMBERFO ) ), uno::makeAny( nNewFormat));
470 }
471 catch (uno::Exception& )
472 {
473 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
474 }
475
476 }
477
478 template< typename Ifc1 >
479 void SAL_CALL
setIndentLevel(const uno::Any & _aLevel)480 ScVbaFormat<Ifc1>::setIndentLevel( const uno::Any& _aLevel ) throw (script::BasicErrorException, uno::RuntimeException)
481 {
482 try
483 {
484 sal_Int32 nLevel = 0;
485 if ( !(_aLevel >>= nLevel ) )
486 throw uno::RuntimeException();
487 table::CellHoriJustify aAPIAlignment = table::CellHoriJustify_STANDARD;
488
489 rtl::OUString sHoriJust( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLHJUS ) );
490 if ( !( mxPropertySet->getPropertyValue(sHoriJust) >>= aAPIAlignment ) )
491 throw uno::RuntimeException();
492 if (aAPIAlignment == table::CellHoriJustify_STANDARD)
493 mxPropertySet->setPropertyValue( sHoriJust, uno::makeAny( table::CellHoriJustify_LEFT) ) ;
494 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_PINDENT ) ), uno::makeAny( sal_Int16(nLevel * 352.8) ) );
495 }
496 catch (uno::Exception& )
497 {
498 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
499 }
500 }
501
502 template< typename Ifc1 >
503 uno::Any SAL_CALL
getIndentLevel()504 ScVbaFormat<Ifc1>::getIndentLevel( ) throw (script::BasicErrorException, uno::RuntimeException)
505 {
506 uno::Any NRetIndentLevel = aNULL();
507 try
508 {
509 rtl::OUString sParaIndent( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_PINDENT ) );
510 if (!isAmbiguous(sParaIndent))
511 {
512 sal_Int16 IndentLevel = 0;
513 if ( ( mxPropertySet->getPropertyValue(sParaIndent) >>= IndentLevel ) )
514 NRetIndentLevel = uno::makeAny( sal_Int32( rtl::math::round(static_cast<double>( IndentLevel ) / 352.8)) );
515 else
516 NRetIndentLevel = uno::makeAny( sal_Int32(0) );
517 }
518 }
519 catch (uno::Exception& )
520 {
521 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
522 }
523 return NRetIndentLevel;
524 }
525
526 template< typename Ifc1 >
527 void SAL_CALL
setLocked(const uno::Any & _aLocked)528 ScVbaFormat<Ifc1>::setLocked( const uno::Any& _aLocked ) throw (script::BasicErrorException, uno::RuntimeException)
529 {
530 try
531 {
532 sal_Bool bIsLocked = sal_False;
533 if ( !( _aLocked >>= bIsLocked ) )
534 throw uno::RuntimeException();
535 util::CellProtection aCellProtection;
536 rtl::OUString sCellProt( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLPRO ) );
537 mxPropertySet->getPropertyValue(sCellProt) >>= aCellProtection;
538 aCellProtection.IsLocked = bIsLocked;
539 mxPropertySet->setPropertyValue(sCellProt, uno::makeAny( aCellProtection ) );
540 }
541 catch (uno::Exception& )
542 {
543 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString() );
544 }
545 }
546
547 template< typename Ifc1 >
548 void SAL_CALL
setFormulaHidden(const uno::Any & FormulaHidden)549 ScVbaFormat<Ifc1>::setFormulaHidden( const uno::Any& FormulaHidden ) throw (script::BasicErrorException, uno::RuntimeException)
550 {
551 try
552 {
553 sal_Bool bIsFormulaHidden = sal_False;
554 FormulaHidden >>= bIsFormulaHidden;
555 util::CellProtection aCellProtection;
556 rtl::OUString sCellProt( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLPRO ) );
557 mxPropertySet->getPropertyValue(sCellProt) >>= aCellProtection;
558 aCellProtection.IsFormulaHidden = bIsFormulaHidden;
559 mxPropertySet->setPropertyValue(sCellProt,uno::makeAny(aCellProtection));
560 }
561 catch (uno::Exception& )
562 {
563 DebugHelper::exception( SbERR_METHOD_FAILED, rtl::OUString() );
564 }
565 }
566
567 template< typename Ifc1 >
568 uno::Any SAL_CALL
getLocked()569 ScVbaFormat<Ifc1>::getLocked( ) throw (script::BasicErrorException, uno::RuntimeException)
570 {
571 uno::Any aCellProtection = aNULL();
572 try
573 {
574 rtl::OUString sCellProt( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLPRO ) );
575
576 if (!isAmbiguous(sCellProt))
577 {
578 SfxItemSet* pDataSet = getCurrentDataSet();
579 if ( pDataSet )
580 {
581 const ScProtectionAttr& rProtAttr = (const ScProtectionAttr &) pDataSet->Get(ATTR_PROTECTION, sal_True);
582 SfxItemState eState = pDataSet->GetItemState(ATTR_PROTECTION, sal_True, NULL);
583 if(eState != SFX_ITEM_DONTCARE)
584 aCellProtection = uno::makeAny(rProtAttr.GetProtection());
585 }
586 else // fallback to propertyset
587 {
588 util::CellProtection cellProtection;
589 mxPropertySet->getPropertyValue(sCellProt) >>= aCellProtection;
590 aCellProtection = uno::makeAny( cellProtection.IsLocked );
591 }
592 }
593 }
594 catch (uno::Exception& )
595 {
596 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
597 }
598 return aCellProtection;
599 }
600
601 template< typename Ifc1 >
602 uno::Any SAL_CALL
getFormulaHidden()603 ScVbaFormat<Ifc1>::getFormulaHidden( ) throw (script::BasicErrorException, uno::RuntimeException)
604 {
605 uno::Any aBoolRet = aNULL();
606 try
607 {
608 rtl::OUString sCellProt( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_CELLPRO ) );
609 if (!isAmbiguous(sCellProt))
610 {
611 SfxItemSet* pDataSet = getCurrentDataSet();
612 if ( pDataSet )
613 {
614 const ScProtectionAttr& rProtAttr = (const ScProtectionAttr &) pDataSet->Get(ATTR_PROTECTION, sal_True);
615 SfxItemState eState = pDataSet->GetItemState(ATTR_PROTECTION, sal_True, NULL);
616 if(eState != SFX_ITEM_DONTCARE)
617 aBoolRet = uno::makeAny(rProtAttr.GetHideFormula());
618 }
619 else
620 {
621 util::CellProtection aCellProtection;
622 mxPropertySet->getPropertyValue(sCellProt) >>= aCellProtection;
623 aBoolRet = uno::makeAny( aCellProtection.IsFormulaHidden );
624 }
625 }
626 }
627 catch (uno::Exception e)
628 {
629 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
630 }
631 return aBoolRet;
632 }
633
634 template< typename Ifc1 >
635 void SAL_CALL
setShrinkToFit(const uno::Any & ShrinkToFit)636 ScVbaFormat<Ifc1>::setShrinkToFit( const uno::Any& ShrinkToFit ) throw (script::BasicErrorException, uno::RuntimeException)
637 {
638 try
639 {
640 mxPropertySet->setPropertyValue(rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_SHRINK_TO_FIT ) ), ShrinkToFit);
641 }
642 catch (uno::Exception& )
643 {
644 DebugHelper::exception(SbERR_NOT_IMPLEMENTED, rtl::OUString() );
645 }
646
647 }
648
649 template< typename Ifc1 >
650 uno::Any SAL_CALL
getShrinkToFit()651 ScVbaFormat<Ifc1>::getShrinkToFit( ) throw (script::BasicErrorException, uno::RuntimeException)
652 {
653 uno::Any aRet = aNULL();
654 try
655 {
656 rtl::OUString sShrinkToFit( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_SHRINK_TO_FIT ) );
657 if (!isAmbiguous(sShrinkToFit))
658 aRet = mxPropertySet->getPropertyValue(sShrinkToFit);
659 }
660 catch (uno::Exception& )
661 {
662 DebugHelper::exception(SbERR_NOT_IMPLEMENTED, rtl::OUString());
663 }
664 return aRet;
665 }
666
667 template< typename Ifc1 >
668 void SAL_CALL
setReadingOrder(const uno::Any & ReadingOrder)669 ScVbaFormat<Ifc1>::setReadingOrder( const uno::Any& ReadingOrder ) throw (script::BasicErrorException, uno::RuntimeException)
670 {
671 try
672 {
673 sal_Int32 nReadingOrder = 0;
674 if ( !(ReadingOrder >>= nReadingOrder ))
675 throw uno::RuntimeException();
676 uno::Any aVal;
677 switch(nReadingOrder)
678 {
679 case excel::Constants::xlLTR:
680 aVal = uno::makeAny( text::WritingMode_LR_TB );
681 break;
682 case excel::Constants::xlRTL:
683 aVal = uno::makeAny( text::WritingMode_RL_TB );
684 break;
685 case excel::Constants::xlContext:
686 DebugHelper::exception(SbERR_NOT_IMPLEMENTED, rtl::OUString());
687 break;
688 default:
689 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
690 }
691 mxPropertySet->setPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_WRITING ) ), aVal );
692 }
693 catch (uno::Exception& )
694 {
695 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
696 }
697
698 }
699
700 template< typename Ifc1 >
701 uno::Any SAL_CALL
getReadingOrder()702 ScVbaFormat<Ifc1>::getReadingOrder( ) throw (script::BasicErrorException, uno::RuntimeException)
703 {
704 uno::Any NRetReadingOrder = aNULL();
705 try
706 {
707 rtl::OUString sWritingMode( RTL_CONSTASCII_USTRINGPARAM( SC_UNONAME_WRITING ) );
708 if (!isAmbiguous(sWritingMode))
709 {
710 text::WritingMode aWritingMode = text::WritingMode_LR_TB;
711 if ( ( mxPropertySet->getPropertyValue(sWritingMode) ) >>= aWritingMode )
712 switch (aWritingMode){
713 case text::WritingMode_LR_TB:
714 NRetReadingOrder = uno::makeAny(excel::Constants::xlLTR);
715 break;
716 case text::WritingMode_RL_TB:
717 NRetReadingOrder = uno::makeAny(excel::Constants::xlRTL);
718 break;
719 default:
720 NRetReadingOrder = uno::makeAny(excel::Constants::xlRTL);
721 }
722 }
723 }
724 catch (uno::Exception& )
725 {
726 DebugHelper::exception(SbERR_NOT_IMPLEMENTED, rtl::OUString());
727 }
728 return NRetReadingOrder;
729
730 }
731
732 template< typename Ifc1 >
733 uno::Any SAL_CALL
getNumberFormat()734 ScVbaFormat< Ifc1 >::getNumberFormat( ) throw (script::BasicErrorException, uno::RuntimeException)
735 {
736 uno::Any aFormat = aNULL();
737 try
738 {
739 sal_Int32 nFormat = -1;
740 rtl::OUString sNumFormat( RTL_CONSTASCII_USTRINGPARAM( SC_UNO_NUMBERFO ) );
741 if (!isAmbiguous(sNumFormat) &&
742 ( mxPropertySet->getPropertyValue(sNumFormat) >>= nFormat) )
743 {
744 initializeNumberFormats();
745
746 sal_Int32 nNewFormat = xNumberFormatTypes->getFormatForLocale(nFormat, getDefaultLocale() );
747 rtl::OUString sFormat;
748 xNumberFormats->getByKey(nNewFormat)->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( FORMATSTRING ))) >>= sFormat;
749 aFormat = uno::makeAny( sFormat );
750 }
751 }
752 catch (uno::Exception& )
753 {
754 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
755 }
756 return aFormat;
757 }
758
759 template< typename Ifc1 >
760 bool
isAmbiguous(const rtl::OUString & _sPropertyName)761 ScVbaFormat<Ifc1>::isAmbiguous(const rtl::OUString& _sPropertyName) throw ( script::BasicErrorException )
762 {
763 bool bResult = false;
764 try
765 {
766 if (mbCheckAmbiguoity)
767 bResult = ( getXPropertyState()->getPropertyState(_sPropertyName) == beans::PropertyState_AMBIGUOUS_VALUE );
768 }
769 catch (uno::Exception& )
770 {
771 DebugHelper::exception(SbERR_METHOD_FAILED, rtl::OUString());
772 }
773 return bResult;
774 }
775
776 template< typename Ifc1 >
777 void
initializeNumberFormats()778 ScVbaFormat<Ifc1>::initializeNumberFormats() throw ( script::BasicErrorException )
779 {
780 if ( !xNumberFormats.is() )
781 {
782 mxNumberFormatsSupplier.set( mxModel, uno::UNO_QUERY_THROW );
783 xNumberFormats = mxNumberFormatsSupplier->getNumberFormats();
784 xNumberFormatTypes.set( xNumberFormats, uno::UNO_QUERY ); // _THROW?
785 }
786 }
787
788 template< typename Ifc1 >
789 uno::Reference< beans::XPropertyState >
getXPropertyState()790 ScVbaFormat<Ifc1>::getXPropertyState() throw ( uno::RuntimeException )
791 {
792 if ( !xPropertyState.is() )
793 xPropertyState.set( mxPropertySet, uno::UNO_QUERY_THROW );
794 return xPropertyState;
795 }
796
797 template< typename Ifc1 >
798 rtl::OUString&
getServiceImplName()799 ScVbaFormat<Ifc1>::getServiceImplName()
800 {
801 static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("ScVbaFormat") );
802 return sImplName;
803 }
804
805 template< typename Ifc1 >
806 uno::Sequence< rtl::OUString >
getServiceNames()807 ScVbaFormat<Ifc1>::getServiceNames()
808 {
809 static uno::Sequence< rtl::OUString > aServiceNames;
810 if ( aServiceNames.getLength() == 0 )
811 {
812 aServiceNames.realloc( 1 );
813 aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.excel.Format" ) );
814 }
815 return aServiceNames;
816 }
817
818 template< typename Ifc1 >
819 ScCellRangesBase*
getCellRangesBase()820 ScVbaFormat<Ifc1>::getCellRangesBase() throw ( ::uno::RuntimeException )
821 {
822 return ScCellRangesBase::getImplementation( mxPropertySet );
823 }
824
825 template< typename Ifc1 >
826 SfxItemSet*
getCurrentDataSet()827 ScVbaFormat<Ifc1>::getCurrentDataSet( ) throw ( uno::RuntimeException )
828 {
829 SfxItemSet* pDataSet = excel::ScVbaCellRangeAccess::GetDataSet( getCellRangesBase() );
830 if ( !pDataSet )
831 throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "Can't access Itemset for XPropertySet" ) ), uno::Reference< uno::XInterface >() );
832 return pDataSet;
833 }
834
835
836 template class ScVbaFormat< excel::XStyle >;
837 template class ScVbaFormat< excel::XRange >;
838
839
840