Metamorphing Machine
I rather be this walking metamorphosis than having that old formed opinion about everything!
Let's build a transpiler! Part 48
This is the forty-eighth post in a series of building a transpiler.
You can find the previous ones here.
An eventful thing
Events in VB are composed of four elements: Two on the producer side and two on the consumer side.
Suppose we wanted to add an Added event to KeyedList so, anytime a new item is added, KeyedList's user is warned.
First, we would need to declare that KeyedList now has an Added event:
Public Class KeyedList Public Event Added()
(...) End Class
Then, we would need to fire it when a new item is added:
Public Sub Add(ByVal Item As Variant, Optional ByVal Key As Variant, Optional Before As Variant)
(...) RaiseEvent Added End Sub
From the producer side, that's it.
Now on the consumer side.
We would need to declare a WithEvents KeyedList variable. It has to be in a class and its declaration area:
Class MyClass Private WithEvents MyList As KeyedList
(...) End Class
Unfortunately, we cannot declare it "As New KeyedList". So, we need to instantiate it somewhere else:
Private Sub Class_Initialize() Set MyList = New KeyedList End Class
Then we need to set up a handler, that is, the code that will be called when the event happens.
Its name must be composed of the variable's and the event's names:
Private Sub MyList_Added() Rem Do whatever you want here... End Sub
Now, every time an item is added to MyList, MyList_Added will be called.
VB hides a very complex COM protocol behind these four elements.
So far our classes are:
Public Class KeyedList Public Event Added()
(...)
Public Sub Add(...)
(...) RaiseEvent Added() End Sub End Class
Public Class MyClass Private WithEvents MyList As KeyedList
Private Sub Class_Initialize() Set MyList = New KeyedList End Sub
Private Sub MyList_Added() Rem Do whatever you want here... End Sub End Class
Without VB's magic, this is what would happen - kinda:
That event in KeyedList would be moved to an interface.
Public Class IKeyedListEvent Sub Added() End Sub End Class
This is an outgoing interface, meaning it originates from KeyedList, but is implemented externally by KeyedList's clients.
It may also be called 'sink.'
This interface will need an IID:
Const Guid_IKeyedListEvent As Guid = (...)
Then, KeyedList would need to implement IConnectionPoint and IConnectionPointContainer interfaces, so clients would be able to connect to it:
'This is the connectable / source object. It supports - but does not implement - IKeyedListEvent Public Class KeyedList Implements IConnectionPoint Implements IConnectionPointContainer
Private Sub IConnectionPoint_Advise(ByRef Sink As Object, ByRef Cookie As Long)
Cookie = SafeUBound(Sinks) + 1 ReDim Preserve Sinks(Cookie) Set Sinks(Cookie) = Sink End Sub
(...)
Private Sub IConnectionPoint_Unadvise(ByVal Cookie As Long) Set Sinks(Cookie) = Nothing End Sub
Private Sub IConnectionPointContainer_FindConnectionPoint(ByRef ItfId As Guid, ByRef Point As IConnectionPoint) If ItfId = Guid_IKeyedListEvent Then Set Point = Me End Sub
Public Sub Add(...) Dim Sink As IKeyedListEvent
(...)
For Each Sink In Sinks If Not Sink Is Nothing Then Call Sink.Added() Next End Sub End Class
Finally, MyClass would have to implement the outgoing interface and manage the connection and disconnection to the source object:
'This is the client. It may be called 'sink', too. Public Class MyClass Implements IKeyedListEvent
Private Cookie As Long Private Point As IConnectionPoint Private MyList As KeyedList
Private Sub Class_Initialize() Dim Container As IConnectionPointContainer
Set MyList = New KeyedList 'Error checks removed to keep it simple Set Container = MyList
Container.FindConnectioPoint Guid_IKeyedListEvent, Point If Point Is Nothing Then Err.Raise -1
Point.Advise Me, Cookie End Sub
Private Sub IKeyedListEvent_Added() Rem Do whatever you want here... End Sub
Private Sub Class_Terminate()
Point.Unadvise Cookie End Class End Class
So, on the client-side, we have an IConnectionPointContainer variable (Container) that is set to MyList,
which is a KeyedList that implements IConnectionPointContainer interface.
We call its FindConnectioPoint method passing both the GUID to IKeyedListEvent and an IConnectionPoint variable (Point).
If the call is not successful - that is, KeyedList does not support the interface represented by the GUID -,
Point will be Nothing, so we raise an error.
Otherwise, we pass (Me) and a Long variable (Cookie).
We pass Me because KeyedList will call MyClass' IKeyedListEvent implementation through it, that is,
it will call our IKeyedListEvent_Added method.
We pass Cookie because it is an identifier we should use when we are no longer interested in receiving events from KeyedList.
We do that in Class_Terminate method.
On the server-side, if the GUID provided in calling IConnectionPointContainer_FindConnectionPoint is the one for IKeyedListEvent,
we set Point to ourselves (Me), because KeyedList implements the IConnectionPointContainer interface.
In our Advise implementation, we just add another element to an array of IKeyedListEvent and return its index.
We also save Point at that place, so we can call its Added method / IKeyedListEvent implementation in KeyedList's Add method.
Finally, when Unadvise is called, we simply set the place in our array pointed to by Cookie to Nothing.
As it is just an example, we are not de-allocating that array's element because it would turn our code much more complicated.
Back to business
Last time I said I wanted to do so many things...
One of them was to prepare myself to do operations the way VB does.
See, when transpiling to C, while adding two Longs / int32_ts, for instance, if the result is too large to fit in an int32_t,
we have undefined behavior in C, but VB has a very defined behavior for that: Overflow error.
The same goes for several other operators, like -, *, ^, etc.
But, as I said before, I would have to create hundreds of functions to deal with 14 data types times at least 26 operators times 14 data types.
So, I've made a compromise. I'm supposing that if I'm dealing with data type A, operator B, data type C, and I'm getting as result data type D,
I may convert A and C to D and then apply the operator.
Like when multiplying a Single by a Currency and getting a Double.
I can convert Single and Currency to Double and multiply them!
This "reduced" the number of procedures from over 4700 to 310.
Will I use all of them? Probably not, but I want to have it available if needed.
Here are the highlights while working on the code for the operations:
There are two functions in the dump below that I did not create yet:
One that calls a default method on an object - assuming it does have a default method -,
and another that tells me what conversions I should apply to the "A" and "C" data types mentioned above.
I've said before that I had to figure out how to test some 64-bit / LongLong code now that I don't have an
MS Office 64-bit installation available anymore.
What I did to test function Sum_Dec was to implement it in C, test it, then translate it back to VB.
Not much pleasant, but it is an option.
By the way, most functions below were not tested.
I could finally understand the Karatsuba algorithm,
so now I'm using it when multiplying a pair of LongLongs, Currencys, or Decimals.
There's no implementation in the code below for the following operators: + [Identity], AddressOf, AndAlso,
() [Apply], ! [Bang, WithBang], ByVal, . [Dot, WithDot], Like, := [Named], New, OrElse,
To, and TypeOf.
Some are not "real" operators (like Apply), some will be dealt with differently (like AndAlso and OrElse),
and some will be provided later, like, well... Like.
Next week we'll pause our transpiler series to talk about another fiasco of mine (!).
Andrej Biasic
2021-08-18
Update:
Fixed USub64 (changed MAX_LNG and MIN_LNG for MAX_LNGLNG and MIN_LNGLNG respectively. Oh, the shame!)
Andrej Biasic
2021-09-28
Private Module Operations Private Type TooLong
Hi As LongLong
Lo As LongLong End Type
Rem Auxiliary procedures
Private Function USub64(ByVal Minuend As LongLong, ByVal Subtrahend As LongLong) As LongLong Attribute UseHostOps = True If Minuend = 0 Then Exit Subtrahend If Subtrahend = 0 Then Exit Minuend
If Minuend > 0 AndAlso Subtrahend < 0 Then If Minuend > MAX_LNGLNG + Subtrahend Then Exit MIN_LNGLNG + Minuend - Subtrahend + MIN_LNGLNG Exit Minuend - Subtrahend
ElseIf Minuend < 0 AndAlso Subtrahend > 0 Then If Minuend - MIN_LNGLNG - Subtrahend > -1 Then Exit Minuend - Subtrahend Exit Minuend - MIN_LNGLNG - Subtrahend - MIN_LNGLNG
Else Exit Minuend - Subtrahend End If End Function
Private Function UCmp64(ByVal LeftValue As LongLong, ByVal RightValue As LongLong) As Integer Attribute UseHostOps = True If LeftValue = RightValue Then Exit Function If LeftValue >= 0 AndAlso RightValue >= 0 Then Exit IIf(LeftValue > RightValue, 1, -1) If LeftValue < 0 AndAlso RightValue < 0 Then Exit IIf(LeftValue > RightValue, 1, -1) Exit IIf(LeftValue < 0, 1, -1) End Function
Private Sub USub128(ByRef HiLhs As LongLong, ByRef LoLhs As LongLong, ByVal HiRhs As LongLong, ByVal LoRhs As LongLong) Attribute UseHostOps = True Dim HiRes As LongLong = USub64(HiLhs, HiRhs) Dim LoRes As LongLong = USub64(LoLhs, LoRhs)
If UCmp64(LoRes, LoLhs) = 1 Then
HiRes = USub64(HiRes, 1^)
LoRes = UAdd64(LoRes, &H8000000000000000^);
LoRes = UAdd64(LoRes, &H8000000000000000^); End If
HiLhs = HiRes
LoLhs = LoRes End Sub
Private Function XorUCmp128(ByVal HiLhs As LongLong, ByVal LoLhs As LongLong, ByVal HiRhs As LongLong, ByVal LoRhs As LongLong) As Integer Dim Hi As LongLong = Xor_Big(HiLhs, HiRhs) Dim Lo As LongLong = Xor_Big(LoLhs, LoRhs) Exit UCmp128(Hi, Lo, HiRhs, LoRhs) End Function
Private Function UCmp128(ByVal HiLhs As LongLong, ByVal LoLhs As LongLong, ByVal HiRhs As LongLong, ByVal LoRhs As LongLong) As Integer Select Case UCmp64(HiLhs, HiRhs) Case 1 Exit 1
Case 0 Exit UCmp64(LoLhs, LoRhs)
Case Else Exit -1 End Select End Function
Private Sub Inc128(ByRef T As TooLong) Attribute UseHostOps = True If T.Lo = -1^ Then If T.Hi = -1^ Then Err.Raise 6
T.Lo = 0^
T.Hi += 1^ Else
T.Lo += 1^ End If End Sub
Private Function DblDelta(ByVal Value As Double) As Double Attribute UseHostOps = True If Value > -10000000000000000 AndAlso Value <= -1000000000000000 Then Exit -1.0E-1 If Value > -1000000000000000 AndAlso Value <= -100000000000000 Then Exit -1.0E-2 If Value > -100000000000000 AndAlso Value <= -10000000000000 Then Exit -1.0E-3 If Value > -10000000000000 AndAlso Value <= -1000000000000 Then Exit -1.0E-4 If Value > -1000000000000 AndAlso Value <= -100000000000 Then Exit -1.0E-5 If Value > -100000000000 AndAlso Value <= -10000000000 Then Exit -1.0E-6 If Value > -10000000000 AndAlso Value <= -1000000000# Then Exit -1.0E-7 If Value > -1000000000# AndAlso Value <= -100000000# Then Exit -1.0E-8 If Value > -100000000# AndAlso Value <= -10000000# Then Exit -1.0E-9 If Value > -10000000# AndAlso Value <= -1000000# Then Exit -1.0E-10 If Value > -1000000# AndAlso Value <= -100000# Then Exit -1.0E-11 If Value > -100000# AndAlso Value <= -10000# Then Exit -1.0E-12 If Value > -10000# AndAlso Value <= -1000# Then Exit -1.0E-13 If Value > -1000# AndAlso Value <= -100# Then Exit -1.0E-14 If Value > -100# AndAlso Value <= -10# Then Exit -1.0E-15 If Value > -10# AndAlso Value < 0 Then Exit -1.0E-16 If Value >= 0# AndAlso Value < 10# Then Exit 1.0E-16 If Value >= 10# AndAlso Value < 100# Then Exit 1.0E-15 If Value >= 100# AndAlso Value < 1000# Then Exit 1.0E-14 If Value >= 1000# AndAlso Value < 10000# Then Exit 1.0E-13 If Value >= 10000# AndAlso Value < 100000# Then Exit 1.0E-12 If Value >= 100000# AndAlso Value < 1000000# Then Exit 1.0E-11 If Value >= 1000000# AndAlso Value < 10000000# Then Exit 1.0E-10 If Value >= 10000000# AndAlso Value < 100000000# Then Exit 1.0E-9 If Value >= 100000000# AndAlso Value < 1000000000# Then Exit 1.0E-8 If Value >= 1000000000# AndAlso Value < 10000000000 Then Exit 1.0E-7 If Value >= 10000000000 AndAlso Value < 100000000000 Then Exit 1.0E-6 If Value >= 100000000000 AndAlso Value < 1000000000000 Then Exit 1.0E-5 If Value >= 1000000000000 AndAlso Value < 10000000000000 Then Exit 1.0E-4 If Value >= 10000000000000 AndAlso Value < 100000000000000 Then Exit 1.0E-3 If Value >= 100000000000000 AndAlso Value < 1000000000000000 Then Exit 1.0E-2 If Value >= 1000000000000000 AndAlso Value < 10000000000000000 Then Exit 1.0E-1 End Function
Private Function SngDelta(ByVal Value As Single) As Single Attribute UseHostOps = True If Value > -10000000000000000! AndAlso Value <= -1000000000000000! Then Exit -1.0E-1! If Value > -1000000000000000! AndAlso Value <= -100000000000000! Then Exit -1.0E-2! If Value > -100000000000000! AndAlso Value <= -10000000000000! Then Exit -1.0E-3! If Value > -10000000000000! AndAlso Value <= -1000000000000! Then Exit -1.0E-4! If Value > -1000000000000! AndAlso Value <= -100000000000! Then Exit -1.0E-5! If Value > -100000000000! AndAlso Value <= -10000000000! Then Exit -1.0E-6! If Value > -10000000000! AndAlso Value <= -1000000000! Then Exit -1.0E-7! If Value > -1000000000! AndAlso Value <= -100000000! Then Exit -1.0E-8! If Value > -100000000! AndAlso Value <= -10000000! Then Exit -1.0E-9! If Value > -10000000! AndAlso Value <= -1000000! Then Exit -1.0E-10! If Value > -1000000! AndAlso Value <= -100000! Then Exit -1.0E-11! If Value > -100000! AndAlso Value <= -10000! Then Exit -1.0E-12! If Value > -10000! AndAlso Value <= -1000! Then Exit -1.0E-13! If Value > -1000! AndAlso Value <= -100! Then Exit -1.0E-14! If Value > -100! AndAlso Value <= -10! Then Exit -1.0E-15! If Value > -10! AndAlso Value < 0! Then Exit -1.0E-16! If Value >= 0! AndAlso Value < 10! Then Exit 1.0E-16! If Value >= 10! AndAlso Value < 100! Then Exit 1.0E-15! If Value >= 100! AndAlso Value < 1000! Then Exit 1.0E-14! If Value >= 1000! AndAlso Value < 10000! Then Exit 1.0E-13! If Value >= 10000! AndAlso Value < 100000! Then Exit 1.0E-12! If Value >= 100000! AndAlso Value < 1000000! Then Exit 1.0E-11! If Value >= 1000000! AndAlso Value < 10000000! Then Exit 1.0E-10! If Value >= 10000000! AndAlso Value < 100000000! Then Exit 1.0E-9! If Value >= 100000000! AndAlso Value < 1000000000! Then Exit 1.0E-8! If Value >= 1000000000! AndAlso Value < 10000000000! Then Exit 1.0E-7! If Value >= 10000000000! AndAlso Value < 100000000000! Then Exit 1.0E-6! If Value >= 100000000000! AndAlso Value < 1000000000000! Then Exit 1.0E-5! If Value >= 1000000000000! AndAlso Value < 10000000000000! Then Exit 1.0E-4! If Value >= 10000000000000! AndAlso Value < 100000000000000! Then Exit 1.0E-3! If Value >= 100000000000000! AndAlso Value < 1000000000000000! Then Exit 1.0E-2! If Value >= 1000000000000000! AndAlso Value < 10000000000000000! Then Exit 1.0E-1! End Function
Rem Taken from https://www.codeproject.com/tips/311714/natural-logarithms-and-exponent Rem Used by Pow_Dbl Public Function Exp(ByVal Exponent As Double) As Double Dim I As Double Dim L As Double Dim P As Double Dim X As Double Dim Frac As Double
X = Exponent
Frac = X
P = X + 1
I = 1
Do
I = I + 1
Frac = Frac * (X / I)
L = P
P = P + Frac Loop While L <> P
Exp = P End Function
Rem Taken from https://www.codeproject.com/tips/311714/natural-logarithms-and-exponent Rem Used by Pow_Dbl Public Function Ln(ByVal Power As Double) As Double Dim A As Double Dim E As Double Dim L As Double Dim N As Double Dim P As Double Dim R As Double
E = 2.71828182845905
P = Power
Rem This speeds up the convergence by calculating the integral While P >= E
P /= E
N += 1 Wend
N += P / E
P = Power
Do
A = N
L = P / Exp(N - 1)
R = (N - 1) * E
N = (L + R) / E Loop While N <> A
Ln = N End Function
Rem From Hacker's Delight 2nd Ed. - Henry S. Warren, Jr. Private Sub DblLenRSh(ByRef Hi As LongLong, ByRef Lo As LongLong, ByVal Count As Integer) Attribute UseHostOps = True If Count = 0 Then Exit Sub
If Count > SizeOf(vbLongLong) Then
Lo = Hi >>> (Count - SizeOf(vbLongLong))
Hi = 0
ElseIf Count < SizeOf(vbLongLong) Then
Lo = Lo >>> Count Or Hi << (SizeOf(vbLongLong) - Count)
Hi = Hi >>> Count
Else'Count = SizeOf(vbLongLong)
Lo = Hi
Hi = 0 End If End Sub
Private Sub DblLenLSh(ByRef Hi As LongLong, ByRef Lo As LongLong, ByVal Count As Integer) Attribute UseHostOps = True If Count = 0 Exit Sub
If Count > SizeOf(vbLongLong) Then
Hi = Lo << (Count - SizeOf(vbLongLong))
Lo = 0
ElseIf Count < SizeOf(vbLongLong) Then
Hi = Hi << Count Or Lo >> (SizeOf(vbLongLong) - Count)
Lo <<= Count
Else'Count = SizeOf(vbLongLong)
Hi = Lo
Lo = 0 End If End Sub
Private Sub DecAppendOvf(ByRef THigh As Long, ByRef TMiddle As Long, ByRef TLow As Long, ByVal Digit As Long) Dim h As Long = THigh Dim m As Long = TMiddle Dim l As Long = TLow
Dim Result As Boolean = DecAppend(h, m, l, Digit) If Result Then Err.Raise 6
THigh = h
TMiddle = m
TLow = l End Sub
Private Sub DecTrunc10(ByRef Value As Decimal, Optional ByRef Remainder As Integer) Attribute UseHostOps = True Dim b As TooLong = &H1000000000000000^ Dim b10 As TooLong = &HA000000000000000^ Dim v As TooLong Dim x As TooLong
While b.Hi <> 0 AndAlso b.Lo <> 0 If UCmp128(b10.Hi, b10.Lo, v.Hi, v.Lo) <> 1 Then
USub128 v.Hi, v.Lo, b10.Hi, b10.Lo
x.Hi Or= b.Hi
x.Lo Or= b.Lo End If
DblLenRSh b10.Hi, b10.Lo, 1
DblLenRSh b.Hi, b.Lo, 1 End While
x.Hi <<= SizeOf(vbLong)
v.Hi <<= SizeOf(vbLong)
CopyMemory VarPtr(Value), VarPtr(x), SizeOf(vbDecimal)
Remainder = BigToInt(v.Lo) End Sub
Private Function FixDec(ByVal Value As Decimal) As Decimal 'TODO: This function should be in Conversions module Dim Dec As DecimalStruct
CopyMemory VarPtr(Dec), VarPtr(Value), SizeOf(vbDecimal)
While Dec.Places
DecTrunc10 Value
Dec.Places -= 1 End While End Function
Private Function DecayObj(ByVal Obj As Object) As Variant If Obj Is Nothing Then Err.Raise 91 'TODO: Implement it End Function
Private Function InferVarType(ByVal LHS As VbVarType, ByVal Op As Long, ByVal RHS As VbVarType) As VbVarType 'TODO: Implement it End Function
Rem Operator Not Public Function Not_Bln(ByVal Value As Boolean) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit True Xor Value End Function
Public Function Not_Byt(ByVal Value As Byte) As Byte Attribute UseHostOps = True Attribute Inline = True Exit Not Value End Function
Public Function Not_Int(ByVal Value As Integer) As Integer Attribute UseHostOps = True Attribute Inline = True Exit Not Value End Function
Public Function Not_Lng(ByVal Value As Long) As Long Attribute UseHostOps = True Attribute Inline = True Exit Not Value End Function
Public Function Not_Big(ByVal Value As LongLong) As LongLong Attribute UseHostOps = True Attribute Inline = True Exit Not Value End Function
Public Function Not_Ptr(ByVal Value As LongPtr) As LongPtr Attribute UseHostOps = True Attribute Inline = True Exit Not Value End Function
Public Function Not_Cur(ByVal Value As Currency) As Long Exit Not_Lng(CurToLng(Value)) End Function
Public Function Not_Dec(ByVal Value As Decimal) As Long Exit Not_Lng(DecToLng(Value)) End Function
Public Function Not_Sng(ByVal Value As Single) As Long Exit Not_Lng(SngToLng(Value)) End Function
Public Function Not_Dbl(ByVal Value As Double) As Long Exit Not_Lng(DblToLng(Value)) End Function
Public Function Not_Dtm(ByVal Value As Date) As Long Exit Not_Lng(DtmToLng(Value)) End Function
Public Function Not_Str(ByVal Value As String) As Long Exit Not_Lng(StrToLng(Value)) End Function
Public Function Not_Obj(ByVal Value As Object) As Variant Exit Not_Var(ObjToVar(Value)) End Function
Public Function Not_Var(ByVal Value As Variant) As Variant Select Case VarType(Value) Case vbEmpty Exit IntToVar(0)
Case vbNull Exit Null
Case vbBoolean Exit BlnToVar(Not_Bool(VarToBln(Value)))
Case vbByte Exit BytToVar(Not_Byt(VarToByt(Value)))
Case vbInteger Exit IntToVar(Not_Int(VarToInt(Value)))
Case vbLong Exit LngToVar(Not_Lng(VarToLng(Value)))
Case vbLongPtr Exit PtrToVar(Not_Ptr(VarToPtr(Value)))
Case vbLongLong Exit BigToVar(Not_Big(VarToBig(Value)))
Case vbCurrency Exit LngToVar(Not_Cur(VarToCur(Value)))
Case vbDecimal Exit LngToVar(Not_Dec(VarToDec(Value)))
Case vbSingle Exit LngToVar(Not_Sng(VarToSng(Value)))
Case vbDouble Exit LngToVar(Not_Dbl(VarToDbl(Value)))
Case vbDate Exit LngToVar(Not_Dtm(VarToDtm(Value)))
Case vbString Exit LngToVar(Not_Str(VarToStr(Value)))
Case vbObject Exit Not_Var(DecayObj(Value))
Case Else
Err.Raise 13 End Select End Function
Rem Operator unary - Public Function Neg_Bln(ByVal Value As Boolean) As Integer If Value Then Exit 1 Else Exit 0 End Function
Public Function Neg_Byt(ByVal Value As Byte) As Integer Exit Neg_Int(BytToInt(Value)) End Function
Public Function Neg_Int(ByVal Value As Integer) As Integer Attribute UseHostOps = True If Value = MIN_INT Then Err.Raise 6 Exit -Value End Function
Public Function Neg_Lng(ByVal Value As Long) As Long Attribute UseHostOps = True Attribute Inline = True Rem VB does not overflow when -&H80000000, it gives &H80000000 back! Exit -Value End Function
Public Function Neg_Big(ByVal Value As LongLong) As LongLong Attribute UseHostOps = True Attribute Inline = True Rem I'm copyng Neg_Lng behaviour here. Exit -Value End Function
Public Function Neg_Ptr(ByVal Value As LongPtr) As LongPtr Attribute UseHostOps = True Attribute Inline = True Exit -Value End Function
Public Function Neg_Cur(ByVal Value As Currency) As Currency Attribute UseHostOps = True Attribute Inline = True Exit -Value End Function
Public Function Neg_Dec(ByVal Value As Decimal) As Decimal Dim SDec As DecimalStruct Dim Result As Decimal
CopyMemory VarPtr(SDec), VarPtr(Value), SizeOf(vbDecimal) If SDec.Sign = Sign Then SDec.Sign = 0 Else SDec.Sign = Sign
CopyMemory VarPtr(Result), VarPtr(SDec), SizeOf(vbDecimal) Exit Result End Function
Public Function Neg_Sng(ByVal Value As Single) As Single Attribute UseHostOps = True Attribute Inline = True Exit -Value End Function
Public Function Neg_Dbl(ByVal Value As Double) As Double Attribute UseHostOps = True Attribute Inline = True Exit -Value End Function
Public Function Neg_Dtm(ByVal Value As Date) As Date Attribute UseHostOps = True Dim Dbl As Double = DtmToDbl(Value)
Dbl = -Dbl Dim Result As Date = DblToDtm(Dbl) If Result < MIN_DATE OrElse Result >= MAX_DATE Then Err.Raise 6 Exit Result End Function
Public Function Neg_Str(ByVal Value As String) As Double Exit Neg_Dbl(StrToDbl(Value)) End Function
Public Function Neg_Obj(ByVal Value As Object) As Variant Exit Neg_Var(DecayObj(Value)) End Function
Public Function Neg_Var(ByVal Value As Variant) As Variant Select Case VarType(Value) Case vbEmpty Exit IntToVar(0)
Case vbNull Exit Null
Case vbBoolean Exit BlnToVar(Neg_Bool(VarToBln(Value)))
Case vbByte Exit BytToVar(Neg_Byt(VarToByt(Value)))
Case vbInteger Exit IntToVar(Neg_Int(VarToInt(Value)))
Case vbLong Exit LngToVar(Neg_Lng(VarToLng(Value)))
Case vbLongPtr Exit PtrToVar(Neg_Ptr(VarToPtr(Value)))
Case vbLongLong Exit BigToVar(Neg_Big(VarToBig(Value)))
Case vbCurrency Exit LngToVar(Neg_Cur(VarToCur(Value)))
Case vbDecimal Exit LngToVar(Neg_Dec(VarToDec(Value)))
Case vbSingle Exit LngToVar(Neg_Sng(VarToSng(Value)))
Case vbDouble Exit LngToVar(Neg_Dbl(VarToDbl(Value)))
Case vbDate Exit LngToVar(Neg_Dtm(VarToDtm(Value)))
Case vbString Exit LngToVar(Neg_Str(VarToStr(Value)))
Case vbObject Exit Neg_Var(DecayObj(Value))
Case Else
Err.Raise 13 End Select End Function
Rem Operator binary + Public Function Sum_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Integer Exit Sum_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Sum_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Dim Result As Integer
Result = LHS + RHS 'Implicit widening Exit IntToByt(Result) End Function
Public Function Sum_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Dim Result As Long
Result = LHS + RHS 'Implicit widening Exit LngToInt(Result) End Function
Public Function Sum_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Dim Result As LongLong
Result = LHS + RHS 'Implicit widening Exit BigToLng(Result) End Function
Public Function Sum_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong If LHS > 0 AndAlso RHS > 0 Then If MAX_LNGLNG - LHS < RHS Then Err.Raise 6
ElseIf LHS < 0 AndAlso RHS < 0 Then If Min_LNGLNG - LHS > RHS Then Err.Raise 6 End If
Exit LHS + RHS End Function
Public Function Sum_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr If LHS > 0 AndAlso RHS > 0 Then #If Win64 Then If MAX_LNGLNG - LHS < RHS Then Err.Raise 6
ElseIf LHS < 0 AndAlso RHS < 0 Then If MIN_LNGLNG - LHS > RHS Then Err.Raise 6 #Else If MAX_LNG - LHS < RHS Then Err.Raise 6
ElseIf LHS < 0 AndAlso RHS < 0 Then If MIN_LNG - LHS > RHS Then Err.Raise 6 #End If End If
Exit LHS + RHS End Function
Public Function Sum_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Currency Dim Cur1 As LongLong Dim Cur2 As LongLong
CopyMemory VarPtr(Cur1), VarPtr(LHS), SizeOf(vbCurrency)
CopyMemory VarPtr(Cur2), VarPtr(RHS), SizeOf(vbCurrency)
Cur1 = Sum_Big(Cur1, Cur2) Exit BigToCur(Cur1) End Function
Public Function Sum_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Decimal Attribute UseHostOps = True Dim Carry1 As Boolean Dim Carry2 As Boolean Dim Dec As Decimal Dim Res As DecimalStruct Dim LDec As DecimalStruct Dim RDec As DecimalStruct
Rem Align decimal dots If LDec.Places > RDec.Places Then While LDec.Places > RDec.Places If (RDec.High And &H80000000) <> 0 Then Exit While
DecAppend RDec.High, RDec.Middle, RDec.Low, 0
RDec.Places += 1 Wend
ElseIf LDec.Places < RDec.Places Then While LDec.Places < RDec.Places If (LDec.High And &H80000000) <> 0 Then Exit While
DecAppend LDec.High, LDec.Middle, LDec.Low, 0
LDec.Places += 1 Wend End If
If LDec.Places > RDec.Places Then
CopyMemory VarPtr(Dec), VarPtr(LDec), SizeOf(vbDecimal)
Dec = RoundDec(Dec, RDec.Places)
CopyMemory VarPtr(LDec), VarPtr(Dec), SizeOf(vbDecimal)
ElseIf LDec.Places < RDec.Places Then
CopyMemory VarPtr(Dec), VarPtr(RDec), SizeOf(vbDecimal)
Dec = RoundDec(Dec, LDec.Places)
CopyMemory VarPtr(RDec), VarPtr(Dec), SizeOf(vbDecimal) End If
If LDec.Sign = RDec.Sign Then Rem Sum
Res.Low = UAdd(LDec.Low, RDec.Low)
Res.Middle = UAdd(LDec.Middle, RDec.Middle)
Res.High = UAdd(LDec.High, RDec.High)
If Carry1 Then
Res.Middle = UAdd(Res.Middle, 1) If Not Carry2 Then Carry2 = UCmp(Res.Middle, LDec.Middle) = -1 OrElse UCmp(Res.Middle, RDec.Middle) = -1 End If
If Carry1 Then
Res.Middle = USub(Res.Middle, 1) If Not Carry2 Then Carry2 = UCmp(Res.Middle, LDec.Middle) = 1 OrElse UCmp(Res.Middle, RDec.Middle) = 1 End If
If UCmp(LDec.High, RDec.High) = -1 OrElse _
UCmp(LDec.High, RDec.High) = 0 AndAlso UCmp(LDec.High, RDec.High) = -1 OrElse _
UCmp(LDec.High, RDec.High) = 0 AndAlso UCmp(LDec.High, RDec.High) = 0 AndAlso UCmp(LDec.Low, RDec.Low) = -1 Then _
Res.Sign = RDec.Sign End If
CopyMemory VarPtr(Sum_Dec), VarPtr(Res), SizeOf(vbDecimal) End Function
Public Function Sum_Sng(ByVal LHS As Single, ByVal RHS As Single) As Single Dim Dbl1 As Double = SngToDbl(LHS) Dim Dbl2 As Double = SngToDbl(RHS)
Dbl1 = Sum_Dbl(Dbl1, Dbl2) Exit DblToSng(Dbl1) End Function
Public Function Sum_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Double Attribute UseHostOps = True Exit LHS + RHS End Function
Public Function Sum_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Date Attribute UseHostOps = True Dim Result As Date
Result = LHS + RHS If Result < MIN_DATE OrElse Result >= MAX_DATE Then Err.Raise 6 Exit Result End Function
Public Function Sum_Str(ByVal LHS As String, ByVal RHS As String) As String Exit Con_Str(LHS, RHS) End Function
Public Function Sum_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opSum, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Sum_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Sum_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Sum_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Sum_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Sum_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Sum_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Sum_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Sum_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Sum_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator binary - Public Function Sub_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Integer Exit Sub_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Sub_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Attribute Inline = True If RHS > LHS Then Err.Raise 6 Exit LHS - RHS End Function
Public Function Sub_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Attribute Inline = True If RHS = MIN_INT Then Err.Raise 6 Exit LHS - RHS End Function
Public Function Sub_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Attribute Inline = True If RHS = MIN_LNG Then Err.Raise 6 Exit LHS - RHS End Function
Public Function Sub_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Attribute Inline = True If RHS = MIN_LNGLNG Then Err.Raise 6 Exit LHS - RHS End Function
Public Function Sub_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr #If Win64 Then If RHS = MIN_LNGLNG Then Err.Raise 6 #Else If RHS = MIN_LNG Then Err.Raise 6 #End If Exit LHS - RHS End Function
Public Function Sub_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Currency Attribute UseHostOps = True Attribute Inline = True If RHS = MIN_CUR Then Err.Raise 6 Exit LHS - RHS End Function
Public Function Sub_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Decimal Exit Sum_Dec(LHS, Neg_Dec(RHS)) End Function
Public Function Sub_Sng(ByVal LHS As Single, ByVal RHS As Single) As Single Attribute UseHostOps = True Attribute Inline = True Exit LHS - RHS End Function
Public Function Sub_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Double Attribute UseHostOps = True Attribute Inline = True Exit LHS - RHS End Function
Public Function Sub_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Double Exit Sub_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Sub_Str(ByVal LHS As String, ByVal RHS As String) As Double Exit Sub_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Sub_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opSubt, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Sub_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Sub_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Sub_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Sub_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Sub_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Sub_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Sub_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Sub_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Sub_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator * Public Function Mul_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Integer Exit Mul_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Mul_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Dim Result As Integer = BytToInt(LHS) * BytToInt(RHD) If Result < MIN_BYTE OrElse Result > MAX_BYTE Then Err.Raise 6 Exit IntToByt(Result) End Function
Public Function Mul_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Dim Result As Long = IntToLng(LHS) * IntToLng(RHD) If Result < MIN_INT OrElse Result > MAX_INT Then Err.Raise 6 Exit LngToInt(Result) End Function
Public Function Mul_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Dim Result As LongLong = LngToBig(LHS) * LngToBig(RHD) If Result < MIN_LNG OrElse Result > MAX_LNG Then Err.Raise 6 Exit BigToLng(Result) End Function
Private Function Karatsuba(ByVal Multiplicand As LongLong, ByVal Multiplier As LongLong, ByRef HiLngLng As LongLong) As LongLong Attribute UseHostOps = True If Multiplicand = 0 OrElse Multiplier = 0 Then Exit Function If Multiplicand = 1 Then Exit Multiplier If Multiplier = 1 Then Exit Multiplicand If Multiplicand = -1 Then Exit -Multiplier If Multiplier = -1 Then Exit -Multiplicand
Const HALF_LEN = SizeOf(vbLongLong) \ 2 Dim Hi1 As LongLong = Multiplicand >> HALF_LEN Dim Lo1 As LongLong = Multiplicand And &HFFFFFFFF^ Dim Hi2 As LongLong = Multiplier >> HALF_LEN Dim Lo2 As LongLong = Multiplier And &HFFFFFFFF^
Dim LH1 As LongLong = Lo1 - Hi1 Dim LH2 As LongLong = Hi2 - Lo2 Dim Z2 As LongLong = Hi1 * Hi2 Dim Z0 As LongLong = Lo1 * Lo2
'-----------------------------' Dim Count As Integer
If LH1 < 0 Then
Count = 1
LH1 = -LH1 End If
If LH2 < 0 Then
Count += 1
LH2 = -LH2 End If
Dim HLs As LongLong = LH1 * LH2 If Count = 1 Then HLs = -HLs '-----------------------------'
Dim Z20 As LongLong = Z2 + Z0 Dim HLZ As LongLong = HLs + Z20
Dim Result As LongLong = Z0 Dim Shifted As LongLong = HLZ << HALF_LEN
Result = UAdd64(Result, Shifted)
HiLngLng = Z2
If UCmp64(Result, Z0) = -1 OrElse UCmp64(Result, Shifted) = -1 Then If HiLngLng = -1 Then Err.Raise 6
HiLngLng += 1 End If
HiLngLng = UAdd64(HiLngLng, HLZ >> HALF_LEN) Exit Result End If
Public Function Mul_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Dim Overflow As LongLong
Dim Result As LongLong = Karatsuba(LHS, RHS, `ByRef´ Overflow) If Overflow <> 0 Then Err.Raise 6 Exit Result End Function
Public Function Mul_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr #If Win64 Then Exit Mul_Big(LHS, RHS) '<- Implicit conversion #Else Exit Mul_Lng(LHS, RHS) '<- Implicit conversion #End If End Function
Public Function Mul_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Currency Attribute UseHostOps = True Dim IsNeg As Boolean Dim Middle As LongLong
Dim LBig As LongLong = CurToBig(LHS) '1.2345@ -> 12345^ Dim RBig As LongLong = CurToBig(RHS) '9.8765@ -> 98765^ Rem 12345^ * 98765^ = 1_219_253_925^ = &H0_48AC_56A5 -> Middle = 0, Result = &H48AC_56A5 Dim Result As LongLong = Karatsuba(LBig, RBig, `ByRef´ Middle)
IsNeg = LBig < 0 Xor RBig < 0
Dim SDec As DecimalStruct
SDec.Low = Result
SDec.Middle = Middle
SDec.Places = 4 'Middle_Result actually has 8 decimal places, but we want to round it to 4, so a little while lie here. If IsNeg Then SDec.Sign = Sign
Dim Dec As Decimal
CopyMemory VarPtr(Dec), VarPtr(SDec), SizeOf(vbDecimal)
Dec = RoundDec(Dec, 4)
CopyMemory VarPtr(SDec), VarPtr(Dec), SizeOf(vbDecimal) If SDec.Middle <> 0 Then Err.Raise 6
CopyMemory VarPtr(Result), VarPtr(SDec.Low), SizeOf(vbLongLong) If IsNeg Then Result = Neg_Big(Result)
CopyMemory VarPtr(Mul_Cur), VarPtr(Result), SizeOf(vbCurrency) End Function
Public Function Mul_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Decimal Attribute UseHostOps = True Dim Done As Boolean Dim Res1 As LongLong Dim Res2 As LongLong Dim Ovf1 As LongLong Dim RetVal As Decimal Dim LDec As DecimalStruct Dim RDec As DecimalStruct
Res1 = LSh(Res2, 32) Or Res1 If LDec.Sign <> RDec.Sign Then Res1.Sign = Sign
Res1.Places = LDec.Places + RDec.Places End If
CopyMemory VarPtr(RetVal), VarPtr(Res1), SizeOf(vbDecimal) If Res1.Places > 28 Then RetVal = RoundDec(RetVal, Res1.Places - 28) Exit RetVal End Function
Public Function Mul_Sng(ByVal LHS As Single, ByVal RHS As Single) As Single Attribute UseHostOps = True Attribute Inline = True Exit LHS * RHS End Function
Public Function Mul_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Double Attribute UseHostOps = True Attribute Inline = True Exit LHS * RHS End Function
Public Function Mul_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Double Exit Mul_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Mul_Str(ByVal LHS As String, ByVal RHS As String) As Double Exit Mul_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Mul_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opMul, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Mul_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Mul_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Mul_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Mul_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Mul_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Mul_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Mul_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Mul_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Mul_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator / Public Function Div_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Double Exit Div_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Div_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Double Exit Div_Dbl(BytToDbl(LHS), BytToDbl(RHS)) End Function
Public Function Div_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Double Exit Div_Dbl(IntToDbl(LHS), IntToDbl(RHS)) End Function
Public Function Div_Lng(ByVal LHS As Long, ByVal RHS As Long) As Double Exit Div_Dbl(LngToDbl(LHS), LngToDbl(RHS)) End Function
Public Function Div_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Double Exit Div_Dbl(BigToDbl(LHS), BigToDbl(RHS)) End Function
Public Function Div_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Double Exit Div_Dbl(PtrToDbl(LHS), PtrToDbl(RHS)) End Function
Public Function Div_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Double Exit Div_Dbl(CurToDbl(LHS), CurToDbl(RHS)) End Function
Private Function IntDivDec(ByVal Dividend As Decimal, ByVal Divisor As Decimal, ByRef Remainder As Decimal) As Decimal Dim Shifts As Integer Dim Count As Integer Dim HiBits As LongLong Dim LoBits As LongLong
Dim RDec As DecimalStruct Dim LDec As DecimalStruct Dim RetVal As DecimalStruct Dim RetMod As DecimalStruct
Dim TRhs As TooLong Dim TLhs As TooLong Dim TVal As TooLong Dim TMod As TooLong Dim TDiv As TooLong Dim TRes As TooLong
Rem Find RHS' MSB While HiBits AndAlso (HiBits And TRhs.Hi) = 0
HiBits >>>= 1 End While
If HiBits <> 0 Then If HiBits <> &H8000000000000000 Then HiBits Or= HiBits - 1 'Set all 0s at the rigth of the HiBits, i.e. 00010000 -> 00011111 If (HiBits And 1) <> 0 Then LoBits = -1
Else
LoBits = &H8000000000000000^
While (LoBits And TRhs.Lo) = 0
LoBits >>>= 1 End While
If LoBits <> &H8000000000000000^ Then LoBits Or= LoBits - 1 End If
Rem Count how many shifts are needed to align divisor's MSB to dividend's (TLhs) MSB While UCmp128(HiBits, LoBits, TLhs.Hi, TLhs.Lo) = -1 '''''''' MSB <<= 1 ''''''''
DblLenLSh HiBits, LoBits, 1
'''''''''' MSB += 1 '''''''''' If LoBits = -1 Then
LoBits = 0
HiBits = UAdd64(HiBits, 1)
Else
LoBits = UAdd64(LoBits, 1) End If ''''''''''''''''''''''''''''''
Shifts += 1 End While
Do
USub128 TVal.Hi, Val.Lo, TDiv.Hi, TDiv.Lo
Inc128 TRes
Count = 0
' Re-count to align MSBs again While XorUCmp128(HiBits, LoBits, TVal.Hi, TVal.Lo) <> -1 AndAlso Shifts > Count '''''''' MSB >>= 1 ''''''''
DblLenRSh HiBits, LoBits, 1 '''''''''''''''''''''''''''
Count += 1 End While
DblLenRSh TDiv.Hi, TDiv.Lo, Count
'Adjustment if after MSBs are aligned [divisor] is greater than [dividend] If UCmp128(TDiv.Hi, TDiv.Lo, TVal.Hi, TVal.Lo) = 1 Then
Count += 1
DblLenRSh HiBits, LoBits, 1
DblLenRSh TDiv.Hi, TDiv.Lo, 1 End If
If Shifts < Count Then ''''''''' TRes <<= Count '''''''''
DblLenLSh TRes.Hi, TRes.Lo, Shifts ''''''''''''''''''''''''''''''''''
Shifts = 0 Else
Shifts -= Count ''''''''' TRes <<= Count ''''''''
DblLenLSh TRes.Hi, TRes.Lo, Count ''''''''''''''''''''''''''''''''' End If Loop While Shifts > 0
TVal.Hi <<= 32
TRes.Hi <<= 32
LSet RetMod = TVal LSet RetVal = TRes End If
Dim p As Integer
If LDec.Places > RDec.Places Then
p = BigToInt(LDec.Places - RDec.Places) Else
p = BigToInt(RDec.Places - LDec.Places) End If
While p
p -= 1
DecAppendOvf RetVal.High, RetVal.Middle, RetVal.Low, 0 'Multiply by 10 End While
If LDec.Sign <> RDec.Sign Then RetVal.Sign = Sign
CopyMemory VarPtr(Remainder), VarPtr(RetMod), SizeOf(vbDecimal)
CopyMemory VarPtr(IntDivDec), VarPtr(RetVal), SizeOf(vbDecimal) End Function
Public Function Div_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Decimal Attribute UseHostOps = True Dim TDiv As TooLong Dim TMod As TooLong Dim Remainder As Decimal
Rem Integer division Dim Result As Decimal = IntDivDec(LHS, RHS, Remainder)
CopyMemory VarPtr(TDiv), VarPtr(RHS), SizeOf(vbDecimal)
TDiv.Hi >>= 32
If Remainder.High <> 0 OrElse Remainder.Middle <> 0 OrElse Remainder.Low <> 0 Then Dim Digit As Integer Dim Last As Integer
If UCmp128(TMod.Hi, TMod.Lo, TDiv.Hi, TDiv.Lo) <> -1 Then Dim Recurse As Decimal = IntDivDec(Remainder, RHS, Remainder)
Digit = BigToInt(Recurse.Low) End If
Dim Breake As Boolean = DecAppend(Result.High, Result.Middle, Result.Low, Digit) If Break Then Exit While
Last = Digit
Result.Places += 1 End While
Select Case Digit Case 6 To 9
DecAdd Result.High, esult.Middle, Result.Low, 1
Case 5 If (Last And 1) <> 0 Then DecAdd Result.High, Result.Middle, Result.Low, 1 End Select End If
Result.TypeDescriptor = vbDecimal Exit Result End Function
Public Function Div_Sng(ByVal LHS As Single, ByVal RHS As Single) As Single Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS / RHS End Function
Public Function Div_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Double Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS / RHS End Function
Public Function Div_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Double Exit Div_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Div_Str(ByVal LHS As String, ByVal RHS As String) As Double Exit Div_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Div_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opDiv, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Div_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Div_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Div_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Div_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Div_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Div_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Div_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Div_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Div_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator \ Public Function Bls_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Integer Exit Bls_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Bls_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte If RHS = 0 Then Err.Raise 11 Dim Result As Double = Div_Dbl(BytToDbl(LHS), BytToDbl(RHS)) Exit DblToByt(Result) End Function
Public Function Bls_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer If RHS = 0 Then Err.Raise 11 Dim Result As Double = Div_Dbl(IntToDbl(LHS), IntToDbl(RHS)) Exit DblToInt(Result) End Function
Public Function Bls_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long If RHS = 0 Then Err.Raise 11 Dim Result As Double = Div_Dbl(LngToDbl(LHS), LngToDbl(RHS)) Exit DblToLng(Result) End Function
Public Function Bls_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong If RHS = 0 Then Err.Raise 11 Dim Result As Double = Div_Dbl(BigToDbl(LHS), BigToDbl(RHS)) Exit DblToBig(Result) End Function
Public Function Bls_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr If RHS = 0 Then Err.Raise 11 Dim Result As Double #If Win64 Then
Result = Div_Dbl(BigToDbl(LHS), BigToDbl(RHS)) Exit DblToBig(Result) '<- Implicit conversion #Else
Result = Div_Dbl(LngToDbl(LHS), LngToDbl(RHS)) Exit DblToLng(Result) '<- Implicit conversion #End If End Function
Public Function Bls_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long If RHS = 0 Then Err.Raise 11 Dim Result As Double = Div_Dbl(CurToDbl(LHS), CurToDbl(RHS)) Exit DblToLng(Result) End Function
Public Function Bls_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Dim Result As Decimal = Div_Dec(LHS, RHS)
Result = RoundDec(Result, 0) Exit DecToLng(Result) End Function
Public Function Bls_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Dim Result As Single = Div_Sng(LHS, RHS)
Result = RoundSng(Result, 0) Exit SngToLng(Result) End Function
Public Function Bls_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Attribute UseHostOps = True If RHS = 0 Then Err.Raise 11 Dim Result As Double = LHS / RHS Exit DblToLng(Result) End Function
Public Function Bls_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Bls_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Bls_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Bls_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Bls_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opIntDiv, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Bls_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Bls_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Bls_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Bls_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Bls_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Bls_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Bls_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Bls_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Bls_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator Mod Public Function Mod_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Integer Exit Mod_Int(BlnToInt(LHS), BlnToInt(RHS)) End Function
Public Function Mod_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS Mod RHS End Function
Public Function Mod_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS Mod RHS End Function
Public Function Mod_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS Mod RHS End Function
Public Function Mod_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS Mod RHS End Function
Public Function Mod_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Attribute UseHostOps = True Attribute Inline = True If RHS = 0 Then Err.Raise 11 Exit LHS Mod RHS End Function
Public Function Mod_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Dim LBig As LongLong = CurToBig(LHS) Dim RBig As LongLong = CurToBig(RHS)
Dim Tmp As Double = Div_Big(LBig, RBig)
Tmp = FixDbl(Tmp)
Dim LDbl As Double = BigToDbl(LBig) Dim RDbl As Double = BigToDbl(RBig)
Tmp = Mul_Dbl(RDbl, Tmp)
Tmp = Sub_Dbl(LDbl, Tmp) Exit DblToLng(Tmp) End Function
Public Function Mod_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long
LHS = RoundDec(LHS, 0)
RHS = RoundDec(RHS, 0) Dim Result As Decimal = Div_Dec(LHS, RHS)
Result = FixDec(Result)
Result = Mul_Dec(RHS, Result)
Result = Sub_Dec(LHS, Result) Exit DecToLng(Result) End Function
Public Function Mod_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long
LHS = RoundSng(LHS, 0)
RHS = RoundSng(RHS, 0) Dim Result As Single = Div_Sng(LHS, RHS)
Result = FixSng(Result)
Result = Mul_Sng(RHS, Result)
Result = Sub_Sng(LHS, Result) Exit SngToLng(Result) End Function
Public Function Mod_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long
LHS = RoundDbl(LHS)
RHS = RoundDbl(RHS) Dim Result As Double = Div_Dbl(LHS, RHS)
Result = FixDbl(Result)
Result = Mul_Dbl(RHS, Result)
Result = Sub_Dbl(LHS, Result) Exit DblToLng(Result) End Function
Public Function Mod_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Mod_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Mod_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Mod_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Mod_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opMod, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Mod_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Mod_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Mod_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Mod_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Mod_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Mod_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Mod_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Mod_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Mod_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator ^ Public Function Pow_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Double Exit Pow_Int(BlnToInt(LHS), BlnToInt(LHS)) End Function
Public Function Pow_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Double Exit Pow_Dbl(BytToDbl(LHS), BytToDbl(RHS)) End Function
Public Function Pow_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Double Exit Pow_Dbl(IntToDbl(LHS), IntToDbl(RHS)) End Function
Public Function Pow_Lng(ByVal LHS As Long, ByVal RHS As Long) As Double Exit Pow_Dbl(LngToDbl(LHS), LngToDbl(RHS)) End Function
Public Function Pow_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Double Exit Pow_Dbl(BigToDbl(LHS), BigToDbl(RHS)) End Function
Public Function Pow_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Double Exit Pow_Dbl(PtrToDbl(LHS), PtrToDbl(RHS)) End Function
Public Function Pow_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Double Exit Pow_Dbl(CurToDbl(LHS), CurToDbl(RHS)) End Function
Public Function Pow_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Double Exit Pow_Dbl(DecToDbl(LHS), DecToDbl(RHS)) End Function
Public Function Pow_Sng(ByVal LHS As Single, ByVal RHS As Single) As Double Exit Pow_Dbl(SngToDbl(LHS), SngToDbl(RHS)) End Function
Rem Taken from https://www.codeproject.com/tips/311714/natural-logarithms-and-exponent Public Function Pow_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Double
Pow_Dbl = Exp(RHS * Ln(LHS)) End Function
Public Function Pow_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Double Exit Pow_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Pow_Str(ByVal LHS As String, ByVal RHS As String) As Double Exit Pow_Dbl(StrToDbl(LHS), StrToDbl(RHS)) End Function
Public Function Pow_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Double If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opPow, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Pow_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Pow_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Pow_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Pow_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Pow_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Pow_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Pow_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Pow_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Pow_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator << Public Function LSh_Bln(ByVal LHS As Boolean, ByVal RHS As Integer) As Integer Exit LSh_Int(BlnToInt(LHS), RHS) End Function
Public Function LSh_Byt(ByVal LHS As Byte, ByVal RHS As Integer) As Byte Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit RSh_Int(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbByte) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit RSh_Int(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbInteger) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Lng(ByVal LHS As Long, ByVal RHS As Integer) As Long Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit RSh_Lng(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbLong) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Big(ByVal LHS As LongLong, ByVal RHS As Integer) As LongLong Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit RSh_Big(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbLongLong) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Ptr(ByVal LHS As LongPtr, ByVal RHS As Integer) As LongPtr Attribute UseHostOps = True If RHS = 0 Then Exit LHS #If Win64 Then If RHS < 0 Then Exit RSh_Big(LHS, Neg_Int(RHS)) #Else If RHS < 0 Then Exit RSh_Lng(LHS, Neg_Int(RHS)) #End If If RHS >= SizeOf(vbLongPtr) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Cur(ByVal LHS As Currency, ByVal RHS As Integer) As Currency Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit RSh_Cur(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbCurrency) * 8 Then Exit 0 Exit LHS << RHS End Function
Public Function LSh_Dec(ByVal LHS As Decimal, ByVal RHS As Integer) As Decimal If Equ_Dec(LHS, 0+) Then Exit LHS Dim Factor As Decimal = IntToDec(RHS)
If RHS < 0 Then
Factor = Neg_Dec(Factor) Exit Div_Dec(LHS, Factor) Else Exit Mul_Dec(LHS, Factor) End If End Function
Public Function LSh_Sng(ByVal LHS As Single, ByVal RHS As Integer) As Single If RHS = 0 Then Exit LHS Dim Factor As Single = IntToDbl(RHS)
If RHS < 0 Then
Factor = Neg_Sng(Factor) Exit Div_Sng(LHS, Factor) Else Exit Mul_Sng(LHS, Factor) End If End Function
Public Function LSh_Dbl(ByVal LHS As Double, ByVal RHS As Integer) As Double If RHS = 0 Then Exit LHS Dim Factor As Double = IntToDbl(RHS)
If RHS < 0 Then
Factor = Neg_Dbl(Factor) Exit Div_Dbl(LHS, Factor) Else Exit Mul_Dbl(LHS, Factor) End If End Function
Public Function LSh_Dtm(ByVal LHS As Date, ByVal RHS As Integer) As Double Exit LSh_Int(DtmToDbl(LHS), RHS) End Function
Public Function LSh_Str(ByVal LHS As String, ByVal RHS As Integer) As Double Exit LSh_Int(StrToDbl(LHS), RHS) End Function
Public Function LSh_Var(ByVal LHS As Variant, ByVal RHS As Integer) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case VarType(LHS) Case vbEmpty Exit IntToVar(0)
Case vbNull Exit Null
Case vbBoolean, vbInteger Exit LSh_Int(VarToInt(LHS), RHS)
Case vbByte Exit LSh_Int(VarToByt(LHS), RHS)
Case vbLong Exit LSh_Int(VarToLng(LHS), RHS)
Case vbLongLong Exit LSh_Int(VarToBig(LHS), RHS)
Case vbLongPtr Exit LSh_Int(VarToPtr(LHS), RHS)
Case vbCurrency Exit LSh_Int(VarToCur(LHS), RHS)
Case vbDecimal Exit LSh_Int(VarToDec(LHS), RHS)
Case vbSingle Exit LSh_Int(VarToSng(LHS), RHS)
Case vbDouble, vbDate, vbString Exit LSh_Int(VarToDbl(LHS), RHS)
Case Else
Err.Raise 13 End Select End Function
Rem Operator >> Public Function RSh_Bln(ByVal LHS As Boolean, ByVal RHS As Integer) As Integer Exit RSh_Int(BlnToInt(LHS), RHS) End Function
Public Function RSh_Byt(ByVal LHS As Byte, ByVal RHS As Integer) As Byte Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Byt(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbByte) * 8 Then
LHS >>= 7
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Int(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbInteger) * 8 Then
LHS >>= 15
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Lng(ByVal LHS As Long, ByVal RHS As Integer) As Long Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Lng(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbLong) * 8 Then
LHS >>= 31
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Big(ByVal LHS As LongLong, ByVal RHS As Integer) As LongLong Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Big(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbLongLong) * 8 Then
LHS >>= 63
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Ptr(ByVal LHS As LongPtr, ByVal RHS As Integer) As LongPtr Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Ptr(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbLongPtr) * 8 Then #If Win64 Then
LHS >>= 63 #Else
LHS >>= 31 #End If
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Cur(ByVal LHS As Currency, ByVal RHS As Integer) As Currency Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Cur(LHS, Neg_Int(RHS))
If RHS >= SizeOf(vbCurrency) * 8 Then
LHS >>= 63
RHS = 1 End If
Exit LHS >> RHS End Function
Public Function RSh_Dec(ByVal LHS As Decimal, ByVal RHS As Integer) As Decimal If Equ_Dec(LHS, 0+) Then Exit LHS Dim Factor As Decimal = IntToDec(RHS)
If RHS < 0 Then
Factor = Neg_Dec(Factor) Exit Mul_Dec(LHS, Factor) Else Exit Div_Dec(LHS, Factor) End If End Function
Public Function RSh_Sng(ByVal LHS As Single, ByVal RHS As Integer) As Single If RHS = 0 Then Exit LHS Dim Factor As Single = IntToSng(RHS)
If RHS < 0 Then
Factor = Neg_Sng(Factor) Exit Mul_Sng(LHS, Factor) Else Exit Div_Sng(LHS, Factor) End If End Function
Public Function RSh_Dbl(ByVal LHS As Double, ByVal RHS As Integer) As Double If RHS = 0 Then Exit LHS Dim Factor As Double = IntToDbl(RHS)
If RHS < 0 Then
Factor = Neg_Dbl(Factor) Exit Mul_Dbl(LHS, Factor) Else Exit Div_Dbl(LHS, Factor) End If End Function
Public Function RSh_Dtm(ByVal LHS As Date, ByVal RHS As Integer) As Double Exit RSh_Dbl(DtmToDbl(LHS), RHS) End Function
Public Function RSh_Str(ByVal LHS As String, ByVal RHS As Integer) As Double Exit RSh_Dbl(StrToDbl(LHS), RHS) End Function
Public Function RSh_Var(ByVal LHS As Variant, ByVal RHS As Integer) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case VarType(LHS) Case vbEmpty Exit IntToVar(0)
Case vbNull Exit Null
Case vbBoolean, vbInteger Exit RSh_Int(VarToInt(LHS), RHS)
Case vbByte Exit RSh_Int(VarToByt(LHS), RHS)
Case vbLong Exit RSh_Int(VarToLng(LHS), RHS)
Case vbLongLong Exit RSh_Int(VarToBig(LHS), RHS)
Case vbLongPtr Exit RSh_Int(VarToPtr(LHS), RHS)
Case vbCurrency Exit RSh_Int(VarToCur(LHS), RHS)
Case vbDecimal Exit RSh_Int(VarToDec(LHS), RHS)
Case vbSingle Exit RSh_Int(VarToSng(LHS), RHS)
Case vbDouble, vbDate, vbString Exit RSh_Int(VarToDbl(LHS), RHS)
Case Else
Err.Raise 13 End Select End Function
Rem Operator >>> Public Function WSh_Bln(ByVal LHS As Boolean, ByVal RHS As Integer) As Integer Exit WSh_Int(BlnToInt(LHS), RHS) End Function
Public Function WSh_Byt(ByVal LHS As Byte, ByVal RHS As Integer) As Byte Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Byt(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbByte) * 8 Then Exit 0 Exit LHS >> RHS And &B01111111 End Function
Public Function WSh_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Int(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbInteger) * 8 Then Exit 0 Exit LHS >> RHS And &H7FFF End Function
Public Function WSh_Lng(ByVal LHS As Long, ByVal RHS As Integer) As Long Attribute UseHostOps = True If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Lng(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbLong) * 8 Then Exit 0 Exit LHS >> RHS And &H7FFFFFFF End Function
Public Function WSh_Big(ByVal LHS As LongLong, ByVal RHS As Integer) As LongLong If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Int(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbLongLong) * 8 Then Exit 0 Exit LHS >> RHS And &H7FFFFFFFFFFFFFFF End Function
Public Function WSh_Ptr(ByVal LHS As LongPtr, ByVal RHS As Integer) As LongPtr If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Ptr(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbLongPtr) * 8 Then Exit 0 #If Win64 Then Exit LHS >> RHS And &H7FFFFFFFFFFFFFFF #Else Exit LHS >> RHS And &H7FFFFFFF #End If End Function
Public Function WSh_Cur(ByVal LHS As Currency, ByVal RHS As Integer) As Currency If RHS = 0 Then Exit LHS If RHS < 0 Then Exit LSh_Cur(LHS, Neg_Int(RHS)) If RHS >= SizeOf(vbCurrency) * 8 Then Exit 0 Exit LHS >> RHS And &H7FFFFFFFFFFFFFFF End Function
Public Function WSh_Dec(ByVal LHS As Decimal, ByVal RHS As Integer) As Decimal If Equ_Dec(LHS, 0+) Then Exit LHS Dim Factor As Decimal = IntToDec(RHS)
If RHS < 0 Then
Factor = Neg_Dec(Factor) Exit Mul_Dec(LHS, Factor) Else If Dec_Ltn(LHS, 0+) Then LHS = Neg_Dec(LHS) Exit Div_Dec(LHS, Factor) End If End Function
Public Function WSh_Sng(ByVal LHS As Single, ByVal RHS As Integer) As Single If RHS = 0 Then Exit LHS Dim Factor As Single = IntToSng(RHS)
If RHS < 0 Then
Factor = Neg_Sng(Factor) Exit Mul_Sng(LHS, Factor) Else If LHS < 0 Then LHS = -LHS Exit Div_Sng(LHS, Factor) End If End Function
Public Function WSh_Dbl(ByVal LHS As Double, ByVal RHS As Integer) As Double Attribute UseHostOps = True If RHS = 0 Then Exit LHS Dim Factor As Double = IntToDbl(RHS)
If RHS < 0 Then
Factor = Neg_Dbl(Factor) Exit Mul_Dbl(LHS, Factor) Else If LHS < 0 Then LHS = -LHS Exit Div_Dbl(LHS, Factor) End If End Function
Public Function WSh_Dtm(ByVal LHS As Date, ByVal RHS As Integer) As Double Exit WSh_Dbl(DtmToDbl(LHS), RHS) End Function
Public Function WSh_Str(ByVal LHS As String, ByVal RHS As Integer) As Double Exit WSh_Dbl(StrToDbl(LHS), RHS) End Function
Public Function WSh_Var(ByVal LHS As Variant, ByVal RHS As Integer) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case VarType(LHS) Case vbEmpty Exit IntToVar(0)
Case vbNull Exit Null
Case vbBoolean, vbInteger Exit WSh_Int(VarToInt(LHS), RHS)
Case vbByte Exit WSh_Int(VarToByt(LHS), RHS)
Case vbLong Exit WSh_Int(VarToLng(LHS), RHS)
Case vbLongLong Exit WSh_Int(VarToBig(LHS), RHS)
Case vbLongPtr Exit WSh_Int(VarToPtr(LHS), RHS)
Case vbCurrency Exit WSh_Int(VarToCur(LHS), RHS)
Case vbDecimal Exit WSh_Int(VarToDec(LHS), RHS)
Case vbSingle Exit WSh_Int(VarToSng(LHS), RHS)
Case vbDouble, vbDate, vbString Exit WSh_Int(VarToDbl(LHS), RHS)
Case Else
Err.Raise 13 End Select End Function
Rem Operator & Public Function Con_Str(ByVal LHS As String, ByVal RHS As String) As String Dim Length As Long Dim LeftLength As Long Dim RightLength As Long Dim Ptr As LongPtr
Rem Operator > Public Function Gtn_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS > RHS End Function
Public Function Gtn_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Dim SDec1 As DecimalStruct Dim SDec2 As DecimalStruct
Public Function Gtn_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Dim Dif As Single = LHS - RHS If Dif = 0! OrElse Dif <= -1! Then Exit Function If Dif >= 1! Then Exit True
Dim Delta As Single = SngDelta(LHS) If Dif < 0! Then Dif = -Dif If Delta < 0! Then Delta = -Delta Exit Dif > Delta End Function
Public Function Gtn_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Dim Dif As Double = LHS - RHS If Dif = 0# OrElse Dif <= -1# Then Exit Function If Dif = 1# Then Exit True
Dim Delta As Double = DblDelta(LHS) If Dif < 0# Then Dif = -Dif If Delta < 0# Then Delta = -Delta Exit Dif > Delta End Function
Public Function Gtn_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Gtn_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Gtn_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Dim Result As Integer = CompareStrings(LHS, RHS, Compare) Exit Result > 0 End Function
Public Function Gtn_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opGt, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Gtn_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Gtn_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Gtn_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Gtn_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Gtn_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Gtn_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Gtn_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Gtn_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Gtn_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Gtn_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator >= Public Function Gte_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Dim Left As LongLong = CurToBig(LHS) Dim Right As LongLong = CurToBig(RHS) Exit Gte_Big(Left, Right) End Function
Public Function Gte_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Exit Equ_Dec(LHS, RHS) OrElse Gtn_Dec(LHS, RHS) End Function
Public Function Gte_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS >= RHS End Function
Public Function Gte_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Gte_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Gte_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Dim Result As Integer = CompareStrings(LHS, RHS, Compare) Exit Result >= 0 End Function
Public Function Gte_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opGe, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Gte_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Gte_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Gte_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Gte_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Gte_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Gte_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Gte_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Gte_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Gte_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Gte_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator = Public Function Equ_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Attribute UseHostOps = True Attribute Inline = True Exit LHS = RHS End Function
Public Function Equ_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Dim SDec1 As DecimalStruct Dim SDec2 As DecimalStruct
Public Function Equ_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Dim Dif As Single = LHS - RHS If Dif = 0! Then Exit True If Dif <= -1! OrElse Dif >= 1! Then Exit Function
Dim Delta As Single = SngDelta(LHS) If Dif < 0! Then Dif = -Dif If Delta < 0! Then Delta = -Delta Exit Dif <= Delta End Function
Public Function Equ_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Dim Dif As Double = LHS - RHS If Dif = 0# Then Exit True If Dif <= -1# OrElse Dif >= 1# Then Exit Function
Dim Delta As Double = DblDelta(LHS) If Dif < 0# Then Dif = -Dif If Delta < 0# Then Delta = -Delta Exit Dif <= Delta End Function
Public Function Equ_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Equ_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Private Function StrLenB(ByVal Value As String) As Long Dim Ptr As LongPtr
CopyMemory VarPtr(Ptr), VarPtr(Value), SizeOf(vbLongPtr)
Ptr -= SizeOf(vbLong)
Dim Result As Long
CopyMemory VarPtr(Result), Ptr, SizeOf(vbLong) Exit Result End Function
Private Function StrLen(ByVal Value As String) As Long Dim Result As Long = StrLenB(Value)
Result >>= 1 Exit Result End Function
Public Function Equ_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Dim Result As Integer = CompareStrings(LHS, RHS, Compare) Exit Result = 0 End Function
Private Function CompareStrings(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Integer Attribute UseHostOps = True Dim TheChar As Integer Dim LeftChar As Integer Dim RiteChar As Integer Dim Idx As Long Dim Found As Long
Dim LeftLen As Long = StrLen(LHS) Dim RiteLen As Long = StrLen(RHS) If LeftLen <> RiteLen Then Exit LeftLen - RiteLen
If LeftChar = RiteChar Then Continue For If Compare <> vbTextCompare Then Exit LeftLen - RiteLen If Not IsInit_ Then Init
TheChar = LeftChar GoSub UpIt
LeftChar = TheChar
TheChar = RiteChar GoSub UpIt
RiteChar = TheChar
If LeftChar <> RiteChar Then Exit LeftChar - RiteChar Next
Exit True
UpIt: Select Case TheChar Case 65 `AscW("A")´ To 90 `AscW("Z")´ Rem Nothing to do
Case 97 `AscW("a")´To 122 `AscW("z")´
TheChar -= 32
Case Else
Found = BinarySearch(CodePoints_, TheChar, FirstIndex:=0, Step:=NO_OF_COLS) If Found <> -1 Then TheChar = CodePoints_(Found + 1) End Select
Return End Function
Public Function Equ_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opEq, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Equ_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Equ_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Equ_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Equ_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Equ_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Equ_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Equ_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Equ_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Equ_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Equ_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator <= Public Function Lte_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Attribute UseHostOps = True Exit LHS <= RHS End Function
Public Function Lte_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Exit Equ_Dec(LHS, RHS) OrElse Not Gtn_Dec(LHS, RHS) End Function
Public Function Lte_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Exit Equ_Sng(LHS, RHS) OrElse Not Gtn_Sng(LHS, RHS) End Function
Public Function Lte_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Exit Equ_Dbl(LHS, RHS) OrElse Not Gtn_Dbl(LHS, RHS) End Function
Public Function Lte_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Lte_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Lte_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Dim Result As Integer = CompareStrings(LHS, RHS, Compare) Exit Result <= 0 End Function
Public Function Lte_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opLe, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Lte_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Lte_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Lte_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Lte_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Lte_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Lte_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Lte_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Lte_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Lte_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Lte_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator < Public Function Ltn_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Attribute UseHostOps = True Exit LHS < RHS End Function
Public Function Ltn_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Exit Not Equ_Dec(LHS, RHS) AndAlso Not Gtn_Dec(LHS, RHS) End Function
Public Function Ltn_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Exit Not Equ_Sng(LHS, RHS) AndAlso Not Gtn_Sng(LHS, RHS) End Function
Public Function Ltn_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Exit Not Equ_Dbl(LHS, RHS) AndAlso Not Gtn_Dbl(LHS, RHS) End Function
Public Function Ltn_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Ltn_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Ltn_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Dim Result As Integer = CompareStrings(LHS, RHS, Compare) Exit Result < 0 End Function
Public Function Ltn_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opLt, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Ltn_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Ltn_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Ltn_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Ltn_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Ltn_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Ltn_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Ltn_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Ltn_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Ltn_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Ltn_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator <> Public Function Dif_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Lng(ByVal LHS As Long, ByVal RHS As Long) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Boolean Attribute UseHostOps = True Exit LHS <> RHS End Function
Public Function Dif_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Boolean Attribute UseHostOps = True Exit Not Equ_Dec(LHS, RHS) End Function
Public Function Dif_Sng(ByVal LHS As Single, ByVal RHS As Single) As Boolean Attribute UseHostOps = True Exit Not Equ_Sng(LHS, RHS) End Function
Public Function Dif_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Boolean Attribute UseHostOps = True Exit Not Equ_Dbl(LHS, RHS) End Function
Public Function Dif_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Boolean Exit Dif_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Dif_Str(ByVal LHS As String, ByVal RHS As String, ByVal Compare As VbCompareMethod) As Boolean Attribute UseHostOps = True Exit Not Equ_Str(LHS, RHS, Compare) End Function
Public Function Dif_Var(ByVal LHS As Variant, ByVal RHS As Variant, ByVal Compare As VbCompareMethod) As Boolean If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS) Dim Inferred As VbVarType = InferVarType(VarType(LHS), opNe, VarType(RHS))
Select Case Inferred Case vbBoolean, vbInteger Exit IntToVar(Dif_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Dif_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Dif_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Dif_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Dif_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Dif_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Dif_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Dif_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate Exit DblToVar(Dif_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case vbString Exit DblToVar(Dif_Str(VarToStr(LHS), VarToStr(RHS), Compare))
Case Else
Err.Raise 13 End Select End Function
Rem Operator IsNot Public Function Isn_Var(ByVal LHS As Object, ByVal RHS As Object) As Boolean Attribute UseHostOps = True Exit Not LHS Is RHS End Function
Rem Operator Is Public Function Is_Var(ByVal LHS As Object, ByVal RHS As Object) As Boolean Attribute UseHostOps = True Exit LHS Is RHS End Function
Rem Operator And Public Function And_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Attribute UseHostOps = True Exit LHS And RHS End Function
Public Function And_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Exit And_Lng(CurToLng(LHS), CurToLng(RHS)) End Function
Public Function And_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Exit And_Lng(DecToLng(LHS), DecToLng(RHS)) End Function
Public Function And_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Exit And_Lng(SngToLng(LHS), SngToLng(RHS)) End Function
Public Function And_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Exit And_Lng(DblToLng(LHS), DblToLng(RHS)) End Function
Public Function And_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit And_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function And_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit And_Lng(StrToLng(LHS), StrToLng(RHS)) End Function
Public Function And_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opAnd, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(And_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(And_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(And_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(And_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(And_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(And_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(And_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(And_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(And_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator Or Public Function Or_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Attribute UseHostOps = True Exit LHS Or RHS End Function
Public Function Or_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Exit Or_Lng(CurToLng(LHS), CurToLng(RHS)) End Function
Public Function Or_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Exit Or_Lng(DecToLng(LHS), DecToLng(RHS)) End Function
Public Function Or_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Exit Or_Lng(SngToLng(LHS), SngToLng(RHS)) End Function
Public Function Or_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Exit Or_Lng(DblToLng(LHS), DblToLng(RHS)) End Function
Public Function Or_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Or_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Or_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Or_Lng(StrToLng(LHS), StrToLng(RHS)) End Function
Public Function Or_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opOr, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Or_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Or_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Or_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Or_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Or_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Or_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Or_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Or_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Or_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator Xor Public Function Xor_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Attribute UseHostOps = True Exit LHS Xor RHS End Function
Public Function Xor_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Exit Xor_Lng(CurToLng(LHS), CurToLng(RHS)) End Function
Public Function Xor_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Exit Xor_Lng(DecToLng(LHS), DecToLng(RHS)) End Function
Public Function Xor_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Exit Xor_Lng(SngToLng(LHS), SngToLng(RHS)) End Function
Public Function Xor_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Exit Xor_Lng(DblToLng(LHS), DblToLng(RHS)) End Function
Public Function Xor_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Xor_Dbl(DtmToDbl(LHS), DtmToDbl(RHS)) End Function
Public Function Xor_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Xor_Lng(StrToLng(LHS), StrToLng(RHS)) End Function
Public Function Xor_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant If IsObject(LHS) Then LHS = DecayObj(LHS) If IsObject(RHS) Then RHS = DecayObj(RHS)
Select Case InferVarType(VarType(LHS), opXor, VarType(RHS)) Case vbBoolean, vbInteger Exit IntToVar(Xor_Int(VarToInt(LHS), VarToInt(RHS)))
Case vbByte Exit BytToVar(Xor_Byt(VarToByt(LHS), VarToByt(RHS)))
Case vbLong Exit LngToVar(Xor_Lng(VarToLng(LHS), VarToLng(RHS)))
Case vbLongLong Exit BigToVar(Xor_Big(VarToBig(LHS), VarToBig(RHS)))
Case vbLongPtr Exit PtrToVar(Xor_Ptr(VarToPtr(LHS), VarToPtr(RHS)))
Case vbCurrency Exit CurToVar(Xor_Cur(VarToCur(LHS), VarToCur(RHS)))
Case vbDecimal Exit DecToVar(Xor_Dec(VarToDec(LHS), VarToDec(RHS)))
Case vbSingle Exit SngToVar(Xor_Sng(VarToSng(LHS), VarToSng(RHS)))
Case vbDouble, vbDate, vbString Exit DblToVar(Xor_Dbl(VarToDbl(LHS), VarToDbl(RHS)))
Case Else
Err.Raise 13 End Select End Function
Rem Operator Eqv Public Function Eqv_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Exit Not_Bln(Xor_Bln(LHS, RHS)) End Function
Public Function Eqv_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Exit Not_Byt(Xor_Byt(LHS, RHS)) End Function
Public Function Eqv_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Exit Not_Int(Xor_Int(LHS, RHS)) End Function
Public Function Eqv_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Exit Not_Lng(Xor_Lng(LHS, RHS)) End Function
Public Function Eqv_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Exit Not_Big(Xor_Big(LHS, RHS)) End Function
Public Function Eqv_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Exit Not_Ptr(Xor_Ptr(LHS, RHS)) End Function
Public Function Eqv_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Exit Not_Lng(Xor_Cur(LHS, RHS)) End Function
Public Function Eqv_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Exit Not_Lng(Xor_Dec(LHS, RHS)) End Function
Public Function Eqv_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Exit Not_Lng(Xor_Sng(LHS, RHS)) End Function
Public Function Eqv_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Exit Not_Lng(Xor_Dbl(LHS, RHS)) End Function
Public Function Eqv_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Not_Lng(Xor_Dtm(LHS, RHS)) End Function
Public Function Eqv_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Not_Lng(Xor_Str(LHS, RHS)) End Function
Public Function Eqv_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant Exit Not_Var(Xor_Var(LHS, RHS)) End Function
Rem Operator Imp Public Function Imp_Bln(ByVal LHS As Boolean, ByVal RHS As Boolean) As Boolean Exit Or_Bln(Not_Bln(LHS), RHS) End Function
Public Function Imp_Byt(ByVal LHS As Byte, ByVal RHS As Byte) As Byte Exit Or_Byt(Not_Byt(LHS), RHS) End Function
Public Function Imp_Int(ByVal LHS As Integer, ByVal RHS As Integer) As Integer Exit Or_Int(Not_Int(LHS), RHS) End Function
Public Function Imp_Lng(ByVal LHS As Long, ByVal RHS As Long) As Long Exit Or_Lng(Not_Lng(LHS), RHS) End Function
Public Function Imp_Big(ByVal LHS As LongLong, ByVal RHS As LongLong) As LongLong Exit Or_Big(Not_Big(LHS), RHS) End Function
Public Function Imp_Ptr(ByVal LHS As LongPtr, ByVal RHS As LongPtr) As LongPtr Exit Or_Ptr(Not_Ptr(LHS), RHS) End Function
Public Function Imp_Cur(ByVal LHS As Currency, ByVal RHS As Currency) As Long Exit Or_Cur(Not_Cur(LHS), RHS) End Function
Public Function Imp_Dec(ByVal LHS As Decimal, ByVal RHS As Decimal) As Long Exit Or_Dec(Not_Dec(LHS), RHS) End Function
Public Function Imp_Sng(ByVal LHS As Single, ByVal RHS As Single) As Long Exit Or_Sng(Not_Sng(LHS), RHS) End Function
Public Function Imp_Dbl(ByVal LHS As Double, ByVal RHS As Double) As Long Exit Or_Dbl(Not_Dbl(LHS), RHS) End Function
Public Function Imp_Dtm(ByVal LHS As Date, ByVal RHS As Date) As Long Exit Or_Lng(Not_Dtm(LHS), DtmToLng(RHS)) End Function
Public Function Imp_Str(ByVal LHS As String, ByVal RHS As String) As Long Exit Or_Dbl(Not_Str(LHS), StrToDbl(RHS)) End Function
Public Function Imp_Var(ByVal LHS As Variant, ByVal RHS As Variant) As Variant Exit Or_Var(Not_Var(LHS), RHS) End Function End Module