Advertisement
4_2005-2006 Windows API Call/ Explanation #153474

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

AI Summary: 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.

Source Code
original-source
'---------------------------- 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
Original Comments (3)
Recovered from Wayback Machine