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
$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
performance vba excel winapi
$endgroup$
add a comment |
$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
performance vba excel winapi
$endgroup$
add a comment |
$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
performance vba excel winapi
$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
performance vba excel winapi
asked 4 mins ago
learnAsWeGolearnAsWeGo
2737
2737
add a comment |
add a comment |
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
);
);
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
var $window = $(window),
onScroll = function(e)
var $elem = $('.new-login-left'),
docViewTop = $window.scrollTop(),
docViewBottom = docViewTop + $window.height(),
elemTop = $elem.offset().top,
elemBottom = elemTop + $elem.height();
if ((docViewTop elemBottom))
StackExchange.using('gps', function() StackExchange.gps.track('embedded_signup_form.view', location: 'question_page' ); );
$window.unbind('scroll', onScroll);
;
$window.on('scroll', onScroll);
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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
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.
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
var $window = $(window),
onScroll = function(e)
var $elem = $('.new-login-left'),
docViewTop = $window.scrollTop(),
docViewBottom = docViewTop + $window.height(),
elemTop = $elem.offset().top,
elemBottom = elemTop + $elem.height();
if ((docViewTop elemBottom))
StackExchange.using('gps', function() StackExchange.gps.track('embedded_signup_form.view', location: 'question_page' ); );
$window.unbind('scroll', onScroll);
;
$window.on('scroll', onScroll);
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
var $window = $(window),
onScroll = function(e)
var $elem = $('.new-login-left'),
docViewTop = $window.scrollTop(),
docViewBottom = docViewTop + $window.height(),
elemTop = $elem.offset().top,
elemBottom = elemTop + $elem.height();
if ((docViewTop elemBottom))
StackExchange.using('gps', function() StackExchange.gps.track('embedded_signup_form.view', location: 'question_page' ); );
$window.unbind('scroll', onScroll);
;
$window.on('scroll', onScroll);
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
var $window = $(window),
onScroll = function(e)
var $elem = $('.new-login-left'),
docViewTop = $window.scrollTop(),
docViewBottom = docViewTop + $window.height(),
elemTop = $elem.offset().top,
elemBottom = elemTop + $elem.height();
if ((docViewTop elemBottom))
StackExchange.using('gps', function() StackExchange.gps.track('embedded_signup_form.view', location: 'question_page' ); );
$window.unbind('scroll', onScroll);
;
$window.on('scroll', onScroll);
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
var $window = $(window),
onScroll = function(e)
var $elem = $('.new-login-left'),
docViewTop = $window.scrollTop(),
docViewBottom = docViewTop + $window.height(),
elemTop = $elem.offset().top,
elemBottom = elemTop + $elem.height();
if ((docViewTop elemBottom))
StackExchange.using('gps', function() StackExchange.gps.track('embedded_signup_form.view', location: 'question_page' ); );
$window.unbind('scroll', onScroll);
;
$window.on('scroll', onScroll);
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
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