Split Chrome and Excel windows side by side

[Vincent88]

Hi Guys,
I use this code to split the IE browser and excel file windows side by side. Is it possible to change the IE frame to Chrome instead !

Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type


Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare PtrSafe Function MoveWindow Lib "user32" ( _
    ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Sub SideBySide()
  Dim hwnd As Long
  Dim R As RECT, LW As RECT, RW As RECT

  'Get the size of the deskop
  If GetWindowRect(GetDesktopWindow, R) = 0 Then Exit Sub
  'Calculate the left and right side
  LW = R
  LW.Right = R.Left + (R.Right - R.Left) / 2
  RW = R
  RW.Left = R.Right - (R.Right - R.Left) / 2

  'Move Excel to the Right
  hwnd = FindWindow("XLMAIN", vbEmpty)
  With RW
    MoveWindow hwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
  End With
  BringWindowToTop hwnd

  'Move IE to the Left
  hwnd = FindWindow("IEFrame", vbEmpty)
  With LW
    MoveWindow hwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
  End With
  BringWindowToTop hwnd
End Sub

 

[Fluff]

Do you really want me to post all 1800 lines of stdLambda and all 2200 lines of stdWindow in my answer?

Yes please, although you may need to split it into individual posts.

 

[sancarn]

Dependencies as requested - stdLambda:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "stdLambda"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'Ensure Option-Explicit is disabled!! 
'For VB6 compatibility we rely on the auto-definition of Application and ThisWorkbook
'Option Explicit

'Used for enabling some debugging features
#Const devMode = True 

'For Mac testing purposes only
'#const Mac = true



'Implement stdICallable interface
Implements stdICallable

'Direct call convention of VBA.CallByName
#If Not Mac Then
    #If VBA7 Then
        'VBE7 is interchangable with msvbvm60.dll    however VBE7.dll appears to always be present where as msvbvm60 is only occasionally present.
        Private Declare PtrSafe Function rtcCallByName Lib "VBE7.dll" (ByVal cObj As Object, ByVal sMethod As LongPtr, ByVal eCallType As VbCallType, ByRef pArgs() As Variant, ByVal lcid As Long) As Variant
    #Else
        Private Declare Function rtcCallByName Lib "msvbvm60" (ByVal cObj As Object, ByVal sMethod As Long, ByVal eCallType As VbCallType, ByRef pArgs() As Variant, ByVal lcid As Long) As Variant
    #End If
#End If


'Tokens, token definitions and operations
Private Type TokenDefinition
    name As String
    Regex As String
    RegexObj As Object
End Type
Private Type token
    Type As TokenDefinition
    value As Variant
    BracketDepth As Long
End Type
Private Type Operation
    Type As iType
    subType As ISubType
    value As Variant
End Type

'Evaluation operation types
Private Enum iType
    oPush = 1
    oPop = 2
    oMerge = 3
    oAccess = 4
    oSet = 5
    oArithmetic = 6
    oLogic = 7
    oFunc = 8
    oComparison = 9
    oMisc = 10
    oJump = 11
    oReturn = 12
    oObject = 13
End Enum
Private Enum ISubType
    'Arithmetic
    oAdd = 1
    oSub = 2
    oMul = 3
    oDiv = 4
    oPow = 5
    oNeg = 6
    oMod = 7
    'Logic
    oAnd = 8
    oOr = 9
    oNot = 10
    oXor = 11
    'comparison
    oEql = 12
    oNeq = 13
    oLt = 14
    oLte = 15
    oGt = 16
    oGte = 17
    oIs = 18
    'misc operators
    oCat = 19
    oLike = 20
    'misc
    ifTrue = 21
    ifFalse = 22
    withValue = 23
    argument = 24
    'object
    oPropGet = 25
    oPropLet = 26
    oPropSet = 27
    oMethodCall = 28
    oFieldCall = 29
    oEquality = 30    'Yet to be implemented
    oIsOperator = 31  'Yet to be implemented
    oEnum = 32        'Yet to be implemented
End Enum

'Special constant used in parsing:
Const UniqueConst As String = "3207af79-30df-4890-ade1-640f9f28f309"

Private tokens() As token
Private iTokenIndex As Long
Private operations() As Operation
Private iOperationIndex As Long
Private stackSize As Long
Private scopes() As Variant
Private scopesArgCount() As Variant
Private scopeCount As Long
Private funcScope As Long
Private pEquation as string

Private Enum LambdaType
    iStandardLambda = 1
    iBoundLambda = 2
End Enum


Const minStackSize = 30 'note that the stack size may become smaller than this

'@protected
Public oFunctExt As Object 'Dictionary<string => stdCallback>

Private oCache As Object
Private bBound As Boolean
Private oBound As stdLambda
Private vBound As Variant
Private bUsePerformanceCache as Boolean
Private pPerformanceCache as  object

''Usage:
'Debug.Print stdLambda.Create("1+3*8/2*(2+2+3)").Execute()
'With stdLambda.Create("$1+1+3*8/2*(2+2+3)")
'    Debug.Print .Execute(10)
'    Debug.Print .Execute(15)
'    Debug.Print .Execute(20)
'End With
'Debug.Print stdLambda.Create("$1.Range(""A1"")").Execute(Sheets(1)).Address(True, True, xlA1, True)
'Debug.Print stdLambda.Create("$1.join("","")").Execute(stdArray.Create(1,2))
Public Function Create(ByVal sEquation As String, Optional ByVal bUsePerformanceCache As Boolean = False, Optional ByVal bSandboxExtras As Boolean = False) As stdLambda
    'Cache Lambda created
    If oCache Is Nothing Then Set oCache = CreateObject("Scripting.Dictionary")
    Dim sID As String: sID = bUsePerformanceCache & "-" & bSandboxExtras & ")" & sEquation
    If Not oCache.exists(sID) Then
        Set oCache(sID) = New stdLambda
        Call oCache(sID).Init(LambdaType.iStandardLambda, sEquation, bUsePerformanceCache, bSandboxExtras)
    End If
    
    'Return cached lambda
    Set Create = oCache(sID)
End Function

Public Function CreateMultiline(ByRef sEquation As Variant, Optional ByVal bUsePerformanceCache As Boolean = False, Optional ByVal bSandboxExtras As Boolean = False) As stdLambda
    Set CreateMultiline = Create(Join(sEquation, " "), bUsePerformanceCache, bSandboxExtras)
End Function

Public Function BindEx(ByVal params As Variant) As stdLambda
    Set BindEx = New stdLambda
    Dim callable As stdICallable: Set callable = Me
    Call BindEx.Init(LambdaType.iBoundLambda, callable, params)
End Function

'Bind a global variable to the function
'@param {String} - New global name
'@param {Variant}- Data to store in global variable
'@returns {stdLambda} The lambda existing lambda
Public Function BindGlobal(ByVal sGlobalName as string, ByVal variable as Variant) as stdLambda
    set BindGlobal = Me
    If bBound Then
        Call oBound.BindGlobal(sGlobalName, variable)
    Else
        If IsObject(variable) Then
            Set oFunctExt(sGlobalName) = variable
        Else
            Let oFunctExt(sGlobalName) = variable
        End If
    End If
End Function


Public Sub Init(ByVal iLambdaType As Long, ParamArray params() As Variant)
    Select Case iLambdaType
        Case LambdaType.iStandardLambda
            Dim sEquation As String: sEquation = params(0)
            pEquation = sEquation
            bUsePerformanceCache = params(1)
            Dim bSandboxExtras As Boolean: bSandboxExtras = params(2)
            
            'Performance cache
            if bUsePerformanceCache then set pPerformanceCache = CreateObject("Scripting.Dictionary")

            'Function extensions
            Set oFunctExt = stdLambda.oFunctExt
            If bSandboxExtras OR oFunctExt is nothing Then set oFunctExt = CreateObject("Scripting.Dictionary")

            bBound = false
            tokens = Tokenise(sEquation)
            iTokenIndex = 1
            iOperationIndex = 0
            stackSize = 0
            scopeCount = 0
            funcScope = 0
            Call parseBlock("eof")
            Call finishOperations

        Case LambdaType.iBoundLambda
            bBound = True
            Set oBound = params(0)
            vBound = params(1)
            pEquation = "BOUND..."
            
            'Function extensions
            Set oFunctExt = stdLambda.oFunctExt
            If bSandboxExtras OR oFunctExt is nothing Then set oFunctExt = CreateObject("Scripting.Dictionary")
        Case Else
            Err.Raise 1, "stdLambda::Init", "No lambda with that type."
    End Select
End Sub

Private Function stdICallable_Run(ParamArray params() As Variant) As Variant
    If Not bBound Then
        'Execute top-down parser
        Call CopyVariant(stdICallable_Run, evaluate(operations, params))
    Else
        Call CopyVariant(stdICallable_Run, oBound.RunEx(ConcatArrays(vBound, params)))
    End If
End Function
Private Function stdICallable_RunEx(ByVal params As Variant) As Variant
    If Not isArray(params) Then
        Err.Raise 1, "params to be supplied as array of arguments", ""
    End If
    
    If Not bBound Then
        'Execute top-down parser
        Call CopyVariant(stdICallable_RunEx, evaluate(operations, params))
    Else
        Call CopyVariant(stdICallable_RunEx, oBound.RunEx(ConcatArrays(vBound, params)))
    End If
End Function

Function Run(ParamArray params() As Variant) As Variant
Attribute Run.VB_UserMemId = 0
    If Not bBound Then
        'Execute top-down parser
        Call CopyVariant(Run, evaluate(operations, params))
    Else
        Call CopyVariant(Run, oBound.RunEx(ConcatArrays(vBound, params)))
    End If
End Function

Function RunEx(ByVal params As Variant) As Variant
    If Not bBound Then
        If Not isArray(params) Then
            Err.Raise 1, "params to be supplied as array of arguments", ""
        End If
        
        'Execute top-down parser
        Call CopyVariant(RunEx, evaluate(operations, params))
    Else
        Call CopyVariant(RunEx, oBound.RunEx(ConcatArrays(vBound, params)))
    End If
End Function

'Bind a parameter to the function
Private Function stdICallable_Bind(ParamArray params() As Variant) As stdICallable
    Set stdICallable_Bind = BindEx(params)
End Function
Public Function Bind(ParamArray params() As Variant) As stdLambda
    Set Bind = BindEx(params)
End Function

'Low-dependency function calling
'@protected
'@param {ByVal String}       - Message to send
'@param {ByRef Boolean}      - Success of message. If message wasn't processed return false.
'@param {Paramarray Variant} - Parameters to pass along with message
'@returns {Variant} - Anything returned by the function
Private Function stdICallable_SendMessage(ByVal sMessage as string, ByRef success as boolean, ByVal params as variant) as Variant
    select case sMessage
        case "obj"
            set stdICallable_SendMessage = Me
            success = true
        case "className"
            stdICallable_SendMessage = "stdLambda"
            success = true
        case "bindGlobal"
            'Bind global based whether this is a bound lambda or not
            Call BindGlobal(params(0), params(1))
            success = true
        case else 
            success = false
    end select
End Function

'================
'
'  TOKENISATION
'
'================


'Tokeniser helpers
Private Function getTokenDefinitions() As TokenDefinition()
    Dim arr() As TokenDefinition
    ReDim arr(1 To 99)
    
    Dim i As Long: i = 0
    'Whitespace
    i = i + 1: arr(i) = getTokenDefinition("space", "\s+") 'String

    'Literal
    i = i + 1: arr(i) = getTokenDefinition("literalString", """(?:""""|[^""])*""") 'String
    i = i + 1: arr(i) = getTokenDefinition("literalNumber", "\d+(?:\.\d+)?") 'Number
    i = i + 1: arr(i) = getTokenDefinition("literalBoolean", "True|False", isKeyword:=True)
    
    'Named operators
    i = i + 1: arr(i) = getTokenDefinition("is", "is", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("mod", "mod", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("and", "and", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("or", "or", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("xor", "xor", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("not", "not", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("like", "like", isKeyword:=True)

    'Structural
    ' Inline if
    i = i + 1: arr(i) = getTokenDefinition("if", "if", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("then", "then", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("else", "else", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("end", "end", isKeyword:=True)
    ' Brackets
    i = i + 1: arr(i) = getTokenDefinition("lBracket", "\(")
    i = i + 1: arr(i) = getTokenDefinition("rBracket", "\)")
    ' Functions
    i = i + 1: arr(i) = getTokenDefinition("fun", "fun", isKeyword:=True)
    i = i + 1: arr(i) = getTokenDefinition("comma", ",") 'params
    ' Lines
    i = i + 1: arr(i) = getTokenDefinition("colon", ":")
    
    'VarName
    i = i + 1: arr(i) = getTokenDefinition("arg", "\$\d+")
    i = i + 1: arr(i) = getTokenDefinition("var", "[a-zA-Z][a-zA-Z0-9_]*")
    
    'Operators
    i = i + 1: arr(i) = getTokenDefinition("propertyAccess", "\.\$")
    i = i + 1: arr(i) = getTokenDefinition("methodAccess", "(\.\#)")
    i = i + 1: arr(i) = getTokenDefinition("fieldAccess", "\.")
    i = i + 1: arr(i) = getTokenDefinition("multiply", "\*")
    i = i + 1: arr(i) = getTokenDefinition("divide", "\/")
    i = i + 1: arr(i) = getTokenDefinition("power", "\^")
    i = i + 1: arr(i) = getTokenDefinition("add", "\+")
    i = i + 1: arr(i) = getTokenDefinition("subtract", "\-")
    i = i + 1: arr(i) = getTokenDefinition("equal", "\=")
    i = i + 1: arr(i) = getTokenDefinition("notEqual", "\<\>")
    i = i + 1: arr(i) = getTokenDefinition("greaterThanEqual", "\>\=")
    i = i + 1: arr(i) = getTokenDefinition("greaterThan", "\>")
    i = i + 1: arr(i) = getTokenDefinition("lessThanEqual", "\<\=")
    i = i + 1: arr(i) = getTokenDefinition("lessThan", "\<")
    i = i + 1: arr(i) = getTokenDefinition("concatenate", "\&")
    
    ReDim Preserve arr(1 To i)

    getTokenDefinitions = arr
End Function

'===========
'
'  PARSING
'
'===========

Private Sub parseBlock(ParamArray endToken() As Variant)
    Call addScope
    Dim size As Integer: size = stackSize + 1
    
    ' Consume multiple lines
    Dim bLoop As Boolean: bLoop = True
    Do
        While optConsume("colon"): Wend
        Call parseStatement
        
        For i = LBound(endToken) To UBound(endToken)
            If peek(endToken(i)) Then
                bLoop = False
            End If
        Next
    Loop While bLoop
    
    ' Get rid of all extra expression results and declarations
    While stackSize > size
        Call addOperation(oMerge, , , -1)
    Wend
    scopeCount = scopeCount - 1
End Sub

Private Sub addScope()
    scopeCount = scopeCount + 1
    Dim scope As Long: scope = scopeCount
    ReDim Preserve scopes(1 To scope)
    ReDim Preserve scopesArgCount(1 To scope)
    Set scopes(scope) = CreateObject("Scripting.Dictionary")
    Set scopesArgCount(scope) = CreateObject("Scripting.Dictionary")
End Sub

Private Sub parseStatement()
    If peek("var") And peek("equal", 2) Then
        Call parseAssignment
    ElseIf peek("fun") Then
        Call parseFunctionDeclaration
    Else
        Call parseExpression
    End If
End Sub

Private Sub parseExpression()
    Call parseLogicPriority1
End Sub

Private Sub parseLogicPriority1() 'xor
    Call parseLogicPriority2
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("xor") Then
            Call parseLogicPriority2
            Call addOperation(oLogic, oXor, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseLogicPriority2() 'or
    Call parseLogicPriority3
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("or") Then
            Call parseLogicPriority3
            Call addOperation(oLogic, oOr, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseLogicPriority3() 'and
    Call parseLogicPriority4
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("and") Then
            Call parseLogicPriority4
            Call addOperation(oLogic, oAnd, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseLogicPriority4() 'not
    Dim invert As Variant: invert = vbNull
    While optConsume("not")
        If invert = vbNull Then invert = False
        invert = Not invert
    Wend
    
    Call parseComparisonPriority1
    
    If invert <> vbNull Then
        Call addOperation(oLogic, oNot)
        If invert = False Then
            Call addOperation(oLogic, oNot)
        End If
    End If
End Sub

Private Sub parseComparisonPriority1() '=, <>, <, <=, >, >=, is, Like
    Call parseArithmeticPriority1
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("lessThan") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oLt, , -1)
        ElseIf optConsume("lessThanEqual") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oLte, , -1)
        ElseIf optConsume("greaterThan") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oGt, , -1)
        ElseIf optConsume("greaterThanEqual") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oGte, , -1)
        ElseIf optConsume("equal") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oEql, , -1)
        ElseIf optConsume("notEqual") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oNeq, , -1)
        ElseIf optConsume("is") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oIs, , -1)
        ElseIf optConsume("like") Then
            Call parseArithmeticPriority1
            Call addOperation(oComparison, oLike, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseArithmeticPriority1() '&
    Call parseArithmeticPriority2
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("concatenate") Then
            Call parseArithmeticPriority2
            Call addOperation(oMisc, oCat, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseArithmeticPriority2() '+, -
    Call parseArithmeticPriority3
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("add") Then
            Call parseArithmeticPriority3
            Call addOperation(oArithmetic, oAdd, , -1)
        ElseIf optConsume("subtract") Then
            Call parseArithmeticPriority3
            Call addOperation(oArithmetic, oSub, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub


Private Sub parseArithmeticPriority3() 'mod
    Call parseArithmeticPriority4
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("mod") Then
            Call parseArithmeticPriority4
            Call addOperation(oArithmetic, oMod, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseArithmeticPriority4() '*, /
    Call parseArithmeticPriority5
    Dim bLoop As Boolean: bLoop = True
    Do
        If optConsume("multiply") Then
            Call parseArithmeticPriority4
            Call addOperation(oArithmetic, oMul, , -1)
        ElseIf optConsume("divide") Then
            Call parseArithmeticPriority4
            Call addOperation(oArithmetic, oDiv, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseArithmeticPriority5() '+, - (unary)
    If optConsume("subtract") Then
        Call parseArithmeticPriority5 'recurse
        Call addOperation(oArithmetic, oNeg)
    ElseIf optConsume("add") Then
        Call parseArithmeticPriority5 'recurse
    Else
        Call parseArithmeticPriority6
    End If
End Sub

Private Sub parseArithmeticPriority6() '^
    Call parseFlowPriority1
    Do
        If optConsume("power") Then
            Call parseArithmeticPriority6andahalf '- and + are still identity operators
            Call addOperation(oArithmetic, oPow, , -1)
        Else
            bLoop = False
        End If
    Loop While bLoop
End Sub

Private Sub parseArithmeticPriority6andahalf() '+, - (unary)
    If optConsume("subtract") Then
        Call parseArithmeticPriority6andahalf 'recurse
        Call addOperation(oArithmetic, oNeg)
    ElseIf optConsume("add") Then
        Call parseArithmeticPriority6andahalf 'recurse
    Else
        Call parseFlowPriority1
    End If
End Sub

Private Sub parseFlowPriority1() 'if then else
    If optConsume("if") Then
        Call parseExpression
        Dim skipThenJumpIndex As Integer: skipThenJumpIndex = addOperation(oJump, ifFalse, , -1)
        
        Dim size As Integer: size = stackSize
        Call consume("then")
        Call parseBlock("else", "end")
        Dim skipElseJumpIndex As Integer: skipElseJumpIndex = addOperation(oJump)
        operations(skipThenJumpIndex).value = iOperationIndex
        stackSize = size
        
        If optConsume("end") Then
            Call addOperation(oPush, , 0, 1) 'Expressions should always return a value
            operations(skipElseJumpIndex).value = iOperationIndex
        Else
            Call consume("else")
            Call parseBlock("eof", "rBracket", "end")
            operations(skipElseJumpIndex).value = iOperationIndex
        
            Call optConsume("end")
        End If
    Else
        Call parseValuePriority1
    End If
End Sub

Private Sub parseValuePriority1() 'numbers, $vars, strings, booleans, (expressions)

    If peek("literalNumber") Then
        Call addOperation(oPush, , CDbl(consume("literalNumber")), 1)
    ElseIf peek("arg") Then
        Call addOperation(oAccess, argument, val(mid(consume("arg"), 2)), 1)
        Call parseManyAccessors
    ElseIf peek("literalString") Then
        Call parseString
    ElseIf peek("literalBoolean") Then
        Call addOperation(oPush, , consume("literalBoolean") = "true", 1)
    ElseIf peek("var") Then
        If Not parseScopeAccess Then
            Call parseFunction
        End If
        Call parseManyAccessors
    Else
        Call consume("lBracket")
        Call parseExpression
        Call consume("rBracket")
        Call parseManyAccessors
    End If
End Sub

Private Function parseFunction() As Variant
    Call addOperation(oPush, , consume("var"), 1)
    Dim size As Integer: size = stackSize
    Call parseOptParameters
    Call addOperation(oFunc)
    stackSize = size
End Function

Private Sub parseManyAccessors()
    Dim bLoop As Boolean: bLoop = True
    Do
        bLoop = False
        if parseOptObjectField() then bLoop = True
        If parseOptObjectProperty() Then bLoop = True
        If parseOptObjectMethod() Then bLoop = True
    Loop While bLoop
End Sub

Private Function parseOptObjectField() as Boolean
    parseOptObjectField = false
    if optConsume("fieldAccess") then
        Dim size As Integer: size = stackSize
        Call addOperation(oPush, , consume("var"), 1)
        Call parseOptParameters
        Call addOperation(oObject, oFieldCall)
        stackSize = size
        parseOptObjectField = True
    end if
End Function

Private Function parseOptObjectProperty() As Boolean
    parseOptObjectProperty = False
    If optConsume("propertyAccess") Then
        Dim size As Integer: size = stackSize
        Call addOperation(oPush, , consume("var"), 1)
        Call parseOptParameters
        Call addOperation(oObject, oPropGet)
        stackSize = size
        parseOptObjectProperty = True
    End If
End Function

Private Function parseOptObjectMethod() As Boolean
    parseOptObjectMethod = False
    If optConsume("methodAccess") Then
        Dim size As Integer: size = stackSize
        Call addOperation(oPush, , consume("var"), 1)
        Call parseOptParameters
        Call addOperation(oObject, oMethodCall)
        stackSize = size
        parseOptObjectMethod = True
    End If
End Function

Private Function parseOptParameters() As Boolean
    parseOptParameters = False
    If optConsume("lBracket") Then
        Dim iArgCount As Integer
        While Not peek("rBracket")
            If iArgCount > 0 Then
                Call consume("comma")
            End If
            Call parseExpression
            iArgCount = iArgCount + 1
        Wend
        Call consume("rBracket")
        If iArgCount > 0 Then
            Call addOperation(oPush, , iArgCount, 1)
        End If
        parseOptParameters = True
    End If
End Function

Private Sub parseString()
    Dim sRes As String: sRes = consume("literalString")
    sRes = Mid(sRes, 2, Len(sRes) - 2)
    sRes = Replace(sRes, """""", """")
    Call addOperation(oPush, , sRes, 1)
End Sub

Private Function parseScopeAccess() As Boolean
    If peek("lBracket", 2) Then
        parseScopeAccess = parseFunctionAccess()
    Else
        parseScopeAccess = parseVariableAccess()
    End If
End Function

Private Function parseVariableAccess() As Boolean
    parseVariableAccess = False
    Dim varName As String: varName = consume("var")
    Dim offset As Long: offset = findVariable(varName)
    If offset >= 0 Then
        parseVariableAccess = True
        Call addOperation(oAccess, , 1 + offset, 1)
    Else
        iTokenIndex = iTokenIndex - 1 ' Revert token consumption
    End If
End Function

Private Sub parseAssignment()
    Dim varName As String: varName = consume("var")
    Call consume("equal")
    Call parseExpression
    Dim offset As Long: offset = findVariable(varName)
    If offset >= 0 Then
        ' If the variable already existed, move the data to that pos on the stack
        Call addOperation(oSet, , offset, -1)
        Call addOperation(oAccess, , offset, 1) ' To keep a return value
    Else
        ' If the variable didn't exist yet, treat this stack pos as its source
        Call scopes(scopeCount).add(varName, stackSize)
    End If
End Sub

Private Function findVariable(varName As String) As Long
    Dim scope As Long: scope = scopeCount
    findVariable = -1
    While scope > 0
        If scopes(scope).exists(varName) Then
            If scope < funcScope Then
                Call Throw("Can't access """ & varName & """, functions can unfortunately not access data outside their block")
            ElseIf scopesArgCount(scope).exists(varName) Then
                Call Throw("Expected a variable, but found a function for name " & varName)
            Else
                findVariable = stackSize - scopes(scope).item(varName)
                scope = 0
            End If
        End If
        scope = scope - 1
    Wend
End Function
'todo:
Private Function parseFunctionAccess() As Boolean
    parseFunctionAccess = False
    Dim funcName As String: funcName = consume("var")
    Dim argCount As Long
    Dim funcPos As Long: funcPos = findFunction(funcName, argCount)
    If funcPos <> -1 Then
        parseFunctionAccess = True
        Dim returnPosIndex As Integer: returnPosIndex = addOperation(oPush, , , 1)
        
        ' Consume the arguments
        consume ("lBracket")
        Dim iArgCount As Integer
        While Not peek("rBracket")
            If iArgCount > 0 Then Call consume("comma")
            Call parseExpression
            iArgCount = iArgCount + 1
        Wend
        Call consume("rBracket")
        If iArgCount <> argCount Then
            Call Throw(argCount & " arguments should have been provided to " & funcName & " but only " & iArgCount & " were received")
        End If
        
        ' Add call and return data
        Call addOperation(oJump, , funcPos, -iArgCount) 'only -argCount since pushing Result and popping return pos cancel out
        operations(returnPosIndex).value = iOperationIndex
    Else
        iTokenIndex = iTokenIndex - 1 ' Revert token consumption
    End If
End Function
'todo:
Private Sub parseFunctionDeclaration()
    ' Create a dedicated scope for this funcion
    Call addScope
    Dim prevFuncScope As Long: prevFuncScope = funcScope
    funcScope = scopeCount
    
    ' Add operation to skip this code in normal operation flow
    Dim skipToIndex As Integer: skipToIndex = addOperation(oJump)
    
    ' Obtain the signature
    Call consume("fun")
    Dim funcName As String: funcName = consume("var")
    Call consume("lBracket")
    Dim iArgCount As Integer
    While Not peek("rBracket")
        If iArgCount > 0 Then Call consume("comma")
        Call parseParameterDeclaration
        iArgCount = iArgCount + 1
    Wend
    Call consume("rBracket")
    
    ' Register the function
    Call scopes(scopeCount - 1).add(funcName, iOperationIndex)
    Call scopesArgCount(scopeCount - 1).add(funcName, iArgCount)
    
    ' Obtain the body
    Call parseBlock("end")
    Call consume("end")
    While iArgCount > 0
        Call addOperation(oMerge, , , -1)
        iArgCount = iArgCount - 1
    Wend
    Call addOperation(oReturn, withValue, , -1)
    operations(skipToIndex).value = iOperationIndex
    
    ' Reset the scope
    scopeCount = scopeCount - 1
    funcScope = prevFuncScope
End Sub
'todo:
Private Sub parseParameterDeclaration()
    Dim varName As String: varName = consume("var")
    Dim offset As Long: offset = findVariable(varName)
    If offset >= 0 Then
        Call Throw("You can't declare multiple parameters with the same name")
    Else
        ' Reserve a spot for this parameter, it will be pushed by the caller
        stackSize = stackSize + 1
        Call scopes(scopeCount).add(varName, stackSize)
    End If
End Sub

Private Function findFunction(varName As String, Optional ByRef argCount As Long) As Long
    Dim scope As Long: scope = scopeCount
    findFunction = -1
    While scope > 0
        If scopes(scope).exists(varName) Then
            If Not scopesArgCount(scope).exists(varName) Then
                Call Throw("Expected a function, but found a variable for name " & varName)
            Else
                findFunction = scopes(scope).item(varName)
                argCount = scopesArgCount(scope).item(varName)
                scope = 0
            End If
        End If
        scope = scope - 1
    Wend
End Function


'==============
'
'  EVALUATION
'
'==============

'Evaluates the given list of operations
'@param {Operation()} operations  The operations to evaluate
'@returns {Variant} The result of the operations
Private Function evaluate(ByRef ops() As Operation, ByVal vLastArgs As Variant) As Variant
    Dim stack() As Variant
    ReDim stack(0 To 5)
    Dim stackPtr As Long: stackPtr = 0
    
    Dim op As Operation
    Dim v1 As Variant
    Dim v2 As Variant
    Dim v3 As Variant
    Dim opIndex As Long: opIndex = 0
    Dim opCount As Long: opCount = UBound(ops)
    
    'If result is in performance cache then return it immediately
    if bUsePerformanceCache then
        Dim sPerformanceCacheID as string: sPerformanceCacheID = getPerformanceCacheID(vLastArgs)     
        if pPerformanceCache.exists(sPerformanceCacheID) then
            Call CopyVariant(evaluate, pPerformanceCache(sPerformanceCacheID))
            Exit Function
        end if
    end if

    'Evaluate operations to identify result
    While opIndex <= opCount
        op = ops(opIndex)
        opIndex = opIndex + 1
        Select Case op.Type
            Case iType.oPush
                Call pushV(stack, stackPtr, op.value)
            'Arithmetic
            Case iType.oArithmetic
                v2 = popV(stack, stackPtr)
                Select Case op.subType
                    Case ISubType.oAdd
                        v1 = popV(stack, stackPtr)
                        v3 = v1 + v2
                    Case ISubType.oSub
                        v1 = popV(stack, stackPtr)
                        v3 = v1 - v2
                    Case ISubType.oMul
                        v1 = popV(stack, stackPtr)
                        v3 = v1 * v2
                    Case ISubType.oDiv
                        v1 = popV(stack, stackPtr)
                        v3 = v1 / v2
                    Case ISubType.oPow
                        v1 = popV(stack, stackPtr)
                        v3 = v1 ^ v2
                    Case ISubType.oMod
                        v1 = popV(stack, stackPtr)
                        v3 = v1 Mod v2
                    Case ISubType.oNeg
                        v3 = -v2
                    Case Else
                        v3 = Empty
                End Select
                Call pushV(stack, stackPtr, v3)
            'Comparison
            Case iType.oComparison
                v2 = popV(stack, stackPtr)
                v1 = popV(stack, stackPtr)
                Select Case op.subType
                    Case ISubType.oEql
                        v3 = v1 = v2
                    Case ISubType.oNeq
                        v3 = v1 <> v2
                    Case ISubType.oGt
                        v3 = v1 > v2
                    Case ISubType.oGte
                        v3 = v1 >= v2
                    Case ISubType.oLt
                        v3 = v1 < v2
                    Case ISubType.oLte
                        v3 = v1 <= v2
                    Case ISubType.oLike
                        v3 = v1 Like v2
                    Case Else
                        v3 = Empty
                End Select
                Call pushV(stack, stackPtr, v3)
            'Logic
            Case iType.oLogic
                v2 = popV(stack, stackPtr)
                Select Case op.subType
                    Case ISubType.oAnd
                        v1 = popV(stack, stackPtr)
                        v3 = v1 And v2
                    Case ISubType.oOr
                        v1 = popV(stack, stackPtr)
                        v3 = v1 Or v2
                    Case ISubType.oNot
                        v3 = Not v2
                    Case ISubType.oXor
                        v1 = popV(stack, stackPtr)
                        v3 = v1 Xor v2
                    Case Else
                        v3 = Empty
                End Select
                Call pushV(stack, stackPtr, v3)
            'Object
            Case iType.oObject
                Call objectCaller(stack, stackPtr, op)
            'Func
            Case iType.oFunc
                Dim args() As Variant
                args = getArgs(stack, stackPtr)
                v1 = popV(stack, stackPtr)
                Call pushV(stack, stackPtr, evaluateFunc(v1, args))
            'Misc
            Case iType.oMisc
                v2 = popV(stack, stackPtr)
                v1 = popV(stack, stackPtr)
                Select Case op.subType
                    Case ISubType.oCat
                        v3 = v1 & v2
                    Case Else
                        v3 = Empty
                End Select
                Call pushV(stack, stackPtr, v3)
            'Variable
            Case iType.oAccess
                Select Case op.subType
                    Case ISubType.argument
                        Dim iArgIndex As Long: iArgIndex = op.value + LBound(vLastArgs) - 1
                        If iArgIndex <= UBound(vLastArgs) Then
                            Call pushV(stack, stackPtr, vLastArgs(iArgIndex))
                        Else
                            Call Throw("Argument " & iArgIndex & " not supplied to Lambda.")
                        End If
                    Case Else
                        Call pushV(stack, stackPtr, stack(stackPtr - op.value))
                End Select
            Case iType.oSet
                v1 = popV(stack, stackPtr)
                stack(stackPtr - op.value) = v1
            'Flow
            Case iType.oJump
                Select Case op.subType
                    Case ISubType.ifTrue
                        v1 = popV(stack, stackPtr)
                        If v1 Then
                            opIndex = op.value
                        End If
                    Case ISubType.ifFalse
                        v1 = popV(stack, stackPtr)
                        If Not v1 Then
                            opIndex = op.value
                        End If
                    Case Else
                        opIndex = op.value
                End Select
            Case iType.oReturn
                Select Case op.subType
                    Case ISubType.withValue
                        v1 = popV(stack, stackPtr)
                        opIndex = stack(stackPtr - 1)
                        stack(stackPtr - 1) = v1
                    Case Else
                        opIndex = popV(stack, stackPtr)
                End Select
            'Data
            Case iType.oMerge
                Call CopyVariant(v1, popV(stack, stackPtr))
                Call CopyVariant(stack(stackPtr - 1), v1)
            Case iType.oPop
                Call popV(stack, stackPtr)
            Case Else
                'End loop - This occurs when opIndex > opCount 
                opIndex = opCount+1
        End Select
    Wend

    'Add result to performance cache
    if bUsePerformanceCache then
        if isObject(stack(0)) then
            set pPerformanceCache(sPerformanceCacheID) = stack(0)
        else
            let pPerformanceCache(sPerformanceCacheID) = stack(0)
        end if
    end if

    Call CopyVariant(evaluate, stack(0))
End Function

'Retrieves the arguments from the stack
'@param {ByRef Variant()} stack     The stack to get the data from and add the result to
'@param {ByRef Long} stackPtr       The pointer that indicates the position of the top of the stack
'@returns {Variant()} The args list
Private Function getArgs(ByRef stack() As Variant, ByRef stackPtr As Long) As Variant
    Dim argCount As Variant: argCount = stack(stackPtr - 1)
    Dim args() As Variant
    If VarType(argCount) = vbString Then
        'If no argument count is specified, there are no arguments
        argCount = 0
        args = Array()
    Else
        'If an argument count is provided, extract all arguments into an array
        Call popV(stack, stackPtr)
        ReDim args(1 To argCount)
        
        'Arguments are held on the stack in order, which means that we need to fill the array in reverse order.
        For i = argCount To 1 Step -1
            Call CopyVariant(args(i), popV(stack, stackPtr))
        Next
    End If
    
    getArgs = args
End Function

'Calls an object method/setter/getter/letter
'@param {ByRef Variant()} stack     The stack to get the data from and add the result to
'@param {ByRef Long} stackPtr       The pointer that indicates the position of the top of the stack
'@param {ByRef Operation} op        The operation to execute
Private Sub objectCaller(ByRef stack() As Variant, ByRef stackPtr As Long, ByRef op As Operation)
    'Get the name and arguments
    Dim args() As Variant: args = getArgs(stack, stackPtr)
    Dim funcName As Variant: funcName = popV(stack, stackPtr)
    
    'Get caller type
    Dim callerType As VbCallType
    Select Case op.subType
        Case ISubType.oFieldCall:   callerType = VbGet or VbMethod
        Case ISubType.oPropGet:     callerType = VbGet
        Case ISubType.oMethodCall:  callerType = VbMethod
        Case ISubType.oPropLet:     callerType = VbLet
        Case ISubType.oPropSet:     callerType = VbSet
    End Select
                
    'Call rtcCallByName
    Dim obj As Object
    Set obj = popV(stack, stackPtr)
    Call pushV(stack, stackPtr, stdCallByName(obj, funcName, callerType, args))
End Sub

'Calls an object method/setter/getter/letter. Treats dictionary properties as direct object properties, I.E. `A.B` ==> `A.item("B")`
'@param {ByRef Object} - The object to call
'@param {ByVal String} - The method name to call
'@param {ByVal VbCallType} - The property/method call type
'@param {ByVal Variant()}  - An array of arguments. This function supports up to 30 arguments, akin to Application.Run
'@returns Variant - The return value of the called function
Public Function stdCallByName(ByRef obj As Object, ByVal funcName As String, ByVal callerType As VbCallType, ByRef args() As Variant) As Variant
    'If Dictionary and
    If TypeName(obj) = "Dictionary" Then
        Select Case funcName
            Case "add", "exists", "items", "keys", "remove", "removeall", "comparemode", "count", "item", "key"
                'These methods already exist on dictionary, do not override
            Case Else
                'Call DictionaryInstance.Item(funcName) only if funcName exists on the item
                If obj.exists(funcName) Then
                    'TODO: Make this work for callerType.VbLet
                    Call CopyVariant(stdCallByName, obj.item(funcName))
                    Exit Function
                End If
        End Select
    End If

    'Call CallByName from DLL or
    #If Mac Then
        Call CopyVariant(stdCallByName, macCallByName(obj, funcName, callerType, args))
    #Else
        'TODO: Better error handling (property or method <funcName> doesn't exist on object with type <typename(obj)>)
        On Error GoTo ErrorInRTCCallByName
        Call CopyVariant(stdCallByName, rtcCallByName(obj, StrPtr(funcName), callerType, args, &H409))
    #End If
    Exit Function
ErrorInRTCCallByName:
    Dim sCallerTypeName as string
    select case callerType
        case VbGet or VbMethod: sCallerTypeName = "Property or Method "
        case VbGet: sCallerTypeName = "Property "
        Case VbMethod: sCallerTypeName = "Method "
    end select
    Throw(sCallerTypeName & funcName & " doesn't exist on object with type " & typename(obj))
End Function

'Evaluates the built in standard functions
'@param {String} sFuncName The name of the function to invoke
'@param {Variant} args() The arguments
'@returns The result
Private Function evaluateFunc(ByVal sFuncName As String, ByVal args As Variant) As Variant
    Dim iArgStart As Long: iArgStart = LBound(args)
    If TypeName(Me.oFunctExt) = "Dictionary" Then
        If Me.oFunctExt.exists(sFuncName) Then
            Dim vInjectedVar As Variant
            Call CopyVariant(vInjectedVar, oFunctExt(sFuncName))
            If TypeOf vInjectedVar Is stdICallable Then
                Call CopyVariant(evaluateFunc, Me.oFunctExt(sFuncName).RunEx(args))
            Else
                Call CopyVariant(evaluateFunc, vInjectedVar)
            End If
            Exit Function
        End If
    End If
    
    Select Case LCase(sFuncName)
        'Useful OOP constants
        Case "thisworkbook": if isObject(ThisWorkbook) then Set evaluateFunc = ThisWorkbook
        Case "application":  if isObject(Application)  then  Set evaluateFunc = Application

        'MATH:
        '-----
        Case "abs": evaluateFunc = VBA.Math.Abs(args(iArgStart))
        Case "int": evaluateFunc = VBA.Int(args(iArgStart))
        Case "fix": evaluateFunc = VBA.Fix(args(iArgStart))
        Case "exp": evaluateFunc = VBA.Math.Exp(args(iArgStart))
        Case "log": evaluateFunc = VBA.Math.Log(args(iArgStart))
        Case "sqr": evaluateFunc = VBA.Math.Sqr(args(iArgStart))
        Case "sgn": evaluateFunc = VBA.Math.Sgn(args(iArgStart))
        Case "rnd": evaluateFunc = VBA.Math.Rnd(args(iArgStart))

        'Trigonometry
        Case "cos":  evaluateFunc = VBA.Math.Cos(args(iArgStart))
        Case "sin":  evaluateFunc = VBA.Math.Sin(args(iArgStart))
        Case "tan":  evaluateFunc = VBA.Math.Tan(args(iArgStart))
        Case "atn":  evaluateFunc = VBA.Math.Atn(args(iArgStart))
        Case "asin": evaluateFunc = VBA.Math.Atn(args(iArgStart) / VBA.Math.Sqr(-1 * args(iArgStart) * args(iArgStart) + 1))
        Case "acos": evaluateFunc = VBA.Math.Atn(-1 * args(iArgStart) / VBA.Math.Sqr(-1 * args(iArgStart) * args(iArgStart) + 1)) + 2 * Atn(1)

        'VBA Constants:
        Case "vbcrlf":          evaluateFunc = vbCrLf
        Case "vbcr":            evaluateFunc = vbCr
        Case "vblf":            evaluateFunc = vbLf
        Case "vbnewline":       evaluateFunc = vbNewLine
        Case "vbnullchar":      evaluateFunc = vbNullChar
        Case "vbnullstring":    evaluateFunc = vbNullString
        Case "vbobjecterror":   evaluateFunc = vbObjectError
        Case "vbtab":           evaluateFunc = vbTab
        Case "vbback":          evaluateFunc = vbBack
        Case "vbformfeed":      evaluateFunc = vbFormFeed
        Case "vbverticaltab":   evaluateFunc = vbVerticalTab
        Case "null":            evaluateFunc = Null
        Case "nothing":         set evaluateFunc = Nothing
        Case "empty":           evaluateFunc = Empty
        Case "missing":         evaluateFunc = getMissing()

        'VBA Structure
        Case "array": evaluateFunc = args
        'TODO: Case "callbyname": evaluateFunc = CallByName(args(iArgStart))
        Case "createobject"
            Select Case UBound(args)
                Case iArgStart
                    Set evaluateFunc = CreateObject(args(iArgStart))
                Case iArgStart + 1
                    Set evaluateFunc = CreateObject(args(iArgStart), args(iArgStart + 1))
            End Select
        Case "getobject"
            Select Case UBound(args)
                Case iArgStart
                    Set evaluateFunc = GetObject(args(iArgStart))
                Case iArgStart + 1
                    Set evaluateFunc = GetObject(args(iArgStart), args(iArgStart + 1))
            End Select
        Case "iff"
            If CBool(args(iArgStart)) Then
                evaluateFunc = args(iArgStart + 1)
            Else
                evaluateFunc = args(iArgStart + 2)
            End If
        Case "typename"
            evaluateFunc = TypeName(args(iArgStart))
            
        'VBA Casting
        Case "cbool": evaluateFunc = VBA.Conversion.CBool(args(iArgStart))
        Case "cbyte": evaluateFunc = VBA.Conversion.CByte(args(iArgStart))
        Case "ccur":  evaluateFunc = VBA.Conversion.CCur(args(iArgStart))
        Case "cdate": evaluateFunc = VBA.Conversion.CDate(args(iArgStart))
        Case "csng":  evaluateFunc = VBA.Conversion.CSng(args(iArgStart))
        Case "cdbl":  evaluateFunc = VBA.Conversion.CDbl(args(iArgStart))
        Case "cint":  evaluateFunc = VBA.Conversion.CInt(args(iArgStart))
        Case "clng":  evaluateFunc = VBA.Conversion.CLng(args(iArgStart))
        Case "cstr":  evaluateFunc = VBA.Conversion.CStr(args(iArgStart))
        Case "cvar":  evaluateFunc = VBA.Conversion.CVar(args(iArgStart))
        Case "cverr": evaluateFunc = VBA.Conversion.CVErr(args(iArgStart))
        
        'Conversion
        Case "asc":     evaluateFunc = VBA.Asc(args(iArgStart))
        Case "chr":     evaluateFunc = VBA.Chr(args(iArgStart))
        
        Case "format"
            Select Case UBound(args)
                Case iArgStart
                    evaluateFunc = Format(args(iArgStart))
                Case iArgStart + 1
                    evaluateFunc = Format(args(iArgStart), args(iArgStart + 1))
                Case iArgStart + 2
                    evaluateFunc = Format(args(iArgStart), args(iArgStart + 1), args(iArgStart + 2))
                Case iArgStart + 3
                    evaluateFunc = Format(args(iArgStart), args(iArgStart + 1), args(iArgStart + 2), args(iArgStart + 3))
            End Select
        Case "hex":     evaluateFunc = VBA.Conversion.Hex(args(iArgStart))
        Case "oct":     evaluateFunc = VBA.Conversion.Oct(args(iArgStart))
        Case "str":     evaluateFunc = VBA.Conversion.Str(args(iArgStart))
        Case "val":     evaluateFunc = VBA.Conversion.val(args(iArgStart))
        
        'String functions
        Case "trim":  evaluateFunc = VBA.Trim(args(iArgStart))
        Case "lcase": evaluateFunc = VBA.LCase(args(iArgStart))
        Case "ucase": evaluateFunc = VBA.UCase(args(iArgStart))
        Case "right": evaluateFunc = VBA.right(args(iArgStart), args(iArgStart + 1))
        Case "left":  evaluateFunc = VBA.Left(args(iArgStart), args(iArgStart + 1))
        Case "len":   evaluateFunc = VBA.Len(args(iArgStart))

        Case "mid"
            Select Case UBound(args)
                Case iArgStart + 1
                    evaluateFunc = VBA.Mid(args(iArgStart), args(iArgStart + 1))
                Case iArgStart + 2
                    evaluateFunc = VBA.Mid(args(iArgStart), args(iArgStart + 1), args(iArgStart + 2))
            End Select
        'Misc
        Case "now": evaluateFunc = VBA.DateTime.Now()
        Case "switch"
            'TODO: Switch caching and use of dictionary would be good here
            For i = iArgStart + 1 To UBound(args) Step 2
              If i + 1 > UBound(args) Then
                Call CopyVariant(evaluateFunc, args(i))
                Exit For
              Else
                If IsObject(args(iArgStart)) And IsObject(args(i)) Then
                  If args(iArgStart) Is args(i) Then
                    Set evaluateFunc = args(i + 1)
                    Exit For
                  End If
                ElseIf (Not IsObject(args(iArgStart))) And (Not IsObject(args(i))) Then
                  If args(iArgStart) = args(i) Then
                    evaluateFunc = args(i + 1)
                    Exit For
                  End If
                End If
              End If
            Next
        Case "any"
            evaluateFunc = False
            'Detect if comparee is an object or a value
            If IsObject(args(iArgStart)) Then
                For i = iArgStart + 1 To UBound(args)
                  If IsObject(args(i)) Then
                    If args(iArgStart) Is args(i) Then
                      evaluateFunc = True
                      Exit For
                    End If
                  End If
                Next
            Else
                For i = iArgStart + 1 To UBound(args)
                  If Not IsObject(args(i)) Then
                    If args(iArgStart) = args(i) Then
                      evaluateFunc = True
                      Exit For
                    End If
                  End If
                Next
            End If
        Case "eval": evaluateFunc = stdLambda.Create(args(iArgStart)).Run()
        Case "lambda": set evaluateFunc = stdLambda.Create(args(iArgStart))
        Case Else
            Call Throw("No such function: " & sFuncName)
    End Select
End Function

'==========================
'
'  General helper methods
'
'==========================

'Class initialisation
Private Sub Class_Initialize()
    'If this is stdLambda predeclared class, ensure that oFuncExt is defined.
    If Me Is stdLambda Then Set oFuncExt = CreateObject("Scripting.Dictionary")
End Sub

'------------
'tokenisation
'------------

'Tokenise the input string
'@param {string} sInput String to tokenise
'@return {token[]} A list of Token structs
Private Function Tokenise(ByVal sInput As String) As token()
    Dim defs() As TokenDefinition
    defs = getTokenDefinitions()
    
    Dim tokens() As token, iTokenDef As Long
    ReDim tokens(1 To 1)
    
    Dim sInputOld As String
    sInputOld = sInput
    
    Dim iNumTokens As Long
    iNumTokens = 0
    While Len(sInput) > 0
        Dim bMatched As Boolean
        bMatched = False
        
        For iTokenDef = 1 To UBound(defs)
            'Test match, if matched then add token
            If defs(iTokenDef).RegexObj.test(sInput) Then
                'Get match details
                Dim oMatch As Object: Set oMatch = defs(iTokenDef).RegexObj.execute(sInput)
                
                'Create new token
                iNumTokens = iNumTokens + 1
                ReDim Preserve tokens(1 To iNumTokens)
                
                'Tokenise
                tokens(iNumTokens).Type = defs(iTokenDef)
                tokens(iNumTokens).value = oMatch(0)
                
                'Trim string to unmatched range
                sInput = Mid(sInput, Len(oMatch(0)) + 1)
                
                'Flag that a match was made
                bMatched = True
                Exit For
            End If
        Next
        
        'If no match made then syntax error
        If Not bMatched Then
            Call Throw("Syntax Error unexpected character """ & Mid(sInput, 1, 1) & """")
        End If
    Wend
    
    'Add eof token
    ReDim Preserve tokens(1 To iNumTokens + 1)
    tokens(iNumTokens + 1).Type.name = "eof"
    
    Tokenise = removeTokens(tokens, "space")
End Function

'Obtains a TokenDefinition from input params
'@param {ByVal String} The name of the token
'@param {ByVal String} The regex pattern to match durin tokenisation
'@param {ByVal Boolean?=True} Should this token ignoreCase?
'@param {ByVal Boolean?=False} Is this token a keyword?
'@returns {TokenDefinition} The definition of the token
Private Function getTokenDefinition(ByVal sName As String, ByVal sRegex As String, Optional ByVal ignoreCase As Boolean = True, Optional ByVal isKeyword As Boolean = False) As TokenDefinition
    getTokenDefinition.name = sName
    getTokenDefinition.Regex = sRegex & IIf(isKeyword, "\b", "")
    Set getTokenDefinition.RegexObj = CreateObject("VBScript.Regexp")
    getTokenDefinition.RegexObj.pattern = "^(?:" & sRegex & IIf(isKeyword, "\b", "") & ")"
    getTokenDefinition.RegexObj.ignoreCase = ignoreCase
End Function

'Copies one variant to a destination
'@param {ByRef Token()} tokens Tokens to remove the specified type from
'@param {string} sRemoveType   Token type to remove.
'@returns {Token()} The modified token array.
Private Function removeTokens(ByRef tokens() As token, ByVal sRemoveType As String) As token()
    Dim iCountRemoved As Long: iCountRemoved = 0
    Dim iToken As Long
    For iToken = LBound(tokens) To UBound(tokens)
        If tokens(iToken).Type.name <> sRemoveType Then
            tokens(iToken - iCountRemoved) = tokens(iToken)
        Else
            iCountRemoved = iCountRemoved + 1
        End If
    Next
    ReDim Preserve tokens(LBound(tokens) To (UBound(tokens) - iCountRemoved))
    removeTokens = tokens
End Function

'-------
'parsing
'-------

'Shifts the Tokens array (uses an index)
'@returns {token} The token at the tokenIndex
Private Function ShiftTokens() As token
    If iTokenIndex = 0 Then iTokenIndex = 1
    
    'Get next token
    ShiftTokens = tokens(iTokenIndex)
    
    'Increment token index
    iTokenIndex = iTokenIndex + 1
End Function

' Consumes a token
' @param {string} token The token type name to consume
' @throws If the expected token wasn't found
' @returns {string} The value of the token
Private Function consume(ByVal sType As String) As String
    Dim firstToken As token
    firstToken = ShiftTokens()
    If firstToken.Type.name <> sType Then
        Call Throw("Unexpected token, found: " & firstToken.Type.name & " but expected: " & sType)
    Else
        consume = firstToken.value
    End If
End Function

'Checks whether the token at iTokenIndex is of the given type
'@param {string} token  The token that is expected
'@param {long} offset   The number of tokens to look into the future, defaults to 1
'@returns {boolean} Whether the expected token was found
Private Function peek(ByVal sTokenType As String, Optional offset As Long = 1) As Boolean
    If iTokenIndex = 0 Then iTokenIndex = 1
    If iTokenIndex + offset - 1 <= UBound(tokens) Then
        peek = tokens(iTokenIndex + offset - 1).Type.name = sTokenType
    Else
        peek = False
    End If
End Function

' Combines peek and consume, consuming a token only if matched, without throwing an error if not
' @param {string} token The token that is expected
' @returns {vbNullString|string} Whether the expected token was found
Private Function optConsume(ByVal sTokenType As String) As Boolean
    Dim matched As Boolean: matched = peek(sTokenType)
    If matched Then
        Call consume(sTokenType)
    End If
    optConsume = matched
End Function

'Checks the value of the passed parameter, to check if it is the unique constant
'@param {Variant} test The value to test. May be an object or literal value
'@returns {Boolean} True if the value is the unique constant, otherwise false
Private Function isUniqueConst(ByRef test As Variant) As Boolean
    If Not IsObject(test) Then
        If VarType(test) = vbString Then
            If test = UniqueConst Then
                isUniqueConst = True
                Exit Function
            End If
        End If
    End If
    isUniqueConst = False
End Function
 
'Adds an operation to the instance operations list
'@param {IType} kType         The main type of the operation
'@param {ISubType} subType    The sub type of the operation
'@param {Variant} value       The value associated with the operation
'@param {Integer} stackDelta  The effect this has on the stack size (increasing or decreasing it)
'@returns {Integer} The index of the created operation
Private Function addOperation(kType As iType, Optional subType As ISubType, Optional value As Variant, Optional stackDelta As Integer) As Integer
    If iOperationIndex = 0 Then
        ReDim Preserve operations(0 To 1)
    Else
        Dim size As Long: size = UBound(operations)
        If iOperationIndex > size Then
            ReDim Preserve operations(0 To size * 2)
        End If
    End If
    
    With operations(iOperationIndex)
        .Type = kType
        .subType = subType
        Call CopyVariant(.value, value)
    End With
    addOperation = iOperationIndex
    stackSize = stackSize + stackDelta
    
    iOperationIndex = iOperationIndex + 1
End Function

'Resizes the operations list so there are no more empty operations
Private Sub finishOperations()
    ReDim Preserve operations(0 To iOperationIndex)
End Sub

'----------
'evaluation
'----------

Private Sub pushV(ByRef stack() As Variant, ByRef index As Long, ByVal item As Variant)
    Dim size As Long: size = UBound(stack)
    If index > size Then
        ReDim Preserve stack(0 To size * 2)
    End If
    If IsObject(item) Then
        Set stack(index) = item
    Else
        stack(index) = item
    End If
    index = index + 1
End Sub

Private Function popV(ByRef stack() As Variant, ByRef index As Variant) As Variant
    Dim size As Long: size = UBound(stack)
    If index < size / 3 And index > minStackSize Then
        ReDim Preserve stack(0 To CLng(size / 2))
    End If
    index = index - 1
    If IsObject(stack(index)) Then
        Set popV = stack(index)
    Else
        popV = stack(index)
    End If
    #If devMode Then
        stack(index) = Empty
    #End If
End Function

'Serializes the argument array passed to a string.
'@param {ByRef Variant()} Arguments to serialize
'@returns {String} Serialized representation of the arguments.
'@remark Objects cannot be split into their components and thus are cached as a conglomerate of type and pointer (e.g. Dictionary<12341234123>). 
'@TODO: Potentially use [StgSerializePropVariant ](https://docs.microsoft.com/en-us/windows/win32/api/propvarutil/nf-propvarutil-stgserializepropvariant) as this'd be more optimal
'@example
'  Debug.Print getPerformanceCacheID(Array())=""
'  Debug.Print getPerformanceCacheID(Array(Array(1, 2, Null), "yop", Empty, "", Nothing, New Collection, DateSerial(2020, 1, 1), False, True)) = "Array[1;2;null;];""yop"";empty;"""";Nothing;Collection<1720260481920>;01/01/2020;False;True;"
'returns
'  True
'  True
Private Function getPerformanceCacheID(ByRef Arguments As Variant) As String
    Dim length As Long: length = UBound(Arguments) - LBound(Arguments) + 1
    If length > 0 Then
        Dim sSerialized As String: sSerialized = ""
        For i = LBound(Arguments) To UBound(Arguments)
            Select Case VarType(Arguments(i))
              Case vbBoolean, vbByte, vbInteger, vbLong, vbLongLong, vbCurrency, vbDate, vbDecimal, vbDouble, vbSingle
                  sSerialized = sSerialized & Arguments(i) & ";"
              Case vbString
                  sSerialized = sSerialized & """" & Arguments(i) & """;"
              Case vbObject, vbDataObject
                  If Arguments(i) Is Nothing Then
                      sSerialized = sSerialized & "Nothing;"
                  Else
                      sSerialized = sSerialized & TypeName(Arguments(i)) & "<" & ObjPtr(Arguments(i)) & ">;"
                  End If
              Case vbEmpty
                  sSerialized = sSerialized & "empty;"
              Case vbNull
                  sSerialized = sSerialized & "null;"
              Case vbError
                  sSerialized = sSerialized & "error;"
              Case Else
                  If CBool(VarType(Arguments(i)) And vbArray) Then
                      sSerialized = sSerialized & "Array[" & getPerformanceCacheID(Arguments(i)) & "];"
                  Else
                      sSerialized = sSerialized & "Unknown;"
                  End If
            End Select
        Next
    End If
    getPerformanceCacheID = sSerialized
End Function

'-------
'general
'-------

'Used to obtain missing
'@Param {Variant} The value to be returned - Please do not populate this parameter.
'@returns {Missing} Missing value
Private Function GetMissing(Optional arg As Variant) As Variant
  GetMissing = arg
End Function

'Copies one variant to a destination
'@param {ByRef Variant} dest Destination to copy variant to
'@param {Variant} value Source to copy variant from.
'@perf This appears to be a faster variant of "oleaut32.dll\VariantCopy" + it's multi-platform
Private Sub CopyVariant(ByRef dest As Variant, ByVal value As Variant)
  If IsObject(value) Then
    Set dest = value
  Else
    Let dest = value
  End If
End Sub


'TODO: Better error handling
'Throws an error
'@param {string} The error message to be thrown
'@returns {void}
Private Sub Throw(ByVal sMessage As String)
    Err.Raise 1, "stdLambda", sMessage, vbCritical
    End
End Sub


'Used by Bind() for binding arguments ontop of BoundArgs and binding bound args to passed arguments
'@param {Variant()} The 1st array which will
'@param {Variant()} The 2nd array which will be concatenated after the 1st
'@complexity O(1)
Private Function ConcatArrays(ByVal Arr1 As Variant, ByVal Arr2 As Variant) As Variant
    Dim ub1 As Long: ub1 = UBound(Arr1)
    Dim lb1 As Long: lb1 = LBound(Arr1)
    Dim ub2 As Long: ub2 = UBound(Arr2)
    Dim lb2 As Long: lb2 = LBound(Arr2)
    Dim iub As Long: iub = ub1 + ub2 - lb2 + 1
    
    If iub > -1 Then
        Dim v() As Variant
        ReDim v(lb1 To iub)
        
        
        Dim i As Long
        For i = LBound(v) To UBound(v)
            If i <= ub1 Then
                Call CopyVariant(v(i), Arr1(i))
            Else
                Call CopyVariant(v(i), Arr2(i - ub1 - 1 + lb2))
            End If
        Next
        ConcatArrays = v
    Else
        ConcatArrays = Array()
    End If
End Function



'----------
'evaluation Mac
'----------

'Reimplementation of rtcCallByName() but for Mac OS
'@param {ByRef Object} - The object to call
'@param {ByVal String} - The method name to call
'@param {ByVal VbCallType} - The property/method call type
'@param {ByVal Variant()}  - An array of arguments. This function supports up to 30 arguments, akin to Application.Run
'@returns Variant - The return value of the called function
Private Function macCallByName(ByRef obj As Object, ByVal funcName As String, ByVal callerType As VbCallType, ByVal args As Variant) As Variant
    'Get currentLength
    Dim currentLength As Integer: currentLength = UBound(args) - LBound(args) + 1
    Dim i As Long: i = LBound(args)
    
    'Cant use same trick as in stdCallback, as it seems CallByName doesn't support the Missing value... So have to do it this way...
    'Will go up to 30 as per Application.Run() Also seems that you can't pass args array directly to CallByName() because it causes an Overflow error,
    'instead we need to convert the args to vars first... Yes this doesn't look at all pretty, but at least it's compartmentalised to the end of the code...
    Dim a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29
    If currentLength - 1 >= 0 Then Call CopyVariant(a0, args(i + 0)) Else GoTo macJmpCall
    If currentLength - 1 >= 1 Then Call CopyVariant(a1, args(i + 1)) Else GoTo macJmpCall
    If currentLength - 1 >= 2 Then Call CopyVariant(a2, args(i + 2)) Else GoTo macJmpCall
    If currentLength - 1 >= 3 Then Call CopyVariant(a3, args(i + 3)) Else GoTo macJmpCall
    If currentLength - 1 >= 4 Then Call CopyVariant(a4, args(i + 4)) Else GoTo macJmpCall
    If currentLength - 1 >= 5 Then Call CopyVariant(a5, args(i + 5)) Else GoTo macJmpCall
    If currentLength - 1 >= 6 Then Call CopyVariant(a6, args(i + 6)) Else GoTo macJmpCall
    If currentLength - 1 >= 7 Then Call CopyVariant(a7, args(i + 7)) Else GoTo macJmpCall
    If currentLength - 1 >= 8 Then Call CopyVariant(a8, args(i + 8)) Else GoTo macJmpCall
    If currentLength - 1 >= 9 Then Call CopyVariant(a9, args(i + 9)) Else GoTo macJmpCall
    If currentLength - 1 >= 10 Then Call CopyVariant(a10, args(i + 10)) Else GoTo macJmpCall
    If currentLength - 1 >= 11 Then Call CopyVariant(a11, args(i + 11)) Else GoTo macJmpCall
    If currentLength - 1 >= 12 Then Call CopyVariant(a12, args(i + 12)) Else GoTo macJmpCall
    If currentLength - 1 >= 13 Then Call CopyVariant(a13, args(i + 13)) Else GoTo macJmpCall
    If currentLength - 1 >= 14 Then Call CopyVariant(a14, args(i + 14)) Else GoTo macJmpCall
    If currentLength - 1 >= 15 Then Call CopyVariant(a15, args(i + 15)) Else GoTo macJmpCall
    If currentLength - 1 >= 16 Then Call CopyVariant(a16, args(i + 16)) Else GoTo macJmpCall
    If currentLength - 1 >= 17 Then Call CopyVariant(a17, args(i + 17)) Else GoTo macJmpCall
    If currentLength - 1 >= 18 Then Call CopyVariant(a18, args(i + 18)) Else GoTo macJmpCall
    If currentLength - 1 >= 19 Then Call CopyVariant(a19, args(i + 19)) Else GoTo macJmpCall
    If currentLength - 1 >= 20 Then Call CopyVariant(a20, args(i + 20)) Else GoTo macJmpCall
    If currentLength - 1 >= 21 Then Call CopyVariant(a21, args(i + 21)) Else GoTo macJmpCall
    If currentLength - 1 >= 22 Then Call CopyVariant(a22, args(i + 22)) Else GoTo macJmpCall
    If currentLength - 1 >= 23 Then Call CopyVariant(a23, args(i + 23)) Else GoTo macJmpCall
    If currentLength - 1 >= 24 Then Call CopyVariant(a24, args(i + 24)) Else GoTo macJmpCall
    If currentLength - 1 >= 25 Then Call CopyVariant(a25, args(i + 25)) Else GoTo macJmpCall
    If currentLength - 1 >= 26 Then Call CopyVariant(a26, args(i + 26)) Else GoTo macJmpCall
    If currentLength - 1 >= 27 Then Call CopyVariant(a27, args(i + 27)) Else GoTo macJmpCall
    If currentLength - 1 >= 28 Then Call CopyVariant(a28, args(i + 28)) Else GoTo macJmpCall
    If currentLength - 1 >= 29 Then Call CopyVariant(a29, args(i + 29)) Else GoTo macJmpCall

macJmpCall:
    Select Case currentLength
        Case 0:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType))
        Case 1:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0))
        Case 2:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1))
        Case 3:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2))
        Case 4:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3))
        Case 5:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4))
        Case 6:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5))
        Case 7:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6))
        Case 8:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7))
        Case 9:  Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8))
        Case 10: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9))
        Case 11: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10))
        Case 12: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11))
        Case 13: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12))
        Case 14: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13))
        Case 15: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14))
        Case 16: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15))
        Case 17: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16))
        Case 18: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17))
        Case 19: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18))
        Case 20: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19))
        Case 21: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20))
        Case 22: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21))
        Case 23: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22))
        Case 24: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23))
        Case 25: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24))
        Case 26: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25))
        Case 27: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26))
        Case 28: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27))
        Case 29: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28))
        Case 30: Call CopyVariant(macCallByName, CallByName(obj, funcName, callerType, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29))
    End Select
