summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--basic/qa/vba_tests/formatnumber.vb43
-rw-r--r--basic/source/inc/rtlproto.hxx1
-rw-r--r--basic/source/runtime/methods.cxx129
-rw-r--r--basic/source/runtime/stdobj.cxx6
4 files changed, 170 insertions, 9 deletions
diff --git a/basic/qa/vba_tests/formatnumber.vb b/basic/qa/vba_tests/formatnumber.vb
index 3132e58edb54..060d1342cb98 100644
--- a/basic/qa/vba_tests/formatnumber.vb
+++ b/basic/qa/vba_tests/formatnumber.vb
@@ -8,7 +8,7 @@ Dim result As String
Function doUnitTest() As String
result = verify_testFormatNumber()
-If failCount <> 0 And passCount > 0 Then
+If failCount <> 0 Or passCount = 0 Then
doUnitTest = result
Else
doUnitTest = "OK"
@@ -25,20 +25,45 @@ Function verify_testFormatNumber() As String
result = "Test Results" & Chr$(10) & "============" & Chr$(10)
Dim testName As String
- Dim date1, date2
- testName = "Test FormatNumber function"
+ Dim str1 As String, str2 As String
On Error GoTo errorHandler
- date2 = "42778.00"
- date1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse)
- TestLog_ASSERT date1 = date2, "the return FormatNumber is: " & date1
+ testName = "Test 1: positive, 2 decimals"
+ str2 = "12.20"
+ str1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 2: negative, 20 decimals, use leading zero"
+ str2 = "-0.20000000000000000000"
+ str1 = FormatNumber("-.2", 20, vbTrue, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 3: negative, 20 decimals, no leading zero"
+ str2 = "-.20000000000000000000"
+ str1 = FormatNumber("-0.2", 20, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 4: negative, no leading zero, use parens"
+ str2 = "(.20)"
+ str1 = FormatNumber("-0.2", -1, vbFalse, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 5: negative, default leading zero, use parens"
+ str2 = "(0.20)"
+ str1 = FormatNumber("-0.2", -1, vbUseDefault, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 6: group digits"
+ str2 = "-12,345,678.00"
+ str1 = FormatNumber("-12345678", -1, vbUseDefault, vbUseDefault, vbTrue)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
verify_testFormatNumber = result
Exit Function
errorHandler:
- TestLog_ASSERT (False), testName & ": hit error handler"
+ TestLog_ASSERT False, testName & ": hit error handler"
End Function
Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
@@ -48,10 +73,10 @@ Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional tes
Else
Dim testMsg As String
If Not IsMissing(testId) Then
- testMsg = testMsg + " : " + testId
+ testMsg = testId & " "
End If
If Not IsMissing(testComment) And Not (testComment = "") Then
- testMsg = testMsg + " (" + testComment + ")"
+ testMsg = testMsg + "(" + testComment + ")"
End If
result = result & Chr$(10) & " Failed: " & testMsg
diff --git a/basic/source/inc/rtlproto.hxx b/basic/source/inc/rtlproto.hxx
index 75ef16f469a5..6e26f9316103 100644
--- a/basic/source/inc/rtlproto.hxx
+++ b/basic/source/inc/rtlproto.hxx
@@ -234,6 +234,7 @@ extern void SbRtl_IsUnoStruct(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
extern void SbRtl_FileDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
extern void SbRtl_Format(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
+extern void SbRtl_FormatNumber(StarBASIC* pBasic, SbxArray& rPar, bool bWrite);
extern void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
extern void SbRtl_Randomize(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM
extern void SbRtl_Round(StarBASIC * pBasic, SbxArray & rPar, bool bWrite);
diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx
index 9049d787d04e..4eb36147f175 100644
--- a/basic/source/runtime/methods.cxx
+++ b/basic/source/runtime/methods.cxx
@@ -48,6 +48,7 @@
#include <osl/file.hxx>
#include <errobject.hxx>
+#include <comphelper/string.hxx>
#include <comphelper/processfactory.hxx>
#include <comphelper/string.hxx>
@@ -59,6 +60,7 @@
#include <com/sun/star/ucb/SimpleFileAccess.hpp>
#include <com/sun/star/script/XErrorQuery.hpp>
#include <ooo/vba/XHelperInterface.hpp>
+#include <ooo/vba/VbTriState.hpp>
#include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
#include <memory>
#include <random>
@@ -3294,6 +3296,133 @@ void SbRtl_Format(StarBASIC *, SbxArray & rPar, bool)
}
}
+// https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/formatnumber-function
+void SbRtl_FormatNumber(StarBASIC*, SbxArray& rPar, bool)
+{
+ const sal_uInt16 nArgCount = rPar.Count();
+ if (nArgCount < 2 || nArgCount > 6)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+
+ // The UI locale never changes -> we can use static value here
+ static const LocaleDataWrapper localeData(Application::GetSettings().GetUILanguageTag());
+ sal_Int16 nNumDigitsAfterDecimal = -1;
+ if (nArgCount > 2 && !rPar.Get(2)->IsEmpty())
+ {
+ nNumDigitsAfterDecimal = rPar.Get(2)->GetInteger();
+ if (nNumDigitsAfterDecimal < -1)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ else if (nNumDigitsAfterDecimal > 255)
+ nNumDigitsAfterDecimal %= 256;
+ }
+ if (nNumDigitsAfterDecimal == -1)
+ nNumDigitsAfterDecimal = LocaleDataWrapper::getNumDigits();
+
+ bool bIncludeLeadingDigit = LocaleDataWrapper::isNumLeadingZero();
+ if (nArgCount > 3 && !rPar.Get(3)->IsEmpty())
+ {
+ switch (rPar.Get(3)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ bIncludeLeadingDigit = false;
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bIncludeLeadingDigit = true;
+ break;
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bUseParensForNegativeNumbers = false;
+ if (nArgCount > 4 && !rPar.Get(4)->IsEmpty())
+ {
+ switch (rPar.Get(4)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bUseParensForNegativeNumbers = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bGroupDigits = false;
+ if (nArgCount > 5 && !rPar.Get(5)->IsEmpty())
+ {
+ switch (rPar.Get(5)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bGroupDigits = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ double fVal = rPar.Get(1)->GetDouble();
+ const bool bNegative = fVal < 0;
+ if (bNegative)
+ fVal = fabs(fVal); // Always work with non-negatives, to easily handle leading zero
+
+ static const sal_Unicode decSep = localeData.getNumDecimalSep().toChar();
+ OUString aResult = rtl::math::doubleToUString(
+ fVal, rtl_math_StringFormat_F, nNumDigitsAfterDecimal, decSep,
+ bGroupDigits ? localeData.getDigitGrouping().getConstArray() : nullptr,
+ localeData.getNumThousandSep().toChar());
+
+ if (!bIncludeLeadingDigit && aResult.getLength() > 1 && aResult.startsWith("0"))
+ aResult = aResult.copy(1);
+
+ if (nNumDigitsAfterDecimal > 0)
+ {
+ sal_Int32 nActualDigits = nNumDigitsAfterDecimal;
+ const sal_Int32 nSepPos = aResult.indexOf(decSep);
+ if (nSepPos == -1)
+ nActualDigits = 0;
+ else
+ nActualDigits = aResult.getLength() - nSepPos - 1;
+
+ // VBA allows up to 255 digits; rtl::math::doubleToUString outputs up to 15 digits
+ // for ~small numbers, so pad them as appropriate.
+ if (nActualDigits < nNumDigitsAfterDecimal)
+ {
+ OUStringBuffer sBuf;
+ comphelper::string::padToLength(sBuf, nNumDigitsAfterDecimal - nActualDigits, '0');
+ aResult += sBuf.makeStringAndClear();
+ }
+ }
+
+ if (bNegative)
+ {
+ if (bUseParensForNegativeNumbers)
+ aResult = "(" + aResult + ")";
+ else
+ aResult = "-" + aResult;
+ }
+
+ rPar.Get(0)->PutString(aResult);
+}
+
namespace {
// note: BASIC does not use comphelper::random, because
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
index d6349e0000a0..ff10ad4f2695 100644
--- a/basic/source/runtime/stdobj.cxx
+++ b/basic/source/runtime/stdobj.cxx
@@ -278,6 +278,12 @@ static Methods aMethods[] = {
{ "FormatDateTime", SbxSTRING, 2 | FUNCTION_ | COMPATONLY_, RTLNAME(FormatDateTime),0 },
{ "Date", SbxDATE, 0,nullptr,0 },
{ "NamedFormat", SbxINTEGER, OPT_, nullptr,0 },
+{ "FormatNumber", SbxSTRING, 5 | FUNCTION_, RTLNAME(FormatNumber), 0 },
+ { "expression", SbxDOUBLE, 0, nullptr, 0 },
+ { "numDigitsAfterDecimal", SbxINTEGER, OPT_, nullptr, 0 },
+ { "includeLeadingDigit", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
+ { "useParensForNegativeNumbers", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
+ { "groupDigits", SbxINTEGER, OPT_, nullptr, 0 }, // vbTriState
{ "Frac", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Frac),0 },
{ "number", SbxDOUBLE, 0,nullptr,0 },
{ "FRAMEANCHORCHAR", SbxINTEGER, CPROP_, RTLNAME(FRAMEANCHORCHAR),0 },
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-23 13:56:29 +0000