I'm designing a dynamic buffer for outgoing messages. The data structure takes the form of a queue of nodes that have a Byte Array buffer as a member. Unfortunately in VBA, Arrays cannot be public members of a class.
For example, this is a no-no and will not compile:
'clsTest
Public Buffer() As Byte
You will get the following error: "Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules"
Well, that's fine, I'll just make it a private member with public Property accessors...
'clsTest
Private m_Buffer() As Byte
Public Property Let Buffer(buf() As Byte)
m_Buffer = buf
End Property
Public Property Get Buffer() As Byte()
Buffer = m_Buffer
End Property
...and then a few tests in a module to make sure it works:
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
' Debug.Print oBuffer.Buffer(2) 'Fail
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Fail, diplays "3" in the immediate window
End Sub
Test #1 works fine, but Test #2 breaks, Buffer is highlighted, and the error message is "Wrong number of arguments or invalid property assignment"
Test #2 now works! GSerg points out that in order to call the Property Get Buffer() correctly and also refer to a specific index in the buffer, TWO sets of parenthesis are necessary: oBuffer.Buffer()(2)
Test #3 fails - the original value of 3 is printed to the Immediate window. GSerg pointed out in his comment that the Public Property Get Buffer() only returns a copy and not the actual class member array, so modifications are lost.
How can this third issue be resolved make the class member array work as expected?
(I should clarify that the general question is "VBA doesn't allow arrays to be public members of classes. How can I get around this to have an array member of a class that behaves as if it was for all practical purposes including: #1 assigning the array, #2 getting values from the array, #3 assigning values in the array and #4 using the array directly in a call to CopyMemory (#3 and #4 are nearly equivalent)?)"
So it turns out I needed a little help from OleAut32.dll, specifically the 'VariantCopy' function. This function faithfully makes an exact copy of one Variant to another, including when it is ByRef!
'clsTest
Private Declare Sub VariantCopy Lib "OleAut32" (pvarDest As Any, pvargSrc As Any)
Private m_Buffer() As Byte
Public Property Let Buffer(buf As Variant)
m_Buffer = buf
End Property
Public Property Get Buffer() As Variant
Buffer = GetByRefVariant(m_Buffer)
End Property
Private Function GetByRefVariant(ByRef var As Variant) As Variant
VariantCopy GetByRefVariant, var
End Function
With this new definition, all the tests pass!
'mdlMain
Public Sub Main()
Dim buf() As Byte
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
Dim oBuffer As clsTest
Set oBuffer = New clsTest
'Test #1, the assignment
oBuffer.Buffer = buf 'Success!
'Test #2, get the value of an index in the array
Debug.Print oBuffer.Buffer()(2) 'Success! This is from GSerg's comment on the question
'Test #3, change the value of an index in the array and verify that it is actually modified
oBuffer.Buffer()(2) = 27
Debug.Print oBuffer.Buffer()(2) 'Success! Diplays "27" in the immediate window
End Sub
#Blackhawk,
I know it is an old post, but thought I'd post it anyway.
Below is a code I used to add an array of points to a class, I used a subclass to define the individual points, it sounds your challenge is similar:
Mainclass tCurve
Private pMaxAmplitude As Double
Private pCurvePoints() As cCurvePoint
Public cDay As Date
Public MaxGrad As Double
Public GradChange As New intCollection
Public TideMax As New intCollection
Public TideMin As New intCollection
Public TideAmplitude As New intCollection
Public TideLow As New intCollection
Public TideHigh As New intCollection
Private Sub Class_Initialize()
ReDim pCurvePoints(1 To 1500)
ReDim curvePoints(1 To 1500) As cCurvePoint
Dim i As Integer
For i = 1 To 1500
Set Me.curvePoint(i) = New cCurvePoint
Next
End Sub
Public Property Get curvePoint(Index As Integer) As cCurvePoint
Set curvePoint = pCurvePoints(Index)
End Property
Public Property Set curvePoint(Index As Integer, Value As cCurvePoint)
Set pCurvePoints(Index) = Value
End Property
subclass cCurvePoint
Option Explicit
Private pSlope As Double
Private pCurvature As Double
Private pY As Variant
Private pdY As Double
Private pRadius As Double
Private pArcLen As Double
Private pChordLen As Double
Public Property Let Slope(Value As Double)
pSlope = Value
End Property
Public Property Get Slope() As Double
Slope = pSlope
End Property
Public Property Let Curvature(Value As Double)
pCurvature = Value
End Property
Public Property Get Curvature() As Double
Curvature = pCurvature
End Property
Public Property Let valY(Value As Double)
pY = Value
End Property
Public Property Get valY() As Double
valY = pY
End Property
Public Property Let Radius(Value As Double)
pRadius = Value
End Property
Public Property Get Radius() As Double
Radius = pRadius
End Property
Public Property Let ArcLen(Value As Double)
pArcLen = Value
End Property
Public Property Get ArcLen() As Double
ArcLen = pArcLen
End Property
Public Property Let ChordLen(Value As Double)
pChordLen = Value
End Property
Public Property Get ChordLen() As Double
ChordLen = pChordLen
End Property
Public Property Let dY(Value As Double)
pdY = Value
End Property
Public Property Get dY() As Double
dY = pdY
End Property
This will create a tCurve with 1500 tCurve.Curvepoints().dY (for example)
The trick is to get the index process correct in the main class !
Good luck !
Not the most elegant solution, but modeling from the code you provided...
In clsTest:
Option Explicit
Dim ArrayStore() As Byte
Public Sub AssignArray(vInput As Variant, Optional lItemNum As Long = -1)
If Not lItemNum = -1 Then
ArrayStore(lItemNum) = vInput
Else
ArrayStore() = vInput
End If
End Sub
Public Function GetArrayValue(lItemNum As Long) As Byte
GetArrayValue = ArrayStore(lItemNum)
End Function
Public Function GetWholeArray() As Byte()
ReDim GetWholeArray(LBound(ArrayStore) To UBound(ArrayStore))
GetWholeArray = ArrayStore
End Function
And in mdlMain:
Sub test()
Dim buf() As Byte
Dim bufnew() As Byte
Dim oBuffer As New clsTest
ReDim buf(0 To 4)
buf(0) = 1
buf(1) = 2
buf(2) = 3
buf(3) = 4
oBuffer.AssignArray vInput:=buf
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
oBuffer.AssignArray vInput:=27, lItemNum:=2
Debug.Print oBuffer.GetArrayValue(lItemNum:=2)
bufnew() = oBuffer.GetWholeArray
Debug.Print bufnew(0)
Debug.Print bufnew(1)
Debug.Print bufnew(2)
Debug.Print bufnew(3)
End Sub
I added code to pass the class array to another array to prove accessibility.
Even though VBA won't allow us to pass arrays as properties, we can still use Functions to pick up where properties fall short.
Related
I'm trying to create a class with arrays in it, and I'm having issues creating the class for it...
CLASS:
Private pST(0 To 2) As String
Public Property Get ST() As String
ST() = pST()
End Property
Public Property Let ST(value() As String) '<---- ERROR HERE
pST() = value()
End Property
CODE RUN:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.ST(0) = "test"
Debug.Print foo.ST(0)
End Sub
THE ERROR:
Compile error:
Definitions of property procedures for the same property are inconsistent, or property procedure has an optional parameter, a ParamArray, or an invalid Set final parameter.
THE QUESTION:
How can I properly initialize a class with arrays as variables?
EDIT: in relation to Mat's Mug response
CLASS CHANGED:
Private pST As Variant
Public Property Get STContent(ByVal index As Long) As String
STContent = pST(index)
End Property
Public Property Let STContent(ByVal index As Long, ByVal value As String)
pST(index) = value
End Property
Private Sub Class_Initialize()
ReDim pST(0 To 2)
End Sub
CODE RUN TO TEST:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.STContent(0) = "test" '<--- Type mismatch here
Debug.Print foo.STContent(0)
End Sub
Your getter would need to return a String() array for the types to be consistent:
Public Property Get ST() As String()
However I wouldn't recommend exposing an array like this. First because assigning typed arrays is rather painful, second because the setter (Property Let) is actually cheating here:
Public Property Let ST([ByRef] value() As String)
Unless you specify ByVal explicitly, a parameter is always passed ByRef in VBA... except there's this quirk about Property Let - the RHS/value parameter is always passed ByVal at run-time.
And arrays can only ever be passed ByRef.
Therefore, a property that gets (or assigns, actually) a whole array doesn't make much sense.
A better way would be to encapsulate the array (I'd make it a Variant though), and expose its contents (not the array itself) through an indexed property:
Private internal As Variant 'String array
'...
Public Property Get Content(ByVal index As Long) As String
Content = internal(index)
End Property
Public Property Let Content(ByVal index As Long, ByVal value As String)
internal(index) = value
End Property
You have a lot of issues there.
First, your Property Get needs to return a String array. Second, your array needs to be dynamic, or you need to rewrite the whole thing so that you pass an index value to it, otherwise there is no way to indicate which value you are passing to the array. So, for example, using a dynamic array:
Private pST() As String
Public Property Get ST() As String()
ST = pST
End Property
Public Property Let ST(value() As String)
pST() = value()
End Property
and the calling code:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
Dim asData() As String
ReDim asData(0)
asData(0) = "test"
foo.ST = asData
Debug.Print foo.ST()(0)
End Sub
Unfortunately, I couldn't be sure form the original what the intent was.
It is getting late here but give it a try. In the module:
Option Explicit
Sub Test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.AddValueToSt "test", 1
Debug.Print foo.ST(1)
End Sub
In the Class:
Option Explicit
Private pST
Public Property Get ST() As Variant
ST = pST
End Property
Public Property Let ST(value As Variant)
pST = value
End Property
Public Function AddValueToSt(value As Variant, position As Long)
pST(position) = value
End Function
Private Sub Class_Initialize()
ReDim pST(2)
End Sub
This is my way to use the Factory Method Pattern. When I say "my way", for me this pattern is translated to "Whenever some OOP requires more than 5 minutes of thinking simply add a function."
I am trying to make a bit of a leap in coding from just using dictionaries (which I only understand in a basic way) to using a Class object to hold data.
I have created a Class purely to hold 4 items of data which need to be held together and then referenced later. I then have code that creates a couple of these Class objects and which populate data into their 4 bits.
Here is my Class Module (called NarrativeGroup) :
Private pNarrative As String
Private pBillCat As String
Private pDateIndex As String
Private pFrequency As Long
''''''''''''''''''''''
' Narrative properties
''''''''''''''''''''''
Public Property Get Narrative() As String
Narrative = pNarrative
End Property
Public Property Let Narrative(Value As String)
pNarrative = Value
End Property
''''''''''''''''''''''
' BillCat properties
''''''''''''''''''''''
Public Property Get BillCat() As String
BillCat = pBillCat
End Property
Public Property Let BillCat(Value As String)
pBillCat = Value
End Property
''''''''''''''''''''''
' DateIndex properties
''''''''''''''''''''''
Public Property Get DateIndex() As String
DateIndex = pDateIndex
End Property
Public Property Let DateIndex(Value As String)
pDateIndex = Value
End Property
''''''''''''''''''''''
' Frequency properties
''''''''''''''''''''''
Public Property Get Frequency() As String
Frequency = pFrequency
End Property
Public Property Let Frequency(Value As String)
pFrequency = Value
End Property
I then have the following code in a normal module. I am trying to load the 4 item types into an array and then to try and test if it is working. My reason for loading it into an array is to then use a sub to output it onto a worksheet. But the code errors! :
Sub setNarrativeGroup() 'to put the dictionary of Narrative object Items into an array
Set dict_Narratives = New Scripting.Dictionary
dict_Narratives.CompareMode = TextCompare 'make text comparisons so they are not case sensitive
Dim NewNarrative As NarrativeGroup
Set NewNarrative = New NarrativeGroup
Dim array_Narratives As Variant
NewNarrative.Narrative = "fee prep"
NewNarrative.BillCat = "Billing"
NewNarrative.DateIndex = "01.2015"
NewNarrative.Frequency = 3
dict_Narratives.Add NewNarrative.Narrative, NewNarrative
NewNarrative.Narrative = "meeting"
NewNarrative.BillCat = "Trustee Meeting"
NewNarrative.DateIndex = "02.2015"
NewNarrative.Frequency = 1
dict_Narratives.Add NewNarrative.Narrative, NewNarrative
array_Narratives = dict_Narratives.Items
MsgBox array_Narratives(1, 1)
Call PrintArray(array_Narratives, "Sheet1", 1, 1)
End Sub
Sub PrintArray(Data, SheetName As String, intStartRow As Integer, intStartCol As Integer)
Dim oWorksheet As Worksheet
Dim rngCopyTo As Range
Set oWorksheet = ActiveWorkbook.Worksheets(SheetName)
' size of array
Dim intEndRow As Integer
Dim intEndCol As Integer
intEndRow = UBound(Data, 1)
intEndCol = UBound(Data, 2)
Set rngCopyTo = oWorksheet.Range(oWorksheet.Cells(intStartRow, intStartCol), oWorksheet.Cells(intEndRow, intEndCol))
rngCopyTo.Value = Data
End Sub
I have tried to search for help on working with dictionaries of class objects and spitting them out into an array, but there doesn't seem to be much out there! Any help much appreciated, and apologies for any big no-no's in my code above! :)
I've been searching all over but nothing seems to do the trick for me. Here is the problem:
I want to store an array of "keys"
Here is my simple class:
Private pkeys_length As Integer
Private pkeys() As String
Public Property Get keys_length() As Integer
keys_length = pkeys_length
End Property
Public Property Let keys_length(arg As Integer)
pkeys_length = arg
End Property
Public Property Get Keys() As String
Keys = pkeys()
End Property
Public Property Let Keys(ByVal arg As String)
ReDim pkeys(0 To pkeys_length) As String
pkeys = arg
End Property
And here is what I am trying to store:
Dim str_pkeys() As String
Dim pkey_count As Integer
pkey_count = CountPrimaryKeys(stbl)
'Store the keys of that table
ReDim str_pkeys(pkey_count) As String
keyset_1.keys_length = pkey_count
str_pkeys = FindPrimaryKeys(keyset_1.Table)
keyset_1.Keys = str_pkeys
As it stands, it Gives the error Compile Error: Type mismatch
I have had several problems while storing the array, I'm not sure if I am actually getting anywhere. This is the only error I haven't been able to fix. All I need to be able to do is store the array of strings in the class.
Anyone familiar with how to go about this?
I think you need to use String() in your Get property and remove the ByVal in the Let:
Private pkeys_length As Integer
Private pkeys() As String
Public Property Get keys_length() As Integer
keys_length = pkeys_length
End Property
Public Property Let keys_length(arg As Integer)
pkeys_length = arg
End Property
Public Property Get Keys() As String()
Keys = pkeys
End Property
Public Property Let Keys(arg() As String)
ReDim pkeys(0 To pkeys_length) As String
pkeys = arg
End Property
Apart from this a small design suggestion: do you really need a Set for the array length? Why not include this in the set of the array - and only provide the Get instead?
I have two properties in my VB6 code:
Public Property Get PropFileID() As Long
PropFileID = m_FileID
End Property
Public Property Get PropFileIDArray() As Long()
PropFileIDArray = m_FileIDArray
End Property
While debugging, I can see the first property (PropFileID) being assigned a value without error. m_FileID has a value, and after passing through the Get accessor, PropFileID gets the same value.
While debugging the second property (PropFileIDArray), I can see that m_FileIDArray has a valid array value. However, after passing through the Get accessor, PropFileIDArray remains empty.
Am I making some kind of error in the syntax?
Any suggestions would be greatly appreciated
The class code looks ok. Maybe something is wrong in the consuming part? Here is an example that works for me:
'Class1
Private m_FileIDArray(2) As Long
Public Sub SetValues()
m_FileIDArray(0) = 0
m_FileIDArray(1) = 1
m_FileIDArray(2) = 2
End Sub
Public Property Get PropFileIDArray() As Long()
PropFileIDArray = m_FileIDArray
End Property
'Form
Private Sub Form_Load()
Dim class1 As class1
Set class1 = New class1
class1.SetValues
Dim pa As Variant
pa = class1.PropFileIDArray
MsgBox pa(0)
MsgBox pa(1)
MsgBox pa(2)
Set class1 = Nothing
End Sub
If arrays are returned by reference, why doesn't the following work:
'Class1 class module
Private v() As Double
Public Property Get Vec() As Double()
Vec = v()
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec()(1) ' prints 0 as expected
c.Vec()(1) = 5.6
Debug.Print c.Vec()(1) ' still prints 0
End Sub
You don't have a let property. Also, the get property is returning the entire array, rather than just the element in question. Change the return type of Property Get from Double() to just plain Double. Add Property Let. Note that it takes two inputs, but only one is passed to it. The last variable (MyValue, in this case) is assumed to get it's value from whatever is after the = sign. Put a break point somewhere early in Test1() and see how the values are affected in the Locals window. Compare the variables created by the original code versus my code:
'Class1 class module
Private v() As Double
Public Property Get Vec(index As Long) As Double
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
'Begin module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec(1) ' prints 0 as expected
c.Vec(1) = 5.6
Debug.Print c.Vec(1) ' prints 5.6
End Sub
'End module
In VBA, arrays are never returned by reference unless they are returned through a ByRef parameter. Furthermore, whenever you use = to assign an array to a variable, you've made a new copy of the array, even if you're assigning it to a ByRef argument inside of a procedure, so you're pretty much out of luck trying to make this work.
Some alternative are...
Use a VBA.Collection instead of an array.
Make your own class that encapsulates an array and exposes procedures for indirectly accessing and manipulating the internal array.
I want to suggest another nice way to do this using a Collection and a static Property without the need to use a class:
imagine you want to have the xlCVError enum as an array (or collection), e.g. to loop through it on errors and handle it based on the actual error.
The following is initialized once on access:
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorColl() As Collection
Dim c As Collection 'will be already initalized after 1st access
'because of "Static Property" above!
Set XlCVErrorColl = c
If Not c Is Nothing Then Exit Property
'initialize once:
Set c = New Collection
c.Add XlCVError.xlErrDiv0
c.Add XlCVError.xlErrNA
c.Add XlCVError.xlErrName
c.Add XlCVError.xlErrNull
c.Add XlCVError.xlErrNum
c.Add XlCVError.xlErrRef
c.Add XlCVError.xlErrValue
Set XlCVErrorColl = c
End Property
Turning this into an array or implementing it as an array is straight forward, but collections seem to be more useful to me, with the disadvantage that their elements are not implicitely typed/(compile-time-)type checked.
So this would e.g. turn it into an (read-only) array (with the in-mem-copy-disadvantage mentioned in other answers/comments):
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorArr() As XlCVError()
Dim a() As XlCVError
XlCVErrorArr = a
If UBound( a ) > 0 Then Exit Property
'initialize once:
Dim c As Collection: Set c = XlCVErrorColl
ReDim a(c.Count)
Dim i As Integer: For i = 1 To c.Count
a(i) = c(i)
Next i
XlCVErrorArr = a
End Function
So transforming the example from Clayton Ss answer into a static, modifiable module property using some array it would be:
'module (no class required)
'from https://stackoverflow.com/a/56646199/1915920
Private v() As Double
Static Property Get Vec(index As Long) As Double
If UBound(v) < 3 Then 'initialize once:
ReDim v(0 To 3) 'one could initialize it with anyting after here too
end if
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property