End Function

 

[sancarn]

Dependencies as requested - stdWindow:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "stdWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 
'======================================
'TODO:    Submit merge request
'======================================

'@class stdWindow
'@description A class for managing windows
'@example:
'   With stdWindow.CreateFromDesktop()
'     Dim notepad as stdWindow
'     set notepad = .Find(stdLambda.Create("$1.Caption = ""Untitled - Notepad"" and $1.ProcessName = ""notepad.exe"""))
'     nodepad.SendKeysInput("hello world")
'     nodepad.SendKeysInput("^a")
'     nodepad.SendKeysInput("^c")
'     Debug.Print stdClipboard.Text
'   End With
'
'   'Make a userform resizable
'   MyForm.show
'   stdWindow.CreateFromIUnknown(MyForm).resizable = true
'
'Spec:
' CONSTRUCTORS
'   [ ] Create(sClassName,sCaption,dwStyle, x, y, Width, Height, hWndParent, hMenu, hInstance, lpParam) as stdWindow
'   [ ] TODO:CreateStaticPopup(x, y, Width, Height, BorderWidth, BorderColor) as stdWindow
'   [X] CreateFromDesktop() as stdWindow
'   [X] CreateFromHwnd(hwnd) as stdWindow
'   [X] CreateFromPoint(x, y) as stdWindow
'   [ ] CreateFromEvent() as stdWindow
'   [X] CreateFromIUnknown(obj) as stdWindow
'   [X] CreateFromContextMenu() as stdWindow    'Class == "#32768"
' STATIC METHODS
'   [?] Requires()
' INSTANCE PROPERTIES
'   [X] Get     handle() as LongPtr
'   [X] Get     hDC() as LongPtr
'   [X] Get     Exists as Boolean
'   [X] Get/Let Visible() as Boolean
'   [X] Get/Let State() as EWndState    'Normal,Minimised,Maximised
'   [X] Get     IsFrozen() as Boolean
'   [X] Get/Let Caption() as string
'   [X] Get     Class() as string
'   [X] Get     RectClient() as Long()
'   [X] Get/Let RectWindow() as Long()
'   [X] Get/Let X() as Long
'   [X] Get/Let Y() as Long
'   [X] Get/Let Width() as Long
'   [X] Get/Let Height() as Long
'   [X] Get     ProcessID() as long
'   [X] Get     ProcessName() as string
'   [X] Get/Set Parent() as stdWindow
'   [X] Get     AncestralRoot() as stdWindow
'   [X] Get/Let Style() as Long
'   [X] Get/Let StyleEx() as Long
'   [X] Get/Let UserData() as LongPtr
'   [X] Get/Let WndProc() as LongPtr
'   [X] Get/Let Resizable() as Boolean
'   [X] Get     Children() as Collection
'   [X] Get     Descendents() as Collection
'   [ ] Get/Let AlwaysOnTop() as Boolean
'
' INSTANCE METHODS
'   [ ] SetHook(idHook, hook, hInstance, dwThreadID) as LongPtr
'   [X] Redraw()
'   [X] SendMessage(wMsg, wParam, lParam)
'   [X] PostMessage(wMsg, wParam, lParam)
'   [ ] TODO: SendMessageTimeout(wMsg, wParam, lParam, TimeoutMilliseconds)
'   [ ] ClickInput(x?, y?, Button?)
'   [X] ClickEvent(x?, y?, Button?, isDoubleClick?, wParam?)
'   [ ] SendKeysInput(sKeys, bRaw?, keyDelay?)
'   [X] SendKeysEvent(sKeys, bRaw?, keyDelay?)
'   [X] Activate()
'   [X] Close()
'   [X] FindFirst(query)
'   [X] FindAll(query)
'   [ ] Screenshot()
' PROTECTED METHODS
'   [X] zProtGetNextDescendent(stack, DFS, Prev) as stdWindow
' GENERIC
'   [ ] TODO: Mac compatibility







