Очистка массива (так, что UBound(a) = -1)

[Filyus]

Для массивов пользовательских типов не годится, но для массивов классов и стандартных типов - вполне.

Код: Выделить всё

Public Sub EmptyArray(a, Optional Dims As Long = 1)
  Dim ArrayVar As Long, ArrayDesc As Long, Bounds As SAFEARRAYBOUND
  ArrayVar = Mem(VarPtr(a) + 8)
  ArrayDesc = Mem(ArrayVar)
  If ArrayDesc = 0 Then
    Mem(ArrayVar) = SafeArrayCreate(VarType(a) And (Not vbArray), Dims, Bounds)
  Else
    SafeArrayRedim ArrayDesc, Bounds
  End If
End Sub

Можно прописать для отдельных типов:

Код: Выделить всё

Public Sub EmptyByteArray(a() As Byte, Optional Dims As Long = 1)
  Dim ArrayVar As Long, ArrayDesc As Long, Bounds As SAFEARRAYBOUND
  ArrayVar = ArrPtr(a)
  ArrayDesc = Mem(ArrayVar)
  If ArrayDesc = 0 Then
    Mem(ArrayVar) = SafeArrayCreate(vbByte, Dims, Bounds)
  Else
    SafeArrayRedim ArrayDesc, Bounds
  End If
End Sub

Пояснения:
Mem(VarPtr(a) + 8 ) - чтение адреса переменной из типа Variant, смещение = 8 байтам
Mem(ArrayVar) - чтение адреса структуры SAFEARRAY, 0 - если массив не инициализирован
VarType(a) And (Not vbArray) - возращает тип элементов массива
Bounds As SAFEARRAYBOUND - .cElements = 0, .lLbound = 0

[Qwertiy]

Не понял, а в чём смысл данного кода? Т. е. для чего он нужен?

[Filyus]

Не понял, а в чём смысл данного кода? Т. е. для чего он нужен?

Чтобы не проверять массив на инициализированность. Т.е. чтобы вместо этого:

Код: Выделить всё

Private Sub Form_Load()
  Dim a() As Long
  Randomize Timer
  For i = 1 To CLng(Rnd * 2)
    ReDim Preserve a(i)
    a(i) = Rnd * 100
  Next i
  If SAPtr(a) <> 0 Then
    For i = 1 To UBound(a)
      Debug.Print a(i)
    Next i
  End If
End Sub


писать так:

Код: Выделить всё

Private Sub Form_Load()
  Dim a() As Long
  EmptyArray a
  Randomize Timer
  For i = 1 To CLng(Rnd * 2)
    ReDim Preserve a(i)
    a(i) = Rnd * 100
  Next i
  For i = 1 To UBound(a)
    Debug.Print a(i)
  Next i
End Sub

[Хакер]

Идеологически верно иметь не такую функцию, а иметь функцию ArySize, возвращающую кол-во элементов в массиве.
Название функции никуда не годное.
Трюк с обёртыванием массива внутрь Variant-а — не очень хороший.

[Viper]

ЕМНИП, у нас есть аж два кирпича посвященные работе с массивами.

[Filyus]

ЕМНИП, у нас есть аж два кирпича посвященные работе с массивами.

и где эти "кирпичи"?

[Viper]

Раз и два.

[Filyus]

Раз и два.

Их я уже видел. Они тут не причём.

[ark]

Простая подмена указателей прошла бы (возможно), если массив изначально был бы VT_BYREF. А так, в VarPtr(a)+8 надо всю структуру SAFEARRAY копировать:

Код: Выделить всё

Public Function EmptyArray(ByRef TheArray As Variant, Optional vt As VbVarType = vbEmpty) As Boolean
   Dim saBound As SAFEARRAYBOUND
   If vt = vbEmpty Then vt = VarType(TheArray)
   vt = vt And Not vbArray
   If vt <= vbNull Then vt = vbVariant
   Dim pSA As Long
   pSA = SafeArrayCreate(vt, 1, saBound)
   If pSA = 0 Then Exit Function
   vt = vt Or vbArray
   CopyMemory ByVal VarPtr(TheArray), vt, 2
   CopyMemory ByVal VarPtr(TheArray) + 8, pSA, Len(saBound) + 16
   EmptyArray = True
