-
Notifications
You must be signed in to change notification settings - Fork 3
/
Variants.cls
194 lines (158 loc) · 5.27 KB
/
Variants.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Variants"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Public Function isEquatable(item As Variant) As Boolean
If IsObject(item) Then
isEquatable = TypeOf item Is IEquatable
Else
isEquatable = True
End If
End Function
Public Function isComparable(item As Variant) As Boolean
If IsObject(item) Then
isComparable = TypeOf item Is IComparable
Else
isComparable = True
End If
End Function
Public Function equals(value As Variant, other As Variant) As Boolean
If IsObject(value) <> IsObject(other) Then
equals = False
ElseIf IsObject(value) Then
equals = value Is other
ElseIf isArray(value) <> isArray(other) Then
equals = False
ElseIf isArray(value) Then
If LBound(value) = LBound(other) And UBound(value) = UBound(other) Then
Dim i As Integer
equals = True
For i = LBound(value) To UBound(value)
If Not Variants.equals(value(i), other(i)) Then
equals = False
Exit For
End If
Next
Else
equals = False
End If
Else
equals = value = other
End If
End Function
Public Function fuzzyEquals(value As Variant, other As Variant) As Boolean
If Not isEquatable(value) Or Not isEquatable(other) Then
Err.Raise E_ARGUMENTOUTOFRANGE, "Variants.Equals()", "Can only equate things that are Variants.IsEquatable()."
End If
If IsObject(value) <> IsObject(other) Then
fuzzyEquals = False
ElseIf IsObject(value) Then
Dim equatable As IEquatable
Set equatable = value
fuzzyEquals = equatable.equals(other)
Else
fuzzyEquals = value = other
End If
End Function
Public Function isArray(var As Variant) As Boolean
' TODO: Test
isArray = CBool(varType(var) And vbArray)
End Function
Public Sub verifyArray(var As Variant)
If Not isArray(var) Then
Err.Raise E_ARGUMENTOUTOFRANGE, "", "The parameter has to be an array."
End If
End Sub
Public Function gist(var As Variant) As String
If varType(var) And vbArray Then
gist = "Array<" & varTypeToString(varType(var) - vbArray) & ">"
gist = gist & "["
Dim inner As String
Dim runner As Integer
For runner = LBound(var) To UBound(var)
If inner <> "" Then
inner = inner & ", "
End If
inner = inner & gist(var(runner))
Next
gist = gist & inner
gist = gist & "]"
ElseIf varType(var) = vbBoolean _
Or varType(var) = vbByte _
Or varType(var) = vbCurrency _
Or varType(var) = vbDate _
Or varType(var) = vbDecimal _
Or varType(var) = vbDouble _
Or varType(var) = vbInteger _
Or varType(var) = vbLong _
Or varType(var) = vbSingle Then
gist = CStr(var)
ElseIf varType(var) = vbString Then
gist = "'" & CStr(var) & "'"
ElseIf varType(var) = vbDataObject Then
gist = "DataObject"
ElseIf varType(var) = vbEmpty Then
gist = "Empty"
ElseIf varType(var) = vbError Then
gist = CStr(var) & " (Error)"
ElseIf varType(var) = vbNull Then
gist = "Null"
ElseIf varType(var) = vbObject Then
If var Is Nothing Then
gist = TypeName(var)
ElseIf TypeName(var) = "List" Or TypeName(var) = "Map" Or TypeName(var) = "Setx" Then
gist = var.gist
Else
gist = TypeName(var)
End If
ElseIf varType(var) = vbUserDefinedType Then
gist = "UserDefinedType"
ElseIf varType(var) = vbVariant Then
gist = "Variant"
End If
End Function
Public Function varTypeToString(varType As Long) As String
If varType = vbBoolean Then
varTypeToString = "Boolean"
ElseIf varType = vbByte Then
varTypeToString = "Byte"
ElseIf varType = vbCurrency Then
varTypeToString = "Currency"
ElseIf varType = vbDataObject Then
varTypeToString = "DataObject"
ElseIf varType = vbDate Then
varTypeToString = "Date"
ElseIf varType = vbDecimal Then
varTypeToString = "Decimal"
ElseIf varType = vbDouble Then
varTypeToString = "Double"
ElseIf varType = vbEmpty Then
varTypeToString = "Empty"
ElseIf varType = vbInteger Then
varTypeToString = "Integer"
ElseIf varType = vbLong Then
varTypeToString = "Long"
ElseIf varType = vbNull Then
varTypeToString = "Null"
ElseIf varType = vbSingle Then
varTypeToString = "Single"
ElseIf varType = vbString Then
varTypeToString = "String"
ElseIf varType = vbObject Then
varTypeToString = "Object"
ElseIf varType = vbUserDefinedType Then
varTypeToString = "UserDefinedType"
ElseIf varType = vbVariant Then
varTypeToString = "Variant"
ElseIf varType = vbArray Then
varTypeToString = "Array"
Else
varTypeToString = "Unknown: " & varType
End If
End Function