VBA Array Functions: insert Element, remove Element The Next CEO of Stack OverflowPorting ProcMonDebugOutput from C# to VBAWin32 File API in VBAFunctional FrameworkMapping one array onto another where columns from first array become rows in second arrayVBA UDF SUMIF with Array ParametersVBA Script to Remove DuplicatesPerformance of generic VS non-generic method (array generating function)Speed up array loop vba ExcelVba to create a new column and insert array formulaVBA array functions: push, pop, shift, unshift

Does it make sense to invest money on space investigation?

Chain wire methods together in Lightning Web Components

Is a distribution that is normal, but highly skewed considered Gaussian?

Would a grinding machine be a simple and workable propulsion system for an interplanetary spacecraft?

Why doesn't UK go for the same deal Japan has with EU to resolve Brexit?

INSERT to a table from a database to other (same SQL Server) using Dynamic SQL

Recycling old answers

Is wanting to ask what to write an indication that you need to change your story?

Does soap repel water?

Unclear about dynamic binding

Reference request: Grassmannian and Plucker coordinates in type B, C, D

I believe this to be a fraud - hired, then asked to cash check and send cash as Bitcoin

Why isn't the Mueller report being released completely and unredacted?

Why isn't acceleration always zero whenever velocity is zero, such as the moment a ball bounces off a wall?

How to place nodes around a circle from some initial angle?

What does "Its cash flow is deeply negative" mean?

Why, when going from special to general relativity, do we just replace partial derivatives with covariant derivatives?

Is it possible to replace duplicates of a character with one character using tr

Why this way of making earth uninhabitable in Interstellar?

Why didn't Khan get resurrected in the Genesis Explosion?

Why did CATV standarize in 75 ohms and everyone else in 50?

Is there a difference between "Fahrstuhl" and "Aufzug"

0 rank tensor vs 1D vector

Example of a Mathematician/Physicist whose Other Publications during their PhD eclipsed their PhD Thesis



VBA Array Functions: insert Element, remove Element



The Next CEO of Stack OverflowPorting ProcMonDebugOutput from C# to VBAWin32 File API in VBAFunctional FrameworkMapping one array onto another where columns from first array become rows in second arrayVBA UDF SUMIF with Array ParametersVBA Script to Remove DuplicatesPerformance of generic VS non-generic method (array generating function)Speed up array loop vba ExcelVba to create a new column and insert array formulaVBA array functions: push, pop, shift, unshift










2












$begingroup$


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



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

Private Type SnakePart
Column As Long
Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8


FUNCTIONS



Private Function ArrayInsertElement(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart, ByRef Position As Long) As SnakePart()
Dim NewLength As Long
Dim CopiedBytesFirstSection As Long
Dim CopiedBytesSecondSection As Long

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

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

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

Private Function ArrayRemoveElement(ByRef ArrayOriginal() As SnakePart, ByRef Position As Long) As SnakePart()
Dim NewLength As Long
Dim CopiedBytesFirstSection As Long
Dim CopiedBytesSecondSection As Long

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

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

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


