VBA-Expressions v3.2.11

ws-garcia · ws-garcia · commit 52552b0d9f9e · 2025-05-09T23:37:32.000-04:00
diff --git a/docs/assets/img/VBAExprManual.pdf b/docs/assets/img/VBAExprManual.pdf
diff --git a/src/LO Basic/VBAExpressions.update.xml b/src/LO Basic/VBAExpressions.update.xml
@@ -2,8 +2,8 @@
 <description xmlns="https://openoffice.org/extensions/update/2006"
   xmlns:xlink="https://www.w3.org/1999/xlink">
   <identifier value="com.ecpsolutions.extensions.vbaexpressions.oxt"/>
-  <version value="1.1.1"/>
+  <version value="1.1.2"/>
   <update-download>
-    <src xlink:href="https://github.com/ws-garcia/VBA-Expressions/releases/download/v3.2.10/VBAExpressions.oxt"/>
+    <src xlink:href="https://github.com/ws-garcia/VBA-Expressions/releases/download/v3.2.11/VBAExpressions.oxt"/>
   </update-download>
 </description>
diff --git a/src/LO Basic/VBAExpressionsLib/TestRunner.xba b/src/LO Basic/VBAExpressionsLib/TestRunner.xba
@@ -8,7 +8,7 @@ Private tTotal As Long
 
 &apos;#
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
-&apos; Copyright © 2024 W. García
+&apos; Copyright © 2024-2025 W. García
 &apos; GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 &apos; https://github.com/ws-garcia
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
@@ -364,6 +364,27 @@ Sub RunAllTests
 			&quot;INSTR(&apos;Gear&apos;;&apos;e&apos;)&quot;, _
 			&quot;2&quot; _
 		)
+	&apos;Analytical Geometry
+	Run( _
+			&quot;Distance between two points&quot;, _
+			&quot;ROUND(DISTANCE({{3.1441;0}};{{4.45415;3.1441}});4)&quot;, _
+			&quot;3.4061&quot; _
+		)
+	Run( _
+			&quot;Lines intersection&quot;, _
+			&quot;MROUND(LINESINTERSECT({{12;0};{0;5}};{{0;1.31004};{0.79693;3.22267}});2)&quot;, _
+			&quot;{{1.31;4.45}}&quot; _
+		)
+	Run( _
+			&quot;Parallel line&quot;, _
+			&quot;MROUND(PARALLEL({{12;0};{0;5}};{{3.1441;0}});2)&quot;, _
+			&quot;{{3.14;0};{0;1.31}}&quot; _
+		)
+	Run( _
+			&quot;Perpendicular line&quot;, _
+			&quot;MROUND(PERPENDICULAR({{12;0};{0;5}};{{3.1441;0}});2)&quot;, _
+			&quot;{{3.14;0};{4.45;3.14}}&quot; _
+		)
 	SF_Exception.debugprint(&quot;Passed tests:&quot;,sAcum)	
 	SF_Exception.debugprint(&quot;Failed tests:&quot;,tTotal - sAcum)	
 	SF_Exception.debugprint(&quot;Passed tests Ratio:&quot;,Round(100*sAcum/tTotal,2) &amp;&quot;%&quot;)
diff --git a/src/LO Basic/VBAExpressionsLib/UDFunctions.xba b/src/LO Basic/VBAExpressionsLib/UDFunctions.xba
@@ -6,7 +6,7 @@ Option VBASupport 1
 option ClassModule
 &apos;#
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
-&apos; Copyright © 2024 W. García
+&apos; Copyright © 2024-2025 W. García
 &apos; GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 &apos; https://github.com/ws-garcia
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/LO Basic/VBAExpressionsLib/VBAcallBack.xba b/src/LO Basic/VBAExpressionsLib/VBAcallBack.xba
@@ -5,7 +5,7 @@ option Compatible
 option ClassModule
 &apos;#
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
-&apos; Copyright © 2024 W. García
+&apos; Copyright © 2024-2025 W. García
 &apos; GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 &apos; https://github.com/ws-garcia
 &apos;////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/LO Basic/VBAExpressionsLib/VBAexpressions.xba b/src/LO Basic/VBAExpressionsLib/VBAexpressions.xba
diff --git a/src/LO Basic/VBAExpressionsLib/VBAexpressionsScope.xba b/src/LO Basic/VBAExpressionsLib/VBAexpressionsScope.xba
@@ -7,7 +7,7 @@ option ClassModule
 Option Base 0
 &apos;#
 &apos;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-&apos; Copyright © 2024 W. García
+&apos; Copyright © 2024-2025 W. García
 &apos; GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 &apos; https://github.com/ws-garcia
 &apos;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/LO Basic/VBAExpressionsLib/VBAstrHelper.xba b/src/LO Basic/VBAExpressionsLib/VBAstrHelper.xba
