ANDLL
Быстрое удаление элемента из массива

Интерлюдия

Если Вы хотя бы немного времени занимаетесь программированием, то у Вас наверняка возникал вопрос о том, каким образом удалить какой-либо элемент из «середины» массива. И вы наверняка решали для себя эту задачу, ведь на самом деле нет ничего сложного. Более вероятно, вы просто по порядку смещали элементы массива, а затем удаляли последний. Я приведу еще один метод для удаления элемента из массива. Отличительной особенностью этого метода является его более высокое быстродействие в случае, если массив содержит много элементов. Также Вы можете сравнить длину Вашего кода и моего. Какой больше?

Просто массив

Что бы очистить простой массив, скажем чисел типа Long можно особо не мудрствовать:

Private Function ShrinkArray_long(ByRef nArr() As Long, ByVal nIndex As Long)
    If UBound(nArr) = nIndex Then
        ReDim Preserve nArr(nIndex - 1)
    Else
        If nIndex < LBound(nArr) Or nIndex > UBound(nArr) Then
            Err.Raise 10, , "Откуда такой индекс?"
        Else
            'Смещаем все элементы
            CopyMemory VarPtr(nArr(nIndex)), VarPtr(nArr(nIndex + 1)), (UBound(nArr) - nIndex) * 4 '4 – длина Long-переменных
            'Подтираем последний
            ReDim Preserve nArr(UBound(nArr) - 1)
        End If
    End If
End Function

Собственно здесь все просто: только для перемещения мы используем CopyMemory(вместо, скажем, последовательного приравнивания элементов массива), которая работает несколько быстрее, если элементов в массиве много, и несколько медленнее, если их мало.

Массив структур

Как не странно, но здесь не существует принципиальных отличий от первого варианта.

Private Type FirstType
    A As Long
    B As Long
End Type
'===============================
Private Function ShrinkArray_FirstType(ByRef nArr() As FirstType, ByVal nIndex As Long)
    If UBound(nArr) = nIndex Then
        ReDim Preserve nArr(nIndex - 1)
    Else
        If nIndex < LBound(nArr) Or nIndex > UBound(nArr) Then
            Err.Raise 10, , "Откуда такой индекс?"
        Else
            'Смещаем все элементы
            CopyMemory VarPtr(nArr(nIndex)), VarPtr(nArr(nIndex + 1)), (UBound(nArr) - nIndex) * LenB(nArr(0))
            'Подтираем последний
            ReDim Preserve nArr(UBound(nArr) - 1)
        End If
    End If
End Function

Здесь мы просто заменили цифру 4 на LenB(nArr(0)). Собственно, этого и следовало ожидать. Вы можете использовать этот способ тогда, когда структура не содержит каких-либо указателей(т.е. состоит только из данных типа число, типа Date или типа Boolean). Например:

Private Type SomeType1
    A As Long
    B As Long
End Type

Private Type SomeType2
    A As Boolean
    B As Double
    C As Date
End Type

Private Type SomeType3
    A As SomeType2
    B As SomeType1
    C(3) As Date
End Type

Private Type SomeType4
    A As String
    B() As Double
    C As Date
End Type

Здесь все типы, кроме последнего можно использовать так, как показано выше. Последний тип использовать нельзя, так как он содержит строку(элемент A) и динамический массив(элемент B). Так как же быть в этом случае? Ответим:

Массив сложных структур

Private Type SecondType
    A() As Long
    B As Long
    C As Variant
    D As String
End Type
'===============================
Private Function ShrinkArray_SecondType(ByRef nArr() As SecondType, ByVal nIndex As Long)
    If UBound(nArr) = nIndex Then
        ReDim Preserve nArr(nIndex - 1)
    Else
        If nIndex < LBound(nArr) Or nIndex > UBound(nArr) Then
            Err.Raise 10, , "Откуда такой индекс?"
        Else
            'Очищаем удаляемый элемент
            Erase nArr(nIndex).A
            nArr(nIndex).C = Empty
            nArr(nIndex).D = vbNullString
            'Смещаем все элементы
            CopyMemory VarPtr(nArr(nIndex)), VarPtr(nArr(nIndex + 1)), (UBound(nArr) - nIndex) * LenB(nArr(0))
            'Мы уже очистили последний элемент(см. выше). Так не дадим же VB еще что-нибыдь очистить!
            ZeroMemory VarPtr(nArr(UBound(nArr))), LenB(nArr(0))
            'Подтираем последний
            ReDim Preserve nArr(UBound(nArr) - 1)
        End If
    End If
End Function

Тут есть два важных момента: для начала мы самостоятельно опустошаем удаляемый элемент. Если мы этого не сделаем, то у нас не освободится оперативная память, занятая удаляемой структурой. В следствие этого, наша программа может значительно «растолстеть» в процессе выполнения.
Второй важный момент: VB автоматически производит очистку элемента при использовании ReDim Preserve. Несложно понять, что тем самым VB удалит данные последнего элемента массива. А это нам вовсе не надо, ведь мы удаляем элемент из середины! Дабы предотвратить этот неприятный эффект, мы «обнулим» содержимое последнего элемента нашего массива. Сделаем мы это функцией ZeroMemory. Думаю, что последний метод Вас особенно порадует своей скоростью.

Использованные API-функции

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (ByVal Destination As Long, ByVal numBytes As Long)

Хотелось бы обратить Ваше внимание на правильное объявление API-функций. Ну и вкратце о том, для чего они служат.

• CopyMemory – копирует диапазон ячеек оперативной памяти. Первый параметр указывает «пункт назначения», второй – «источник», а третий – сколько байт следует скопировать.
• ZeroMemroy – заполняет диапазон ячеек оперативной памяти нулями. Первый параметр указывает адрес первого байта диапазона, второй – его длину, в байтах.

В заключение

Может быть, эти методы и не поразят Вас своей красотой. Первый, пожалуй, даже не поразит Вас своей скоростью (в отличие от третьего, скажем). Однако полезно знать, что некоторые вопросы имеют порой оригинальное (в крайнем случае, для VB) решение. И это решение, порой бывает даже лучше стандартного. Если Вы вдруг не поняли до конца сути использованных API, это не мешает Вам использовать эти Shrink-функции. Все, что Вам требуется для адаптации последней Shrink-функции под Ваши нужды, это правильно указать те поля, которые нужно очищать. Еще раз напомню: очищать следует Variant-переменные(приравнивая их к Empty), String-переменные(приравнивая их именно к vbNullString, а не ""), Object-переменные(приравнивая их к Nothing) и динамические(не статические!) массивы(используя оператор Erease).