VBA array functions: push, pop, shift, unshift The Next CEO of Stack OverflowPorting ProcMonDebugOutput from C# to VBAWin32 File API in VBAArbitrary-dimensional arrays with transpose and sliceUsing Array to store calculations in VBAFunctional FrameworkCheck employee input from shift workMapping one array onto another where columns from first array become rows in second arrayVBA UDF SUMIF with Array ParametersVba to create a new column and insert array formulaVisual Basic For Applications - Array Functions | Insert Element | Remove Element

Is 'diverse range' a pleonastic phrase?

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

How do I make a variable always equal to the result of some calculations?

How do scammers retract money, while you can’t?

How do we know the LHC results are robust?

Can I run my washing machine drain line into a condensate pump so it drains better?

Calculus II Question

Anatomically Correct Strange Women In Ponds Distributing Swords

Is it ever safe to open a suspicious html file (e.g. email attachment)?

What exact does MIB represent in SNMP? How is it different from OID?

How does the mv command work with external drives?

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

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

Why don't programming languages automatically manage the synchronous/asynchronous problem?

What is the result of assigning to std::vector<T>::begin()?

Which tube will fit a -(700 x 25c) wheel?

sp_blitzCache results Memory grants

How did people program for Consoles with multiple CPUs?

Are there any unintended negative consequences to allowing PCs to gain multiple levels at once in a short milestone-XP game?

Which kind of appliances can one connect to electric sockets located in a airplane's toilet?

What happens if you roll doubles 3 times then land on "Go to jail?"

What flight has the highest ratio of time difference to flight time?

Can we say or write : "No, it'sn't"?

Why do remote companies require working in the US?



VBA array functions: push, pop, shift, unshift



The Next CEO of Stack OverflowPorting ProcMonDebugOutput from C# to VBAWin32 File API in VBAArbitrary-dimensional arrays with transpose and sliceUsing Array to store calculations in VBAFunctional FrameworkCheck employee input from shift workMapping one array onto another where columns from first array become rows in second arrayVBA UDF SUMIF with Array ParametersVba to create a new column and insert array formulaVisual Basic For Applications - Array Functions | Insert Element | Remove Element










2












$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!!



API CALLS



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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean


DATA STRUCTS



Private Type SAFEARRAY_BOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound(0) As SAFEARRAY_BOUND
End Type

Private Type SnakePart
Column As Long
Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8


FUNCTIONS



Private Function 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 = NewLength * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, 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 = UBound(ArrayOriginal) * 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 = NewLength * 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 = UBound(ArrayOriginal) * 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



Private Sub test()

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

' expect all 1s
Debug.Print x(0).Column
Debug.Print x(1).Column
Debug.Print x(2).Column
Debug.Print x(3).Column
Debug.Print "_______________________"

sp.Column = 2

Dim temparry() As SnakePart
temparry = x
temparry = ArrayPush(temparry, sp)

