10

我正在为传出消息设计一个动态缓冲区。数据结构采用具有字节数组缓冲区作为成员的节点队列的形式。不幸的是，在 VBA 中，数组不能是类的公共成员。

例如，这是一个禁忌，不会编译：

'clsTest

Public Buffer() As Byte

您将收到以下错误：“常量、固定长度字符串、数组、用户定义类型和 Declare 语句不允许作为对象模块的公共成员”

好吧，没关系，我只需将其设为具有公共属性访问器的私有成员...

'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

...然后在模块中进行一些测试以确保其正常工作：

'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

测试#1 工作正常，但测试 #2 中断，Buffer突出显示，并且错误消息是“参数数量错误或属性分配无效”

测试 #2 现在有效！GSerg指出，为了Property Get Buffer()正确调用并引用缓冲区中的特定索引， 需要两组括号：oBuffer.Buffer()(2)

测试#3 失败 - 原始值 3 打印到立即窗口。GSerg 在他的评论中指出，Public Property Get Buffer()只返回一个副本而不是实际的类成员数组，因此修改会丢失。

如何解决第三个问题，使类成员数组按预期工作？

（我应该澄清一般问题是“VBA 不允许数组成为类的公共成员。我怎样才能解决这个问题，让一个类的数组成员表现得好像它用于所有实际目的，包括：# 1 分配数组，#2 从数组中获取值，#3 在数组中分配值，#4 直接在调用中使用数组CopyMemory（#3 和#4 几乎等效）？）”

4

3 回答 3

3

所以事实证明我需要 OleAut32.dll 的一点帮助，特别是“VariantCopy”函数。这个函数忠实地复制一个变体到另一个变体，包括当它是 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

有了这个新定义，所有的测试都通过了！

'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
于 2015-10-29T19:56:39.947 回答
2

@黑鹰，

我知道这是一个旧帖子，但我想我还是会发布它。

下面是我用来向类添加点数组的代码，我使用子类来定义各个点，听起来你的挑战是相似的：

主流曲线

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

子类 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

这将创建一个具有 1500 tCurve.Curvepoints().dY 的 tCurve（例如）

诀窍是让主类中的索引过程正确！

祝你好运 ！

于 2015-09-23T15:53:30.453 回答
0

不是最优雅的解决方案，而是根据您提供的代码建模......

在 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

在 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

我添加了代码以将类数组传递给另一个数组以证明可访问性。

即使 VBA 不允许我们将数组作为属性传递，我们仍然可以使用函数来找出属性不足的地方。

于 2014-11-22T23:19:03.107 回答