End Function

Ну и объявляй массив как вариант, а уж тип ставь в EmptyArray

Код: Выделить всё

Private Sub Command1_Click()
   Dim a As Variant
   If EmptyArray(a, vbLong) Then
      Debug.Print LBound(a)
      Debug.Print UBound(a)
   End If
End Sub


ЗЫ А вообще-то, ИМХО, правильнее написать какой-нить UBoundEx, возвращающий -1 для неинициализированного массива и пользовать его For i=1 To UboundEx(a)

[Filyus]

Так что ли?)

Код: Выделить всё

Public Function UboundEx(Ar, Optional UnInitedValue = -1) As Long
  Dim n As Long
  n = Mem(VarPtr(Ar) + 8)
  If (MemInt(VarPtr(Ar)) And VT_BYREF) <> 0 Then n = Mem(n)
  If n <> 0 Then
    n = n + ((MemInt(n + SafeArrayDims) - 1) * 8)
    UboundEx = Mem(n + SafeArrayElements1D) + Mem(n + SafeArrayLbound1D) - 1
  Else
    UboundEx = UnInitedValue
  End If
End Function

Код: Выделить всё

Sub Main()
  Dim a(1), b(2) As Long, c() As Long, d(4, 6, 8)
  a(0) = b
  a(1) = с
  Debug.Print UboundEx(a) 'VT_BYREF
  Debug.Print UboundEx(a(0))
  Debug.Print UboundEx(a(1))
  Debug.Print UboundEx(с)
  Debug.Print UboundEx(d), UBound(d)
End Sub

[Хакер]

Filyus, твой код — полная гадость.
Не должно быть никаких Mem(n + загадочноечисло) в коде. Не должно быть никакого вариант-враппера.

[Filyus]

Filyus, твой код — полная гадость.
Не должно быть никаких Mem(n + загадочноечисло) в коде. Не должно быть никакого вариант-враппера.

Спасибо, я старался. А по правде, такой код написан для максимальной скорости его выполнения, а не чтения программистом. При желании можно вместо чисел ввести константы, а вместо враппера...
Если только для каждого типа прописывать...

Код: Выделить всё

Public Function UboundExLng(Ar() As Long, Optional UnInitedValue = -1) As Long
  Dim n As Long
  n = SAPtr(Ar)
  If n <> 0 Then
    n = n + ((MemInt(n + SafeArrayDims) - 1) * 8)
    UboundExLng = Mem(n + SafeArrayElements1D) + Mem(n + SafeArrayLbound1D) - 1
  Else
    UboundExLng = UnInitedValue
  End If
End Function

А ArrPtr и SAPtr для последних трёх строчек не работают...

Код: Выделить всё

Sub Main()
  Dim a(1), b(2) As Long, c() As Long
  a(0) = b
  a(1) = c
  Debug.Print UboundEx(SAPtr(a)) 'VT_BYREF
  Debug.Print UboundEx(SAPtr(a(0)))
  Debug.Print UboundEx(SAPtr(a(1)))
  Debug.Print UboundEx(SAPtr(c))
End Sub

[Хакер]

А ArrPtr и SAPtr для последних трёх строчек не работают...

Что такое ArrPtr и SAPtr?

[Filyus]

SAPtr - оболочка для GetMem4, получает или меняет адрес структуры SAFEARRAY, ArrPtr - оболочка для VarPtr, возращает адрес переменной, которая указывает на эту структуру.

Код: Выделить всё

[entry("GetMem4"), propget]
      HRESULT __stdcall SAPtr(
         [in]          SAFEARRAY(void) *   Array,
         [out, retval]   long *            lpRetVal
      );
[entry("PutMem4"), propput,]
      HRESULT __stdcall SAPtr(
         [in]          SAFEARRAY(void) *   Array,
         [in]          long               NewValue
      );

Код: Выделить всё

[entry("VarPtr")]
      long __stdcall ArrPtr([in] SAFEARRAY(void) * Ptr);