Debug.Print "expect 2 at end"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayPop(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print "_______________________"

temparry = ArrayShift(temparry, sp)

Debug.Print "expect 2 at start"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayUnshift(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
End Sub









share|improve this question











$endgroup$







  • 2




    $begingroup$
    Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
    $endgroup$
    – Greedo
    Mar 19 at 10:50











  • $begingroup$
    had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
    $endgroup$
    – learnAsWeGo
    Mar 19 at 13:54










  • $begingroup$
    by got working i mean understand how to use!
    $endgroup$
    – learnAsWeGo
    Mar 20 at 13:47















2












$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!!



API CALLS



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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean


DATA STRUCTS



Private Type SAFEARRAY_BOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound(0) As SAFEARRAY_BOUND
End Type

Private Type SnakePart
Column As Long
Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8


FUNCTIONS



Private Function 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 = NewLength * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, 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 = UBound(ArrayOriginal) * 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 = NewLength * 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 = UBound(ArrayOriginal) * 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



Private Sub test()

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

' expect all 1s
Debug.Print x(0).Column
Debug.Print x(1).Column
Debug.Print x(2).Column
Debug.Print x(3).Column
Debug.Print "_______________________"

sp.Column = 2

Dim temparry() As SnakePart
temparry = x
temparry = ArrayPush(temparry, sp)

Debug.Print "expect 2 at end"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayPop(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print "_______________________"

temparry = ArrayShift(temparry, sp)

Debug.Print "expect 2 at start"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayUnshift(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
End Sub









share|improve this question











$endgroup$







  • 2




    $begingroup$
    Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
    $endgroup$
    – Greedo
    Mar 19 at 10:50











  • $begingroup$
    had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
    $endgroup$
    – learnAsWeGo
    Mar 19 at 13:54










  • $begingroup$
    by got working i mean understand how to use!
    $endgroup$
    – learnAsWeGo
    Mar 20 at 13:47













2












2








2





$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!!



API CALLS



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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean


DATA STRUCTS



Private Type SAFEARRAY_BOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound(0) As SAFEARRAY_BOUND
End Type

Private Type SnakePart
Column As Long
Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8


FUNCTIONS



Private Function 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 = NewLength * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, 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 = UBound(ArrayOriginal) * 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 = NewLength * 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 = UBound(ArrayOriginal) * 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



Private Sub test()

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

' expect all 1s
Debug.Print x(0).Column
Debug.Print x(1).Column
Debug.Print x(2).Column
Debug.Print x(3).Column
Debug.Print "_______________________"

sp.Column = 2

Dim temparry() As SnakePart
temparry = x
temparry = ArrayPush(temparry, sp)

Debug.Print "expect 2 at end"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayPop(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print "_______________________"

temparry = ArrayShift(temparry, sp)

Debug.Print "expect 2 at start"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayUnshift(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
End Sub









share|improve this question











$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!!



API CALLS



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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean


DATA STRUCTS



Private Type SAFEARRAY_BOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound(0) As SAFEARRAY_BOUND
End Type

Private Type SnakePart
Column As Long
Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8


FUNCTIONS



Private Function 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 = NewLength * SNAKEPART_BYTELENGTH
NewBytes = SNAKEPART_BYTELENGTH

CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, 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 = UBound(ArrayOriginal) * 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 = NewLength * 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 = UBound(ArrayOriginal) * 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



Private Sub test()

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

' expect all 1s
Debug.Print x(0).Column
Debug.Print x(1).Column
Debug.Print x(2).Column
Debug.Print x(3).Column
Debug.Print "_______________________"

sp.Column = 2

Dim temparry() As SnakePart
temparry = x
temparry = ArrayPush(temparry, sp)

Debug.Print "expect 2 at end"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayPop(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print "_______________________"

temparry = ArrayShift(temparry, sp)

Debug.Print "expect 2 at start"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
Debug.Print temparry(4).Column
Debug.Print "_______________________"

temparry = ArrayUnshift(temparry)

Debug.Print "expect all 1"
Debug.Print temparry(0).Column
Debug.Print temparry(1).Column
Debug.Print temparry(2).Column
Debug.Print temparry(3).Column
End Sub






array vba excel vectors winapi






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited 5 mins ago









200_success

130k17156420




130k17156420










asked Mar 18 at 5:06









learnAsWeGolearnAsWeGo

2987




2987







  • 2




    $begingroup$
    Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
    $endgroup$
    – Greedo
    Mar 19 at 10:50











  • $begingroup$
    had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
    $endgroup$
    – learnAsWeGo
    Mar 19 at 13:54










  • $begingroup$
    by got working i mean understand how to use!
    $endgroup$
    – learnAsWeGo
    Mar 20 at 13:47












  • 2




    $begingroup$
    Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
    $endgroup$
    – Greedo
    Mar 19 at 10:50











  • $begingroup$
    had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
    $endgroup$
    – learnAsWeGo
    Mar 19 at 13:54










  • $begingroup$
    by got working i mean understand how to use!
    $endgroup$
    – learnAsWeGo
    Mar 20 at 13:47







2




2




$begingroup$
Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
$endgroup$
– Greedo
Mar 19 at 10:50





$begingroup$
Quick thing, I've got to ask why you use Debug.Print rather than Debug.Assert for your tests, the latter will actually let you know when something has gone wrong - rather than relying on your eyes to tell you. Or indeed switch to Rubberduck for some proper unit tests
$endgroup$
– Greedo
Mar 19 at 10:50













$begingroup$
had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
$endgroup$
– learnAsWeGo
Mar 19 at 13:54




$begingroup$
had never seen .assert used, will explore. thanks. i have rubber duck but have barely gotten the indentation features working, will look into the unit testing. just time!!
$endgroup$
– learnAsWeGo
Mar 19 at 13:54












$begingroup$
by got working i mean understand how to use!
$endgroup$
– learnAsWeGo
Mar 20 at 13:47




$begingroup$
by got working i mean understand how to use!
$endgroup$
– learnAsWeGo
Mar 20 at 13:47










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%2fvba-array-functions-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%2fvba-array-functions-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