Private Function ArrayElementGetPointer(ByRef Arr() As SnakePart, 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

' Get Pointer To Array *Variable*
ptrToArrayVar = VarPtrArray(Arr)
' Get Pointer To Array Variable *SAFEARRAY* By Directly Reading Array Variable
CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
' Read The SAFEARRAY Structure
CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
' Get Pointer To Array Data
ptrToArrayData = uSAFEARRAY.pvData
' Get Pointer To Array Element
ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
ArrayElementGetPointer = ptrCursor
End Function


TESTS



Private Sub ArrayInsertElementTest()
Dim x(3) As SnakePart
Dim sp As SnakePart

sp.Column = 1
sp.Row = 1

x(0) = sp
x(1) = sp
x(2) = sp
x(3) = sp

Debug.Print x(0).Column = 1
Debug.Print x(1).Column = 1
Debug.Print x(2).Column = 1
Debug.Print x(3).Column = 1
Debug.Print "_______________________"

Dim temparry() As SnakePart
temparry = x

sp.Column = 2
sp.Row = 2

temparry = ArrayInsertElement(temparry, sp, 2)

Debug.Print temparry(0).Column = 1
Debug.Print temparry(1).Column = 1
Debug.Print temparry(2).Column = 2
Debug.Print temparry(3).Column = 1
Debug.Print temparry(4).Column = 1
Debug.Print "_______________________"

sp.Column = 4
sp.Row = 4

temparry = ArrayInsertElement(temparry, sp, 4)

Debug.Print temparry(0).Column = 1
Debug.Print temparry(1).Column = 1
Debug.Print temparry(2).Column = 2
Debug.Print temparry(3).Column = 1
Debug.Print temparry(4).Column = 4
Debug.Print temparry(5).Column = 1
Debug.Print "_______________________"

sp.Column = 0
sp.Row = 0

temparry = ArrayInsertElement(temparry, sp, 0)

Debug.Print temparry(0).Column = 0
Debug.Print temparry(1).Column = 1
Debug.Print temparry(2).Column = 1
Debug.Print temparry(3).Column = 2
Debug.Print temparry(4).Column = 1
Debug.Print temparry(5).Column = 4
Debug.Print temparry(6).Column = 1
Debug.Print "_______________________"

End Sub

Private Sub ArrayRemoveElementTest()
Dim x(5) As SnakePart
Dim sp As SnakePart

sp.Column = 0
sp.Row = 0
x(0) = sp

sp.Column = 1
sp.Row = 1
x(1) = sp

sp.Column = 2
sp.Row = 2
x(2) = sp

sp.Column = 3
sp.Row = 3
x(3) = sp

sp.Column = 4
sp.Row = 4
x(4) = sp

sp.Column = 5
sp.Row = 5
x(5) = sp

Debug.Print x(0).Column = 0
Debug.Print x(1).Column = 1
Debug.Print x(2).Column = 2
Debug.Print x(3).Column = 3
Debug.Print x(4).Column = 4
Debug.Print x(5).Column = 5
Debug.Print "_______________________"

Dim temparry() As SnakePart
temparry = x

temparry = ArrayRemoveElement(temparry, 4)

Debug.Print temparry(0).Column = 0
Debug.Print temparry(1).Column = 1
Debug.Print temparry(2).Column = 2
Debug.Print temparry(3).Column = 3
Debug.Print temparry(4).Column = 5
Debug.Print "_______________________"

temparry = ArrayRemoveElement(temparry, 2)

Debug.Print temparry(0).Column = 0
Debug.Print temparry(1).Column = 1
Debug.Print temparry(2).Column = 3
Debug.Print temparry(3).Column = 5
Debug.Print "_______________________"

temparry = ArrayRemoveElement(temparry, 1)

Debug.Print temparry(0).Column = 0
Debug.Print temparry(1).Column = 3
Debug.Print temparry(2).Column = 5
Debug.Print "_______________________"

temparry = ArrayRemoveElement(temparry, 0)

Debug.Print temparry(0).Column = 3
Debug.Print temparry(1).Column = 5
Debug.Print "_______________________"
End Sub









share|improve this question











$endgroup$
















    2












    $begingroup$


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



    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

    Private Type SnakePart
    Column As Long
    Row As Long
    End Type

    Private Const SNAKEPART_BYTELENGTH = 8


    FUNCTIONS



    Private Function ArrayInsertElement(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart, ByRef Position As Long) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytesFirstSection As Long
    Dim CopiedBytesSecondSection As Long

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

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

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

    Private Function ArrayRemoveElement(ByRef ArrayOriginal() As SnakePart, ByRef Position As Long) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytesFirstSection As Long
    Dim CopiedBytesSecondSection As Long

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

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

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


    Private Function ArrayElementGetPointer(ByRef Arr() As SnakePart, 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

    ' Get Pointer To Array *Variable*
    ptrToArrayVar = VarPtrArray(Arr)
    ' Get Pointer To Array Variable *SAFEARRAY* By Directly Reading Array Variable
    CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
    ' Read The SAFEARRAY Structure
    CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
    ' Get Pointer To Array Data
    ptrToArrayData = uSAFEARRAY.pvData
    ' Get Pointer To Array Element
    ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
    ArrayElementGetPointer = ptrCursor
    End Function


    TESTS



    Private Sub ArrayInsertElementTest()
    Dim x(3) As SnakePart
    Dim sp As SnakePart

    sp.Column = 1
    sp.Row = 1

    x(0) = sp
    x(1) = sp
    x(2) = sp
    x(3) = sp

    Debug.Print x(0).Column = 1
    Debug.Print x(1).Column = 1
    Debug.Print x(2).Column = 1
    Debug.Print x(3).Column = 1
    Debug.Print "_______________________"

    Dim temparry() As SnakePart
    temparry = x

    sp.Column = 2
    sp.Row = 2

    temparry = ArrayInsertElement(temparry, sp, 2)

    Debug.Print temparry(0).Column = 1
    Debug.Print temparry(1).Column = 1
    Debug.Print temparry(2).Column = 2
    Debug.Print temparry(3).Column = 1
    Debug.Print temparry(4).Column = 1
    Debug.Print "_______________________"

    sp.Column = 4
    sp.Row = 4

    temparry = ArrayInsertElement(temparry, sp, 4)

    Debug.Print temparry(0).Column = 1
    Debug.Print temparry(1).Column = 1
    Debug.Print temparry(2).Column = 2
    Debug.Print temparry(3).Column = 1
    Debug.Print temparry(4).Column = 4
    Debug.Print temparry(5).Column = 1
    Debug.Print "_______________________"

    sp.Column = 0
    sp.Row = 0

    temparry = ArrayInsertElement(temparry, sp, 0)

    Debug.Print temparry(0).Column = 0
    Debug.Print temparry(1).Column = 1
    Debug.Print temparry(2).Column = 1
    Debug.Print temparry(3).Column = 2
    Debug.Print temparry(4).Column = 1
    Debug.Print temparry(5).Column = 4
    Debug.Print temparry(6).Column = 1
    Debug.Print "_______________________"

    End Sub

    Private Sub ArrayRemoveElementTest()
    Dim x(5) As SnakePart
    Dim sp As SnakePart

    sp.Column = 0
    sp.Row = 0
    x(0) = sp

    sp.Column = 1
    sp.Row = 1
    x(1) = sp

    sp.Column = 2
    sp.Row = 2
    x(2) = sp

    sp.Column = 3
    sp.Row = 3
    x(3) = sp

    sp.Column = 4
    sp.Row = 4
    x(4) = sp

    sp.Column = 5
    sp.Row = 5
    x(5) = sp

    Debug.Print x(0).Column = 0
    Debug.Print x(1).Column = 1
    Debug.Print x(2).Column = 2
    Debug.Print x(3).Column = 3
    Debug.Print x(4).Column = 4
    Debug.Print x(5).Column = 5
    Debug.Print "_______________________"

    Dim temparry() As SnakePart
    temparry = x

    temparry = ArrayRemoveElement(temparry, 4)

    Debug.Print temparry(0).Column = 0
    Debug.Print temparry(1).Column = 1
    Debug.Print temparry(2).Column = 2
    Debug.Print temparry(3).Column = 3
    Debug.Print temparry(4).Column = 5
    Debug.Print "_______________________"

    temparry = ArrayRemoveElement(temparry, 2)

    Debug.Print temparry(0).Column = 0
    Debug.Print temparry(1).Column = 1
    Debug.Print temparry(2).Column = 3
    Debug.Print temparry(3).Column = 5
    Debug.Print "_______________________"

    temparry = ArrayRemoveElement(temparry, 1)

    Debug.Print temparry(0).Column = 0
    Debug.Print temparry(1).Column = 3
    Debug.Print temparry(2).Column = 5
    Debug.Print "_______________________"

    temparry = ArrayRemoveElement(temparry, 0)

    Debug.Print temparry(0).Column = 3
    Debug.Print temparry(1).Column = 5
    Debug.Print "_______________________"
    End Sub









    share|improve this question











    $endgroup$














      2












      2








      2





      $begingroup$


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



      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

      Private Type SnakePart
      Column As Long
      Row As Long
      End Type

      Private Const SNAKEPART_BYTELENGTH = 8


      FUNCTIONS



      Private Function ArrayInsertElement(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart, ByRef Position As Long) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytesFirstSection As Long
      Dim CopiedBytesSecondSection As Long

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

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

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

      Private Function ArrayRemoveElement(ByRef ArrayOriginal() As SnakePart, ByRef Position As Long) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytesFirstSection As Long
      Dim CopiedBytesSecondSection As Long

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

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

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


      Private Function ArrayElementGetPointer(ByRef Arr() As SnakePart, 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

      ' Get Pointer To Array *Variable*
      ptrToArrayVar = VarPtrArray(Arr)
      ' Get Pointer To Array Variable *SAFEARRAY* By Directly Reading Array Variable
      CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
      ' Read The SAFEARRAY Structure
      CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
      ' Get Pointer To Array Data
      ptrToArrayData = uSAFEARRAY.pvData
      ' Get Pointer To Array Element
      ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
      ArrayElementGetPointer = ptrCursor
      End Function


      TESTS



      Private Sub ArrayInsertElementTest()
      Dim x(3) As SnakePart
      Dim sp As SnakePart

      sp.Column = 1
      sp.Row = 1

      x(0) = sp
      x(1) = sp
      x(2) = sp
      x(3) = sp

      Debug.Print x(0).Column = 1
      Debug.Print x(1).Column = 1
      Debug.Print x(2).Column = 1
      Debug.Print x(3).Column = 1
      Debug.Print "_______________________"

      Dim temparry() As SnakePart
      temparry = x

      sp.Column = 2
      sp.Row = 2

      temparry = ArrayInsertElement(temparry, sp, 2)

      Debug.Print temparry(0).Column = 1
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 1
      Debug.Print temparry(4).Column = 1
      Debug.Print "_______________________"

      sp.Column = 4
      sp.Row = 4

      temparry = ArrayInsertElement(temparry, sp, 4)

      Debug.Print temparry(0).Column = 1
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 1
      Debug.Print temparry(4).Column = 4
      Debug.Print temparry(5).Column = 1
      Debug.Print "_______________________"

      sp.Column = 0
      sp.Row = 0

      temparry = ArrayInsertElement(temparry, sp, 0)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 1
      Debug.Print temparry(3).Column = 2
      Debug.Print temparry(4).Column = 1
      Debug.Print temparry(5).Column = 4
      Debug.Print temparry(6).Column = 1
      Debug.Print "_______________________"

      End Sub

      Private Sub ArrayRemoveElementTest()
      Dim x(5) As SnakePart
      Dim sp As SnakePart

      sp.Column = 0
      sp.Row = 0
      x(0) = sp

      sp.Column = 1
      sp.Row = 1
      x(1) = sp

      sp.Column = 2
      sp.Row = 2
      x(2) = sp

      sp.Column = 3
      sp.Row = 3
      x(3) = sp

      sp.Column = 4
      sp.Row = 4
      x(4) = sp

      sp.Column = 5
      sp.Row = 5
      x(5) = sp

      Debug.Print x(0).Column = 0
      Debug.Print x(1).Column = 1
      Debug.Print x(2).Column = 2
      Debug.Print x(3).Column = 3
      Debug.Print x(4).Column = 4
      Debug.Print x(5).Column = 5
      Debug.Print "_______________________"

      Dim temparry() As SnakePart
      temparry = x

      temparry = ArrayRemoveElement(temparry, 4)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 3
      Debug.Print temparry(4).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 2)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 3
      Debug.Print temparry(3).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 1)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 3
      Debug.Print temparry(2).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 0)

      Debug.Print temparry(0).Column = 3
      Debug.Print temparry(1).Column = 5
      Debug.Print "_______________________"
      End Sub









      share|improve this question











      $endgroup$




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



      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

      Private Type SnakePart
      Column As Long
      Row As Long
      End Type

      Private Const SNAKEPART_BYTELENGTH = 8


      FUNCTIONS



      Private Function ArrayInsertElement(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart, ByRef Position As Long) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytesFirstSection As Long
      Dim CopiedBytesSecondSection As Long

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

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

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

      Private Function ArrayRemoveElement(ByRef ArrayOriginal() As SnakePart, ByRef Position As Long) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytesFirstSection As Long
      Dim CopiedBytesSecondSection As Long

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

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

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


      Private Function ArrayElementGetPointer(ByRef Arr() As SnakePart, 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

      ' Get Pointer To Array *Variable*
      ptrToArrayVar = VarPtrArray(Arr)
      ' Get Pointer To Array Variable *SAFEARRAY* By Directly Reading Array Variable
      CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
      ' Read The SAFEARRAY Structure
      CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
      ' Get Pointer To Array Data
      ptrToArrayData = uSAFEARRAY.pvData
      ' Get Pointer To Array Element
      ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
      ArrayElementGetPointer = ptrCursor
      End Function


      TESTS



      Private Sub ArrayInsertElementTest()
      Dim x(3) As SnakePart
      Dim sp As SnakePart

      sp.Column = 1
      sp.Row = 1

      x(0) = sp
      x(1) = sp
      x(2) = sp
      x(3) = sp

      Debug.Print x(0).Column = 1
      Debug.Print x(1).Column = 1
      Debug.Print x(2).Column = 1
      Debug.Print x(3).Column = 1
      Debug.Print "_______________________"

      Dim temparry() As SnakePart
      temparry = x

      sp.Column = 2
      sp.Row = 2

      temparry = ArrayInsertElement(temparry, sp, 2)

      Debug.Print temparry(0).Column = 1
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 1
      Debug.Print temparry(4).Column = 1
      Debug.Print "_______________________"

      sp.Column = 4
      sp.Row = 4

      temparry = ArrayInsertElement(temparry, sp, 4)

      Debug.Print temparry(0).Column = 1
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 1
      Debug.Print temparry(4).Column = 4
      Debug.Print temparry(5).Column = 1
      Debug.Print "_______________________"

      sp.Column = 0
      sp.Row = 0

      temparry = ArrayInsertElement(temparry, sp, 0)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 1
      Debug.Print temparry(3).Column = 2
      Debug.Print temparry(4).Column = 1
      Debug.Print temparry(5).Column = 4
      Debug.Print temparry(6).Column = 1
      Debug.Print "_______________________"

      End Sub

      Private Sub ArrayRemoveElementTest()
      Dim x(5) As SnakePart
      Dim sp As SnakePart

      sp.Column = 0
      sp.Row = 0
      x(0) = sp

      sp.Column = 1
      sp.Row = 1
      x(1) = sp

      sp.Column = 2
      sp.Row = 2
      x(2) = sp

      sp.Column = 3
      sp.Row = 3
      x(3) = sp

      sp.Column = 4
      sp.Row = 4
      x(4) = sp

      sp.Column = 5
      sp.Row = 5
      x(5) = sp

      Debug.Print x(0).Column = 0
      Debug.Print x(1).Column = 1
      Debug.Print x(2).Column = 2
      Debug.Print x(3).Column = 3
      Debug.Print x(4).Column = 4
      Debug.Print x(5).Column = 5
      Debug.Print "_______________________"

      Dim temparry() As SnakePart
      temparry = x

      temparry = ArrayRemoveElement(temparry, 4)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 2
      Debug.Print temparry(3).Column = 3
      Debug.Print temparry(4).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 2)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 1
      Debug.Print temparry(2).Column = 3
      Debug.Print temparry(3).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 1)

      Debug.Print temparry(0).Column = 0
      Debug.Print temparry(1).Column = 3
      Debug.Print temparry(2).Column = 5
      Debug.Print "_______________________"

      temparry = ArrayRemoveElement(temparry, 0)

      Debug.Print temparry(0).Column = 3
      Debug.Print temparry(1).Column = 5
      Debug.Print "_______________________"
      End Sub






      performance vba excel winapi






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited 6 mins ago







      learnAsWeGo

















      asked 2 days ago









      learnAsWeGolearnAsWeGo

      2987




      2987




















          0






          active

          oldest

          votes












          Your Answer





          StackExchange.ifUsing("editor", function ()
          return StackExchange.using("mathjaxEditing", function ()
          StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix)
          StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
          );
          );
          , "mathjax-editing");

          StackExchange.ifUsing("editor", function ()
          StackExchange.using("externalEditor", function ()
          StackExchange.using("snippets", function ()
          StackExchange.snippets.init();
          );
          );
          , "code-snippets");

          StackExchange.ready(function()
          var channelOptions =
          tags: "".split(" "),
          id: "196"
          ;
          initTagRenderer("".split(" "), "".split(" "), channelOptions);

          StackExchange.using("externalEditor", function()
          // Have to fire editor after snippets, if snippets enabled
          if (StackExchange.settings.snippets.snippetsEnabled)
          StackExchange.using("snippets", function()
          createEditor();
          );

          else
          createEditor();

          );

          function createEditor()
          StackExchange.prepareEditor(
          heartbeatType: 'answer',
          autoActivateHeartbeat: false,
          convertImagesToLinks: false,
          noModals: true,
          showLowRepImageUploadWarning: true,
          reputationToPostImages: null,
          bindNavPrevention: true,
          postfix: "",
          imageUploader:
          brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
          contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
          allowUrls: true
          ,
          onDemand: true,
          discardSelector: ".discard-answer"
          ,immediatelyShowMarkdownHelp:true
          );



          );













          draft saved

          draft discarded


















          StackExchange.ready(
          function ()
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f216385%2fvba-array-functions-insert-element-remove-element%23new-answer', 'question_page');

          );

          Post as a guest















          Required, but never shown

























          0






          active

          oldest

          votes








          0






          active

          oldest

          votes









          active

          oldest

          votes






          active

          oldest

          votes















          draft saved

          draft discarded
















































          Thanks for contributing an answer to Code Review Stack Exchange!


          • Please be sure to answer the question. Provide details and share your research!

          But avoid


          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.

          Use MathJax to format equations. MathJax reference.


          To learn more, see our tips on writing great answers.




          draft saved


          draft discarded














          StackExchange.ready(
          function ()
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f216385%2fvba-array-functions-insert-element-remove-element%23new-answer', 'question_page');

          );

          Post as a guest















          Required, but never shown





















































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown

































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown







          Popular posts from this blog

          कुँवर स्रोत दिक्चालन सूची"कुँवर""राणा कुँवरके वंशावली"

          शेव्रोले वोल्ट अनुक्रम इतिहास इन्हे भी देखें चित्र दीर्घा संदर्भ दिक्चालन सूची

          चैत्य भूमि चित्र दीर्घा सन्दर्भ बाहरी कडियाँ दिक्चालन सूची"Chaitya Bhoomi""Chaitya Bhoomi: Statue of Equality in India""Dadar Chaitya Bhoomi: Statue of Equality in India""Ambedkar memorial: Centre okays transfer of Indu Mill land"चैत्यभमि