'--------------------------------------------------------------------------------
'Win API Declares
'--------------------------------------------------------------------------------
Private Type apiRect
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type

Private Type apiWindowInfo
  cbSize As Integer         'DWORD
  rcWindow As apiRect       'RECT
  rcClient As apiRect       'RECT
  dwStyle As Integer        'DWORD
  dwExStyle As Integer      'DWORD
  dwWindowStatus As Integer 'DWORD
  cxWindowBorders As Long   'UINT
  cyWindowBorders As Long   'UINT
  atomWindowType As Long    'ATOM
  wCreatorVersion As Long   'WORD
End Type
Public Enum apiWindowHookType
  WH_MSGFILTER = -1
  WH_JOURNALRECORD = 0
  WH_JOURNALPLAYBACK = 1
  WH_KEYBOARD = 2
  WH_GETMESSAGE = 3
  WH_CALLWNDPROC = 4
  WH_SYSMSGFILTER = 6
  WH_MOUSE = 7
  WH_SHELL = 10
  WH_CALLWNDPROCRET = 12
  WH_KEYBOARD_LL = 13
  WH_MOUSE_LL = 14
  WH_CBT = 5
  WH_DEBUG = 9
  WH_FOREGROUNDIDLE = 11
End Enum

'https://www.autohotkey.com/docs_1.0/misc/Styles.htm
Public Enum EWndStyles
  WS_BORDER = &H800000
  WS_CAPTION = &HC00000
  WS_CHILD = &H40000000
  WS_CHILDWINDOW = &H40000000
  WS_CLIPCHILDREN = &H2000000
  WS_CLIPSIBLINGS = &H4000000
  WS_DISABLED = &H8000000
  WS_DLGFRAME = &H400000
  WS_GROUP = &H20000
  WS_HSCROLL = &H100000
  WS_ICONIC = &H20000000
  WS_MAXIMIZE = &H1000000
  WS_MAXIMIZEBOX = &H10000
  WS_MINIMIZE = &H20000000
  WS_MINIMIZEBOX = &H20000
  WS_OVERLAPPED = &H0
  WS_POPUP = &H80000000
  WS_SIZEBOX = &H40000
  WS_SYSMENU = &H80000
  WS_TABSTOP = &H10000
  WS_THICKFRAME = &H40000
  WS_TILED = &H0
  WS_VISIBLE = &H10000000
  WS_VSCROLL = &H200000

  WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
  WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
End Enum
Public Enum EWndExStyles
  WS_EX_ACCEPTFILES = &H10
  WS_EX_APPWINDOW = &H40000
  WS_EX_CLIENTEDGE = &H200
  WS_EX_COMPOSITED = &H2000000
  WS_EX_CONTEXTHELP = &H400
  WS_EX_CONTROLPARENT = &H10000
  WS_EX_DLGMODALFRAME = &H1
  WS_EX_LAYERED = &H80000
  WS_EX_LAYOUTRTL = &H400000
  WS_EX_LEFT = &H0
  WS_EX_LEFTSCROLLBAR = &H4000
  WS_EX_LTRREADING = &H0
  WS_EX_MDICHILD = &H40
  WS_EX_NOACTIVATE = &H8000000
  WS_EX_NOINHERITLAYOUT = &H100000
  WS_EX_NOPARENTNOTIFY = &H4
  WS_EX_NOREDIRECTIONBITMAP = &H200000
  WS_EX_RIGHT = &H1000
  WS_EX_RIGHTSCROLLBAR = &H0
  WS_EX_RTLREADING = &H2000
  WS_EX_STATICEDGE = &H20000
  WS_EX_TOOLWINDOW = &H80
  WS_EX_TOPMOST = &H8
  WS_EX_TRANSPARENT = &H20
  WS_EX_WINDOWEDGE = &H100
  WS_EX_OVERLAPPEDWINDOW = WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE
  WS_EX_PALETTEWINDOW = WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or WS_EX_TOPMOST
End Enum
Public Enum EWndState
  Normal
  Maximised
  Minimised
End Enum
Public Enum EWndRectType
  RectTypeWindow
  RectTypeClient
End Enum

'SendInput() API helpers
'TODO: Not used yet
'========================================
Private Enum KeyState
  tap
  up
  down
End Enum
Private Enum EVirtualKey
  VK_LBUTTON = &H1:   VK_RBUTTON = &H2:     VK_CANCEL = &H3:     VK_MBUTTON = &H4:     VK_XBUTTON1 = &H5
  VK_XBUTTON2 = &H6:  VK_BACK = &H8:        VK_TAB = &H9:        VK_CLEAR = &HC:       VK_RETURN = &HD
  VK_SHIFT = &H10:    VK_CONTROL = &H11:    VK_ALT = &H12:       VK_PAUSE = &H13:      VK_CAPITAL = &H14
  VK_KANA = &H15:     VK_HANGUEL = &H15:    VK_HANGUL = &H15:    VK_IME_ON = &H16:     VK_JUNJA = &H17
  VK_FINAL = &H18:    VK_HANJA = &H19:      VK_KANJI = &H19:     VK_IME_OFF = &H1A:    VK_ESCAPE = &H1B
  VK_CONVERT = &H1C:  VK_NONCONVERT = &H1D: VK_ACCEPT = &H1E:    VK_MODECHANGE = &H1F: VK_SPACE = &H20
  VK_PRIOR = &H21:    VK_NEXT = &H22:       VK_END = &H23:       VK_HOME = &H24:       VK_LEFT = &H25
  VK_UP = &H26:       VK_RIGHT = &H27:      VK_DOWN = &H28:      VK_SELECT = &H29:     VK_PRINT = &H2A
  VK_EXECUTE = &H2B:  VK_SNAPSHOT = &H2C:   VK_INSERT = &H2D:    VK_DELETE = &H2E:     VK_HELP = &H2F
  
  'Numbers
  VK_0 = &H30:        VK_1 = &H31:          VK_2 = &H32:         VK_3 = &H33:          VK_4 = &H34
  VK_5 = &H35:        VK_6 = &H36:          VK_7 = &H37:         VK_8 = &H38:          VK_9 = &H39
  
  'Alphabet:
  VK_A = &H41:        VK_B = &H42:          VK_C = &H43:         VK_D = &H44:          VK_E = &H45
  VK_F = &H46:        VK_G = &H47:          VK_H = &H48:         VK_I = &H49:          VK_J = &H4A
  VK_K = &H4B:        VK_L = &H4C:          VK_M = &H4D:         VK_N = &H4E:          VK_O = &H4F
  VK_P = &H50:        VK_Q = &H51:          VK_R = &H52:         VK_S = &H53:          VK_T = &H54
  VK_U = &H55:        VK_V = &H56:          VK_W = &H57:         VK_X = &H58:          VK_Y = &H59
  VK_Z = &H5A:

  VK_LWIN = &H5B:     VK_RWIN = &H5C:       VK_APPS = &H5D:      VK_SLEEP = &H5F
  
  'Numpad
  VK_NUMPAD0 = &H60:  VK_NUMPAD1 = &H61:    VK_NUMPAD2 = &H62:   VK_NUMPAD3 = &H63:    VK_NUMPAD4 = &H64:
  VK_NUMPAD5 = &H65:  VK_NUMPAD6 = &H66:    VK_NUMPAD7 = &H67:   VK_NUMPAD8 = &H68:    VK_NUMPAD9 = &H69:
  VK_MULTIPLY = &H6A: VK_ADD = &H6B:        VK_SEPARATOR = &H6C: VK_SUBTRACT = &H6D:   VK_DECIMAL = &H6E:
  VK_DIVIDE = &H6F:
  
  'Function keys
  VK_F1 = &H70:       VK_F2 = &H71:         VK_F3 = &H72:        VK_F4 = &H73:         VK_F5 = &H74:
  VK_F6 = &H75:       VK_F7 = &H76:         VK_F8 = &H77:        VK_F9 = &H78:         VK_F10 = &H79:
  VK_F11 = &H7A:      VK_F12 = &H7B:        VK_F13 = &H7C:       VK_F14 = &H7D:        VK_F15 = &H7E:
  VK_F16 = &H7F:      VK_F17 = &H80:        VK_F18 = &H81:       VK_F19 = &H82:        VK_F20 = &H83:
  VK_F21 = &H84:      VK_F22 = &H85:        VK_F23 = &H86:       VK_F24 = &H87:
  
  'Modifiers
  VK_NUMLOCK = &H90:  VK_SCROLL = &H91:
  VK_LSHIFT = &HA0:   VK_RSHIFT = &HA1:
  VK_LCONTROL = &HA2: VK_RCONTROL = &HA3:
  VK_LALT = &HA4:     VK_RALT = &HA5:

  'Media keys
  VK_BROWSER_BACK = &HA6:    VK_BROWSER_FORWARD = &HA7:   VK_BROWSER_REFRESH = &HA8:   VK_BROWSER_STOP = &HA9:   VK_BROWSER_SEARCH = &HAA:   VK_BROWSER_FAVORITES = &HAB:   VK_BROWSER_HOME = &HAC:
  VK_VOLUME_MUTE = &HAD:   VK_VOLUME_DOWN = &HAE:   VK_VOLUME_UP = &HAF:
  VK_MEDIA_NEXT_TRACK = &HB0:   VK_MEDIA_PREV_TRACK = &HB1:   VK_MEDIA_STOP = &HB2:   VK_MEDIA_PLAY_PAUSE = &HB3:
  VK_LAUNCH_MAIL = &HB4:   VK_LAUNCH_MEDIA_SELECT = &HB5:   VK_LAUNCH_APP1 = &HB6:   VK_LAUNCH_APP2 = &HB7:
  VK_OEM_PLUS = &HBB:   VK_OEM_COMMA = &HBC:   VK_OEM_MINUS = &HBD:   VK_OEM_PERIOD = &HBE: VK_OEM_CLEAR = &HFE:
  VK_OEM_1 = &HBA:   VK_OEM_2 = &HBF:   VK_OEM_3 = &HC0:   VK_OEM_4 = &HDB:   VK_OEM_5 = &HDC:   VK_OEM_6 = &HDD:   VK_OEM_7 = &HDE:   VK_OEM_8 = &HDF:   VK_OEM_102 = &HE2:
  VK_PROCESSKEY = &HE5:   VK_PACKET = &HE7:   VK_ATTN = &HF6:   VK_CRSEL = &HF7:   VK_EXSEL = &HF8:   VK_EREOF = &HF9:   VK_PLAY = &HFA:   VK_ZOOM = &HFB:   VK_NONAME = &HFC:   VK_PA1 = &HFD
End Enum

'
Private Type KeyToken
  wVirtualKey As EVirtualKey  'https://docs.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes
  wScanCode As Integer    '
  iKeyState As KeyState
  iTimes As Long
End Type

