Visual Basic For Applications | Array Functions - Insert Element | Remove ElementFunctional FrameworkRemove an element from an arrayTest for Array vs Range in my TEXTJOIN UDFExcel: displaying an array, works fast for one array, slow for anotherRetrieve, remove duplicates and total ingredients into arrayMapping one array onto another where columns from first array become rows in second arrayPerformance of generic VS non-generic method (array generating function)Vba to create a new column and insert array formulaVisual Basic For Applications - Array Functions - Push | Pop | Shift | UnshiftPublic Function to remove empty or “” elements from a single dimension array

India just shot down a satellite from the ground. At what altitude range is the resulting debris field?

How do I find the solutions of the following equation?

Sort a list by elements of another list

Is exact Kanji stroke length important?

How to Reset Passwords on Multiple Websites Easily?

Go Pregnant or Go Home

Why are there no referendums in the US?

Different result between scanning in Epson's "color negative film" mode and scanning in positive -> invert curve in post?

Is there a korbon needed for conversion?

How can I get through very long and very dry, but also very useful technical documents when learning a new tool?

Type int? vs type int

Did Dumbledore lie to Harry about how long he had James Potter's invisibility cloak when he was examining it? If so, why?

How do I go from 300 unfinished/half written blog posts, to published posts?

Detecting if an element is found inside a container

Trouble understanding the speech of overseas colleagues

What is the intuitive meaning of having a linear relationship between the logs of two variables?

Inappropriate reference requests from Journal reviewers

How to safely derail a train during transit?

Is there a problem with hiding "forgot password" until it's needed?

Lay out the Carpet

How did Arya survive the stabbing?

How do we know the LHC results are robust?

Is the destination of a commercial flight important for the pilot?

Crossing the line between justified force and brutality



Visual Basic For Applications | Array Functions - Insert Element | Remove Element


Functional FrameworkRemove an element from an arrayTest for Array vs Range in my TEXTJOIN UDFExcel: displaying an array, works fast for one array, slow for anotherRetrieve, remove duplicates and total ingredients into arrayMapping one array onto another where columns from first array become rows in second arrayPerformance of generic VS non-generic method (array generating function)Vba to create a new column and insert array formulaVisual Basic For Applications - Array Functions - Push | Pop | Shift | UnshiftPublic Function to remove empty or “” elements from a single dimension array













0












$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


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









$endgroup$
















    0












    $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


    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









    $endgroup$














      0












      0








      0





      $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


      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









      $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


      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












      share










      share



      share










      asked 5 mins ago









      learnAsWeGolearnAsWeGo

      2837




      2837




















          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%2fvisual-basic-for-applications-array-functions-insert-element-remove-elemen%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%2fvisual-basic-for-applications-array-functions-insert-element-remove-elemen%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

          Why is a white electrical wire connected to 2 black wires?How to wire a light fixture with 3 white wires in box?How should I wire a ceiling fan when there's only three wires in the box?Two white, two black, two ground, and red wire in ceiling box connected to switchWhy is there a white wire connected to multiple black wires in my light box?How to wire a light with two white wires and one black wireReplace light switch connected to a power outlet with dimmer - two black wires to one black and redHow to wire a light with multiple black/white/green wires from the ceiling?Ceiling box has 2 black and white wires but fan/ light only has 1 of eachWhy neutral wire connected to load wire?Switch with 2 black, 2 white, 2 ground and 1 red wire connected to ceiling light and a receptacle?

          Image
          Why one should not leave fingerprints on bulbs and plugs? New passport but visa is in old (lost) passport How to pronounce "I ♥ Huckabees"? Fastest way to pop N items from a large dict Why does energy conservation give me the wrong answer in this inelastic collision problem? Is there a place to find the pricing for things not mentioned in the PHB? (non-magical) Why did it take so long to abandon sail after steamships were demonstrated? Bach's Toccata and Fugue in D minor breaks the "no parallel octaves" rule? Problem with FindRoot Why do passenger jet manufacturers design their planes with stall prevention systems? Print a physical multiplication table "of which" is correct here? Why is the President allowed to veto a cancellation of emergency powers? Can I use USB data pins as power source How difficult is it to simply disable/disengage the MCAS on Boeing 737 Max 8 & 9 Aircraft? As a new Ubuntu desktop 18.04 LTS user,
          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