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!!
https://github.com/Evanml2030/Excel-ArrayFunctions
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
Public Type TestStruct
Column As Long
Row As Long
End Type
Private Const TESTSTRUCT_BYTELENGTH = 8
FUNCTIONS
Public Function ArrayPush(ByRef ArrayOriginal() As TestStruct, ByRef ElementToAdd As TestStruct) As TestStruct()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long
NewLength = UBound(ArrayOriginal) + 1
ReDim ArrayPush(NewLength)
CopiedBytes = NewLength * TESTSTRUCT_BYTELENGTH
NewBytes = TESTSTRUCT_BYTELENGTH
CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, TESTSTRUCT_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, TESTSTRUCT_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function
Public Function ArrayPop(ByRef ArrayOriginal() As TestStruct) As TestStruct()
Dim NewLength As Long
Dim CopiedBytes As Long
NewLength = UBound(ArrayOriginal) - 1
ReDim ArrayPop(NewLength)
CopiedBytes = UBound(ArrayOriginal) * TESTSTRUCT_BYTELENGTH
CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, TESTSTRUCT_BYTELENGTH), CopiedBytes
End Function
Public Function ArrayShift(ByRef ArrayOriginal() As TestStruct, ByRef ElementToAdd As TestStruct) As TestStruct()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long
NewLength = UBound(ArrayOriginal) + 1
ReDim ArrayShift(NewLength)
CopiedBytes = NewLength * TESTSTRUCT_BYTELENGTH
NewBytes = TESTSTRUCT_BYTELENGTH
CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, TESTSTRUCT_BYTELENGTH), CopiedBytes
CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, TESTSTRUCT_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function
Public Function ArrayUnshift(ByRef ArrayOriginal() As TestStruct) As TestStruct()
Dim NewLength As Long
Dim CopiedBytes As Long
NewLength = UBound(ArrayOriginal) - 1
ReDim ArrayUnshift(NewLength)
CopiedBytes = UBound(ArrayOriginal) * TESTSTRUCT_BYTELENGTH
CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, TESTSTRUCT_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, TESTSTRUCT_BYTELENGTH), CopiedBytes
End Function
Public Function ArrayElementGetPointer(ByRef Arr() As TestStruct, 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
ptrToArrayVar = VarPtrArray(Arr)
CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
ptrToArrayData = uSAFEARRAY.pvData
ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
ArrayElementGetPointer = ptrCursor
End Function
Debug.Print
rather thanDebug.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\$