'Used by SendInput() to send keys to window
Private Type KeyboardInput
  iType As Long    'DWORD = INPUT_KEYBOARD
  wVk As Integer   'WORD
  wScan As Integer 'WORD
  dwFlags As Long  'DWORD
  time As Long     'DWORD
  #If VBA7 Then    'ULONG_PTR
    dwExtraInfo As LongPtr
    bPadding(1 To 12) As Byte '   12 extra bytes, because mouses take more.
  #Else
    dwExtraInfo As Long
    bPadding(1 To 8) As Byte '   8 extra bytes, because mouses take more.
  #End If
End Type
'========================================


'Or use EnumChildWindows
Private Enum apiWindowRelationship
  GW_CHILD = 5
  GW_ENABLEDPOPUP = 6
  GW_HWNDFIRST = 0
  GW_HWNDLAST = 1
  GW_HWNDNEXT = 2
  GW_HWNDPREV = 3
  GW_OWNER = 4
End Enum

Private Enum EWndShowStyle
  SW_HIDE = 0
  SW_SHOWNORMAL = 1          'Shows/Restores + Activates
  SW_SHOWMINIMIZED = 2       'Activates the window and displays it as a minimized window.
  SW_MAXIMIZE = 3            'Maximize
  SW_SHOWNOACTIVATE = 4      'Shows in most recent size + position but doesn't activate
  SW_SHOW = 5                'Activate
  SW_MINIMIZE = 6            'Minimize
  SW_SHOWMINNOACTIVE = 7     'Minimize no activate
  SW_SHOWNA = 8              'Show in current size and position, no activate
  SW_RESTORE = 9             'Restore
  SW_SHOWDEFAULT = 10        'Default window state at start of program
  SW_FORCEMINIMIZE = 11
End Enum

Private Enum apiWindowLongType
  GWL_WNDPROC = -4
  GWL_HINSTANCE = -6
  GWL_HWNDPARENT = -8
  GWL_ID = -12
  GWL_STYLE = -16
  GWL_EXSTYLE = -20
  GWL_USERDATA = -21
  
  'If HWND is a dialog box
  DWL_MSGRESULT = 0
  'DWL_DLGPROC = DWLP_MSGRESULT + sizeof(LRESULT)
  'DWL_USER = DWL_DLGPROC + sizeof(DLGPROC)
End Enum

Private Enum apiWindowAncestorType
  GA_PARENT = 1
  GA_ROOT = 2
  GA_ROOTOWNER = 3
End Enum

Public Enum EWndMouseButton
  LButton
  RButton
  MButton
End Enum

'Used while walking the Window tree. Can be used to toggle between a Breadth first search and a depth first search.
Public Enum EWndFindType
  BreadthFirst = 0
  DepthFirst = 1
End Enum

'Used while walking the Window tree. Can be used to discard entire trees of elements, to increase speed of walk algorithms.
Public Enum EWndFindResult
  matchFound = 1                   'Matched
  MatchFoundSearchDescendents = 4  'Same as `ESearchResult.MatchFound`
  NoMatchFound = 0                 'Not found, continue searching descendents
  NoMatchCancelSearch = 2          'Not found, cancel search
  NoMatchSkipDescendents = 3       'Not found, don't search descendents
End Enum

Private Type tFindNode
  initialised As Boolean
  depth As Long
  element As Object
End Type

#If VBA7 Then
  'Constructors
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
  Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long) As LongPtr

  'Getting window data
  Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function IsHungAppWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function IsZoomed Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
  Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, ByRef pRect As apiRect) As Long
  Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, ByRef pRect As apiRect) As Long
  Private Declare PtrSafe Function GetWindowInfo Lib "user32" (ByVal hwnd As LongPtr, ByRef pInf As apiWindowInfo) As Long
  Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndParent As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As apiWindowLongType) As Long
  Private Declare PtrSafe Function GetWindowLongPtrA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As apiWindowLongType) As LongPtr
  Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As apiWindowLongType, ByVal dwNewLong As Long) As Long
  Private Declare PtrSafe Function SetWindowLongPtrA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As apiWindowLongType, ByVal dwNewPtr As LongPtr) As Long
  Private Declare PtrSafe Function GetAncestor Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As apiWindowAncestorType) As LongPtr
  Private Declare PtrSafe Function FindWindowExA Lib "user32" (ByVal hwnd As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
  Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hwndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal flags As Long) As Long
  Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal bRepaint As Boolean) As Long
  Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
  
  'Redrawing window, UpdateWindow can also be used but isn't as safe...
  Private Declare PtrSafe Function RedrawWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal lprcUpdate As LongPtr, ByVal hrgnUpdate As LongPtr, ByVal flags As Long) As Long

  'Get children / siblings / parent
  Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As apiWindowRelationship) As LongPtr

  'Get process related data
  Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, ByRef ldpwProcessId As Long) As Long
  Private Declare PtrSafe Function GetWindowModuleFileName Lib "user32" Alias "GetWindowModuleFileNameA" (ByVal hwnd As LongPtr, ByVal pszFileName As String, ByVal cchFileNameMax As Long) As Long
  Private Declare PtrSafe Function GetCurrentThreadId Lib "Kernel32" () As Long
  Private Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
  
  'Setting window data
  Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long

  'Automating windows
  Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Any) As Long
  Private Declare PtrSafe Function PostMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Any) As Long
  Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As EWndShowStyle) As Long
  Private Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
  Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long

  'SendKeys
  Private Declare PtrSafe Function MapVirtualKeyA Lib "user32" (ByVal uCode As Long, ByVal uMapType As Long) As Long
  Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVK As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
  Private Declare PtrSafe Function SendInput Lib "user32" (ByVal cInputs As Long, ByRef pInput As KeyboardInput, ByVal cbSize As Long) As Long
  Private Declare PtrSafe Function GetMessageExtraInfo Lib "user32" () As LongPtr
  Private Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