@@ -7,7 +7,7 @@ option ClassModule
 Option Base 0
 &apos;#
 &apos;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-&apos; Copyright © 2024 W. García
+&apos; Copyright © 2024-2025 W. García
 &apos; GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 &apos; https://github.com/ws-garcia
 &apos;///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/LO Basic/release-notes_en.txt b/src/LO Basic/release-notes_en.txt
@@ -1,6 +1,13 @@
-# A single one
-## New function
-- [x] `INSTR`
+# Embracing analytic geometry basis!
+## Setting changes
+- [x] The `GallopingMode` option is disabled by default.
+## Bug fixed
+- [x] Broken tokenization for expressions involving evaluable literal strings.
+## New functions
+- [x] `DISTANCE`: computes the distance between two Cartesian points.
+- [x] `LINESINTERSECT`: computes the intersection point between two lines defined by two points each.
+- [x] `PARALLEL`: computes two points representing a line parallel to the given one and containing the given point.
+- [x] `PERPENDICULAR`: computes two points representing a line perpendicular to the given one and containing the given point.
 
 ## Download 
-https://github.com/ws-garcia/VBA-Expressions/releases/download/v3.2.10/VBAExpressions.oxt
+https://github.com/ws-garcia/VBA-Expressions/releases/download/v3.2.11/VBAExpressions.oxt
diff --git a/src/UDFunctions.cls b/src/UDFunctions.cls
@@ -10,7 +10,7 @@ Attribute VB_Exposed = True
 Option Explicit
 '#
 '////////////////////////////////////////////////////////////////////////////////////////////
-' Copyright � 2022-2024 W. Garc�a
+' Copyright � 2022-2025 W. Garc�a
 ' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 ' https://ingwilfredogarcia.wordpress.com
 '////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/VBAcallBack.cls b/src/VBAcallBack.cls
@@ -10,7 +10,7 @@ Attribute VB_Exposed = True
 Option Explicit
 '#
 '////////////////////////////////////////////////////////////////////////////////////////////
-' Copyright � 2022-2024 W. Garc�a
+' Copyright � 2022-2025 W. Garc�a
 ' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 ' https://ingwilfredogarcia.wordpress.com
 '////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/src/VBAexpressions.cls b/src/VBAexpressions.cls
@@ -12,7 +12,7 @@ Option Explicit
 Option Base 0
 '#
 '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-' Copyright � 2022-2024 W. Garc�a
+' Copyright � 2022-2025 W. Garc�a
 ' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 ' https://ingwilfredogarcia.wordpress.com
 '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -312,7 +312,7 @@ Private Sub Class_Initialize()
     P_SEPARATORCHAR = d_Semicolon
     P_DEC_SYMBOL = dsDot
     AscDecSymbol = 46
-    P_GALLOPING_MODE = True
+    P_GALLOPING_MODE = False
     P_FORMATRESULT = False
     BuildinFunctIDList = "abs;floor;achisq;asin;acos;aerf;afishf;agauss;asc;anorm;atn;astudt;array;avg;beta.dist" & _
                             ";betainv;ceil;chisq;cholesky;cholinverse;cholsolve;chr;cos;choose;date;dateadd;datediff" & _
@@ -2888,10 +2888,10 @@ err_Handler:
 End Function
 
 ''' <summary>
-'''     Returns the distance between two given points. The points
-'''     must be given each one in array format, ex.:
-'''         {{x1;y1}};{{x2;y2}}
+'''     Returns the distance between two given points.
 ''' </summary>
+''' <param name="Point1">Array of coordinates in format {{x1;y1}}.</param>
+''' <param name="Point2">Array of coordinates in format {{x2;y2}}.</param>
 Private Function Distance(ByRef expression As String, ByRef fName As String) As String
     Dim argsCount As Long
     Dim tmpData() As String
