Visual Basic For Applications - Array - Push | Pop | Shift | UnshiftStandard Methods in VBAFunctional FrameworkMaking a report from payroll detailsBinary search a 2D array for multiple matching criteria fieldsStack class in Ruby to calculate maximum number, get the average, pop, pushTest for Array vs Range in my TEXTJOIN UDFExcel: displaying an array, works fast for one array, slow for anotherMapping one array onto another where columns from first array become rows in second array2D array script for retailAbstracting and unit testing lookups in Excel table

Loading the leaflet Map in Lightning Web Component

Do native speakers use "ultima" and "proxima" frequently in spoken English?

Maths symbols and unicode-math input inside siunitx commands

Asserting that Atheism and Theism are both faith based positions

What is the significance behind "40 days" that often appears in the Bible?

What is the English word for a graduation award?

How is the partial sum of a geometric sequence calculated?

gerund and noun applications

Why is indicated airspeed rather than ground speed used during the takeoff roll?

Worshiping one God at a time?

Relation between independence and correlation of uniform random variables

Print a physical multiplication table

Comment Box for Substitution Method of Integrals

How to terminate ping <dest> &

Optimising a list searching algorithm

Help prove this basic trig identity please!

Should I be concerned about student access to a test bank?

When did antialiasing start being available?

Brake pads destroying wheels

Pronounciation of the combination "st" in spanish accents

두음법칙 - When did North and South diverge in pronunciation of initial ㄹ?

Fewest number of steps to reach 200 using special calculator

What (if any) is the reason to buy in small local stores?

Practical application of matrices and determinants



Visual Basic For Applications - Array - Push | Pop | Shift | Unshift


Standard Methods in VBAFunctional FrameworkMaking a report from payroll detailsBinary search a 2D array for multiple matching criteria fieldsStack class in Ruby to calculate maximum number, get the average, pop, pushTest for Array vs Range in my TEXTJOIN UDFExcel: displaying an array, works fast for one array, slow for anotherMapping one array onto another where columns from first array become rows in second array2D array script for retailAbstracting and unit testing lookups in Excel table













0












$begingroup$


I want to write my snake game procedurally, using as much windows call as I can so as to practice. Looking into GetAsyncKeyState to capture keyboard inputs and play sound functions. Also making a sweet user interface. Fun!



Also shout to bytecomb for providing example as to how to traverse the array structure, used his code function to find ptr to element in array!!



Wrote this to practice!




DECLARATIONS AND FUNCTIONS




Option Explicit

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)

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
Private SnakeParts() As SnakePart

