devxlogo

The number of dimensions of an array

The number of dimensions of an array

Using “pure” VB, the only way to build a generic routine that returns the number of dimensions of an array passed as an argument is using a loop that repeatedly tests the LBound (o UBound) function until it fails:

Function ArrayDims(arr As Variant) As Integer    Dim i As Integer, bound As Long    On Error Resume Next    For i = 1 To 60        bound = LBound(arr, i)        If Err Then            ArrayDims = i - 1            Exit Function        End If    NextEnd Function

You can write a faster routine by peeking at the memory location where Visual Basic holds the number of dimensions of any array:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _    Any, source As Any, ByVal bytes As Long)Function ArrayDims(arr As Variant) As Integer    Dim ptr As Long    Dim VType As Integer        Const VT_BYREF = &H4000&        ' get the real VarType of the argument    ' this is similar to VarType(), but returns also the VT_BYREF bit    CopyMemory VType, arr, 2        ' exit if not an array    If (VType And vbArray) = 0 Then Exit Function        ' get the address of the SAFEARRAY descriptor    ' this is stored in the second half of the    ' Variant parameter that has received the array    CopyMemory ptr, ByVal VarPtr(arr) + 8, 4        ' see whether the routine was passed a Variant    ' that contains an array, rather than directly an array    ' in the former case ptr already points to the SA structure.    ' Thanks to Monte Hansen for this fix        If (VType And VT_BYREF) Then        ' ptr is a pointer to a pointer        CopyMemory ptr, ByVal ptr, 4    End If        ' get the address of the SAFEARRAY structure    ' this is stored in the descriptor        ' get the first word of the SAFEARRAY structure    ' which holds the number of dimensions    ' ...but first check that saAddr is non-zero, otherwise    ' this routine bombs when the array is uninitialized    ' (Thanks to VB2TheMax aficionado Thomas Eyde for    '  suggesting this edit to the original routine.)    If ptr Then        CopyMemory ArrayDims, ByVal ptr, 2    End IfEnd Function

devx-admin

Share the Post: