Remove item from dynamic type array (MemCopy - fast solution)
Erase a specified (mIndex) item in a Dynamic Type Array. When the index is valid it shrinks the Array, so an item will not hold any 'empty' variable/data (1,2,3,4, 0 ,6,7,8 OR "a","b","c","d", "" ,"f","g") This is the fastest possible way I know. Please comment anything!
AI
Resumen de IA: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Código fuente
'---------------------------- MODULE --------------------------
Public Type ArrayOfType
item_01 As Long
item_02 As Long
item_03 As Long
item_04 As Long
item_05 As Long
item_06 As Long
item_07 As Long
End Type
Public ArrayOfType() As ArrayOfType ' declare type as array
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Public Function RemoveArrayItem(ByVal mIndex As Long) As Boolean
' Erase a specified (mIndex) item in a Dynamic Type Array.
' When the index is valid it shrinks the Array, so an item
' will not hold any 'empty' variable (1,2,3,4, 0 ,6,7,8 OR "a","b","c","d", "" ,"f","g")
' NOTE: I don't use ArrayOfType(0)
' if we use (as below) UBound(ArrayOfType), and the ArrayOfType() isn't
' holding any data ( = Nothing) we get an error! :(
On Error GoTo dspErr
Dim i As Long ' counter
Dim hMatrix As Long ' size of array
hMatrix = UBound(ArrayOfType)
If hMatrix = 1 Then ' size of array is 1 (1 item hold data)
Erase ArrayOfType ' clear complete array (size was 1)
RemoveArrayItem = True ' return function
Exit Function ' done...
ElseIf mIndex = hMatrix Then ' last item in matrix?
ReDim Preserve ArrayOfType(hMatrix - 1) As ArrayOfType ' hold data and resize array and delete last item
RemoveArrayItem = True ' return function
Exit Function ' done...
End If
For i = mIndex + 1 To hMatrix ' start with item mIndex
MemCopy ArrayOfType(i - 1), ArrayOfType(i), Len(ArrayOfType(i)) ' copy all items into the items 1 step down in the array (overwrites)
Next i
ReDim Preserve ArrayOfType(hMatrix - 1) As ArrayOfType ' resize array [removes last item -> we copied it, remember?!]
RemoveArrayItem = True ' return function
Exit Function ' done...
dspErr:
MsgBox Err.Number & " - " & Err.Description
End Function
Comentarios originales (3)
Recuperado de Wayback Machine