Array as a member of a class

Question

I am developing a dynamic buffer for outgoing messages. The data structure takes the form of a node queue in which a byte array buffer is used as a member. Unfortunately, in VBA arrays cannot be public members of a class.

For example, it is no-no and will not compile:

'clsTest Public Buffer() As Byte 

You will receive the following error: "Constants, fixed-length strings, arrays, user-defined types and Declare statements that are not allowed as" Public members of object modules "

Ok, that’s fine, I’ll just make it a private member with the Property Property Accessory ...

 '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 the 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 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 tags # 2, Buffer highlighted, and the error message is "Invalid number of arguments or invalid property assignment"

Test # 2 now works! GSerg indicates that in order to correctly call Property Get Buffer() , as well as to specify a specific index in the buffer, TWO strong> brackets are needed : oBuffer.Buffer()(2)

Test No. 3 does not work - the initial value of 3 is printed in the Immediate window. In a comment, GSerg pointed out that Public Property Get Buffer() returns a copy, not an actual array of class members, so changes are lost.

How to solve this third problem so that the array of class members works as expected?

(I must clarify that the general question is: “VBA does not allow arrays to be public members of classes. How can I get around this to have a member of the class array that behaves as if it were for all practical purposes including: 1 assignment of the array, # 2 receiving values ​​from the array, # 3 assigning values ​​in the array and # 4 using the array directly in the CopyMemory call (# 3 and # 4 are almost equivalent)? ""

Answer 1

So it turns out I need a little help from OleAut32.dll, in particular the 'VariantCopy' function. This function accurately makes an exact copy of one option to another, including when it's 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 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 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 

Answer 2

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 availability.

Although VBA will not allow us to pass arrays as properties, we can still use functions to get where the properties do not match.

Answer 3

@Blackhawk,

I know this is an old post, but I thought I would post it anyway.

Below is the code that I used to add an array of points to the class, I used a subclass to define individual points, it seems that your task is similar:

TCurve main class

 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 tCurve with 1500 tCurve.Curvepoints (). dY (for example)

The trick is to get the index process in the main class!

Good luck