basic/source/sbx/sbxcurr.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
  20
  21 #include <tools/errcode.hxx>
  22 #include <vcl/svapp.hxx>        // for SvtSysLocale
  23
  24 #include <basic/sbx.hxx>
  25 #include <basic/sbxvar.hxx>
  26 #include "sbxconv.hxx"
  27
  28
  29 static OUString ImpCurrencyToString( const sal_Int64 &rVal )
  30 {
  31     bool isNeg = ( rVal < 0 );
  32     sal_Int64 absVal = isNeg ? -rVal : rVal;
  33
  34     sal_Unicode cDecimalSep = '.';
  35 #ifdef MAYBEFUTURE
  36     sal_Unicode cThousandSep = ',';
  37     ImpGetIntntlSep( cDecimalSep, cThousandSep );
  38 #endif
  39
  40     OUString aAbsStr = OUString::valueOf( absVal );
  41     OUStringBuffer aBuf;
  42
  43     sal_Int32 initialLen = aAbsStr.getLength();
  44
  45     bool bLessThanOne = false;
  46     if ( initialLen  <= 4 )  // if less the 1
  47         bLessThanOne = true;
  48
  49     sal_Int32 nCapacity = 6; // minimum e.g. 0.0000
  50
  51     if ( !bLessThanOne )
  52     {
  53         nCapacity = initialLen + 1;
  54 #ifdef MAYBEFUTURE
  55         if ( initialLen > 5 )
  56         {
  57             sal_Int32 nThouSeparators = ( initialLen - 5 ) / 3;
  58             nCapacity += nThouSeparators;
  59         }
  60 #endif
  61     }
  62
  63     if ( isNeg )
  64         ++nCapacity;
  65
  66     aBuf.setLength( nCapacity );
  67
  68
  69     sal_Int32 nDigitCount = 0;
  70     sal_Int32 nInsertIndex = nCapacity - 1;
  71     sal_Int32 nEndIndex = isNeg ? 1 : 0;
  72
  73     for ( sal_Int32 charCpyIndex = aAbsStr.getLength() - 1; nInsertIndex >= nEndIndex;  ++nDigitCount )
  74     {
  75         if ( nDigitCount == 4 )
  76             aBuf[nInsertIndex--] = cDecimalSep;
  77 #ifdef MAYBEFUTURE
  78         if ( nDigitCount > 4 && ! ( ( nDigitCount - 4  ) % 3) )
  79             aBuf[nInsertIndex--] = cThousandSep;
  80 #endif
  81         if ( nDigitCount < initialLen )
  82             aBuf[nInsertIndex--] = aAbsStr[ charCpyIndex-- ];
  83         else
  84         // Handle leading 0's to right of decimal point
  85         // Note: in VBA the stringification is a little more complex
  86         // but more natural as only the necessary digits
  87         // to the right of the decimal places are displayed
  88         // It would be great to conditionally be able to display like that too
  89         //
  90         // Val   OOo (Cur)  VBA (Cur)
  91         // ---   ---------  ---------
  92         // 0     0.0000     0
  93         // 0.1   0.1000     0.1
  94
  95             aBuf[nInsertIndex--] = (sal_Unicode)'0';
  96     }
  97     if ( isNeg )
  98             aBuf[nInsertIndex] = (sal_Unicode)'-';
  99
 100     aAbsStr = aBuf.makeStringAndClear();
 101     return aAbsStr;
 102 }
 103
 104
 105 static sal_Int64 ImpStringToCurrency( const OUString &rStr )
 106 {
 107
 108     sal_Int32   nFractDigit = 4;
 109
 110     sal_Unicode cDeciPnt = sal_Unicode('.');
 111     sal_Unicode c1000Sep = sal_Unicode(',');
 112
 113 #ifdef MAYBEFUTURE
 114     sal_Unicode cLocaleDeciPnt, cLocale1000Sep;
 115     ImpGetIntntlSep( cLocaleDeciPnt, cLocale1000Sep );
 116
 117         // score each set of separators (Locale and Basic) on total number of matches
 118         // if one set has more matches use that set
 119         // if tied use the set with the only or rightmost decimal separator match
 120         // currency is fixed pt system: usually expect the decimal pt, 1000sep may occur
 121     sal_Int32 LocaleScore = 0;
 122     sal_Int32 LocaleLastDeci = -1;
 123     sal_Int32 LOBasicScore = 0;
 124     sal_Int32 LOBasicLastDeci = -1;
 125
 126     for( int idx=0; idx<rStr.getLength(); idx++ )
 127     {
 128         if ( *(p+idx) == cLocaleDeciPnt )
 129         {
 130             LocaleScore++;
 131             LocaleLastDeci = idx;
 132         }
 133         if ( *(p+idx) == cLocale1000Sep )
 134             LocaleScore++;
 135
 136         if ( *(p+idx) == cDeciPnt )
 137         {
 138             LOBasicScore++;
 139             LOBasicLastDeci = idx;
 140         }
 141         if ( *(p+idx) == c1000Sep )
 142             LOBasicScore++;
 143     }
 144     if ( ( LocaleScore > LOBasicScore )
 145        ||( LocaleScore = LOBasicScore && LocaleLastDeci > LOBasicLastDeci ) )
 146     {
 147         cDeciPnt = cLocaleDeciPnt;
 148         c1000Sep = cLocale1000Sep;
 149     }
 150 #endif
 151
 152     // lets use the existing string number conversions
 153     // there is a performance impact here ( multiple string copies )
 154     // but better I think than a home brewed string parser, if we need a parser
 155     // we should share some existing ( possibly from calc is there a currency
 156     // conversion there ? #TODO check )
 157
 158     OUString sTmp( rStr.trim() );
 159     const sal_Unicode* p =  sTmp.getStr();
 160
 161     // normalise string number by removeing thousands & decimal point separators
 162     OUStringBuffer sNormalisedNumString( sTmp.getLength() +  nFractDigit );
 163
 164     if ( *p == '-'  || *p == '+' )
 165         sNormalisedNumString.append( *p );
 166
 167     while ( ( *p >= '0' && *p <= '9' ) )
 168     {
 169         sNormalisedNumString.append( *p++ );
 170         // #TODO in vba mode set runtime error when a space ( or other )
 171         // illegal character is found
 172         if( *p == c1000Sep )
 173             p++;
 174     }
 175
 176     bool bRoundUp = false;
 177
 178     if( *p == cDeciPnt )
 179     {
 180         p++;
 181         while( nFractDigit && *p >= '0' && *p <= '9' )
 182         {
 183             sNormalisedNumString.append( *p++ );
 184             nFractDigit--;
 185         }
 186         // Consume trailing content
 187         if ( p != NULL )
 188         {
 189             // Round up if necessary
 190             if( *p >= '5' && *p <= '9' )
 191                 bRoundUp = true;
 192             while( *p >= '0' && *p <= '9' )
 193                 p++;
 194         }
 195
 196     }
 197     // can we raise error here ? ( previous behaviour was more forgiving )
 198     // so... not sure that could bread existing code, lets see if anyone
 199     // complains.
 200
 201     if ( p != sTmp.getStr() + sTmp.getLength() )
 202         SbxBase::SetError( SbxERR_CONVERSION );
 203     while( nFractDigit )
 204     {
 205         sNormalisedNumString.append( sal_Unicode('0') );
 206         nFractDigit--;
 207     }
 208
 209     sal_Int64 result = sNormalisedNumString.makeStringAndClear().toInt64();
 210
 211     if ( bRoundUp )
 212         ++result;
 213     return result;
 214 }
 215
 216
 217 sal_Int64 ImpGetCurrency( const SbxValues* p )
 218 {
 219     SbxValues   aTmp;
 220     sal_Int64  nRes;
 221 start:
 222     switch( +p->eType )
 223     {
 224         case SbxERROR:
 225         case SbxNULL:
 226             SbxBase::SetError( SbxERR_CONVERSION );
 227             nRes = 0; break;
 228         case SbxEMPTY:
 229             nRes = 0; break;
 230         case SbxCURRENCY:
 231             nRes = p->nInt64; break;
 232         case SbxBYTE:
 233             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->nByte);
 234             break;
 235         case SbxCHAR:
 236             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->pChar);
 237             break;
 238         case SbxBOOL:
 239         case SbxINTEGER:
 240             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->nInteger);
 241             break;
 242         case SbxUSHORT:
 243             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->nUShort);
 244             break;
 245         case SbxLONG:
 246             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->nLong);
 247             break;
 248         case SbxULONG:
 249             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(p->nULong);
 250             break;
 251
 252         case SbxSALINT64:
 253         {
 254             nRes = p->nInt64 * CURRENCY_FACTOR; break;
 255 #if 0
 256             // Huh, is the 'break' above intentional? That means this
 257             // is unreachable, obviously. Avoid warning by ifdeffing
 258             // this out for now. Do not delete this #if 0 block unless
 259             // you know for sure the 'break' above is intentional.
 260             if ( nRes > SbxMAXSALINT64 )
 261             {
 262                 SbxBase::SetError( SbxERR_OVERFLOW ); nRes = SbxMAXSALINT64;
 263             }
 264 #endif
 265         }
 266         case SbxSALUINT64:
 267             nRes = p->nInt64 * CURRENCY_FACTOR; break;
 268 #if 0
 269             // As above
 270             if ( nRes > SbxMAXSALINT64 )
 271             {
 272                 SbxBase::SetError( SbxERR_OVERFLOW ); nRes = SbxMAXSALINT64;
 273             }
 274             else if ( nRes < SbxMINSALINT64 )
 275             {
 276                 SbxBase::SetError( SbxERR_OVERFLOW ); nRes = SbxMINSALINT64;
 277             }
 278             break;
 279 #endif
 280 //TODO: bring back SbxINT64 types here for limits -1 with flag value at SAL_MAX/MIN
 281         case SbxSINGLE:
 282             if( p->nSingle * CURRENCY_FACTOR + 0.5 > (float)SAL_MAX_INT64
 283              || p->nSingle * CURRENCY_FACTOR - 0.5 < (float)SAL_MIN_INT64 )
 284             {
 285                 nRes = SAL_MAX_INT64;
 286                 if( p->nSingle * CURRENCY_FACTOR - 0.5 < (float)SAL_MIN_INT64 )
 287                     nRes = SAL_MIN_INT64;
 288                 SbxBase::SetError( SbxERR_OVERFLOW );
 289                 break;
 290             }
 291             nRes = ImpDoubleToCurrency( (double)p->nSingle );
 292             break;
 293
 294         case SbxDATE:
 295         case SbxDOUBLE:
 296             if( p->nDouble * CURRENCY_FACTOR + 0.5 > (double)SAL_MAX_INT64
 297              || p->nDouble * CURRENCY_FACTOR - 0.5 < (double)SAL_MIN_INT64 )
 298             {
 299                 nRes = SAL_MAX_INT64;
 300                 if( p->nDouble * CURRENCY_FACTOR - 0.5 < (double)SAL_MIN_INT64 )
 301                     nRes = SAL_MIN_INT64;
 302                 SbxBase::SetError( SbxERR_OVERFLOW );
 303                 break;
 304             }
 305             nRes = ImpDoubleToCurrency( p->nDouble );
 306             break;
 307
 308         case SbxDECIMAL:
 309         case SbxBYREF | SbxDECIMAL:
 310             {
 311             double d = 0.0;
 312             if( p->pDecimal )
 313                 p->pDecimal->getDouble( d );
 314             nRes = ImpDoubleToCurrency( d );
 315             break;
 316             }
 317
 318
 319         case SbxBYREF | SbxSTRING:
 320         case SbxSTRING:
 321         case SbxLPSTR:
 322             if( !p->pOUString )
 323                 nRes=0;
 324             else
 325                 nRes = ImpStringToCurrency( *p->pOUString );
 326             break;
 327         case SbxOBJECT:
 328         {
 329             SbxValue* pVal = PTR_CAST(SbxValue,p->pObj);
 330             if( pVal )
 331                 nRes = pVal->GetCurrency();
 332             else
 333             {
 334                 SbxBase::SetError( SbxERR_NO_OBJECT );
 335                 nRes=0;
 336             }
 337             break;
 338         }
 339
 340         case SbxBYREF | SbxCHAR:
 341             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(*p->pChar);
 342             break;
 343         case SbxBYREF | SbxBYTE:
 344             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(*p->pByte);
 345             break;
 346         case SbxBYREF | SbxBOOL:
 347         case SbxBYREF | SbxINTEGER:
 348             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(*p->pInteger);
 349             break;
 350         case SbxBYREF | SbxERROR:
 351         case SbxBYREF | SbxUSHORT:
 352             nRes = (sal_Int64)CURRENCY_FACTOR * (sal_Int64)(*p->pUShort);
 353             break;
 354
 355         // from here on had to be tested
 356         case SbxBYREF | SbxLONG:
 357             aTmp.nLong = *p->pLong; goto ref;
 358         case SbxBYREF | SbxULONG:
 359             aTmp.nULong = *p->pULong; goto ref;
 360         case SbxBYREF | SbxSINGLE:
 361             aTmp.nSingle = *p->pSingle; goto ref;
 362         case SbxBYREF | SbxDATE:
 363         case SbxBYREF | SbxDOUBLE:
 364             aTmp.nDouble = *p->pDouble; goto ref;
 365         case SbxBYREF | SbxCURRENCY:
 366         case SbxBYREF | SbxSALINT64:
 367             aTmp.nInt64 = *p->pnInt64; goto ref;
 368         case SbxBYREF | SbxSALUINT64:
 369             aTmp.uInt64 = *p->puInt64; goto ref;
 370         ref:
 371             aTmp.eType = SbxDataType( p->eType & ~SbxBYREF );
 372             p = &aTmp; goto start;
 373
 374         default:
 375             SbxBase::SetError( SbxERR_CONVERSION );
 376             nRes=0;
 377     }
 378     return nRes;
 379 }
 380
 381
 382 void ImpPutCurrency( SbxValues* p, const sal_Int64 r )
 383 {
 384     SbxValues aTmp;
 385 start:
 386     switch( +p->eType )
 387     {
 388         // Here are tests necessary
 389         case SbxCHAR:
 390             aTmp.pChar = &p->nChar; goto direct;
 391         case SbxBYTE:
 392             aTmp.pByte = &p->nByte; goto direct;
 393         case SbxINTEGER:
 394         case SbxBOOL:
 395             aTmp.pInteger = &p->nInteger; goto direct;
 396         case SbxLONG:
 397             aTmp.pLong = &p->nLong; goto direct;
 398         case SbxULONG:
 399             aTmp.pULong = &p->nULong; goto direct;
 400         case SbxERROR:
 401         case SbxUSHORT:
 402             aTmp.pUShort = &p->nUShort; goto direct;
 403         direct:
 404             aTmp.eType = SbxDataType( p->eType | SbxBYREF );
 405             p = &aTmp; goto start;
 406
 407         // from here no longer
 408         case SbxSINGLE:
 409             p->nSingle = (float)( r / CURRENCY_FACTOR ); break;
 410         case SbxDATE:
 411         case SbxDOUBLE:
 412             p->nDouble =  ImpCurrencyToDouble( r ); break;
 413         case SbxSALUINT64:
 414             p->uInt64 = r / CURRENCY_FACTOR; break;
 415         case SbxSALINT64:
 416             p->nInt64 = r / CURRENCY_FACTOR; break;
 417
 418         case SbxCURRENCY:
 419             p->nInt64 = r; break;
 420
 421         case SbxDECIMAL:
 422         case SbxBYREF | SbxDECIMAL:
 423             {
 424             SbxDecimal* pDec = ImpCreateDecimal( p );
 425             if( !pDec->setDouble( ImpCurrencyToDouble( r ) / CURRENCY_FACTOR ) )
 426                 SbxBase::SetError( SbxERR_OVERFLOW );
 427             break;
 428             }
 429         case SbxBYREF | SbxSTRING:
 430         case SbxSTRING:
 431         case SbxLPSTR:
 432             if( !p->pOUString )
 433                 p->pOUString = new OUString;
 434
 435             *p->pOUString = ImpCurrencyToString( r );
 436             break;
 437         case SbxOBJECT:
 438         {
 439             SbxValue* pVal = PTR_CAST(SbxValue,p->pObj);
 440             if( pVal )
 441                 pVal->PutCurrency( r );
 442             else
 443                 SbxBase::SetError( SbxERR_NO_OBJECT );
 444             break;
 445         }
 446         case SbxBYREF | SbxCHAR:
 447         {
 448             sal_Int64 val = r / CURRENCY_FACTOR;
 449             if( val > SbxMAXCHAR )
 450             {
 451                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXCHAR;
 452             }
 453             else if( val < SbxMINCHAR )
 454             {
 455                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMINCHAR;
 456             }
 457             *p->pChar = (sal_Unicode) val; break;
 458         }
 459         case SbxBYREF | SbxBYTE:
 460         {
 461             sal_Int64 val = r / CURRENCY_FACTOR;
 462             if( val > SbxMAXBYTE )
 463             {
 464                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXBYTE;
 465             }
 466             else if( val < 0 )
 467             {
 468                 SbxBase::SetError( SbxERR_OVERFLOW ); val = 0;
 469             }
 470             *p->pByte = (sal_uInt8) val; break;
 471         }
 472         case SbxBYREF | SbxINTEGER:
 473         case SbxBYREF | SbxBOOL:
 474         {
 475             sal_Int64 val = r / CURRENCY_FACTOR;
 476             if( r > SbxMAXINT )
 477             {
 478                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXINT;
 479             }
 480             else if( r < SbxMININT )
 481             {
 482                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMININT;
 483             }
 484             *p->pInteger = (sal_uInt16) val; break;
 485         }
 486         case SbxBYREF | SbxERROR:
 487         case SbxBYREF | SbxUSHORT:
 488         {
 489             sal_Int64 val = r / CURRENCY_FACTOR;
 490             if( val > SbxMAXUINT )
 491             {
 492                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXUINT;
 493             }
 494             else if( val < 0 )
 495             {
 496                 SbxBase::SetError( SbxERR_OVERFLOW ); val = 0;
 497             }
 498             *p->pUShort = (sal_uInt16) val; break;
 499         }
 500         case SbxBYREF | SbxLONG:
 501         {
 502             sal_Int64 val = r / CURRENCY_FACTOR;
 503             if( val > SbxMAXLNG )
 504             {
 505                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXLNG;
 506             }
 507             else if( val < SbxMINLNG )
 508             {
 509                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMINLNG;
 510             }
 511             *p->pLong = (sal_Int32) val; break;
 512         }
 513         case SbxBYREF | SbxULONG:
 514         {
 515             sal_Int64 val = r / CURRENCY_FACTOR;
 516             if( val > SbxMAXULNG )
 517             {
 518                 SbxBase::SetError( SbxERR_OVERFLOW ); val = SbxMAXULNG;
 519             }
 520             else if( val < 0 )
 521             {
 522                 SbxBase::SetError( SbxERR_OVERFLOW ); val = 0;
 523             }
 524             *p->pULong = (sal_uInt32) val; break;
 525         }
 526         case SbxBYREF | SbxCURRENCY:
 527             *p->pnInt64 = r; break;
 528         case SbxBYREF | SbxSALINT64:
 529             *p->pnInt64 = r / CURRENCY_FACTOR; break;
 530         case SbxBYREF | SbxSALUINT64:
 531             *p->puInt64 = (sal_uInt64)r / CURRENCY_FACTOR; break;
 532         case SbxBYREF | SbxSINGLE:
 533             p->nSingle = (float)( r / CURRENCY_FACTOR ); break;
 534         case SbxBYREF | SbxDATE:
 535         case SbxBYREF | SbxDOUBLE:
 536             *p->pDouble = ImpCurrencyToDouble( r ); break;
 537         default:
 538             SbxBase::SetError( SbxERR_CONVERSION );
 539     }
 540 }
 541
 542 /* vim:set shiftwidth=4 softtabstop=4 expandtab: */