2
\$\begingroup\$

An extension to array functions I am building for my snake game. This one allows you to remove / insert particular elements.

https://github.com/Evanml2030/Excel-ArrayFunctions

API CALLS

Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" _
        (ByRef Var() As Any) As LongPtr

Private Declare PtrSafe Sub CopyMemoryI Lib "kernel32.dll" Alias "RtlMoveMemory" _
        (ByVal dst As LongPtr, ByVal src As LongPtr, ByVal Length As Long)

Private Declare PtrSafe Sub CopyMemoryII Lib "kernel32.dll" Alias "RtlMoveMemory" _
        (ByRef dst As SAFEARRAY, ByVal src As LongPtr, ByVal Length As Long)

DATA STRUCTS

Private Type SAFEARRAY_BOUND
    cElements    As Long
    lLbound      As Long
End Type

Private Type SAFEARRAY
    cDims        As Integer
    fFeatures    As Integer
    cbElements   As Long
    cLocks       As Long
    pvData       As LongPtr
    rgsabound(0) As SAFEARRAY_BOUND
End Type

Public Type TestStruct
    Column       As Long
    Row          As Long
End Type

Private Const TESTSTRUCT_BYTELENGTH = 8

FUNCTIONS

Public Function ArrayInsertElement(ByRef ArrayOriginal() As TestStruct, ByRef ElementToAdd As TestStruct, ByRef Position As Long) As TestStruct()
Dim NewLength                  As Long
Dim CopiedBytesFirstSection    As Long
Dim CopiedBytesSecondSection   As Long

    NewLength = UBound(ArrayOriginal) + 1
    ReDim ArrayInsertElement(NewLength)

    CopiedBytesFirstSection = Position * TESTSTRUCT_BYTELENGTH
    CopiedBytesSecondSection = (NewLength - Position) * TESTSTRUCT_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayInsertElement, 0, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, TESTSTRUCT_BYTELENGTH), CopiedBytesFirstSection
    CopyMemoryI ArrayElementGetPointer(ArrayInsertElement, Position, TESTSTRUCT_BYTELENGTH), VarPtr(ElementToAdd), TESTSTRUCT_BYTELENGTH
    CopyMemoryI ArrayElementGetPointer(ArrayInsertElement, Position + 1, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, Position, TESTSTRUCT_BYTELENGTH), CopiedBytesSecondSection
End Function

Public Function ArrayRemoveElement(ByRef ArrayOriginal() As TestStruct, ByRef Position As Long) As TestStruct()
Dim NewLength                  As Long
Dim CopiedBytesFirstSection    As Long
Dim CopiedBytesSecondSection   As Long

    NewLength = UBound(ArrayOriginal) - 1
    ReDim ArrayRemoveElement(NewLength)

    CopiedBytesFirstSection = Position * TESTSTRUCT_BYTELENGTH
    CopiedBytesSecondSection = (UBound(ArrayOriginal) - Position) * TESTSTRUCT_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayRemoveElement, 0, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, TESTSTRUCT_BYTELENGTH), CopiedBytesFirstSection
    CopyMemoryI ArrayElementGetPointer(ArrayRemoveElement, Position, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, Position + 1, TESTSTRUCT_BYTELENGTH), CopiedBytesSecondSection
End Function

Public Function ArrayElementGetPointer(ByRef Arr() As TestStruct, ByVal ElementIndex As Long, ByVal ElementByteLength As Long) As LongPtr
Dim ptrToArrayVar  As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrCursor      As LongPtr
Dim uSAFEARRAY     As SAFEARRAY

    ptrToArrayVar = VarPtrArray(Arr)
    CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
    CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
    ptrToArrayData = uSAFEARRAY.pvData
    ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
    ArrayElementGetPointer = ptrCursor
End Function
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.