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





performance vba excel winapi







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





    performance vba excel winapi







    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





      performance vba excel winapi







      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




      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

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

          Image
          पुष्टि की ज़रूरत वाले "सम्बंधित जाति समूह" क्षत्रियक्षेत्रीकर्णालीक्षेत्रीनेपाली भाषामेंकाजीबिष्टपाण्डेबस्नेतथापावत्सपृथ्वीनारायण शाहकेबलभद्र कुंवरभीमसेन थापाकेजंगबहादुर राणाराणा कुँवर/कँवर (गोरखाली) उपर: रामकृष्ण कुँवर बीच:बलभद्र कुंवर  · बालनरसिंह कुँवर तल:जंगबहादुर कुँवर राणा  · बमबहादुर कुँवर राणा कुल जनसंख्या ८२,१४९ नेपालमे (राणा कुँवरको छोडके) [1] [2] ख़ास आवास क्षेत्र   नेपाल भाषाएँ नेपाली भाषा धर्म हिन्दु धर्म और मष्टो धर्म अन्य सम्बंधित समूह पाँडे, थापा, बस्नेत, बिष्ट कुँवर वा कँवर नेपाली क्षत्रिय वर्णके क्षेत्री जातिके पारिवारिक नाम है। इस परिवारकी उत्पत्ति नेपालके कर्णाली प्रदेशमे अन्य क्षेत्री जातिके साथ हुआ था। कुँवरका अर्थ नेपाली भाषामें कुमार है। यिनका भारतीय राजपुत और मराठा राजाओं से कुछ वैवाहिक सम्बन्ध है। भारतमे पाएजानेवाले कुँवर अलग वंशजके है। कुँवर पाँच पुस्त्यौनी काजी परिवार मध्ये एक है। अन्य चार परिवार बिष्ट, पाण्डे, बस्नेत और थापा है। [3] इनके गोत्र वत्स गोत्र है। [4] रामकृष्ण कुँवर पृथ्वीनारायण शाहके सेनामे सरदार थे। बलभद्र कुंवर भीमसेन थापाके
          Read more

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

          Image
          कार अमेरिकीऑस्ट्रेलियान्यूजीलैंडयूनाइटेड किंगडमयूरोपइंजनलीड-एसिड बैटरी शेव्रोले वोल्ट अवलोकन निर्माता जनरल मोटर्स निर्माण 2011 शेव्रोले वोल्ट एक अमेरिकी कार निर्माता, जनरल मोटर्स द्वारा निर्मित एक प्लग-इन हाइब्रिड कार है. इसे चीन में बुइक वेलाइट 5 के रूप में, [1] ऑस्ट्रेलिया और न्यूजीलैंड में होल्डन वोल्ट , और एक अलग बनावट के साथ वॉक्सहॉल एम्पेरा के रूप में, यूनाइटेड किंगडम और यूरोप के बाकी हिस्सों में ओपल अम्पेरा के नाम से पुनर्निर्मित रूपों में भी विपणन किया (बेचा) जाता है। इस कि बिक्री यूएस में मध्य दिसंबर २०१० से, और यूरोप में २०११ से शुरु हुई। [2] वोल्ट एक शुद्ध बैटरी इलेक्ट्रिक वाहन के रूप में काम करती है जब तक इसकी बैटरी क्षमता पूर्ण चार्ज से पूर्व निर्धारित सीमा तक गिर ना जाए। वहां से इसका आंतरिक दहन इंजन आवश्यकतानुसार वाहन की सीमा का विस्तार करने के लिए एक विद्युत जनरेटर को शक्ति देता है। जब इंजन चलता है, तो ऊर्जा दक्षता में सुधार करने के लिए, यह समय-समय पर यांत्रिक रूप से (एक क्लच द्वारा) एक ग्रह गियर सेट से, और इसलिए आउटपुट ड्राइव धुरी से जुड़ जाता है । वोल्ट की रिजे
          Read more

          चैत्य भूमि चित्र दीर्घा सन्दर्भ बाहरी कडियाँ दिक्चालन सूची"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"चैत्यभमि

          Image
          मुम्बईबौद्ध तीर्थ स्थलभीमराव आंबेडकर को समर्पित स्मारक मुंबईदादरभारतीय संविधानडॉ भीमराव आंबेडकरबौद्ध धर्मदिल्लीमहापरिनिर्वाणमुंबईभदन्त आनन्द कौशल्यायनअरबी समुद्र चैत्यभूमि चैत्यभूमि मुंबई के दादर स्थित भारतीय संविधान के निर्माता भारतरत्न डॉ भीमराव आंबेडकर जी की समाधि स्थली और बौद्ध धर्म के लोगो का आस्था का केंद्र हैं। दादर के समुद्र तट पर चैत्य भूमि स्थित है। [1] [2] [3] [4] दिल्ली में अपने निवास में ६ दिसंबर १९५६ को आंबेडकर का महापरिनिर्वाण हुआ और उनका पार्थिव मुंबई में लाया गया, चैत्यभूमि में ७ दिसंबर १९५६ को भदन्त आनन्द कौशल्यायन ने आंबेडकर का बौद्ध परम्परा के अनुसार दाह संस्कार किया था। आंबेडकर का दाह संस्कार के पहले उन्हें साक्षी रख उनके १०,००,००० अनुयायिओं ने बौद्ध धम्म की दीक्षा ली और यह दीक्षा उन्हें भदन्त आनन्द कौशल्यायन ने दी थी। चित्र दीर्घा चैत्यभूमि स्तूप अशोकस्तंभ अशोकस्तंभ व प्रवेशद्वार (अंदर से) प्रवेशद्वार (अंदर से) चैत्यभूमि परिसर, आगे अशोकस्तंभ और अरबी समुद्र चैत्यभूम
          Read more