@@ -3105,7 +3105,9 @@ Private Function EvalFunction(ByRef Argument As String, ByRef FunctionName As St
             Case "aNow": EvalFunction = Now_(Argument, FunctionName)
             Case "aNPER": EvalFunction = NPER_(Argument, FunctionName)
             Case "aNPV": EvalFunction = NPV_(Argument, FunctionName)
+            Case "ParallelLine": EvalFunction = ParallelLine(Argument, FunctionName)
             Case "Percent": EvalFunction = Percent(Argument, FunctionName)
+            Case "PerpendicularLine": EvalFunction = PerpendicularLine(Argument, FunctionName)
             Case "aPMT": EvalFunction = PMT_(Argument, FunctionName)
             Case "aPPMT": EvalFunction = PPMT_(Argument, FunctionName)
             Case "Power": EvalFunction = Power(Argument, FunctionName)
@@ -3670,7 +3672,6 @@ Private Function fZeroMBM(ByRef aFunction As String, ByVal A As Double, _
     aZero = 10 * epsilon
     With fEvalHelper
         .Create aFunction
-        .GallopingMode = False
         tmpVar() = Split(.CurrentVariables, "; ")
         varLB = LBound(tmpVar)
         If UBound(tmpVar) - varLB > 0 Then  'Reject multivariate functions
@@ -3787,7 +3788,6 @@ Private Function fZeroMRF(ByRef aFunction As String, ByVal A As Double, _
     Set fEvalHelper = New VBAexpressions
     aZero = 10 * epsilon
     With fEvalHelper
-        .GallopingMode = False
         .Create aFunction
         tmpVar() = Split(.CurrentVariables, "; ")
         varLB = LBound(tmpVar)
@@ -5883,10 +5883,9 @@ End Function
 
 ''' <summary>
 '''     Returns the intersection point for two lines.
-'''     The lines must be given by two crossing points each
-'''     in array format, ex.:
-'''                             {{x1;y1};{x2;y2}}; {{x3;y3};{x4;y4}}
 ''' </summary>
+''' <param name="Line1">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
+''' <param name="Line2">Array of coordinates in format {{x3;y3};{x4;y4}}.</param>
 Private Function LinesIntersect(ByRef expression As String, ByRef fName As String) As String
     Dim argsCount As Long
     Dim tmpData() As String
@@ -5906,14 +5905,16 @@ Private Function LinesIntersect(ByRef expression As String, ByRef fName As Strin
             aArray(0) = ToDblArray(ArrayFromString(tmpData(LB)))
             aArray(1) = ToDblArray(ArrayFromString(tmpData(UB)))
             tmpEval = LinesIntersection(aArray(0), aArray(1))
-            If IsArray(tmpEval) Then
-                tmpEval = ArrayToString(tmpEval)
-            End If
         Case Else
             tmpEval = e_ValueError
               BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
     End Select
-    LinesIntersect = tmpEval: Erase tmpData
+    If IsArray(tmpEval) Then
+        LinesIntersect = ArrayToString(tmpEval)
+    Else
+        LinesIntersect = tmpEval
+    End If
+    Erase tmpData
     Exit Function
 err_Handler:
     LinesIntersect = e_ValueError
@@ -7547,6 +7548,66 @@ Private Function PatternToCheckOn(ByRef ArgDefStr As String) As String
     End If
 End Function
 
+''' <summary>
+'''     Returns two points representing a line parallel to the given one and
+'''     containing the given point.
+''' </summary>
+''' <param name="Line">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
+''' <param name="Point">Array of coordinates in format {{x;y}}.</param>
+Private Function ParallelLine(ByRef expression As String, ByRef fName As String) As String
+    Dim argsCount As Long
+    Dim tmpData() As String
+    Dim tmpEval As String
+    Dim LB As Long, UB As Long
+    
+    On Error GoTo err_Handler
+    tmpData() = SplitArgs(expression)
+    LB = LBound(tmpData)
+    UB = UBound(tmpData)
+    argsCount = UB - LB + 1
+    Select Case argsCount
+        Case 2
+            Dim aArray() As Variant
+            Dim aTerm As Double
+            Dim bTerm As Double
+            Dim cTerm As Double
+            Dim pointArr(0 To 1) As Variant
+            Dim tmpArr(0 To 1) As Double
+            ReDim aArray(0 To 1)
+            
+            aArray(0) = ToDblArray(ArrayFromString(tmpData(LB)))
+            aArray(1) = ToDblArray(ArrayFromString(tmpData(UB)))
+            aTerm = aArray(0)(0, 1) - aArray(0)(1, 1) 'y1-y2
+            bTerm = aArray(0)(1, 0) - aArray(0)(0, 0) 'x2-x1
+            cTerm = aArray(0)(0, 0) * aArray(0)(1, 1) _
+                    - aArray(0)(1, 0) * aArray(0)(0, 1) 'x1*y2-x2*y1
+            pointArr(0) = aArray(1)
+            If aTerm <> 0 And bTerm <> 0 Then
+                tmpArr(0) = 0
+                tmpArr(1) = (aTerm * aArray(1)(0) + bTerm * aArray(1)(1)) / bTerm
+            Else
+                If aTerm = 0 Then 'Horizontal line
+                    tmpArr(0) = aArray(1)(0) - aArray(1)(1) + 1
+                    tmpArr(1) = aArray(1)(1)
+                Else 'Vertical line
+                    tmpArr(0) = aArray(1)(0)
+                    tmpArr(1) = aArray(1)(0) - aArray(1)(1) + 1
+                End If
+            End If
+            pointArr(1) = tmpArr
+            tmpEval = ArrayToString(pointArr)
+        Case Else
+            tmpEval = e_ValueError
+              BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
+    End Select
+    ParallelLine = tmpEval: Erase tmpData
+    Exit Function
+err_Handler:
+    ParallelLine = e_ValueError
+    BuildErrMessage errEvalError, d_lCurly & fName & d_rCurly & " | Error#: " & err.Number & d_Space & _
+                                    d_lParenthesis & err.Description & d_rParenthesis
+End Function
+
 Private Function Percent(ByRef expression As String, ByRef fName As String) As String
     On Error GoTo err_Handler
     Percent = CDbl(expression) / 100
@@ -7557,6 +7618,77 @@ err_Handler:
                                     d_lParenthesis & err.Description & d_rParenthesis
 End Function
 
+''' <summary>
+'''     Returns two points representing a line perpendicular to the
+'''     given one and containing the given point.
+''' </summary>
+''' <param name="Line">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
+''' <param name="Point">Array of coordinates in format {{x;y}}.</param>
+Private Function PerpendicularLine(ByRef expression As String, ByRef fName As String) As String
+    Dim argsCount As Long
+    Dim tmpData() As String
+    Dim tmpEval As String
+    Dim LB As Long, UB As Long
+    
+    On Error GoTo err_Handler
+    tmpData() = SplitArgs(expression)
+    LB = LBound(tmpData)
+    UB = UBound(tmpData)
+    argsCount = UB - LB + 1
+    Select Case argsCount
+        Case 2
+            Dim aArray() As Variant
+            Dim aTerm As Double
+            Dim bTerm As Double
+            Dim cTerm As Double
+            Dim pointArr(0 To 1) As Variant
+            Dim tmpArr(0 To 1) As Double
+            ReDim aArray(0 To 1)
+            
+            aArray(0) = ToDblArray(ArrayFromString(tmpData(LB)))
+            aArray(1) = ToDblArray(ArrayFromString(tmpData(UB)))
+            aTerm = aArray(0)(0, 1) - aArray(0)(1, 1) 'y1-y2
+            bTerm = aArray(0)(1, 0) - aArray(0)(0, 0) 'x2-x1
+            cTerm = aArray(0)(0, 0) * aArray(0)(1, 1) _
+                    - aArray(0)(1, 0) * aArray(0)(0, 1) 'x1*y2-x2*y1
+            pointArr(0) = aArray(1)
+            If aTerm <> 0 And bTerm <> 0 Then
+                ' (-c*a+b(b*x3-a*y3))/(a^2 + b^2)
+                tmpArr(0) = (-cTerm * aTerm + bTerm * (bTerm * aArray(1)(0) - aTerm * aArray(1)(1))) _
+                                / _
+                            (aTerm ^ 2 + bTerm ^ 2)
+                ' (-a(b*x3-a*y3)-b*c)/(a^2 + b^2)
+                tmpArr(1) = (-aTerm * (bTerm * aArray(1)(0) - aTerm * aArray(1)(1)) - bTerm * cTerm) _
+                                / _
+                            (aTerm ^ 2 + bTerm ^ 2)
+                If pointArr(0)(0) = tmpArr(0) And _
+                            pointArr(0)(1) = tmpArr(1) Then 'Known point is the intersection
+                    tmpArr(0) = pointArr(0)(0) + 1
+                    tmpArr(1) = pointArr(0)(1) + bTerm / aTerm
+                End If
+            Else
+                If aTerm = 0 Then 'Horizontal line
+                    tmpArr(0) = aArray(1)(0)
+                    tmpArr(1) = aArray(1)(0) - aArray(1)(1) + 1
+                Else  'Vertical line
+                    tmpArr(0) = aArray(1)(0) - aArray(1)(1) + 1
+                    tmpArr(1) = aArray(1)(1)
+                End If
+            End If
+            pointArr(1) = tmpArr
+            tmpEval = ArrayToString(pointArr)
+        Case Else
+            tmpEval = e_ValueError
+              BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
+    End Select
+    PerpendicularLine = tmpEval: Erase tmpData
+    Exit Function
+err_Handler:
+    PerpendicularLine = e_ValueError
+    BuildErrMessage errEvalError, d_lCurly & fName & d_rCurly & " | Error#: " & err.Number & d_Space & _
+                                    d_lParenthesis & err.Description & d_rParenthesis
+End Function
+
 Private Function PMT_(ByRef expression As String, ByRef fName As String) As String
     Dim argsCount As Long
     Dim tmpData() As String
diff --git a/src/VBAexpressionsScope.cls b/src/VBAexpressionsScope.cls
@@ -11,7 +11,7 @@ Option Explicit
 Option Base 0
 '#
 '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-' Copyright � 2022-2024 W. Garc�a
+' Copyright � 2022-2025 W. Garc�a
 ' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
 ' https://ingwilfredogarcia.wordpress.com
 '///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
