Частичные массивы по ссылке

Question

Мой вопрос прост: возможно ли, как я бы это делал в C++, получить две части массива в VBA по ссылке? Я давно не программировал на C++, поэтому не могу вспомнить, как я это делаю прямо сейчас. Может быть, если я вспомню, у меня будет пример.

Я пытаюсь отсортировать массив объектов по одному свойству типа Double. Я делал это раньше в C++, просто больше не имею исходного кода.

Я сомневаюсь, что для этого есть предопределенная функция, но если кто-нибудь знает лучшее решение, оно будет приветствоваться.;)

Это в основном то, что я хочу:

source array(0, 1, 2, 3, 4, 5)

split source array in two
array a(0, 1, 2)
array b(3, 4, 5)

set array a(0) = 4
array a(4, 1, 2)
array b(3, 4, 5)
source array(4, 1, 2, 3, 4, 5)

Конечно, это только абстрактное описание.

Я прошу прощения, если уже есть вопрос, касающийся этого, я тогда не нашел это.

Answer 1

Да, ты можешь. Вам придется вручную создать дескриптор SAFEARRAY, чтобы он указывал на подмножество данных исходного массива.

Module1:

Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Public Declare Function PutMem8 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValueLow As Long, ByVal NewValueHigh As Long) As Long

Module2:

Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppsaOut As Any) As Long
Private Declare Function SafeArrayDestroyDescriptor Lib "oleaut32" (psa As Any) As Long

Private Const S_OK As Long = 0

Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long

Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
  GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function

Public Function UDTArrPtr(ByRef arr As Variant) As Long
  If VarType(arr) Or vbArray Then
    GetMem4 VarPtr(arr) + 8, VarPtr(UDTArrPtr)
  Else
    Err.Raise 5, , "Variant must contain array of user defined type"
  End If
End Function


Public Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As Long, ByVal pData As Long, ParamArray Bounds()) As Long

 'ParamArray Bounds describes desired array dimensions in VB style
 'bounds(0) - lower bound of first dimension
 'bounds(1) - upper bound of first dimension
 'bounds(2) - lower bound of second dimension
 'bounds(3) - upper bound of second dimension
 'etc

  Dim i As Long

  If (UBound(Bounds) - LBound(Bounds) + 1) Mod 2 Then Err.Raise 5, "SafeArray", "Bounds must contain even number of entries."

  If SafeArrayAllocDescriptor((UBound(Bounds) - LBound(Bounds) + 1) / 2, ByVal ppBlankArr) <> S_OK Then Err.Raise 5

  GetMem4 ppBlankArr, VarPtr(CreateSAFEARRAY)
  PutMem4 CreateSAFEARRAY + 4, ElemSize
  PutMem4 CreateSAFEARRAY + 12, pData

  For i = LBound(Bounds) To UBound(Bounds) - 1 Step 2
    If Bounds(i + 1) - Bounds(i) + 1 > 0 Then
      PutMem8 CreateSAFEARRAY + 16 + (UBound(Bounds) - i - 1) * 4, Bounds(i + 1) - Bounds(i) + 1, Bounds(i)
    Else
      SafeArrayDestroyDescriptor ByVal CreateSAFEARRAY
      CreateSAFEARRAY = 0
      PutMem4 ppBlankArr, 0
      Err.Raise 5, , "Each dimension must contain at least 1 element"
    End If
  Next
End Function

Public Function DestroySAFEARRAY(ByVal ppArray As Long) As Long
  GetMem4 ppArray, VarPtr(DestroySAFEARRAY)
  If SafeArrayDestroyDescriptor(ByVal DestroySAFEARRAY) <> S_OK Then Err.Raise 5
  PutMem4 ppArray, 0
  DestroySAFEARRAY = 0
End Function

Использование:

Dim source(0 To 5) As Long
source(0) = 0: source(1) = 1: source(2) = 2: source(3) = 3: source(4) = 4: source(5) = 5

Dim a() As Long
Dim b() As Long

CreateSAFEARRAY ArrPtr(a), 4, VarPtr(source(0)), 0, 2
CreateSAFEARRAY ArrPtr(b), 4, VarPtr(source(3)), 0, 2

MsgBox b(0)

a(0) = 4

DestroySAFEARRAY ArrPtr(a)
DestroySAFEARRAY ArrPtr(b)

MsgBox source(0)

Обязательно используйте правильные ArrPtr аромат в соответствии с вашим массивом (StrArrPtr для массивов строк, UDTArrPtr для массивов пользовательских типов, ArrPtr для всего остального).

Обязательно вручную уничтожьте дочерние массивы, прежде чем исходная переменная массива будет уничтожена erase или выходить за рамки.

---

Однако может быть проще просто передать весь массив по ссылке на подпрограмму, а также указать номер индекса, с которого начинается обработка.