#Else
  'Constructors
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
  Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
  Private Declare Function WindowFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

  'Getting window data
  Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function IsHungAppWindow Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, ByRef pRect As apiRect) As Long
  Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, ByRef pRect As apiRect) As Long
  Private Declare Function GetWindowInfo Lib "user32" (ByVal hwnd As Long, ByRef pInf As apiWindowInfo) As Long
  Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function SetParent Lib "user32" (ByVal hwnd As Long, ByVal hWndParent As Long) As Long
  Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As apiWindowLongType) As Long
  Private Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As apiWindowLongType) As Long
  Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As apiWindowLongType, ByVal dwNewLong As Long) As Long
  Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As apiWindowLongType, ByVal dwNewPtr As Long) As Long
  Private Declare Function GetAncestor Lib "user32" (ByVal hwnd As Long, ByVal nIndex As apiWindowAncestorType) As Long
  Private Declare Function FindWindowExA Lib "user32" (ByVal hwnd As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
  Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hwndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal flags As Long) As Long
  Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal bRepaint As Boolean) As Long
  Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
  
  'Redrawing window, UpdateWindow can also be used but isn't as safe...
  Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, ByVal lprcUpdate As Long, ByVal hrgnUpdate As Long, ByVal flags As Long) As Long

  'Get children / siblings / parent
  Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As apiWindowRelationship) As Long

  'Get process related data
  Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef ldpwProcessId As Long) As Long
  Private Declare Function GetWindowModuleFileName Lib "user32" Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal pszFileName As String, ByVal cchFileNameMax As Long) As Long
  Private Declare Function GetCurrentThreadId Lib "Kernel32" Alias "GetCurrentThreadID" () As Long
  Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long

  'Setting window data
  Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

  'Automating windows
  Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Any) As Long
  Private Declare Function PostMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Any) As Long
  Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As EWndShowStyle) As Long
  Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

  'SendKeys
  Private Declare Function MapVirtualKeyA Lib "user32" (ByVal uCode As Long, ByVal uMapType As Long) As Long
  Private Declare Sub keybd_event Lib "user32" (ByVal bVK As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  Private Declare Function SendInput Lib "user32" (ByVal cInputs As Long, ByRef pInputs As KeyboardInput, ByVal cbSize As Long) As Long
  Private Declare Function GetMessageExtraInfo Lib "user32" () As Long
  Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
#End If


#If VBA7 Then
  Private pHandle As LongPtr
#Else
  Private pHandle As Long
#End If

Private pInitialized As Boolean
Private Lookups As Object


'================================================================================================
'=      PUBLIC CONSTRUCTORS
'================================================================================================
'TODO: Create a window object from information passed in by this function
'@constructor
'@param {ByVal String} The class name can be any name registered with RegisterClass or RegisterClassEx, provided that the module that registers the class is also the module that creates the window. The class name can also be any of the predefined system class names. For a list of system class names, see the Remarks section.
'@param {ByVal String} The name/caption of the window
'@param {ByVal Long (DWORD)} The window style for the window
'@param {ByVal Long} The x coordinate of the window
'@param {ByVal Long} The y coordinate of the window
'@param {ByVal Long} The width of the window
'@param {ByVal Long} The height of the window
'@param {ByVal LongPtr} Parent window handle. Can be 0 for pop-up windows.
'@param {ByVal LongPtr} Menu handle. Can be 0 for pop-up windows.
'@param {ByVal LongPtr} Module Instance handle.
'@param {ByVal lpParam} Pointer to a location where extra information is stored. Or ClientCreateStruct (for MDI windows), or null if no extra data required
'@returns {stdWindow} The created window
'@remarks System Class Names: BUTTON, COMBOBOX, EDIT, LISTBOX, MDICLIENT, RICHEDIT, RICHEDIT_CLASS, SCROLLBAR, STATIC
#If VBA7 Then
Private Function Create(ByVal sClassName As String, ByVal sCaption As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, ByVal lpParam As Long) As stdWindow
#Else
Private Function Create(ByVal sClassName As String, ByVal sCaption As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByVal lpParam As Long) As stdWindow
#End If
  Err.Raise 1, "Create", "Not Implemented"
End Function

'TODO: Create a window object used mainly for highlighting areas
'@constructor
'@param {ByVal Long} The x coordinate of the window
'@param {ByVal Long} The y coordinate of the window
'@param {ByVal Long} The width of the window
'@param {ByVal Long} The height of the window
'@param {ByVal Long} The width of the colored border
'@param {ByVal Long} The color of the colored border
'@returns {stdWindow} The created highlighting box
'@remarks https://stackoverflow.com/questions/3970066/creating-a-transparent-window-in-c-win32
Private Function CreateStaticPopup(ByVal x As Long, ByVal y As Long, ByVal width As Long, ByVal height As Long, ByVal BorderWidth As Long, ByVal BorderColor As Long) As stdWindow
  Err.Raise 1, "Create", "Not Implemented"
End Function

'Create a window object from a window handle
'@constructor
'@param {ByVal LongPtr} Handle to window (hwnd) to create window object for
'@returns {stdWindow} Specificed window.
#If VBA7 Then
Public Function CreateFromHwnd(ByVal hwnd As LongPtr) As stdWindow
#Else
Public Function CreateFromHwnd(ByVal hwnd As Long) As stdWindow
#End If
  Set CreateFromHwnd = New stdWindow
  Call CreateFromHwnd.protInit(hwnd)
End Function

'Creates an `stdWindow` object from the current running application (e.g. Excel / Word / Powerpoint).
'@constructor
'@returns {stdWindow}
Public Function CreateFromApplication() As stdWindow
    select case Application.Name
        case "Microsoft Excel"
            Set CreateFromApplication = CreateFromHwnd(Application.hwnd)
        case "Microsoft Word"
            Set CreateFromApplication = CreateFromHwnd(Application.ActiveWindow.Hwnd)
        case "Microsoft PowerPoint"
            Err.Raise 1, "stdAcc::CreateFromApplication()", "No built in way of finding powerpoint hwnd. We suggest using stdWindow to get hwnd, and create direct from hwnd instead " & Application.name
        case else
            Err.Raise 1, "stdAcc::CreateFromApplication()", "No implementation for getting application window of " & Application.name
    end select
End Function

'Create a window from the desktop window
'@constructor
'@returns {stdWindow} Desktop window
Public Function CreateFromDesktop() As stdWindow
  Set CreateFromDesktop = CreateFromHwnd(GetDesktopWindow())
End Function


'Find and Create a window object for a window displayed intersecting a point on the screen.
'@constructor
'@param {ByVal Long} X of Point to find window at
'@param {ByVal Long} Y of Point to find window at
'@returns {stdWindow} Window intersecting point.
Public Function CreateFromPoint(ByVal x As Long, ByVal y As Long) As stdWindow
  Set CreateFromPoint = New stdWindow
  Call CreateFromPoint.protInit(WindowFromPoint(x, y))
End Function

''Create from Shell event
'Public Function CreateFromEvent() as stdWindow
'
'End Function

'Create a window object from an object which implements either IOleWindow, IInternetSecurityMgrSite or IShellView. Uses shell API's IUnknown_GetWindow internally.
'@constructor
'@param {ByVal IUnknown} Object which implements GetWindow() method
'@returns {stdWindow} Window specified by object
Public Function CreateFromIUnknown(ByVal obj As IUnknown) As stdWindow
  #If VBA7 Then
    Dim hwnd As LongPtr
  #Else
    Dim hwnd As Long
  #End If
  Dim hResult As Long
  hResult = IUnknown_GetWindow(obj, VarPtr(hwnd))
  If hResult = 0 Then
    Set CreateFromIUnknown = New stdWindow
    Call CreateFromIUnknown.protInit(hwnd)
  ElseIf hResult = -2147467262 Then
    Err.Raise 1, "CreateFromIUnknown", "This object does not implement IOleWindow, IInternetSecurityMgrSite or IShellView, and thus cannot retrieve the window assosciated with the object."
  Else
    Err.Raise 1, "CreateFromIUnknown", "An unknown error has occurred.", hResult
  End If
End Function

'Create a window object from the context menu. There should only ever be 1 context menu on the system at one time.
'@constructor
'@returns {stdWindow} Window object representing the ContextMenu
Public Function CreateFromContextMenu() As stdWindow
  #If VBA7 Then
    Dim hwnd As LongPtr
  #Else
    Dim hwnd As Long
  #End If
  hwnd = FindWindowExA(Null, Null, MakeIntAtom(&H8000&), vbNullString)
  If hwnd <> 0 Then
    Set CreateFromContextMenu = CreateFromHwnd(hwnd)
  Else
    Set CreateFromContextMenu = Nothing
  End If
End Function

#if FULL_INTELLISENSE then
Public Function AsAcc() as stdAcc
#else
Public Function AsAcc() as Object
#end if
  if isObject(stdAcc) then
    set AsAcc = stdAcc.CreateFromHwnd(pHandle)
  else
    Err.Raise 1, "", "This function requires stdAcc dependency."
  end if
End Function


'Notes:
'Windows are hierarchical therefore CreateManyFromQuery and CreateFromQuery makes less sense than FindFirst() and FindAll() methods

'================================================================================================
'=      PROTECTED CONSTRUCTORS / DESTRUCTORS
'================================================================================================
'Initialize a window object
'@constructor
'@protected
'@param {ByVal LongPtr} Handle to window (hwnd) to create window object for
'@returns {stdWindow} Specificed window.
#If VBA7 Then
Friend Sub protInit(ByVal hwnd As LongPtr)
#Else
Friend Sub protInit(ByVal hwnd As Long)
#End If
  pHandle = hwnd
  pInitialized = True
End Sub

'Whenever we initialise ensure to get lookups from `stdWindow`
Private Sub Class_Initialize()
    Set Lookups = stdWindow.protGetLookups()
End Sub


'--------------------------------------------------------------------------------
'Access window information
'--------------------------------------------------------------------------------

'Get the hWND / window ID of the window
#If VBA7 Then
Public Property Get handle() As LongPtr
#Else
Public Property Get handle() As Long
#End If
  handle = pHandle
End Property

'Get the handle to the display context for the window
#If VBA7 Then
Public Property Get hDC() As LongPtr
#Else
Public Property Get hDC() As Long
#End If
  hDC = GetWindowDC(pHandle)
End Property

'Detect if the window exists
Public Property Get Exists() As Boolean
  Exists = IsWindow(pHandle)
End Property

'Detect if the window is hanging/frozen
Public Property Get IsFrozen() As Boolean
  If Exists Then
    IsFrozen = IsHungAppWindow(pHandle)
  Else
    Err.Raise 1, "IsFrozen", "Window does not exist."
  End If
End Property

'Get/Set the window caption
Public Property Get Caption() As String
  If Exists Then
    Dim sCharBuffer As String, iNumChars As Long
    sCharBuffer = space(256)
    iNumChars = GetWindowText(pHandle, sCharBuffer, 256)
    Caption = Mid(sCharBuffer, 1, iNumChars)
  Else
    Err.Raise 1, "Caption", "Window does not exist."
  End If
End Property
Public Property Let Caption(ByVal s As String)
  If Exists Then
    If Not CBool(SetWindowText(pHandle, s)) Then
      Err.Raise 1, "Caption [Let]", "Window text could not be set."
    End If
  Else
    Err.Raise 1, "Caption [Let]", "Window does not exist."
  End If
End Property

'Get the window class
Public Property Get Class() As String
  If Exists Then
    Dim sCharBuffer As String, iNumChars As Long
    sCharBuffer = space(256)
    iNumChars = GetClassName(pHandle, sCharBuffer, 256)
    Class = Mid(sCharBuffer, 1, iNumChars)
  Else
    Err.Raise 1, "Class", "Window does not exist."
  End If
End Property

'Get/Let visibility of window
Public Property Get Visible() As Boolean
  If Exists Then
    Visible = IsWindowVisible(pHandle)
  Else
    Err.Raise 1, "Visible", "Window does not exist."
  End If
End Property
Public Property Let Visible(ByVal x As Boolean)
  If Exists Then
    If x Then
      Call ShowWindow(pHandle, EWndShowStyle.SW_SHOW)
    Else
      Call ShowWindow(pHandle, EWndShowStyle.SW_HIDE)
    End If
  Else
    Err.Raise 1, "Visible", "Window does not exist."
  End If
End Property

'Get/Let windowState of window
Public Property Get State() As EWndState
  If Exists Then
    If IsZoomed(pHandle) Then
      State = EWndState.Maximised
    ElseIf IsIconic(pHandle) Then
      State = EWndState.Minimised
    Else
      State = EWndState.Normal
    End If
  Else
    Err.Raise 1, "State", "Window does not exist."
  End If
End Property
Public Property Let State(ByVal x As EWndState)
  If Exists Then
    If Visible Then
      Select Case x
        Case EWndState.Normal
          Call ShowWindow(pHandle, EWndShowStyle.SW_RESTORE)
        Case EWndState.Maximised
          Call ShowWindow(pHandle, EWndShowStyle.SW_MAXIMIZE)
        Case EWndState.Minimised
          Call ShowWindow(pHandle, EWndShowStyle.SW_FORCEMINIMIZE)
      End Select
    Else
      Err.Raise 1, "State", "Cannot set window state of a hidden window."
    End If
  Else
    Err.Raise 1, "State", "Window does not exist."
  End If
End Property

'Get the child windows of this window
Public Property Get children() As collection
  If Exists Then
    'Define collection to return
    Dim ret As collection
    Set ret = New collection

    'Attempt to get a child window
    #If VBA7 Then
      Dim childHandle As LongPtr
    #Else
      Dim childHandle As Long
    #End If
    childHandle = GetWindow(pHandle, GW_CHILD)

    'If a child window exists, find all children
    If childHandle <> 0 Then
      'Quickly add all hwnds to an array
      'This is a fast operation, object creation is anticipated to be a slower operation, thus is left till afterwards
      #If VBA7 Then
        Dim childHandles() As LongPtr
      #Else
        Dim childHandles() As Long
      #End If

      Dim i As Long: i = -1
      Do While (childHandle <> 0)
          i = i + 1
          ReDim Preserve childHandles(i)
          childHandles(i) = childHandle
          childHandle = GetWindow(childHandle, GW_HWNDNEXT)
      Loop
      
      'Create stdWindow objects from hwnds array and add them to collection.
      For i = LBound(childHandles) To UBound(childHandles)
        Call ret.Add(stdWindow.CreateFromHwnd(childHandles(i)))
      Next
    End If

    'Return child objects
    Set children = ret
  Else
    Err.Raise 1, "Children", "Window does not exist."
  End If
End Property

'Get the Client rect - I.E. Position and Size of Window's Client area
Public Property Get RectClient() As Double()
  If Exists Then
    Dim rect As apiRect
    If Not GetClientRect(pHandle, rect) Then
      Dim fRet(0 To 3) As Double
      With rect
        fRet(0) = .left
        fRet(1) = .top
        fRet(2) = .right - .left
        fRet(3) = .bottom - .top
        RectClient = fRet
      End With
    Else
      Err.Raise 1, "RectClient", "Cannot get client rect.", Err.LastDllError
    End If
  Else
    Err.Raise 1, "RectClient", "Window does not exist."
  End If
End Property

'Get/Set the Window rect - I.E. Position and Size of window
Public Property Get RectWindow() As Variant
  If Exists Then
    Dim rect As apiRect
    If Not GetWindowRect(pHandle, rect) Then
      Dim fRet As Variant
      ReDim fRet(0 To 3)
      With rect
        fRet(0) = .left
        fRet(1) = .top
        fRet(2) = .right - .left
        fRet(3) = .bottom - .top
        RectWindow = fRet
      End With
    Else
      Err.Raise 1, "RectWindow", "Cannot get window rect.", Err.LastDllError
    End If
  Else
    Err.Raise 1, "RectWindow", "Window does not exist."
  End If
End Property
Public Property Let RectWindow(ByVal rect As Variant)
  If isArray(rect) Then
    If Exists Then
      Call MoveWindow(pHandle, rect(0), rect(1), rect(2), rect(3), True)
    Else
      Err.Raise 1, "RectWindow [Let]", "Window does not exist."
    End If
  Else
    Err.Raise 1, "RectWindow [Let]", "Value must be an array of 4 doubles - left, top, width, height."
  End If
End Property
Public Property Get RectByType(Optional iClWnd As EWndRectType) As Variant
  Select Case iClWnd
    Case EWndRectType.RectTypeClient
      RectByType = RectClient
    Case EWndRectType.RectTypeWindow
      RectByType = RectWindow
  End Select
End Property
Public Property Let RectByType(Optional iClWnd As EWndRectType, ByVal rect As Variant)
  Select Case iClWnd
    Case EWndRectType.RectTypeClient
      Err.Raise 1, "RectByType [Let]", "Cannot set client rect"
    Case EWndRectType.RectTypeWindow
      RectWindow = rect
  End Select
End Property

'Get/Set the X position of this window
Public Property Get x(Optional ByVal iClWnd As EWndRectType) As Long
  If Exists Then
    x = Me.RectByType(iClWnd)(0)
  Else
    Err.Raise 1, "stdWindow#x", "Window does not exist."
  End If
End Property
Public Property Let x(Optional ByVal iClWnd As EWndRectType, ByVal vX As Long)
  If Exists Then
    Dim rect As Variant: rect = RectByType(iClWnd)
    Call MoveWindow(pHandle, vX, rect(1), rect(2), rect(3), True)
  Else
    Err.Raise 1, "stdWindow#x [Let]", "Window does not exist."
  End If
End Property

'Get/Set the Y position of this window
Public Property Get y(Optional ByVal iClWnd As EWndRectType) As Long
  If Exists Then
    y = RectByType(iClWnd)(1)
  Else
    Err.Raise 1, "stdWindow#y", "Window does not exist."
  End If
End Property
Public Property Let y(Optional ByVal iClWnd As EWndRectType, ByVal vY As Long)
  If Exists Then
    Dim rect As Variant: rect = RectByType(iClWnd)
    Call MoveWindow(pHandle, rect(0), vY, rect(2), rect(3), True)
  Else
    Err.Raise 1, "stdWindow#y [Let]", "Window does not exist."
  End If
End Property

'Get/Set the width of this window
Public Property Get width(Optional ByVal iClWnd As EWndRectType) As Long
  If Exists Then
    width = RectByType(iClWnd)(2)
  Else
    Err.Raise 1, "stdWindow#width", "Window does not exist."
  End If
End Property
Public Property Let width(Optional ByVal iClWnd As EWndRectType, ByVal vW As Long)
  If Exists Then
    Dim rect As Variant:: rect = RectByType(iClWnd)
    Call MoveWindow(pHandle, rect(0), rect(1), vW, rect(3), True)
  Else
    Err.Raise 1, "stdWindow#width [Let]", "Window does not exist."
  End If
End Property

'Get/Set the height of this window
Public Property Get height(Optional ByVal iClWnd As EWndRectType) As Long
  If Exists Then
    height = RectByType(iClWnd)(3)
  Else
    Err.Raise 1, "stdWindow#height", "Window does not exist."
  End If
End Property
Public Property Let height(Optional ByVal iClWnd As EWndRectType, ByVal vH As Long)
  If Exists Then
    Dim rect As Variant:: rect = RectByType(iClWnd)
    Call MoveWindow(pHandle, rect(0), rect(1), rect(2), vH, True)
  Else
    Err.Raise 1, "stdWindow#height [Let]", "Window does not exist."
  End If
End Property

'Get the ID of the process running this window
Public Property Get ProcessID() As Long
  If Exists Then
    Call GetWindowThreadProcessId(pHandle, ProcessID)
  Else
    Err.Raise 1, "ProcessID", "Window does not exist."
  End If
End Property

'Get the name of the process running this window
Public Property Get ProcessName() As String
  If Exists Then
    Dim sCharBuffer As String, iNumChars As Long
    sCharBuffer = space(256)
    iNumChars = GetWindowModuleFileName(pHandle, sCharBuffer, 256)
    ProcessName = Mid(sCharBuffer, 1, iNumChars)
  Else
    Err.Raise 1, "ProcessName", "Window does not exist."
  End If
End Property

'Get/Set the window's parent window:
Public Property Get parent() As stdWindow
  #If VBA7 Then
    Dim pHwnd As LongPtr
  #Else
    Dim pHwnd As Long
  #End If
  pHwnd = GetParent(pHandle)
  If pHwnd <> 0 Then
    Set parent = stdWindow.CreateFromHwnd(GetParent(pHandle))
  ElseIf Class <> "#32769" Then
    Set parent = stdWindow.CreateFromDesktop()
  End If
End Property
Public Property Set parent(ByVal win As stdWindow)
  If Not Exists Then
    Err.Raise 1, "Parent [Set]", "Window does not exist."
  ElseIf Not win.Exists Then
    Err.Raise 1, "Parent [Set]", "New parent window no longer exists."
  Else
    #If VBA7 Then
      Dim hOldParent As LongPtr
    #Else
      Dim hOldParent As Long
    #End If
    hOldParent = SetParent(pHandle, win.handle)
  End If
End Property

'Get the root window of this Window/ChildWindow
Public Property Get AncestralRoot() As stdWindow
  If Exists Then
    Set AncestralRoot = stdWindow.CreateFromHwnd(GetAncestor(pHandle, apiWindowAncestorType.GA_ROOT))
  Else
    Err.Raise 1, "AncestralRoot", "Window does not exist."
  End If
End Property

'Get/Set the style of the window
Public Property Get Style() As Long
  If Exists Then
    Style = GetWindowLongA(pHandle, apiWindowLongType.GWL_STYLE)
  Else
    Err.Raise 1, "Style", "Window does not exist."
  End If
End Property
Public Property Let Style(ByVal newStyle As Long)
  If Exists Then
    'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
    Err.Clear

    'Set window long
    Dim hResult As Long: hResult = SetWindowLongA(pHandle, apiWindowLongType.GWL_STYLE, newStyle)

    'Check for errors
    If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "Style [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
  Else
    Err.Raise 1, "Style [Let]", "Window does not exist."
  End If
End Property

'Get/Set the extended style of the window
Public Property Get StyleEx() As Long
  If Exists Then
    StyleEx = GetWindowLongA(pHandle, apiWindowLongType.GWL_EXSTYLE)
  Else
    Err.Raise 1, "StyleEx", "Window does not exist."
  End If
End Property
Public Property Let StyleEx(ByVal newStyle As Long)
  If Exists Then
    'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
    Err.Clear

    'Set window long
    Dim hResult As Long: hResult = SetWindowLongA(pHandle, apiWindowLongType.GWL_EXSTYLE, newStyle)

    'Check for errors
    If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "StyleEx [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
  Else
    Err.Raise 1, "StyleEx [Let]", "Window does not exist."
  End If
End Property

#If VBA7 Then
  'Get/Set a pointer to userdata/metadata
  Public Property Get UserData() As LongPtr
    If Exists Then
      UserData = GetWindowLongPtrA(pHandle, apiWindowLongType.GWL_USERDATA)
    Else
      Err.Raise 1, "UserData", "Window does not exist."
    End If
  End Property

  Public Property Let UserData(ByVal newUserData As LongPtr)
    If Exists Then
      'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
      Err.Clear

      'Set window long
      Dim hResult As LongPtr: hResult = SetWindowLongPtrA(pHandle, apiWindowLongType.GWL_USERDATA, newUserData)

      'Check for errors
      If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "UserData [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
    Else
      Err.Raise 1, "UserData [Let]", "Window does not exist."
    End If
  End Property

  'Get/Set the WndProc of the window
  Public Property Get WndProc() As LongPtr
    If Exists Then
      WndProc = GetWindowLongPtrA(pHandle, apiWindowLongType.GWL_WNDPROC)
    Else
      Err.Raise 1, "WndProc", "Window does not exist."
    End If
  End Property
  Public Property Let WndProc(ByVal newWndProc As LongPtr)
    If Exists Then
      'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
      Err.Clear

      'Set window long
      Dim hResult As LongPtr: hResult = SetWindowLongPtrA(pHandle, apiWindowLongType.GWL_WNDPROC, newWndProc)

      'Check for errors
      If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "WndProc [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
    Else
      Err.Raise 1, "WndProc [Let]", "Window does not exist."
    End If
  End Property
#Else
  'Get/Set a pointer to userdata/metadata
  Public Property Get UserData() As Long
    If Exists Then
      UserData = GetWindowLongPtrA(pHandle, apiWindowLongType.GWL_USERDATA)
    Else
      Err.Raise 1, "UserData", "Window does not exist."
    End If
  End Property
  Public Property Let UserData(ByVal newUserData As Long)
    If Exists Then
      'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
      Err.Clear

      'Set window long
      Dim hResult As Long: hResult = SetWindowLongPtrA(pHandle, apiWindowLongType.GWL_USERDATA, newUserData)

      'Check for errors
      If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "UserData [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
    Else
      Err.Raise 1, "UserData [Let]", "Window does not exist."
    End If
  End Property

  'Get/Set the WndProc of the window
  Public Property Get WndProc() As Long
    If Exists Then
      WndProc = GetWindowLongPtrA(pHandle, apiWindowLongType.GWL_WNDPROC)
    Else
      Err.Raise 1, "WndProc", "Window does not exist."
    End If
  End Property
  Public Property Let WndProc(ByVal newWndProc As Long)
    If Exists Then
      'Clear Error. See return value at https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlonga
      Err.Clear

      'Set window long
      Dim hResult As Long: hResult = SetWindowLongPtrA(pHandle, apiWindowLongType.GWL_WNDPROC, newWndProc)

      'Check for errors
      If hResult = 0 And Err.LastDllError <> 0 Then Err.Raise 1, "WndProc [Let]", "Unexpected error in SetWindowLongA", Err.LastDllError
    Else
      Err.Raise 1, "WndProc [Let]", "Window does not exist."
    End If
  End Property
#End If
  



'Get/Set ability to resize
Public Property Get Resizable() As Boolean
  'THICK FRAME style is used to determine if a window is resizable
  Resizable = Style And EWndStyles.WS_THICKFRAME
End Property
Public Property Let Resizable(ByVal v As Boolean)
  If v Then
    Style = Style Or EWndStyles.WS_THICKFRAME
  Else
    Style = Style And (Not EWndStyles.WS_THICKFRAME)
  End If
End Property


'================================================================================================
'=      PUBLIC INSTANCE METHODS
'================================================================================================


'Set hooks for a window
#If VBA7 Then
Public Function SetHook(ByVal idHook As apiWindowHookType, ByVal hook As LongPtr, hInstance As LongPtr, dwThreadID As Long) As LongPtr
#Else
Public Function SetHook(ByVal idHook As apiWindowHookType, ByVal hook As Long, hInstance As Long, dwThreadID As Long) As Long
#End If
  'TODO:
  Err.Raise 1, "SetHook", "Error: Not implemented."
End Function

'Search the Window tree for elements which match a certain criteria. Return the first element found.
'@param {ByVal stdICallable<(stdWindow,depth)=>EWndFindResult>} Callback returning
'  EWndFindResult options:
'    EWndFindResult.NoMatchFound/0/False             - Not found, countinue walking
'    EWndFindResult.MatchFound/1/-1/True             - Found, return this element
'    EWndFindResult.NoMatchCancelSearch/2            - Not found, cancel search
'    EWndFindResult.NoMatchSkipDescendents/3,else    - Not found, don't search descendents
'    EWndFindResult.MatchFoundSearchDescendents/4    - Same as EWndFindResult.MatchFound
'@param {EWndFindType=1} - The type of search, 0 for Breadth First Search (BFS) and 1 for Depth First Search (DFS).
' To understand the difference between BFS and DFS take this tree:
'        A
'       / \
'      B   C
'     /   / \
'    D   E   F
' A BFS will walk this tree in the following order: A, B, C, D, E, F
' A DFS will walk this tree in a different order:   A, C, F, E, B, D
'@param {Long=-1} Static depth limit. E.G. if you want to search children only, set this value to 1
'@examples
' ```
' 'Find where name is "hello" and class is "world":
' el.FindFirst(stdLambda.Create("$1.name=""hello"" and $1.class=""world"""))
' 'Find first element named "hello" at depth > 4:
' el.FindFirst(stdLambda.Create("$1.name = ""hello"" AND $2 > 4"))
' ```
Public Function FindFirst(ByVal query As stdICallable, Optional ByVal searchType As EWndFindType = EWndFindType.BreadthFirst, Optional ByVal iStaticDepthLimit As Long = -1) As stdWindow
    Dim stack() As tFindNode
    ReDim stack(0 To 0)
    stack(0).initialised = True
    stack(0).depth = 0
    Set stack(0).element = Me
    
    Dim Length As Long: Length = 1
    Dim index As Long: index = -1

    'Bind globals to query
    Call BindGlobals(query)

    'Loop over the stack/array
    While Length > 0 And index < Length
        Dim part As tFindNode
        Select Case searchType
            Case EWndFindType.DepthFirst
                'Depth first search, so pop the item out of the stack
                part = stackPopV(stack, Length)
            Case EWndFindType.BreadthFirst
                'Breadth first search, get item directly out of array, no need to change array size
                index = index + 1
                part = stack(index)
            Case Else
                Err.Raise 1, "stdWindow#FindFirst", "Invalid search type given. Please use EWndFindType"
        End Select
        
        With part
            If Not .initialised Then Exit Function
            
            'Run query and test options
            Select Case query.Run(.element, .depth)
                Case EWndFindResult.NoMatchFound
                    'Check static depth limit
                    If .depth + 1 <= iStaticDepthLimit Or iStaticDepthLimit = -1 Then
                        'Nothing found, search descendents
                        Dim child As stdWindow
                        For Each child In part.element.children
                            Call stackPushV(stack, Length, CreateFindNode(.depth + 1, child))
                        Next
                    End If
                Case EWndFindResult.matchFound, True, EWndFindResult.MatchFoundSearchDescendents
                    'Found, return element
                    Set FindFirst = .element
                    Exit Function
                Case EWndFindResult.NoMatchCancelSearch
                    'Nothing found, cancel function
                    Set FindFirst = Nothing
                    Exit Function
                Case EWndFindResult.NoMatchSkipDescendents
                '    Nothing found, don't search descendents
            End Select
        End With
        'Just make sure no freezing occurs
        DoEvents
    Wend
    
    'Else set to nothing
    Set FindFirst = Nothing
End Function

'Search the Window tree for elements which match a certain criteria. Return all elements found.
'@param {ByVal stdICallable<(stdWindow,depth)=>EWndFindResult>} Callback returning
'  EWndFindResult options:
'    EWndFindResult.NoMatchFound/0/False             - Not found, countinue walking
'    EWndFindResult.MatchFound/1/-1/True             - Found, return this element, won't search descendents of elements found
'    EWndFindResult.NoMatchCancelSearch/2            - Not found, cancel search
'    EWndFindResult.NoMatchSkipDescendents/3,else    - Not found, don't search descendents
'    EWndFindResult.MatchFoundSearchDescendents/4    - Found, return this element, but continue searching descendents
'@param {EWndFindType} - The type of search, 0 for Breadth First Search (BFS) and 1 for Depth First Search (DFS).
' To understand the difference between BFS and DFS take this tree:
'        A
'       / \
'      B   C
'     /   / \
'    D   E   F
' A BFS will walk this tree in the following order: A, B, C, D, E, F
' A DFS will walk this tree in a different order:   A, C, F, E, B, D
'@param {Long=-1} Static depth limit. E.G. if you want to search children only, set this value to 1
'@examples
' ```
' 'Find where name is "hello" and class is "world":
' el.FindAll(stdLambda.Create("$1.name=""hello"" and $1.class=""world"""))
' 'Find all elements with depth <= 4:
' el.FindAll(stdLambda.Create("if $2 < 4 then 4 else if $2 = 4 then 1 else 3"))
' ```
Public Function FindAll(ByVal query As stdICallable, Optional ByVal searchType As EWndFindType = EWndFindType.BreadthFirst, Optional ByVal iStaticDepthLimit As Long = -1) As collection
    Dim stack() As tFindNode
    ReDim stack(0 To 0)
    stack(0).initialised = True
    stack(0).depth = 0
    Set stack(0).element = Me
    
    Dim Length As Long: Length = 1
    Dim index As Long: index = -1
    
    'Bind globals to query
    Call BindGlobals(query)

    'Initialise collection
    Set FindAll = New collection

    'Loop over the stack/array
    While Length > 0 And index < Length
        Dim part As tFindNode
        Select Case searchType
            Case EWndFindType.DepthFirst
                'Depth first search, so pop the item out of the stack
                part = stackPopV(stack, Length)
            Case EWndFindType.BreadthFirst
                'Breadth first search, get item directly out of array, no need to change array size
                index = index + 1
                part = stack(index)
            Case Else
                Err.Raise 1, "stdWindow#FindAll", "Invalid search type given. Please use EWndFindType"
        End Select
        
        With part
            'When hitting the edge of the stack quit
            If Not .initialised Then Exit Function

            'Run query and test options
            Dim child As stdWindow
            Select Case query.Run(.element, .depth)
                Case EWndFindResult.NoMatchFound
                    'Check static depth limit
                    If .depth + 1 <= iStaticDepthLimit Or iStaticDepthLimit = -1 Then
                        'Nothing found, search descendents
                        For Each child In .element.children
                            Call stackPushV(stack, Length, CreateFindNode(.depth + 1, child))
                        Next
                    End If
                Case EWndFindResult.matchFound, True
                    'Found, add element
                    Call FindAll.Add(.element)
                Case EWndFindResult.NoMatchCancelSearch
                    'Nothing found, cancel function
                    Exit Function
                Case EWndFindResult.NoMatchSkipDescendents
                    'Nothing found, don't search descendents
                Case EWndFindResult.MatchFoundSearchDescendents
                  'Check static depth limit
                  If .depth + 1 <= iStaticDepthLimit Or iStaticDepthLimit = -1 Then
                      Call FindAll.Add(.element)
                      For Each child In .element.children
                          Call stackPushV(stack, Length, CreateFindNode(.depth + 1, child))
                      Next
                  End If
            End Select
        End With
        'Just make sure no freezing occurs
        DoEvents
    Wend
End Function



'--------------------------------------------------------------------------------
'Automate the window
'--------------------------------------------------------------------------------

Public Sub Quit()
  If Exists Then
    If DestroyWindow(pHandle) = 0 Then
      Err.Raise Err.LastDllError, "Close", "Failed to close window"
    End If
  Else
    Err.Raise 1, "Close", "Window does not exist."
  End If
End Sub

Public Sub Activate()
  If Exists Then
    Call setThreadInput(True)
      Call SetForegroundWindow(pHandle)
    Call setThreadInput(False)
  Else
    Err.Raise 1, "Minimize", "Window does not exist."
  End If
End Sub

'Get all descendents of the stdWindow
'@returns {Collection<stdWindow>} Collection of descendents
Public Function GetDescendents() As collection
  'Create collection which will be returned
  Dim c As collection
  Set c = New collection
  
  Dim child As stdWindow, desc As stdWindow
  For Each child In children
    'Add children to collection
    c.Add child
    
    'Add all descendents to collection
    For Each desc In child.GetDescendents
        c.Add desc
    Next
  Next
  
  'Return descendents
  Set GetDescendents = c
End Function

Public Sub Redraw()
  Const RDW_INVALIDATE = &H1
  Call RedrawWindow(pHandle, 0&, 0&, RDW_INVALIDATE)
End Sub

Public Function SendMessage(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  If Exists Then
    SendMessage = SendMessageA(pHandle, wMsg, wParam, lParam)
  Else
    Err.Raise 1, "SendMessage", "Window does not exist."
  End If
End Function
Public Sub PostMessage(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  If Exists Then
    'If desktop then broadcasts
    #If VBA7 Then
      Dim hwnd As LongPtr
    #Else
      Dim hwnd As Long
    #End If
    hwnd = pHandle
    If pHandle = GetDesktopWindow Then hwnd = &HFFFF
    
    If Not PostMessageA(hwnd, wMsg, wParam, lParam) Then
      Err.Raise 1, "PostMessage", "An unexpected error occurred while posting the message.", Err.LastDllError
    End If
  Else
    Err.Raise 1, "PostMessage", "Window does not exist."
  End If
End Sub

Public Function SendMessageTimeout(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal TimeoutMilliseconds As Long)
  If Exists Then
    'TODO:
    Err.Raise 1, "SendMessageTimeout", "Error: Not implemented."
  Else
    Err.Raise 1, "SendMessageTimeout", "Window does not exist."
  End If
End Function



Public Sub ClickInput(Optional ByVal x As Long = &HFFFF, Optional ByVal y As Long = &HFFFF, Optional ByVal Button As EWndMouseButton)
  'TODO:
  'If x or y are missing, then interpret them as center of window
  If x = &HFFFF Or y = &HFFFF Then
    Dim r() As Long: r = RectWindow
    If x = &HFFFF Then x = CLng((r(2) - r(0)) / 2)
    If y = &HFFFF Then y = CLng((r(3) - r(1)) / 2)
  End If

  Select Case Button
    Case LButton
    Case RButton
    Case MButton

  End Select

  'TODO: Use SendInput()
  Err.Raise 1, "ClickInput", "Error: Not implemented."
End Sub

Public Sub ClickEvent(Optional ByVal x As Long = &H10000, Optional ByVal y As Long = &H10000, Optional ByVal Button As EWndMouseButton, Optional ByVal isDoubleClick As Boolean = False, Optional ByVal wParam As Long = 0)
  'If x or y are missing, then interpret them as center of window
  If x = &HFFFF Or y = &HFFFF Then
    Dim r() As Long: r = RectWindow
    If x > &HFFFF Then x = CLng((r(2) - r(0)) / 2)
    If y > &HFFFF Then y = CLng((r(3) - r(1)) / 2)
  End If

  Const WM_LBUTTONDOWN = &H201
  Const WM_LBUTTONUP = &H202
  Const WM_LBUTTONDBLCLK = &H203
  Const WM_RBUTTONDOWN = &H204
  Const WM_RBUTTONUP = &H205
  Const WM_RBUTTONDBLCLK = &H206
  Const WM_MBUTTONDOWN = &H207
  Const WM_MBUTTONUP = &H208
  Const WM_MBUTTONDBLCLK = &H209

  Dim lParam As Long: lParam = MakeDWord(x, y)

  Select Case Button
    Case LButton
      If isDoubleClick Then
        Call PostMessage(WM_LBUTTONDBLCLK, wParam, lParam)
      Else
        Call PostMessage(WM_LBUTTONDOWN, wParam, lParam)
        Call PostMessage(WM_LBUTTONUP, wParam, lParam)
      End If
    Case RButton
      If isDoubleClick Then
        Call PostMessage(WM_RBUTTONDBLCLK, wParam, lParam)
      Else
        Call PostMessage(WM_RBUTTONDOWN, wParam, lParam)
        Call PostMessage(WM_RBUTTONUP, wParam, lParam)
      End If
    Case MButton
      If isDoubleClick Then
        Call PostMessage(WM_MBUTTONDBLCLK, wParam, lParam)
      Else
        Call PostMessage(WM_MBUTTONDOWN, wParam, lParam)
        Call PostMessage(WM_MBUTTONUP, wParam, lParam)
      End If
  End Select
End Sub

'Uses `SendInput` to send keystrokes to a window.
'@param {ByVal String} Keys to send to the window
'@param {Optional ByVal Boolean} Whether to ignore special chars or not e.g. `{Enter}`
'@param {Optional ByVal Long} Delay between each keystroke
'@remark Internally uses SendInput
Public Sub SendKeysInput(ByVal sKeys As String, Optional ByVal bRaw As Boolean = False, Optional ByVal keyDelay As Long = 0, Optional bAutoRelease As Boolean = True)
  Const INPUT_KEYBOARD As Long = 1
  Const KEYEVENTF_KEYUP = &H2
  Dim keys() As KeyToken: keys = TokeniseKeys(sKeys, bAutoRelease)
  If Exists Then
    Me.Activate
    
    'Loop over all keys
    Dim iKey As Long
    For iKey = 1 To UBound(keys)
        Dim key As KeyToken: key = keys(iKey)
        
        'Create generic key signal
        Dim inputKey As KeyboardInput
        inputKey.iType = INPUT_KEYBOARD
        inputKey.wVk = key.wVirtualKey
        inputKey.wScan = key.wScanCode
        inputKey.time = 0
        
        'Key down input
        If key.iKeyState = tap Or key.iKeyState = down Then
          inputKey.dwFlags = 0
          If SendInput(1, inputKey, LenB(inputKey)) = 0 Then
              Err.Raise Err.LastDllError, "SendKeysInput", "Input might be blocked by another thread (DLL Error: " & Err.LastDllError & ")"
          End If
          Call Sleep(keyDelay)
        End If
        
        'Key up input
        If key.iKeyState = tap Or key.iKeyState = up Then
          inputKey.dwFlags = KEYEVENTF_KEYUP
          If SendInput(1, inputKey, LenB(inputKey)) = 0 Then
              Err.Raise Err.LastDllError, "SendKeysInput", "Input might be blocked by another thread (DLL Error: " & Err.LastDllError & ")"
          End If
          Call Sleep(keyDelay)
        End If
    Next
  Else
    Err.Raise 1, "SendKeysInput", "Window does not exist."
  End If
End Sub

'Uses `kybd_event` to send keystrokes to a window.
'@param {ByVal String} Keys to send to the window
'@param {Optional ByVal Long} Delay between each keystroke
'@param {Optional ByVal Boolean} Whether keys pressed down should be auto-released
'@example `notepadWindow.sendKeysEvent("^a")`
Public Sub SendKeysEvent(ByVal sKeys As String, Optional ByVal keyDelay As Long = 10, Optional ByVal bAutoRelease As Boolean = True)
  Const KEYEVENTF_KEYUP = &H2
  Const WM_KEYDOWN = &H100
  Const WM_KEYUP = &H101
        
  Dim keys() As KeyToken: keys = TokeniseKeys(sKeys, bAutoRelease)
  If Exists Then
    Call setThreadInput(True)
      'Activate window
      Call Me.Activate
      Call Sleep(keyDelay)
      
      'Use keybd event
      For iKey = 1 To UBound(keys)
        Dim key As KeyToken: key = keys(iKey)
        
        'Loop as many times as required times
        For n = 1 To key.iTimes
          'Key down event
          If key.iKeyState = tap Or key.iKeyState = down Then
            Call keybd_event(key.wVirtualKey, key.wScanCode, 0, 0)
            Call Sleep(keyDelay)
          End If
          
          'Key up event
          If key.iKeyState = tap Or key.iKeyState = up Then
            Call keybd_event(key.wVirtualKey, key.wScanCode, KEYEVENTF_KEYUP, 0)
            Call Sleep(keyDelay)
          End If
        Next
      Next
    Call setThreadInput(False)
  Else
    Err.Raise 1, "SendKeysEvent", "Window does not exist."
  End If
End Sub

'Uses `PostMessage` to send keystrokes to a window.
'@param {ByVal String} Keys to send to the window
'@param {Optional ByVal Long} Delay between each keystroke
'@param {Optional ByVal Boolean} Whether keys pressed down should be auto-released
'@remark It should be noted that this method is extremely unstable and is unlikely to work in the majority of cases.
'@example `notepadWindow.sendKeysEvent("^a")`
Public Sub SendKeysMessage(ByVal sKeys As String, Optional ByVal keyDelay As Long = 30, Optional ByVal bAutoRelease As Boolean = True)
  Const WM_KEYDOWN = &H100
  Const WM_KEYUP = &H101
        
  Dim keys() As KeyToken: keys = TokeniseKeys(sKeys, bAutoRelease)
  If Exists Then
    Call setThreadInput(True)
      Dim iKey As Long
      For iKey = 1 To UBound(keys)
        Dim key As KeyToken: key = keys(iKey)
        
        'Loop as many times as required times
        For n = 1 To key.iTimes
          'Key down event
          If key.iKeyState = tap Or key.iKeyState = down Then
            'Assume LParam = 0. This is rarely the case but it's not usually required anyway
            Call PostMessageA(pHandle, WM_KEYDOWN, key.wVirtualKey, 0&)
            Call Sleep(keyDelay)
          End If
          
          'Key up event
          If key.iKeyState = tap Or key.iKeyState = up Then
            'Assume LParam = 0. This is rarely the case but it's not usually required anyway
            Call PostMessageA(pHandle, WM_KEYUP, key.wVirtualKey, 0&)
            Call Sleep(keyDelay)
          End If
        Next
      Next
    Call setThreadInput(False)
  Else
    Err.Raise 1, "SendKeysMessage", "Window does not exist."
  End If
End Sub

'================================================================================================
'=      PROTECTED METHODS
'================================================================================================

'Obtain the next window given a stack
Public Function protGetNextDescendent(ByVal stack As collection, ByVal DFS As Boolean, ByVal Prev As stdWindow) As stdWindow
  If stack.Count > 0 Then
    'Get the next window, use popCol if we want to do Depth First Search, else use shiftCol
    Dim oNext As stdWindow
    If DFS Then
      Set oNext = PopCol(stack)
    Else
      Set oNext = ShiftCol(stack)
    End If

    'Add all children to stack
    Dim windows As collection: Set windows = oNext.children.Object
    For Each child In windows
      stack.Add child
    Next

    'Return oNext
    Set protGetNextDescendent = oNext
  Else
    protGetNextDescendent = Null
  End If
End Function

'Returns the lookups object
'@returns {Dictionary<Dictionary<Dictionary<string|long>>>}
Public Function protGetLookups()
    If Lookups Is Nothing Then
        'Notes:
        'EWndShowStyle is not needed, use isVisible, isMinimized and isMaximised

        Set Lookups = CreateObject("Scripting.Dictionary")
        Set Lookups("EWndStyles") = CreateLookupDict(Array( _
          "WS_BORDER", &H800000, "WS_CAPTION", &HC00000, _
          "WS_CHILD", &H40000000, "WS_CHILDWINDOW", &H40000000, _
          "WS_CLIPCHILDREN", &H2000000, "WS_CLIPSIBLINGS", &H4000000, _
          "WS_DISABLED", &H8000000, "WS_DLGFRAME", &H400000, _
          "WS_GROUP", &H20000, "WS_HSCROLL", &H100000, _
          "WS_ICONIC", &H20000000, "WS_MAXIMIZE", &H1000000, _
          "WS_MAXIMIZEBOX", &H10000, "WS_MINIMIZE", &H20000000, _
          "WS_MINIMIZEBOX", &H20000, "WS_OVERLAPPED", &H0, _
          "WS_POPUP", &H80000000, "WS_SIZEBOX", &H40000, _
          "WS_SYSMENU", &H80000, "WS_TABSTOP", &H10000, _
          "WS_THICKFRAME", &H40000, "WS_TILED", &H0, _
          "WS_VISIBLE", &H10000000, "WS_VSCROLL", &H200000, _
          "WS_OVERLAPPEDWINDOW", WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX, _
          "WS_POPUPWINDOW", WS_POPUP Or WS_BORDER Or WS_SYSMENU _
        ))
        Set Lookups("EWndExStyles") = CreateLookupDict(Array( _
          "WS_EX_ACCEPTFILES", &H10, "WS_EX_APPWINDOW", &H40000, _
          "WS_EX_CLIENTEDGE", &H200, "WS_EX_COMPOSITED", &H2000000, _
          "WS_EX_CONTEXTHELP", &H400, "WS_EX_CONTROLPARENT", &H10000, _
          "WS_EX_DLGMODALFRAME", &H1, "WS_EX_LAYERED", &H80000, _
          "WS_EX_LAYOUTRTL", &H400000, "WS_EX_LEFT", &H0, _
          "WS_EX_LEFTSCROLLBAR", &H4000, "WS_EX_LTRREADING", &H0, _
          "WS_EX_MDICHILD", &H40, "WS_EX_NOACTIVATE", &H8000000, _
          "WS_EX_NOINHERITLAYOUT", &H100000, "WS_EX_NOPARENTNOTIFY", &H4, _
          "WS_EX_NOREDIRECTIONBITMAP", &H200000, "WS_EX_RIGHT", &H1000, _
          "WS_EX_RIGHTSCROLLBAR", &H0, "WS_EX_RTLREADING", &H2000, _
          "WS_EX_STATICEDGE", &H20000, "WS_EX_TOOLWINDOW", &H80, _
          "WS_EX_TOPMOST", &H8, "WS_EX_TRANSPARENT", &H20, _
          "WS_EX_WINDOWEDGE", &H100, _
          "WS_EX_OVERLAPPEDWINDOW", WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE, _
          "WS_EX_PALETTEWINDOW", WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or WS_EX_TOPMOST _
        ))
        Set Lookups("EWndFindResult") = CreateLookupDict(Array( _
          "MatchFound", EWndFindResult.matchFound, _
          "MatchFoundSearchDescendents", EWndFindResult.MatchFoundSearchDescendents, _
          "NoMatchFound", EWndFindResult.NoMatchFound, _
          "NoMatchCancelSearch", EWndFindResult.NoMatchCancelSearch, _
          "NoMatchSkipDescendents", EWndFindResult.NoMatchSkipDescendents _
        ))
        Set Lookups("EWndState") = CreateLookupDict(Array( _
          "Normal", EWndState.Normal, _
          "Maximised", EWndState.Maximised, _
          "Minimised", EWndState.Minimised _
        ))
    End If
    Set protGetLookups = Lookups
End Function


'================================================================================================
'=      PRIVATE HELPERS
'================================================================================================
'Pop a value out of the end of a collection
'@param {ByRef Collection<stdWindow>} Collection to pop value out of
'@returns {stdWindow} Window popped out of collection
Private Function PopCol(ByRef col As collection) As stdWindow
  Set PopCol = col(col.Count)
  Call col.remove(col.Count)
End Function

'Shift a value out of a collection
'@param {ByRef Collection<stdWindow>} Collection to shift value out of
'@returns {stdWindow} Window shifted out of collection
Private Function ShiftCol(ByRef col As collection) As stdWindow
  Set ShiftCol = col(1)
  Call col.remove(1)
End Function

'Obtain a DWord from the high and low parts
'@param {ByVal Integer} High word
'@param {ByVal Integer} Low word
'@returns {Long} Long dword returned as the combination of high and low word
Private Function MakeDWord(ByVal wHi As Integer, ByVal wLo As Integer) As Long
  If wHi And &H8000& Then
    MakeDWord = (((wHi And &H7FFF&) * (&HFFFF& + 1)) Or (wLo And &HFFFF&)) Or &H80000000
  Else
    MakeDWord = (wHi * &HFFFF) + wLo
  End If
End Function

'****************************************
'* HELPERS FOR FindFirst() and FindAll()
'****************************************
'Binds Enumerators to FindFirst
'@param {stdICallable} A callable that may
'@returns {VOID}
Private Sub BindGlobals(ByRef query As stdICallable)
    Dim bSuccess As Boolean
    Dim keys: keys = Lookups.keys()
    For Each key In keys
      Call query.SendMessage("bindGlobal", bSuccess, Array(key, Lookups(key)("S2N")))
    Next
End Sub

'Constructor for a tFindNode type
'@param {Long} depth of element
'@param {stdWindow} element
'@returns {tFindNode} FindNode struct
Private Function CreateFindNode(ByVal depth As Long, ByVal element As stdWindow) As tFindNode
    CreateFindNode.initialised = True
    CreateFindNode.depth = depth
    Set CreateFindNode.element = element
End Function

'Given an array `stack`, and length `index`, append `item` onto the stack
'@param {tFindNode()} stack of elements
'@param {Long} current index in stack
'@param {tFindNode} Item to insert into stack
Private Sub stackPushV(ByRef stack() As tFindNode, ByRef index As Long, ByRef Item As tFindNode)
    Dim ub As Long: ub = UBound(stack)
    Dim size As Long: size = ub + 1
    If index > ub Then
        ReDim Preserve stack(0 To size * 2)
    End If
    stack(index).initialised = Item.initialised
    stack(index).depth = Item.depth
    Set stack(index).element = Item.element
    index = index + 1
End Sub

'Given an array `stack`, and `index`=>`n`, pop the nth item off the stack. Used in DFS
'@param {tFindNode()} stack of elements
'@param {Long} current index in stack
'@returns {tFindNode} FindNode found at index
Private Function stackPopV(ByRef stack() As tFindNode, ByRef index As Variant) As tFindNode
    Dim size As Long: size = UBound(stack) + 1
    If index < size / 3 And index > minStackSize Then
        ReDim Preserve stack(0 To CLng(size / 2))
    End If
    index = index - 1
    
    stackPopV.initialised = stack(index).initialised
    stackPopV.depth = stack(index).depth
    Set stackPopV.element = stack(index).element
    stack(index).initialised = False
    stack(index).depth = 0
    Set stack(index).element = Nothing
End Function

'From an array of Key-Value pairs, create a dictionary of Key-->Value and Value-->Key lookups
'@param {Variant()} 1D array of Key,Value pairs
'@returns {Dictionary} Dictionary<{S2N: Dictionary<key,value>, N2S: Dictionary<value, key> }>
Private Function CreateLookupDict(arr As Variant) As Object
    Dim oRet As Object
    Set oRet = CreateObject("Scripting.Dictionary")
    oRet.CompareMode = 1
    Dim i As Long

    'Create string --> number dictionary
    Set oRet("S2N") = CreateObject("Scripting.Dictionary")
    oRet("S2N").CompareMode = 1
    For i = LBound(arr) To UBound(arr) Step 2
        Call oRet("S2N").Add(arr(i), arr(i + 1))
    Next

    'Create number --> string dictionary
    Set oRet("N2S") = CreateObject("Scripting.Dictionary")
    oRet("N2S").CompareMode = 1
    For i = LBound(arr) To UBound(arr) Step 2
      If isObject(arr(i)) Then
        Set oRet("N2S")(arr(i + 1)) = arr(i)
      Else
        Let oRet("N2S")(arr(i + 1)) = arr(i)
      End If
    Next

    'Return dictionary
    Set CreateLookupDict = oRet
End Function

'Create an atom class string representing an atom.
'@param {Long} Atom to convert to a string
'@returns {String} Classname representing atom
Private Function MakeIntAtom(ByVal iAtom As Long) As String
  MakeIntAtom = "#" & iAtom
End Function

'TODO: Docs
Private Sub setThreadInput(ByVal bAttach As Boolean)
    Dim dwExcelTID As Long: dwExcelTID = GetCurrentThreadId()
    Dim dwThisTID As Long: dwThisTID = GetWindowThreadProcessId(pHandle, 0)
    
    'Synchonise Excel's thread with this window's thread
    If AttachThreadInput(dwExcelTID, dwThisTID, iif(bAttach, 1, 0)) = 0 Then
        Err.Raise Err.LastDllError
    End If
End Sub

'Parses a set of keys and converts them into a KeyToken array
'@param {String} Key string to tokenise
'@returns {KeyToken()} Array of key tokens containing all data required for PostMessage / SendInput
'@example   `stdWindow.TokeniseKeys("^a{home up 3}{LControl up}")`
Private Function TokeniseKeys(ByVal sKeys As String, Optional ByVal bAutoRelease As Boolean = True) As KeyToken()
  Const MAPVK_VK_TO_VSC As Long = 0
  Dim iKeyCount As Long: iKeyCount = 0
  Dim ks() As KeyToken
  Dim sKeyExpr As String: sKeyExpr = sKeys
  Dim bModifiers(1 To 4) As Boolean
  Const MODIFIER_CONTROL = 1
  Const MODIFIER_ALT = 2
  Const MODIFIER_WIN = 3
  Const MODIFIER_SHIFT = 4
  
  'Simple keyboard expression parser
  While sKeyExpr <> ""
    'Catch infinite loop
    Dim sPrevExpr As String
    If sPrevExpr = sKeyExpr Then Err.Raise 1, "TokeniseKeys", "Expression same as previous, catching infinite loop."
    sPrevExpr = sKeyExpr
    
    'Parse token
    Dim sChar As String: sChar = Mid(sKeyExpr, 1, 1)
    Dim iVKey As EVirtualKey, iTimes As Long, iState As KeyState, iNextChar As Long, bIsUppercase As Boolean
    Select Case sChar
      Case "^"
        iVKey = VK_LCONTROL
        iTimes = 1
        iState = down
        iNextChar = 2
        bModifiers(MODIFIER_CONTROL) = True
        bIsUppercase = False
      Case "+"
        iVKey = VK_LSHIFT
        iTimes = 1
        iState = down
        iNextChar = 2
        bModifiers(MODIFIER_SHIFT) = True
        bIsUppercase = False
      Case "#"
        iVKey = VK_LWIN
        iTimes = 1
        iState = down
        iNextChar = 2
        bModifiers(MODIFIER_WIN) = True
        bIsUppercase = False
      Case "%", "!"
        iVKey = VK_LALT
        iTimes = 1
        iState = down
        iNextChar = 2
        bModifiers(MODIFIER_ALT) = True
        bIsUppercase = False
      Case " "
        iVKey = VK_SPACE
        iTimes = 1
        iState = tap
        iNextChar = 2
        bIsUppercase = False
      Case "\"
        iVKey = VKeyFromString(Mid(sKeyExpr, 2, 1))
        iTimes = 1
        iState = tap
        iNextChar = 3
        bIsUppercase = False
        
      Case "{"
        'Obtain expression to turn to key code
        Dim iExpressionEnd As Long: iExpressionEnd = InStr(1, sKeyExpr, "}")
        Dim sExpression As String: sExpression = Mid(sKeyExpr, 2, iExpressionEnd - 2)
        While InStr(1, sExpression, "  ") > 0: sExpression = Replace(sExpression, "  ", " "): Wend
        Dim vExpression: vExpression = Split(sExpression, " ")
        Dim iExpressionLen As Long: iExpressionLen = UBound(vExpression) - LBound(vExpression) + 1
        
        '1st arg is always the vkey
        Dim sSpecialKey As String: sSpecialKey = vExpression(0)
        iVKey = VKeyFromString(sSpecialKey)
        iState = tap 'Default
        iTimes = 1   'Default
        
        'Override defaults based on other arguments parsed
        'Arguments can either be UP, DOWN, TAP (key state), or a number (times key is pressed)
        Dim iArg As Long
        For iArg = 1 To UBound(vExpression)
          vArg = UCase(vExpression(iArg))
          Select Case vArg
            Case "UP"
              iState = up
            Case "DOWN"
              iState = down
            Case "TAP"
              iState = tap
            Case Else
            If IsNumeric(vArg) Then
              iTimes = CLng(vArg)
            Else
              Err.Raise 1, "TokeniseKeys", "No arg of type """ & vArg & """ allowed."
            End If
          End Select
        Next
        
        iNextChar = iExpressionEnd + 1
        bIsUppercase = False
      Case Else
        iVKey = VKeyFromString(sChar)
        iTimes = 1
        iState = tap
        iNextChar = 2
        'Note: if only havine one of the checks, characters like `5` are signalled as upper case when they aren't.
        bIsUppercase = sChar = UCase(sChar) And sChar <> LCase(sChar)
    End Select
    
    'Include shift keys for upper case letters
    If bIsUppercase Then
        ReDim Preserve ks(1 To iKeyCount + 3)
        
        With ks(iKeyCount + 1)
            .wVirtualKey = VK_LSHIFT
            .wScanCode = MapVirtualKeyA(VK_LSHIFT, MAPVK_VK_TO_VSC)
            .iKeyState = down
            .iTimes = 1
        End With
        With ks(iKeyCount + 2)
          .wVirtualKey = iVKey
          .wScanCode = MapVirtualKeyA(iVKey, MAPVK_VK_TO_VSC)
          .iKeyState = iState
          .iTimes = iTimes
        End With
        With ks(iKeyCount + 3)
            .wVirtualKey = VK_LSHIFT
            .wScanCode = MapVirtualKeyA(VK_LSHIFT, MAPVK_VK_TO_VSC)
            .iKeyState = up
            .iTimes = 1
        End With
        
        iKeyCount = iKeyCount + 3
    Else
        'Add key directly
        iKeyCount = iKeyCount + 1
        ReDim Preserve ks(1 To iKeyCount)
        With ks(iKeyCount)
          .wVirtualKey = iVKey
          .wScanCode = MapVirtualKeyA(iVKey, MAPVK_VK_TO_VSC)
          .iKeyState = iState
          .iTimes = iTimes
        End With
    End If
    
    'Trim expression
    sKeyExpr = Mid(sKeyExpr, iNextChar)
  Wend
  
  'Make sure all key down events are released
  If bAutoRelease Then
    Dim iStartKeyCount As Long: iStartKeyCount = iKeyCount
    Dim iModifier As Long, jModifier As Long
    For iModifier = 1 To iStartKeyCount
      If ks(iModifier).iKeyState = down Then
        'Check whether the key is down
        Dim isDown As Boolean: isDown = True
        For jModifier = iKeyCount To iModifier Step -1
          If ks(jModifier).wVirtualKey = ks(iModifier).wVirtualKey Then
            isDown = ks(jModifier).iKeyState = down
            Exit For
          End If
        Next
        
        'If the key is down, then add an additional key onto the end of the array releasing it
        If isDown Then
          iKeyCount = iKeyCount + 1
          ReDim Preserve ks(1 To iKeyCount)
          ks(iKeyCount).wVirtualKey = ks(iModifier).wVirtualKey
          ks(iKeyCount).wScanCode = ks(iModifier).wScanCode
          ks(iKeyCount).iTimes = 1
          ks(iKeyCount).iKeyState = up
        End If
      End If
    Next
  End If
  
  'return token list
  TokeniseKeys = ks
End Function

'Obtain VKey code from string
'@param {String} KeyName as string
'@returns {EVirtualKey}
Private Function VKeyFromString(ByRef s As String) As EVirtualKey
  Select Case UCase(s)
    Case "LBUTTON": VKeyFromString = EVirtualKey.VK_LBUTTON
    Case "RBUTTON": VKeyFromString = EVirtualKey.VK_RBUTTON
    Case "CANCEL": VKeyFromString = EVirtualKey.VK_CANCEL
    Case "MBUTTON": VKeyFromString = EVirtualKey.VK_MBUTTON
    Case "XBUTTON1": VKeyFromString = EVirtualKey.VK_XBUTTON1
    Case "XBUTTON2": VKeyFromString = EVirtualKey.VK_XBUTTON2
    Case "BACK": VKeyFromString = EVirtualKey.VK_BACK
    Case "TAB": VKeyFromString = EVirtualKey.VK_TAB
    Case "CLEAR": VKeyFromString = EVirtualKey.VK_CLEAR
    Case "RETURN": VKeyFromString = EVirtualKey.VK_RETURN
    Case "ENTER": VKeyFromString = EVirtualKey.VK_RETURN
    Case "SHIFT": VKeyFromString = EVirtualKey.VK_SHIFT
    Case "CONTROL": VKeyFromString = EVirtualKey.VK_CONTROL
    Case "ALT": VKeyFromString = EVirtualKey.VK_ALT
    Case "PAUSE": VKeyFromString = EVirtualKey.VK_PAUSE
    Case "CAPITAL": VKeyFromString = EVirtualKey.VK_CAPITAL
    Case "KANA": VKeyFromString = EVirtualKey.VK_KANA
    Case "HANGUEL": VKeyFromString = EVirtualKey.VK_HANGUEL
    Case "HANGUL": VKeyFromString = EVirtualKey.VK_HANGUL
    Case "IME_ON": VKeyFromString = EVirtualKey.VK_IME_ON
    Case "JUNJA": VKeyFromString = EVirtualKey.VK_JUNJA
    Case "FINAL": VKeyFromString = EVirtualKey.VK_FINAL
    Case "HANJA": VKeyFromString = EVirtualKey.VK_HANJA
    Case "KANJI": VKeyFromString = EVirtualKey.VK_KANJI
    Case "IME_OFF": VKeyFromString = EVirtualKey.VK_IME_OFF
    Case "ESCAPE": VKeyFromString = EVirtualKey.VK_ESCAPE
    Case "CONVERT": VKeyFromString = EVirtualKey.VK_CONVERT
    Case "NONCONVERT": VKeyFromString = EVirtualKey.VK_NONCONVERT
    Case "ACCEPT": VKeyFromString = EVirtualKey.VK_ACCEPT
    Case "MODECHANGE": VKeyFromString = EVirtualKey.VK_MODECHANGE
    Case "SPACE": VKeyFromString = EVirtualKey.VK_SPACE
    Case "PRIOR": VKeyFromString = EVirtualKey.VK_PRIOR
    Case "NEXT": VKeyFromString = EVirtualKey.VK_NEXT
    Case "END": VKeyFromString = EVirtualKey.VK_END
    Case "HOME": VKeyFromString = EVirtualKey.VK_HOME
    Case "LEFT": VKeyFromString = EVirtualKey.VK_LEFT
    Case "UP": VKeyFromString = EVirtualKey.VK_UP
    Case "RIGHT": VKeyFromString = EVirtualKey.VK_RIGHT
    Case "DOWN": VKeyFromString = EVirtualKey.VK_DOWN
    Case "SELECT": VKeyFromString = EVirtualKey.VK_SELECT
    Case "PRINT": VKeyFromString = EVirtualKey.VK_PRINT
    Case "EXECUTE": VKeyFromString = EVirtualKey.VK_EXECUTE
    Case "SNAPSHOT": VKeyFromString = EVirtualKey.VK_SNAPSHOT
    Case "INSERT": VKeyFromString = EVirtualKey.VK_INSERT
    Case "DELETE": VKeyFromString = EVirtualKey.VK_DELETE
    Case "HELP": VKeyFromString = EVirtualKey.VK_HELP
    Case "0": VKeyFromString = EVirtualKey.VK_0
    Case "1": VKeyFromString = EVirtualKey.VK_1
    Case "2": VKeyFromString = EVirtualKey.VK_2
    Case "3": VKeyFromString = EVirtualKey.VK_3
    Case "4": VKeyFromString = EVirtualKey.VK_4
    Case "5": VKeyFromString = EVirtualKey.VK_5
    Case "6": VKeyFromString = EVirtualKey.VK_6
    Case "7": VKeyFromString = EVirtualKey.VK_7
    Case "8": VKeyFromString = EVirtualKey.VK_8
    Case "9": VKeyFromString = EVirtualKey.VK_9
    Case "A": VKeyFromString = EVirtualKey.VK_A
    Case "B": VKeyFromString = EVirtualKey.VK_B
    Case "C": VKeyFromString = EVirtualKey.VK_C
    Case "D": VKeyFromString = EVirtualKey.VK_D
    Case "E": VKeyFromString = EVirtualKey.VK_E
    Case "F": VKeyFromString = EVirtualKey.VK_F
    Case "G": VKeyFromString = EVirtualKey.VK_G
    Case "H": VKeyFromString = EVirtualKey.VK_H
    Case "I": VKeyFromString = EVirtualKey.VK_I
    Case "J": VKeyFromString = EVirtualKey.VK_J
    Case "K": VKeyFromString = EVirtualKey.VK_K
    Case "L": VKeyFromString = EVirtualKey.VK_L
    Case "M": VKeyFromString = EVirtualKey.VK_M
    Case "N": VKeyFromString = EVirtualKey.VK_N
    Case "O": VKeyFromString = EVirtualKey.VK_O
    Case "P": VKeyFromString = EVirtualKey.VK_P
    Case "Q": VKeyFromString = EVirtualKey.VK_Q
    Case "R": VKeyFromString = EVirtualKey.VK_R
    Case "S": VKeyFromString = EVirtualKey.VK_S
    Case "T": VKeyFromString = EVirtualKey.VK_T
    Case "U": VKeyFromString = EVirtualKey.VK_U
    Case "V": VKeyFromString = EVirtualKey.VK_V
    Case "W": VKeyFromString = EVirtualKey.VK_W
    Case "X": VKeyFromString = EVirtualKey.VK_X
    Case "Y": VKeyFromString = EVirtualKey.VK_Y
    Case "Z": VKeyFromString = EVirtualKey.VK_Z
    Case "LWIN": VKeyFromString = EVirtualKey.VK_LWIN
    Case "RWIN": VKeyFromString = EVirtualKey.VK_RWIN
    Case "APPS": VKeyFromString = EVirtualKey.VK_APPS
    Case "SLEEP": VKeyFromString = EVirtualKey.VK_SLEEP
    Case "NUMPAD0": VKeyFromString = EVirtualKey.VK_NUMPAD0
    Case "NUMPAD1": VKeyFromString = EVirtualKey.VK_NUMPAD1
    Case "NUMPAD2": VKeyFromString = EVirtualKey.VK_NUMPAD2
    Case "NUMPAD3": VKeyFromString = EVirtualKey.VK_NUMPAD3
    Case "NUMPAD4": VKeyFromString = EVirtualKey.VK_NUMPAD4
    Case "NUMPAD5": VKeyFromString = EVirtualKey.VK_NUMPAD5
    Case "NUMPAD6": VKeyFromString = EVirtualKey.VK_NUMPAD6
    Case "NUMPAD7": VKeyFromString = EVirtualKey.VK_NUMPAD7
    Case "NUMPAD8": VKeyFromString = EVirtualKey.VK_NUMPAD8
    Case "NUMPAD9": VKeyFromString = EVirtualKey.VK_NUMPAD9
    Case "MULTIPLY": VKeyFromString = EVirtualKey.VK_MULTIPLY
    Case "ADD": VKeyFromString = EVirtualKey.VK_ADD
    Case "SEPARATOR": VKeyFromString = EVirtualKey.VK_SEPARATOR
    Case "SUBTRACT": VKeyFromString = EVirtualKey.VK_SUBTRACT
    Case "DECIMAL": VKeyFromString = EVirtualKey.VK_DECIMAL
    Case "DIVIDE": VKeyFromString = EVirtualKey.VK_DIVIDE
    Case "F1": VKeyFromString = EVirtualKey.VK_F1
    Case "F2": VKeyFromString = EVirtualKey.VK_F2
    Case "F3": VKeyFromString = EVirtualKey.VK_F3
    Case "F4": VKeyFromString = EVirtualKey.VK_F4
    Case "F5": VKeyFromString = EVirtualKey.VK_F5
    Case "F6": VKeyFromString = EVirtualKey.VK_F6
    Case "F7": VKeyFromString = EVirtualKey.VK_F7
    Case "F8": VKeyFromString = EVirtualKey.VK_F8
    Case "F9": VKeyFromString = EVirtualKey.VK_F9
    Case "F10": VKeyFromString = EVirtualKey.VK_F10
    Case "F11": VKeyFromString = EVirtualKey.VK_F11
    Case "F12": VKeyFromString = EVirtualKey.VK_F12
    Case "F13": VKeyFromString = EVirtualKey.VK_F13
    Case "F14": VKeyFromString = EVirtualKey.VK_F14
    Case "F15": VKeyFromString = EVirtualKey.VK_F15
    Case "F16": VKeyFromString = EVirtualKey.VK_F16
    Case "F17": VKeyFromString = EVirtualKey.VK_F17
    Case "F18": VKeyFromString = EVirtualKey.VK_F18
    Case "F19": VKeyFromString = EVirtualKey.VK_F19
    Case "F20": VKeyFromString = EVirtualKey.VK_F20
    Case "F21": VKeyFromString = EVirtualKey.VK_F21
    Case "F22": VKeyFromString = EVirtualKey.VK_F22
    Case "F23": VKeyFromString = EVirtualKey.VK_F23
    Case "F24": VKeyFromString = EVirtualKey.VK_F24
    Case "NUMLOCK": VKeyFromString = EVirtualKey.VK_NUMLOCK
    Case "SCROLL": VKeyFromString = EVirtualKey.VK_SCROLL
    Case "LSHIFT": VKeyFromString = EVirtualKey.VK_LSHIFT
    Case "RSHIFT": VKeyFromString = EVirtualKey.VK_RSHIFT
    Case "LCONTROL": VKeyFromString = EVirtualKey.VK_LCONTROL
    Case "RCONTROL": VKeyFromString = EVirtualKey.VK_RCONTROL
    Case "LALT": VKeyFromString = EVirtualKey.VK_LALT
    Case "RALT": VKeyFromString = EVirtualKey.VK_RALT
    Case Else
      Err.Raise 1, "VKeyFromString()", "No key """ & s & """"
  End Select
End Function

'Create an lParam key from params
'TODO: Docs
Private Function createKeyLParam(ByVal repeatCount As Long, ByVal scanCode As Long, ByVal extended As Boolean, ByVal bDown As Boolean) As Long
  createKeyLParam = repeatCount Or lshift(scanCode, 16) Or lshift(extended, 24) Or lshift(iif(bDown, 0, 1), 29) Or lshift(iif(bDown, 0, 1), 30) Or lshift(iif(bDown, 0, 1), 31)
End Function

'TODO: Docs
Private Function lshift(ByVal val As Long, ByVal nTimes As Integer) As Long
  lshift = val * 2 ^ nTimes
End Function

 

[sancarn]

Dependencies as requested - stdICallable

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "stdICallable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = false
Attribute VB_Exposed = False

'Call will call the passed function with param array
Public Function Run(ParamArray params() as variant) as variant: End Function

'Call function with supplied array of params
Public Function RunEx(ByVal params as variant) as variant: End Function

'Bind a parameter to the function
Public Function Bind(ParamArray params() as variant) as stdICallable: End Function

'Making late-bound calls to stdICallable members
'@protected
'@param {ByVal String} - Message to send
'@param {ByRef Boolean} - Whether the call was successful
'@param {ByVal Variant} - Any variant, typically parameters as an array. Passed along with the message.
'@returns {Variant} - Any return value.
Public Function SendMessage(ByVal sMessage as string, ByRef success as boolean, ByVal params as variant) as Variant: End Function

'Ideally we would want to get a pointer to the function... However, getting a pointer to an object method is
'going to be defficult, partly due to the first parameter sent to the function is `Me`! We'll likely have to
'use machine code to wrap a call with a `Me` pointer just so we can access the full pointer and use this in
'real life applications.
'Finally it might be better to do something more like: `stdPointer.fromICallable()` anyway
  ''Returns a callback function
  ''Typically this will be achieved with `stdPointer.GetLastPrivateMethod(me)`
  ''If this cannot be implemented return 0
  'Public Function ToPointer() as long

''Bind arguments to functions to appear as first arguments in call.
''e.g. stdLambda.Create("$1.EnableEvents = false: $1.ScreenUpdating = false").bind(Application).Run()
'Public Function Bind(ByVal v as variant) as stdICallable: End Function