Merge pull request rubberduck-vba#8 from MSO-dlx/main

updated repo from my previous pull request (rubberduck-vba#6/rubberduck-vba#7 textbox_change())

src/AppContext.cls

@@ -51,7 +51,7 @@ Attribute Create.VB_Description = "Creates a new MVVM application context."
     Set Result = New MVVM.AppContext
     Result.DebugOutput = DebugOutput
 
-    'temporal coupling: IStringFormatterFactory instance needs to be set before we init the binding manager.
+    'temporal coupling: IStringFormatterVBFactory instance needs to be set before we init the binding manager.
     InitStringFormatterFactory Result, FormatterFactory
 
     'more temporal coupling...
@@ -68,10 +68,10 @@ Private Sub InitStringFormatterFactory(ByVal Context As MVVM.AppContext, ByVal F
         Select Case This.DefaultStringFormatSyntax
 
             Case StringFormatterStrategy.UseDotNetStringFormatSyntax
-                Set Factory = New MVVM.StringFormatterFactory
+                Set Factory = New MVVM.StringFormatterNetFactory
 
             Case StringFormatterStrategy.UseVBStringFormatSyntax
-                Set Factory = New MVVM.VBStringFormatterFactory
+                Set Factory = New MVVM.StringFormatterVBFactory
 
         End Select
     Else

src/BindingManager.cls

@@ -38,7 +38,7 @@ Public Function Create(ByVal Context As IAppContext, ByVal StringFormatFactory A
     Result.DebugOutput = DebugOutput
 
     If StringFormatFactory Is Nothing Then
-        Set Result.StringFormatterFactory = New StringFormatterFactory
+        Set Result.StringFormatterFactory = New StringFormatterNetFactory
     Else
         Set Result.StringFormatterFactory = StringFormatFactory
     End If

src/BindingManagerTests.bas

@@ -58,7 +58,7 @@ End Sub
 Private Sub TestInitialize()
     Set Test.CommandManager = New TestCommandManager
     Set Test.CommandManagerStub = Test.CommandManager
-    Set Test.ConcreteSUT = BindingManager.Create(Test.CommandManager, New StringFormatterFactory)
+    Set Test.ConcreteSUT = BindingManager.Create(Test.CommandManager, New StringFormatterNetFactory)
     Set Test.AbstractSUT = Test.ConcreteSUT
     Set Test.HandlePropertyChangedSUT = Test.ConcreteSUT
     Set Test.BindingSource = New TestBindingObject
@@ -109,7 +109,7 @@ Private Sub Create_GuardsNonDefaultInstance()
     With New BindingManager
         On Error Resume Next
             '@Ignore FunctionReturnValueDiscarded, FunctionReturnValueNotUsed
-            .Create Test.CommandManager, New StringFormatterFactory
+            .Create Test.CommandManager, New StringFormatterNetFactory
             ExpectError
         On Error GoTo 0
     End With

src/BindingPath.cls

@@ -127,7 +127,7 @@ Private Sub IBindingPath_Resolve()
 End Sub
 
 Private Function IBindingPath_ToString() As String
-    IBindingPath_ToString = StringBuilder _
+    IBindingPath_ToString = StringBuilderNet _
         .AppendFormat("Context: {0}; Path: {1}", TypeName(This.Context), This.Path) _
         .ToString
 End Function

src/ComboBoxPropertyBinding.cls

@@ -126,6 +126,9 @@ End Sub
 Private Sub IHandleControlEvents_HandleBeforeUpdate(ByRef Cancel As Boolean)
 End Sub
 
+Private Sub IHandleControlEvents_HandleChange()
+End Sub
+
 Private Sub IHandleControlEvents_HandleEnter()
 End Sub
 

src/ControlEventsPunk.cls

@@ -28,7 +28,7 @@ End Type
 #If VBA7 Then
 Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal Punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal PunkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
 #Else
-Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
+Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal Punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal PunkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
 #End If
 
 Private Type TState
@@ -120,6 +120,14 @@ Attribute OnEnter.VB_UserMemId = -2147384830
         Handler.HandleEnter
     Next
 End Sub
+'VF: added: required to capture Cut/Paste and Backspace/Delete in TextBox, replaced OnKeyPress in TextBox
+'@Description "A callback that handles MSForms.Control.Change events for the registered target control."
+Public Sub OnChange()
+    Dim Handler As IHandleControlEvents
+    For Each Handler In This.Handlers
+        Handler.HandleChange
+    Next
+End Sub
 
 '@Description "Registers the specified object to handle the relayed control events."
 Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents)
@@ -145,6 +153,10 @@ End Sub
 Private Sub IControlEvents_OnBeforeUpdate(ByVal Cancel As MSForms.IReturnBoolean)
     OnBeforeUpdate Cancel
 End Sub
+'VF: added: required to capture Cut/Paste and Backspace/Delete in TextBox control, basically replacing OnKeyPress in TextBox
+Private Sub IControlEvents_OnChange()
+    OnChange
+End Sub
 
 Private Sub IControlEvents_OnEnter()
     OnEnter

src/CustomErrors.bas

@@ -5,7 +5,7 @@ Attribute VB_Description = "Global, general-purpose procedures involving run-tim
 Option Explicit
 Option Private Module
 
-Public Const CustomError As Long = vbObjectError Or 32
+Public Const CustomError As Long = vbObjectError Or 32 'QUESTION: VF: why this value?
 
 '@Description("Re-raises the current error, if there is one.")
 Public Sub RethrowOnError()

src/DecimalKeyValidator.cls

@@ -15,6 +15,7 @@ Option Explicit
 Implements IValueValidator
 
 Private SeparatorChar As String
+Private UpdtSourceTrigger As MVVM.BindingUpdateSourceTrigger 'avoid being called twice
 
 Private Sub Class_Initialize()
     SeparatorChar = VBA.Strings.Format$(0, ".")
@@ -53,9 +54,25 @@ Private Function IsBindingTargetEmpty(ByVal Target As IBindingPath) As Boolean
 End Function
 
 Private Property Get IValueValidator_Message() As String
-    IValueValidator_Message = "Value must be numeric."
+    'IValueValidator_Message = "Value must be numeric."
+    'VF: reworded to reflect different logic/trigger
+    IValueValidator_Message = "Numeric value required."
 End Property
 
 Private Property Get IValueValidator_Trigger() As BindingUpdateSourceTrigger
-    IValueValidator_Trigger = OnKeyPress
+    'VF: funnel through OnChange to capture cut/paste and backspace/delete
+    'avoid being called twice
+    If UpdtSourceTrigger = NotSetYet Then
+        Select Case MsgBox("Trigger validation of numeric textboxes 'OnChange'?" & vbCr & vbCr & "No = Trigger 'OnKeyPress' (as originally, which means not capturing cut/paste and backspace/delete in the textboxes)", vbQuestion + vbYesNo, TypeName(Me))
+            Case vbYes
+                'but deletes entire string ...as of now
+                'IValueValidator_Trigger = OnChange
+                UpdtSourceTrigger = OnChange
+            Case Else
+                'IValueValidator_Trigger = OnKeyPress
+                UpdtSourceTrigger = OnKeyPress
+        End Select
+    Else
+        IValueValidator_Trigger = UpdtSourceTrigger
+    End If
 End Property

src/Disposable.cls

@@ -18,7 +18,7 @@ Option Explicit
 Public Function TryDispose(ByVal Target As Object, Optional ByVal TryLateBound As Boolean = False) As Boolean
 Attribute TryDispose.VB_Description = "True if a Dispose method was successfully invoked (early-bound IDisposable.Dispose unless specified otherwise)."
     Dim DisposableTarget As IDisposable
-    If TryCast(Target, outResult:=DisposableTarget) Then
+    If TryCastToDisposable(Target, outResult:=DisposableTarget) Then
         DisposableTarget.Dispose
         TryDispose = True
     ElseIf TryLateBound Then
@@ -29,9 +29,9 @@ Attribute TryDispose.VB_Description = "True if a Dispose method was successfully
     End If
 End Function
 
-Private Function TryCast(ByVal Target As Object, ByRef outResult As IDisposable) As Boolean
+Private Function TryCastToDisposable(ByVal Target As Object, ByRef outResult As IDisposable) As Boolean
     If TypeOf Target Is IDisposable Then
         Set outResult = Target
-        TryCast = True
+        TryCastToDisposable = True
     End If
 End Function

src/DynamicControls.cls

@@ -197,9 +197,19 @@ Private Function IDynamicControlBuilder_TextBoxFor(ByVal SourceValue As IBinding
     Set Result = This.Container.Add(MVVM.FormsProgID.TextBoxProgId)
 
     Dim Trigger As BindingUpdateSourceTrigger
-    If Validator Is Nothing Then
-        Trigger = Validator.Trigger
-    End If
+'    'VF: Logic error?: would always be zero and that means never // missing: if not validator is nothing then ??? trigger not picked up from validator
+'    'is updated later. Why not set here and skip update later?
+'    If Validator Is Nothing Then
+'        Trigger = Validator.Trigger '= 0 that is never
+''    '    'VF:
+''    '    Else ' set value of validator
+''    '        Trigger = Validator.Trigger
+''    '    End If
+'    End If
+    'VF: simplifies to unconditional
+    'but causes DecimalValuator::IValueValidator_Trigger() to be called twice
+    Trigger = Validator.Trigger
+
 
     This.Context.Bindings.BindPropertyPath SourceValue.Context, SourceValue.Path, Result, _
         StringFormat:=FormatString, _

src/Example.bas

@@ -2,6 +2,15 @@ Attribute VB_Name = "Example"
 '@Folder MVVM.Example
 Option Explicit
 
+'VF: Windows 10 is having a hard time handling multiple monitors, especially if different resolutions and more so if legacy applications like the VBE
+    'keeps shrinking the userform in the VBE and thus showing the shrunk form <- must counteract this ugly Windows bug by specifying Height and Width of IView
+    'rendering engine was changed from 2010 to 2013
+    'should go into IView, shouldn't it?
+Public Type TViewDims
+    Height As Long
+    Width As Long
+End Type
+
 '@Description "Runs the MVVM example UI."
 Public Sub Run()
 Attribute Run.VB_Description = "Runs the MVVM example UI."
@@ -48,8 +57,22 @@ Public Sub DynamicRun()
     Set ViewModel = ExampleViewModel.Create
 
     Dim View As IView
-    Set View = ExampleDynamicView.Create(Context, ViewModel)
-
+    Dim ViewDims As TViewDims
+    'VF: in non-dynamic userforms like ExampleView the controls stay put so I use the right bottom most controls as anchor point like Me.Width = LastControl.left+LastControl.width + OffsetWidthPerOfficeVersion <- yes, userform are rendered differently depending on the version of Office 2007, ....
+        'if sizing dynamically I would proceed likewise somehow with the (right bottom most) container <- is going to take quite an amount of code :-(
+    With ViewDims
+        .Height = 180 'some value that work in 2019, and somehow in 2010, too
+        .Width = 230
+    End With
+    Set View = ExampleDynamicView.Create(Context, ViewModel, ViewDims)
+    'or keep factory .Create 'clean'?
+'    With ExampleDynamicView.Create(Context, ViewModel, ViewDims)
+'        .SizeView 'not implemented
+'        .ShowDialog
+'        'payload DoSomething if not cancelled
+'    End With
+
     Debug.Print View.ShowDialog
 
 End Sub
+