Visual Basic For Applications - Array Functions - Push | Pop | Shift | UnshiftMulti-dimensional array sort...
Valid Badminton Score?
Gears on left are inverse to gears on right?
What is paid subscription needed for in Mortal Kombat 11?
How do I extract a value from a time formatted value in excel?
How easy is it to start Magic from scratch?
Applicability of Single Responsibility Principle
Method to test if a number is a perfect power?
Pre-amplifier input protection
Sequence of Tenses: Translating the subjunctive
Customer Requests (Sometimes) Drive Me Bonkers!
Large drywall patch supports
Do sorcerers' Subtle Spells require a skill check to be unseen?
Is the destination of a commercial flight important for the pilot?
How to Reset Passwords on Multiple Websites Easily?
Is oxalic acid dihydrate considered a primary acid standard in analytical chemistry?
Proof of work - lottery approach
How do I go from 300 unfinished/half written blog posts, to published posts?
System.debug(JSON.Serialize(o)) Not longer shows full string
How does buying out courses with grant money work?
How do I rename a Linux host without needing to reboot for the rename to take effect?
What is the opposite of 'gravitas'?
Short story about space worker geeks who zone out by 'listening' to radiation from stars
Why Were Madagascar and New Zealand Discovered So Late?
Is a stroke of luck acceptable after a series of unfavorable events?
Visual Basic For Applications - Array Functions - Push | Pop | Shift | Unshift
Multi-dimensional array sort and filter functionsThree functions to make a JSON arrayFunctional FrameworkBinary 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 retailPandas functions for motion tracking
1
$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!
EDIT: ADJUSTED TESTS AND FIXED COPIED BYTES AMOUNT - WAS OFF BY 1 ELEMENT FOR EACH!
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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean
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 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
performance vba excel winapi
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
$endgroup$
add a comment |
1
$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!
EDIT: ADJUSTED TESTS AND FIXED COPIED BYTES AMOUNT - WAS OFF BY 1 ELEMENT FOR EACH!
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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean
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 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
performance vba excel winapi
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
$endgroup$
1
$begingroup$
Quick thing, I've got to ask why you useDebug.Printrather thanDebug.Assertfor 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
add a comment |
1
1
1
$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!
EDIT: ADJUSTED TESTS AND FIXED COPIED BYTES AMOUNT - WAS OFF BY 1 ELEMENT FOR EACH!
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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean
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 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
performance vba excel winapi
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
$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!
EDIT: ADJUSTED TESTS AND FIXED COPIED BYTES AMOUNT - WAS OFF BY 1 ELEMENT FOR EACH!
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 Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Boolean
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 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
performance vba excel winapi
performance vba excel winapi
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
edited 13 mins ago
learnAsWeGo
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
asked Mar 18 at 5:06
learnAsWeGolearnAsWeGo
2887
2887
1
$begingroup$
Quick thing, I've got to ask why you useDebug.Printrather thanDebug.Assertfor 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
add a comment |
1
$begingroup$
Quick thing, I've got to ask why you useDebug.Printrather thanDebug.Assertfor 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
1
1
$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
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
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
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-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
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
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-functions-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');
});
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');
});
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');
});
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
1
$begingroup$
Quick thing, I've got to ask why you use
Debug.Printrather thanDebug.Assertfor 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