Private Function ArrayPush(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long

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

CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, UBound(ArrayPush) - 1, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function

Private Function ArrayPop(ByRef ArrayOriginal() As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long

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

CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, SNAKEPART_BYTELENGTH), CopiedBytes
End Function

Private Function ArrayShift(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long

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

CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function

Private Function ArrayUnshift(ByRef ArrayOriginal() As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long

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

CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, SNAKEPART_BYTELENGTH), CopiedBytes
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




Sub TestFunctions()

Dim Arr(10) As SnakePart
Dim SP As SnakePart
SP.Column = 4
SP.Row = 4
Arr(0) = SP
Debug.Print "Expect 4 x2"
Debug.Print Arr(0).Column
Debug.Print Arr(0).Row

Dim ArrTwo() As SnakePart

SP.Column = 8
SP.Row = 8
ArrTwo = ArrayPush(Arr, SP)

Debug.Print "Expect 4 x2 Followed by 8 x2"
Debug.Print ArrTwo(0).Column
Debug.Print ArrTwo(0).Row
Debug.Print ArrTwo(10).Column
Debug.Print ArrTwo(10).Row

ArrTwo = ArrayPop(Arr)

Debug.Print "Expect 4 x2 Followed by 0 x2"
Debug.Print ArrTwo(0).Column
Debug.Print ArrTwo(0).Row
Debug.Print ArrTwo(9).Column
Debug.Print ArrTwo(9).Row

SP.Column = 7
SP.Row = 7
ArrTwo = ArrayShift(ArrTwo, SP)

Debug.Print "Expect 7 x2 Followed by 4 x2"
Debug.Print ArrTwo(0).Column
Debug.Print ArrTwo(0).Row
Debug.Print ArrTwo(1).Column
Debug.Print ArrTwo(1).Row

ArrTwo = ArrayUnshift(ArrTwo)

Debug.Print "Expect 4 x2 Followed by 0 x2"
Debug.Print ArrTwo(0).Column
Debug.Print ArrTwo(0).Row
Debug.Print ArrTwo(1).Column
Debug.Print ArrTwo(1).Row

End Sub








share









$endgroup$
















    0












    $begingroup$


    I want to write my snake game procedurally, using as much windows call as I can so as to practice. Looking into GetAsyncKeyState to capture keyboard inputs and play sound functions. Also making a sweet user interface. Fun!



    Also shout to bytecomb for providing example as to how to traverse the array structure, used his code function to find ptr to element in array!!



    Wrote this to practice!




    DECLARATIONS AND FUNCTIONS




    Option Explicit

    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)

    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
    Private SnakeParts() As SnakePart

    Private Function ArrayPush(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytes As Long
    Dim NewBytes As Long

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

    CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
    NewBytes = SNAKEPART_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
    CopyMemoryI ArrayElementGetPointer(ArrayPush, UBound(ArrayPush) - 1, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
    End Function

    Private Function ArrayPop(ByRef ArrayOriginal() As SnakePart) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytes As Long

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

    CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, SNAKEPART_BYTELENGTH), CopiedBytes
    End Function

    Private Function ArrayShift(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytes As Long
    Dim NewBytes As Long

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

    CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
    NewBytes = SNAKEPART_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
    CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
    End Function

    Private Function ArrayUnshift(ByRef ArrayOriginal() As SnakePart) As SnakePart()
    Dim NewLength As Long
    Dim CopiedBytes As Long

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

    CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

    CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, SNAKEPART_BYTELENGTH), CopiedBytes
    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




    Sub TestFunctions()

    Dim Arr(10) As SnakePart
    Dim SP As SnakePart
    SP.Column = 4
    SP.Row = 4
    Arr(0) = SP
    Debug.Print "Expect 4 x2"
    Debug.Print Arr(0).Column
    Debug.Print Arr(0).Row

    Dim ArrTwo() As SnakePart

    SP.Column = 8
    SP.Row = 8
    ArrTwo = ArrayPush(Arr, SP)

    Debug.Print "Expect 4 x2 Followed by 8 x2"
    Debug.Print ArrTwo(0).Column
    Debug.Print ArrTwo(0).Row
    Debug.Print ArrTwo(10).Column
    Debug.Print ArrTwo(10).Row

    ArrTwo = ArrayPop(Arr)

    Debug.Print "Expect 4 x2 Followed by 0 x2"
    Debug.Print ArrTwo(0).Column
    Debug.Print ArrTwo(0).Row
    Debug.Print ArrTwo(9).Column
    Debug.Print ArrTwo(9).Row

    SP.Column = 7
    SP.Row = 7
    ArrTwo = ArrayShift(ArrTwo, SP)

    Debug.Print "Expect 7 x2 Followed by 4 x2"
    Debug.Print ArrTwo(0).Column
    Debug.Print ArrTwo(0).Row
    Debug.Print ArrTwo(1).Column
    Debug.Print ArrTwo(1).Row

    ArrTwo = ArrayUnshift(ArrTwo)

    Debug.Print "Expect 4 x2 Followed by 0 x2"
    Debug.Print ArrTwo(0).Column
    Debug.Print ArrTwo(0).Row
    Debug.Print ArrTwo(1).Column
    Debug.Print ArrTwo(1).Row

    End Sub








    share









    $endgroup$














      0












      0








      0





      $begingroup$


      I want to write my snake game procedurally, using as much windows call as I can so as to practice. Looking into GetAsyncKeyState to capture keyboard inputs and play sound functions. Also making a sweet user interface. Fun!



      Also shout to bytecomb for providing example as to how to traverse the array structure, used his code function to find ptr to element in array!!



      Wrote this to practice!




      DECLARATIONS AND FUNCTIONS




      Option Explicit

      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)

      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
      Private SnakeParts() As SnakePart

      Private Function ArrayPush(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long
      Dim NewBytes As Long

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

      CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
      NewBytes = SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
      CopyMemoryI ArrayElementGetPointer(ArrayPush, UBound(ArrayPush) - 1, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
      End Function

      Private Function ArrayPop(ByRef ArrayOriginal() As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long

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

      CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, SNAKEPART_BYTELENGTH), CopiedBytes
      End Function

      Private Function ArrayShift(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long
      Dim NewBytes As Long

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

      CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
      NewBytes = SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
      CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
      End Function

      Private Function ArrayUnshift(ByRef ArrayOriginal() As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long

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

      CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, SNAKEPART_BYTELENGTH), CopiedBytes
      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




      Sub TestFunctions()

      Dim Arr(10) As SnakePart
      Dim SP As SnakePart
      SP.Column = 4
      SP.Row = 4
      Arr(0) = SP
      Debug.Print "Expect 4 x2"
      Debug.Print Arr(0).Column
      Debug.Print Arr(0).Row

      Dim ArrTwo() As SnakePart

      SP.Column = 8
      SP.Row = 8
      ArrTwo = ArrayPush(Arr, SP)

      Debug.Print "Expect 4 x2 Followed by 8 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(10).Column
      Debug.Print ArrTwo(10).Row

      ArrTwo = ArrayPop(Arr)

      Debug.Print "Expect 4 x2 Followed by 0 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(9).Column
      Debug.Print ArrTwo(9).Row

      SP.Column = 7
      SP.Row = 7
      ArrTwo = ArrayShift(ArrTwo, SP)

      Debug.Print "Expect 7 x2 Followed by 4 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(1).Column
      Debug.Print ArrTwo(1).Row

      ArrTwo = ArrayUnshift(ArrTwo)

      Debug.Print "Expect 4 x2 Followed by 0 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(1).Column
      Debug.Print ArrTwo(1).Row

      End Sub








      share









      $endgroup$




      I want to write my snake game procedurally, using as much windows call as I can so as to practice. Looking into GetAsyncKeyState to capture keyboard inputs and play sound functions. Also making a sweet user interface. Fun!



      Also shout to bytecomb for providing example as to how to traverse the array structure, used his code function to find ptr to element in array!!



      Wrote this to practice!




      DECLARATIONS AND FUNCTIONS




      Option Explicit

      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)

      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
      Private SnakeParts() As SnakePart

      Private Function ArrayPush(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long
      Dim NewBytes As Long

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

      CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
      NewBytes = SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
      CopyMemoryI ArrayElementGetPointer(ArrayPush, UBound(ArrayPush) - 1, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
      End Function

      Private Function ArrayPop(ByRef ArrayOriginal() As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long

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

      CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, SNAKEPART_BYTELENGTH), CopiedBytes
      End Function

      Private Function ArrayShift(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long
      Dim NewBytes As Long

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

      CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH
      NewBytes = SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
      CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
      End Function

      Private Function ArrayUnshift(ByRef ArrayOriginal() As SnakePart) As SnakePart()
      Dim NewLength As Long
      Dim CopiedBytes As Long

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

      CopiedBytes = NewLength * SNAKEPART_BYTELENGTH

      CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, SNAKEPART_BYTELENGTH), CopiedBytes
      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




      Sub TestFunctions()

      Dim Arr(10) As SnakePart
      Dim SP As SnakePart
      SP.Column = 4
      SP.Row = 4
      Arr(0) = SP
      Debug.Print "Expect 4 x2"
      Debug.Print Arr(0).Column
      Debug.Print Arr(0).Row

      Dim ArrTwo() As SnakePart

      SP.Column = 8
      SP.Row = 8
      ArrTwo = ArrayPush(Arr, SP)

      Debug.Print "Expect 4 x2 Followed by 8 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(10).Column
      Debug.Print ArrTwo(10).Row

      ArrTwo = ArrayPop(Arr)

      Debug.Print "Expect 4 x2 Followed by 0 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(9).Column
      Debug.Print ArrTwo(9).Row

      SP.Column = 7
      SP.Row = 7
      ArrTwo = ArrayShift(ArrTwo, SP)

      Debug.Print "Expect 7 x2 Followed by 4 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(1).Column
      Debug.Print ArrTwo(1).Row

      ArrTwo = ArrayUnshift(ArrTwo)

      Debug.Print "Expect 4 x2 Followed by 0 x2"
      Debug.Print ArrTwo(0).Column
      Debug.Print ArrTwo(0).Row
      Debug.Print ArrTwo(1).Column
      Debug.Print ArrTwo(1).Row

      End Sub






      performance vba excel winapi





      share












      share










      share



      share










      asked 4 mins ago









      learnAsWeGolearnAsWeGo

      2737




      2737




















          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%2f215646%2fvisual-basic-for-applications-array-push-pop-shift-unshift%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%2f215646%2fvisual-basic-for-applications-array-push-pop-shift-unshift%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

          名間水力發電廠 目录 沿革 設施 鄰近設施 註釋 外部連結 导航菜单23°50′10″N 120°42′41″E / 23.83611°N 120.71139°E / 23.83611; 120.7113923°50′10″N 120°42′41″E / 23.83611°N 120.71139°E / 23.83611; 120.71139計畫概要原始内容臺灣第一座BOT 模式開發的水力發電廠-名間水力電廠名間水力發電廠 水利署首件BOT案原始内容《小檔案》名間電廠 首座BOT水力發電廠原始内容名間電廠BOT - 經濟部水利署中區水資源局

          Prove that NP is closed under karp reduction?Space(n) not closed under Karp reductions - what about NTime(n)?Class P is closed under rotation?Prove or disprove that $NL$ is closed under polynomial many-one reductions$mathbfNC_2$ is closed under log-space reductionOn Karp reductionwhen can I know if a class (complexity) is closed under reduction (cook/karp)Check if class $PSPACE$ is closed under polyonomially space reductionIs NPSPACE also closed under polynomial-time reduction and under log-space reduction?Prove PSPACE is closed under complement?Prove PSPACE is closed under union?

          Is my guitar’s action too high? Announcing the arrival of Valued Associate #679: Cesar Manara Planned maintenance scheduled April 23, 2019 at 23:30 UTC (7:30pm US/Eastern)Strings too stiff on a recently purchased acoustic guitar | Cort AD880CEIs the action of my guitar really high?Μy little finger is too weak to play guitarWith guitar, how long should I give my fingers to strengthen / callous?When playing a fret the guitar sounds mutedPlaying (Barre) chords up the guitar neckI think my guitar strings are wound too tight and I can't play barre chordsF barre chord on an SG guitarHow to find to the right strings of a barre chord by feel?High action on higher fret on my steel acoustic guitar