├── LICENSE ├── MVVM.xlsm ├── README.md └── src ├── AcceptCommand.cls ├── AggregateErrorFormatter.cls ├── AppContext.cls ├── BindingManager.cls ├── BindingManagerTests.bas ├── BindingPath.cls ├── BindingPathTests.bas ├── BrowseCommand.cls ├── CancelCommand.cls ├── CaptionBindingStrategy.cls ├── CaptionPropertyBinding.cls ├── CheckBoxBindingStrategy.cls ├── CheckBoxPropertyBinding.cls ├── ComboBoxBindingStrategy.cls ├── ComboBoxPropertyBinding.cls ├── CommandBinding.cls ├── CommandButtonBindingStrategy.cls ├── CommandManager.cls ├── CommandManagerTests.bas ├── ContainerLayout.cls ├── ControlEventsPunk.cls ├── CustomErrors.bas ├── DecimalKeyValidator.cls ├── DefaultErrorAdornerFactory.cls ├── Disposable.cls ├── DynamicControlPosition.cls ├── DynamicControls.cls ├── Example.bas ├── ExampleDynamicView.frm ├── ExampleDynamicView.frx ├── ExampleView.frm ├── ExampleView.frx ├── ExampleViewModel.cls ├── ExploreTextboxEvents.frm ├── ExploreTextboxEvents.frx ├── FormsProgID.bas ├── GuardClauses.bas ├── IAppContext.cls ├── IBindingManager.cls ├── IBindingPath.cls ├── IBindingTargetStrategy.cls ├── ICancellable.cls ├── ICommand.cls ├── ICommandBinding.cls ├── ICommandManager.cls ├── IContainerLayout.cls ├── IControlEvents.cls ├── IDisposable.cls ├── IDynamicAdorner.cls ├── IDynamicAdornerFactory.cls ├── IDynamicContainerPanel.cls ├── IDynamicControlBuilder.cls ├── IDynamicPanel.cls ├── IDynamicPosition.cls ├── IHandleControlEvents.cls ├── IHandlePropertyChanged.cls ├── IHandleValidationError.cls ├── INotifierFactory.cls ├── INotifyPropertyChanged.cls ├── INotifyValidationError.cls ├── IPropertyBinding.cls ├── IStringFormatter.cls ├── IStringFormatterFactory.cls ├── ITestStub.cls ├── IValidationError.cls ├── IValidationErrorFormatter.cls ├── IValidationManager.cls ├── IValueConverter.cls ├── IValueValidator.cls ├── IView.cls ├── InverseBooleanConverter.cls ├── LayoutPanel.cls ├── ListBoxBindingStrategy.cls ├── ListBoxPropertyBinding.cls ├── MultiPageBindingStrategy.cls ├── MultiPagePropertyBinding.cls ├── NotifierBaseFactory.cls ├── OneWayPropertyBinding.cls ├── OptionButtonBindingStrategy.cls ├── OptionButtonPropertyBinding.cls ├── PropertyBindingBase.cls ├── PropertyChangeNotifierBase.cls ├── RequiredStringValidator.cls ├── Resources.frm ├── Resources.frx ├── ScrollBarBindingStrategy.cls ├── ScrollBarPropertyBinding.cls ├── Sheet1.doccls ├── Sheet2.doccls ├── Sheet3.doccls ├── SpinButtonBindingStrategy.cls ├── SpinButtonPropertyBinding.cls ├── StringBuilderNet.cls ├── StringFormatterNet.cls ├── StringFormatterNetFactory.cls ├── StringFormatterVB.cls ├── StringFormatterVBFactory.cls ├── StringToDateConverter.cls ├── TabStripBindingStrategy.cls ├── TabStripPropertyBinding.cls ├── TestBindingManager.cls ├── TestBindingObject.cls ├── TestCommand.cls ├── TestCommandManager.cls ├── TestNotifierFactory.cls ├── TestPropertyBinding.cls ├── TestPropertyChangeNotifier.cls ├── TestStubBase.cls ├── TestValueValidator.cls ├── TestView.cls ├── TextBoxBindingStrategy.cls ├── TextBoxPropertyBinding.cls ├── ThisWorkbook.doccls ├── ValidationError.cls ├── ValidationErrorAdorner.cls ├── ValidationErrorFormatter.cls ├── ValidationErrors.cls ├── ValidationManager.cls ├── ValidationManagerTests.bas ├── ValueRangeValidator.cls ├── WorksheetAreaPropertyBinding.cls ├── WorksheetCellBindingStrategy.cls ├── WorksheetCellPropertyBinding.cls └── WorksheetValidationAdorner.cls /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Mathieu Guindon 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /MVVM.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/MVVM.xlsm -------------------------------------------------------------------------------- /src/AcceptCommand.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "AcceptCommand" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A command that closes (hides) a View, enabled when the ViewModel is valid." 11 | '@Folder MVVM.Common.Commands 12 | '@ModuleDescription "A command that closes (hides) a View, enabled when the ViewModel is valid." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements ICommand 17 | 18 | Private Type TState 19 | View As IView 20 | ValidationManager As IValidationManager 21 | End Type 22 | 23 | Private This As TState 24 | 25 | '@Description "Creates a new instance of this command." 26 | Public Function Create(ByVal View As IView, ByVal ValidationManager As IValidationManager) As ICommand 27 | Attribute Create.VB_Description = "Creates a new instance of this command." 28 | GuardClauses.GuardNonDefaultInstance Me, AcceptCommand 29 | GuardClauses.GuardNullReference View, TypeName(Me), "View cannot be Nothing." 30 | GuardClauses.GuardNullReference ValidationManager, TypeName(Me), "ValidationManager cannot be Nothing." 31 | Dim Result As AcceptCommand 32 | Set Result = New AcceptCommand 33 | Set Result.View = View 34 | Set Result.ValidationManager = ValidationManager 35 | Set Create = Result 36 | End Function 37 | 38 | Public Property Get View() As IView 39 | Set View = This.View 40 | End Property 41 | 42 | Friend Property Set View(ByVal RHS As IView) 43 | GuardClauses.GuardDefaultInstance Me, AcceptCommand 44 | GuardClauses.GuardDoubleInitialization This.View, TypeName(Me) 45 | Set This.View = RHS 46 | End Property 47 | 48 | Public Property Get ValidationManager() As IValidationManager 49 | Set ValidationManager = This.ValidationManager 50 | End Property 51 | 52 | Friend Property Set ValidationManager(ByVal RHS As IValidationManager) 53 | GuardClauses.GuardDefaultInstance Me, AcceptCommand 54 | GuardClauses.GuardDoubleInitialization This.ValidationManager, TypeName(Me) 55 | Set This.ValidationManager = RHS 56 | End Property 57 | 58 | Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean 59 | ICommand_CanExecute = This.ValidationManager.IsValid(Context) 60 | End Function 61 | 62 | Private Property Get ICommand_Description() As String 63 | ICommand_Description = "Accept changes and close." 64 | End Property 65 | 66 | Private Sub ICommand_Execute(ByVal Context As Object) 67 | This.View.Hide 68 | End Sub 69 | -------------------------------------------------------------------------------- /src/AggregateErrorFormatter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "AggregateErrorFormatter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A composite error formatter implementation." 11 | '@Folder MVVM.Infrastructure.Validation.ErrorFormatting 12 | '@ModuleDescription "A composite error formatter implementation." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IValidationErrorFormatter 17 | 18 | Private Const AutoPropertyName As String = "AUTO" 19 | 20 | Private Type TState 21 | Context As Object 22 | PropertyName As String 23 | Formatters As Collection 24 | End Type 25 | 26 | Private This As TState 27 | 28 | '@Description "Creates a new composite formatter that aggregates/combines all the specified formatters." 29 | Public Function Create(ParamArray Formatters() As Variant) As IValidationErrorFormatter 30 | Attribute Create.VB_Description = "Creates a new composite formatter that aggregates/combines all the specified formatters." 31 | GuardClauses.GuardNonDefaultInstance Me, AggregateErrorFormatter, TypeName(Me) 32 | GuardClauses.GuardExpression UBound(Formatters) < 0, TypeName(Me), "At least one formatter is required." 33 | 34 | Dim Result As AggregateErrorFormatter 35 | Set Result = New AggregateErrorFormatter 36 | 37 | 'handle ParamArray proxy args: 38 | Dim LocalFormatters() As Variant 39 | If IsArray(Formatters(0)) Then 40 | LocalFormatters = Formatters(0) 41 | Else 42 | ReDim LocalFormatters(UBound(Formatters)) 43 | Dim j As Long 44 | For j = 0 To UBound(LocalFormatters) 45 | LocalFormatters(j) = Formatters(j) 46 | Next 47 | End If 48 | 49 | Dim i As Long 50 | For i = LBound(LocalFormatters) To UBound(LocalFormatters) 51 | 52 | If Not IsEmpty(LocalFormatters(i)) And Not LocalFormatters(i) Is Nothing Then 53 | Dim Formatter As IValidationErrorFormatter 54 | On Error Resume Next 55 | Set Formatter = LocalFormatters(i) 56 | On Error GoTo 0 57 | If Not Formatter Is Nothing Then Result.AddFormatter Formatter 58 | End If 59 | 60 | Next 61 | 62 | Set Create = Result 63 | 64 | End Function 65 | 66 | '@Description "Adds the specified formatter to this composite formatter." 67 | Public Sub AddFormatter(ByVal Formatter As IValidationErrorFormatter) 68 | Attribute AddFormatter.VB_Description = "Adds the specified formatter to this composite formatter." 69 | GuardClauses.GuardDefaultInstance Me, AggregateErrorFormatter, TypeName(Me) 70 | GuardClauses.GuardNullReference Formatter 71 | 72 | This.Formatters.Add Formatter 73 | 74 | End Sub 75 | 76 | Private Property Get IsDefaultInstance() As Boolean 77 | IsDefaultInstance = Me Is AggregateErrorFormatter 78 | End Property 79 | 80 | Private Sub Class_Initialize() 81 | If Not IsDefaultInstance Then Set This.Formatters = New Collection 82 | End Sub 83 | 84 | Private Sub IValidationErrorFormatter_Apply(ByVal Target As Object, ByVal Message As String) 85 | Dim Formatter As IValidationErrorFormatter 86 | For Each Formatter In This.Formatters 87 | Formatter.Apply Target, Message 88 | Next 89 | End Sub 90 | 91 | Private Sub IValidationErrorFormatter_Restore(ByVal Target As Object) 92 | Dim Formatter As IValidationErrorFormatter 93 | For Each Formatter In This.Formatters 94 | Formatter.Restore Target 95 | Next 96 | End Sub 97 | -------------------------------------------------------------------------------- /src/BrowseCommand.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "BrowseCommand" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Example 11 | Option Explicit 12 | Implements ICommand 13 | 14 | Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean 15 | If TypeOf Context Is ExampleViewModel Then 16 | Dim ViewModel As ExampleViewModel 17 | Set ViewModel = Context 18 | ICommand_CanExecute = ViewModel.SomeOtherOption 19 | End If 20 | End Function 21 | 22 | Private Property Get ICommand_Description() As String 23 | ICommand_Description = "Browse for source file..." 24 | End Property 25 | 26 | Private Sub ICommand_Execute(ByVal Context As Object) 27 | Dim ViewModel As ExampleViewModel 28 | Set ViewModel = Context 29 | 30 | ViewModel.SomeFilePath = "TEST" 31 | 32 | MsgBox "Implement me!", vbInformation, "Hello from " & TypeName(Me) 33 | End Sub 34 | -------------------------------------------------------------------------------- /src/CancelCommand.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CancelCommand" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A command that closes (hides) a cancellable View in a cancelled state." 11 | '@Folder MVVM.Common.Commands 12 | '@ModuleDescription "A command that closes (hides) a cancellable View in a cancelled state." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements ICommand 17 | 18 | Private Type TState 19 | View As ICancellable 20 | End Type 21 | 22 | Private This As TState 23 | 24 | '@Description "Creates a new instance of this command." 25 | Public Function Create(ByVal View As ICancellable) As ICommand 26 | Attribute Create.VB_Description = "Creates a new instance of this command." 27 | Dim Result As CancelCommand 28 | Set Result = New CancelCommand 29 | Set Result.View = View 30 | Set Create = Result 31 | End Function 32 | 33 | Public Property Get View() As ICancellable 34 | Set View = This.View 35 | End Property 36 | 37 | Public Property Set View(ByVal RHS As ICancellable) 38 | GuardClauses.GuardDoubleInitialization This.View, TypeName(Me) 39 | Set This.View = RHS 40 | End Property 41 | 42 | Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean 43 | ICommand_CanExecute = True 44 | End Function 45 | 46 | Private Property Get ICommand_Description() As String 47 | ICommand_Description = "Cancel pending changes and close." 48 | End Property 49 | 50 | Private Sub ICommand_Execute(ByVal Context As Object) 51 | This.View.OnCancel 52 | End Sub 53 | -------------------------------------------------------------------------------- /src/CaptionBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CaptionBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A target binding strategy that creates a CaptionPropertyBinding by default, or a OneWayPropertyBinding given a target property path." 11 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 12 | '@ModuleDescription "A target binding strategy that creates a CaptionPropertyBinding by default, or a OneWayPropertyBinding given a target property path." 13 | Option Explicit 14 | Implements IBindingTargetStrategy 15 | 16 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 17 | ByVal Mode As BindingMode, _ 18 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 19 | ByVal Validator As IValueValidator, _ 20 | ByVal Converter As IValueConverter, _ 21 | ByVal StringFormat As IStringFormatter, _ 22 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 23 | 24 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = CaptionPropertyBinding _ 25 | .Create(Context, Source, Target, _ 26 | Validator:=Validator, _ 27 | StringFormat:=StringFormat, _ 28 | Converter:=Converter, _ 29 | ValidationAdorner:=ValidationAdorner) 30 | 31 | End Function 32 | 33 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 34 | ByVal Mode As BindingMode, _ 35 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 36 | ByVal Validator As IValueValidator, _ 37 | ByVal Converter As IValueConverter, _ 38 | ByVal StringFormat As IStringFormatter, _ 39 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 40 | 41 | Set IBindingTargetStrategy_PropertyBindingFor = OneWayPropertyBinding _ 42 | .Create(Context, Source, Target, _ 43 | Validator:=Validator, _ 44 | StringFormat:=StringFormat, _ 45 | Converter:=Converter, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/CaptionPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CaptionPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A property binding that binds any property of any source, one-way to any property of a UI element target." 11 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 12 | '@ModuleDescription "A property binding that binds any property of any source, one-way to any property of a UI element target." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IPropertyBinding 17 | Implements IDisposable 18 | Implements IHandlePropertyChanged 19 | 20 | Private Const DefaultTargetControlProperty As String = "Caption" 21 | 22 | Private Type TState 23 | Base As PropertyBindingBase 24 | Handler As IHandlePropertyChanged 25 | End Type 26 | 27 | Private This As TState 28 | 29 | Public Property Get DefaultTargetProperty() As String 30 | DefaultTargetProperty = DefaultTargetControlProperty 31 | End Property 32 | 33 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 34 | Optional ByVal Validator As IValueValidator, _ 35 | Optional ByVal Converter As IValueConverter, _ 36 | Optional ByVal StringFormat As IStringFormatter, _ 37 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Dim BindingBase As PropertyBindingBase 40 | Set BindingBase = PropertyBindingBase.Create(Context, Source, Target, _ 41 | TargetPropertyPath:=DefaultTargetProperty, _ 42 | Mode:=BindingMode.OneWayBinding, _ 43 | UpdateSource:=BindingUpdateSourceTrigger.Never, _ 44 | Validator:=Validator, _ 45 | Converter:=Converter, _ 46 | StringFormat:=StringFormat, _ 47 | ValidationAdorner:=ValidationAdorner) 48 | 49 | Dim Result As CaptionPropertyBinding 50 | Set Result = New CaptionPropertyBinding 51 | 52 | If Not Validator Is Nothing Then 53 | BindingBase.AsINotifyValidationError.RegisterHandler ValidationManager 54 | End If 55 | 56 | Result.InjectBindingInfo BindingBase 57 | Set Create = Result 58 | 59 | End Function 60 | 61 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 62 | GuardClauses.GuardDefaultInstance Me, CaptionPropertyBinding, TypeName(Me) 63 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 64 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 65 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 66 | Set This.Base = BindingInfo 67 | Set This.Handler = BindingInfo 68 | End Sub 69 | 70 | Private Property Get IsDefaultInstance() As Boolean 71 | IsDefaultInstance = Me Is TextBoxPropertyBinding 72 | End Property 73 | 74 | Private Sub IDisposable_Dispose() 75 | Set This.Handler = Nothing 76 | Disposable.TryDispose This.Base 77 | Set This.Base = Nothing 78 | End Sub 79 | 80 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 81 | This.Handler.HandlePropertyChanged Source, PropertyName 82 | End Sub 83 | 84 | Private Sub IPropertyBinding_Apply() 85 | This.Base.Apply 86 | End Sub 87 | 88 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 89 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 90 | End Property 91 | 92 | Private Property Get IPropertyBinding_Converter() As IValueConverter 93 | Set IPropertyBinding_Converter = This.Base.Converter 94 | End Property 95 | 96 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 97 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 98 | End Property 99 | 100 | Private Property Get IPropertyBinding_Mode() As BindingMode 101 | IPropertyBinding_Mode = This.Base.Mode 102 | End Property 103 | 104 | Private Property Get IPropertyBinding_Source() As IBindingPath 105 | Set IPropertyBinding_Source = This.Base.Source 106 | End Property 107 | 108 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 109 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 110 | End Property 111 | 112 | Private Property Get IPropertyBinding_Target() As IBindingPath 113 | Set IPropertyBinding_Target = This.Base.Target 114 | End Property 115 | 116 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 117 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 118 | End Property 119 | 120 | Private Property Get IPropertyBinding_Validator() As IValueValidator 121 | Set IPropertyBinding_Validator = This.Base.Validator 122 | End Property 123 | 124 | -------------------------------------------------------------------------------- /src/CheckBoxBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CheckBoxBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = CheckBoxPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = CheckBoxPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.PropertyName, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | StringFormat:=StringFormat, _ 45 | Converter:=Converter, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | 50 | -------------------------------------------------------------------------------- /src/ComboBoxBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ComboBoxBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = ComboBoxPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = ComboBoxPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/CommandButtonBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CommandButtonBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A target binding strategy that creates a CaptionPropertyBinding by default, or a OneWayPropertyBinding given a target property path." 11 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 12 | '@ModuleDescription "A target binding strategy that creates a CaptionPropertyBinding by default, or a OneWayPropertyBinding given a target property path." 13 | Option Explicit 14 | Implements IBindingTargetStrategy 15 | 16 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 17 | ByVal Mode As BindingMode, _ 18 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 19 | ByVal Validator As IValueValidator, _ 20 | ByVal Converter As IValueConverter, _ 21 | ByVal StringFormat As IStringFormatter, _ 22 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 23 | 24 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = CaptionPropertyBinding _ 25 | .Create(Context, Source, Target, _ 26 | Validator:=Validator, _ 27 | StringFormat:=StringFormat, _ 28 | Converter:=Converter, _ 29 | ValidationAdorner:=ValidationAdorner) 30 | 31 | End Function 32 | 33 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 34 | ByVal Mode As BindingMode, _ 35 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 36 | ByVal Validator As IValueValidator, _ 37 | ByVal Converter As IValueConverter, _ 38 | ByVal StringFormat As IStringFormatter, _ 39 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 40 | 41 | Set IBindingTargetStrategy_PropertyBindingFor = OneWayPropertyBinding _ 42 | .Create(Context, Source, Target, _ 43 | Validator:=Validator, _ 44 | StringFormat:=StringFormat, _ 45 | Converter:=Converter, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/CommandManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CommandManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object responsible for managing command bindings." 11 | '@Folder MVVM.Infrastructure.Bindings.CommandBindings 12 | '@ModuleDescription "An object responsible for managing command bindings." 13 | '@Exposed 14 | Option Explicit 15 | Implements ICommandManager 16 | Implements IDisposable 17 | 18 | Private Type TState 19 | CommandBindings As Collection 20 | DebugOutput As Boolean 21 | End Type 22 | 23 | Private This As TState 24 | 25 | '@Description "Gets/sets a value indicating whether the object produces debugger output." 26 | Public Property Get DebugOutput() As Boolean 27 | Attribute DebugOutput.VB_Description = "Gets/sets a value indicating whether the object produces debugger output." 28 | DebugOutput = This.DebugOutput 29 | End Property 30 | 31 | Public Property Let DebugOutput(ByVal RHS As Boolean) 32 | This.DebugOutput = RHS 33 | End Property 34 | 35 | '@Description "Releases all held ICommandBinding references, prepares the object for proper destruction." 36 | Public Sub Dispose() 37 | Attribute Dispose.VB_Description = "Releases all held ICommandBinding references, prepares the object for proper destruction." 38 | '@Ignore VariableNotUsed 39 | Dim Index As Long 40 | For Index = 1 To This.CommandBindings.Count 41 | Disposable.TryDispose This.CommandBindings.Item(This.CommandBindings.Count) 42 | This.CommandBindings.Remove This.CommandBindings.Count 43 | Next 44 | Set This.CommandBindings = Nothing 45 | End Sub 46 | 47 | Private Sub EvaluateCanExecute(ByVal BindingContext As Object) 48 | Dim Binding As ICommandBinding 49 | For Each Binding In This.CommandBindings 50 | Binding.EvaluateCanExecute BindingContext 51 | Next 52 | End Sub 53 | 54 | Private Sub DebugMessage(ByVal Message As String) 55 | If This.DebugOutput Then Debug.Print TypeName(Me) & ": " & Message 56 | End Sub 57 | 58 | Private Sub Class_Initialize() 59 | Set This.CommandBindings = New Collection 60 | End Sub 61 | 62 | Private Function ICommandManager_BindCommand(ByVal BindingContext As Object, ByVal Target As Object, ByVal Command As ICommand) As ICommandBinding 63 | GuardClauses.GuardNullReference BindingContext, TypeName(Me) 64 | GuardClauses.GuardNullReference Target, TypeName(Me) 65 | GuardClauses.GuardNullReference Command, TypeName(Me) 66 | 'GuardClauses.GuardDefaultInstance Me, CommandManager 67 | 68 | Dim Binding As ICommandBinding 69 | 70 | Select Case True 71 | 72 | Case TypeOf Target Is MSForms.CommandButton 73 | Set Binding = CommandBinding.ForCommandButton(Target, Command, BindingContext) 74 | 75 | Case TypeOf Target Is MSForms.Image 76 | Set Binding = CommandBinding.ForImage(Target, Command, BindingContext) 77 | 78 | Case TypeOf Target Is MSForms.Label 79 | Set Binding = CommandBinding.ForLabel(Target, Command, BindingContext) 80 | 81 | Case TypeOf Target Is MSForms.CheckBox 82 | Set Binding = CommandBinding.ForCheckBox(Target, Command, BindingContext) 83 | 84 | Case Else 85 | GuardClauses.GuardExpression True, TypeName(BindingContext), "Target type '" & TypeName(Target) & "' does not currently support command bindings." 86 | 87 | End Select 88 | 89 | This.CommandBindings.Add Binding 90 | Set ICommandManager_BindCommand = Binding 91 | 92 | DebugMessage "Created CommandBinding for " & TypeName(Command) & "." 93 | 94 | End Function 95 | 96 | Private Sub ICommandManager_EvaluateCanExecute(ByVal BindingContext As Object) 97 | EvaluateCanExecute BindingContext 98 | End Sub 99 | 100 | Private Sub IDisposable_Dispose() 101 | Dispose 102 | End Sub 103 | 104 | -------------------------------------------------------------------------------- /src/CommandManagerTests.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "CommandManagerTests" 2 | '@Folder Tests.Bindings 3 | '@TestModule 4 | Option Explicit 5 | Option Private Module 6 | 7 | #Const LateBind = LateBindTests 8 | #If LateBind Then 9 | Private Assert As Object 10 | #Else 11 | Private Assert As Rubberduck.AssertClass 12 | #End If 13 | 14 | Private Type TState 15 | ExpectedErrNumber As Long 16 | ExpectedErrSource As String 17 | ExpectedErrorCaught As Boolean 18 | 19 | ConcreteSUT As CommandManager 20 | AbstractSUT As ICommandManager 21 | 22 | BindingContext As TestBindingObject 23 | Command As TestCommand 24 | 25 | End Type 26 | 27 | Private Test As TState 28 | 29 | '@ModuleInitialize 30 | Private Sub ModuleInitialize() 31 | #If LateBind Then 32 | 'requires HKCU registration of the Rubberduck COM library. 33 | Set Assert = CreateObject("Rubberduck.PermissiveAssertClass") 34 | #Else 35 | 'requires project reference to the Rubberduck COM library. 36 | Set Assert = New Rubberduck.PermissiveAssertClass 37 | #End If 38 | End Sub 39 | 40 | '@ModuleCleanup 41 | Private Sub ModuleCleanup() 42 | Set Assert = Nothing 43 | End Sub 44 | 45 | '@TestInitialize 46 | Private Sub TestInitialize() 47 | Set Test.ConcreteSUT = New CommandManager 48 | Set Test.AbstractSUT = Test.ConcreteSUT 49 | Set Test.BindingContext = New TestBindingObject 50 | Set Test.Command = New TestCommand 51 | End Sub 52 | 53 | '@TestCleanup 54 | Private Sub TestCleanup() 55 | Set Test.ConcreteSUT = Nothing 56 | Set Test.AbstractSUT = Nothing 57 | Set Test.BindingContext = Nothing 58 | Set Test.Command = Nothing 59 | End Sub 60 | 61 | Private Sub ExpectError() 62 | Dim Message As String 63 | If Err.Number = Test.ExpectedErrNumber Then 64 | If (Test.ExpectedErrSource = vbNullString) Or (Err.Source = Test.ExpectedErrSource) Then 65 | Test.ExpectedErrorCaught = True 66 | Else 67 | Message = "An error was raised, but not from the expected source. " & _ 68 | "Expected: '" & TypeName(Test.ConcreteSUT) & "'; Actual: '" & Err.Source & "'." 69 | End If 70 | ElseIf Err.Number <> 0 Then 71 | Message = "An error was raised, but not with the expected number. Expected: '" & Test.ExpectedErrNumber & "'; Actual: '" & Err.Number & "'." 72 | Else 73 | Message = "No error was raised." 74 | End If 75 | 76 | If Not Test.ExpectedErrorCaught Then Assert.Fail Message 77 | End Sub 78 | 79 | Private Function DefaultTargetCommandBindingFor(ByVal ProgID As String, ByRef outTarget As Object) As ICommandBinding 80 | Set outTarget = CreateObject(ProgID) 81 | Set DefaultTargetCommandBindingFor = Test.AbstractSUT.BindCommand(Test.BindingContext, outTarget, Test.Command) 82 | End Function 83 | 84 | '@TestMethod("DefaultCommandTargetBindings") 85 | Private Sub BindCommand_BindsCommandButton() 86 | Dim Target As Object 87 | With DefaultTargetCommandBindingFor(FormsProgID.CommandButtonProgId, outTarget:=Target) 88 | Assert.AreSame Test.Command, .Command 89 | Assert.AreSame Target, .Target 90 | End With 91 | End Sub 92 | 93 | '@TestMethod("DefaultCommandTargetBindings") 94 | Private Sub BindCommand_BindsCheckBox() 95 | Dim Target As Object 96 | With DefaultTargetCommandBindingFor(FormsProgID.CheckBoxProgId, outTarget:=Target) 97 | Assert.AreSame Test.Command, .Command 98 | Assert.AreSame Target, .Target 99 | End With 100 | End Sub 101 | 102 | '@TestMethod("DefaultCommandTargetBindings") 103 | Private Sub BindCommand_BindsImage() 104 | Dim Target As Object 105 | With DefaultTargetCommandBindingFor(FormsProgID.ImageProgId, outTarget:=Target) 106 | Assert.AreSame Test.Command, .Command 107 | Assert.AreSame Target, .Target 108 | End With 109 | End Sub 110 | 111 | '@TestMethod("DefaultCommandTargetBindings") 112 | Private Sub BindCommand_BindsLabel() 113 | Dim Target As Object 114 | With DefaultTargetCommandBindingFor(FormsProgID.LabelProgId, outTarget:=Target) 115 | Assert.AreSame Test.Command, .Command 116 | Assert.AreSame Target, .Target 117 | End With 118 | End Sub 119 | 120 | 121 | -------------------------------------------------------------------------------- /src/ContainerLayout.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ContainerLayout" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Encapsulates basic layout logic for dynamic MSForms controls." 11 | '@Folder MVVM.Infrastructure.View.Dynamic 12 | '@ModuleDescription "Encapsulates basic layout logic for dynamic MSForms controls." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IContainerLayout 17 | 18 | Private Type TState 19 | Parent As MSForms.Controls 20 | Direction As LayoutDirection 21 | NextControlTop As Long 22 | NextControlLeft As Long 23 | Margin As Long 24 | End Type 25 | 26 | Private Const DefaultMargin As Long = 3 27 | 28 | Private This As TState 29 | 30 | Public Function Create(ByVal Parent As MSForms.Controls, Optional ByVal Direction As LayoutDirection, Optional ByVal Top As Long = 0, Optional ByVal Left As Long = 0, Optional ByVal Margin As Long = DefaultMargin) As IContainerLayout 31 | Dim Result As ContainerLayout 32 | Set Result = New ContainerLayout 33 | Set Result.Parent = Parent 34 | Result.NextControlTop = Top + Margin 35 | Result.NextControlLeft = Left + Margin 36 | Result.Direction = Direction 37 | Result.Margin = Margin 38 | Set Create = Result 39 | End Function 40 | 41 | Public Property Get Parent() As MSForms.Controls 42 | Set Parent = This.Parent 43 | End Property 44 | 45 | Public Property Set Parent(ByVal RHS As MSForms.Controls) 46 | Set This.Parent = RHS 47 | End Property 48 | 49 | Public Property Get NextControlTop() As Long 50 | NextControlTop = This.NextControlTop 51 | End Property 52 | 53 | Public Property Let NextControlTop(ByVal RHS As Long) 54 | This.NextControlTop = RHS 55 | End Property 56 | 57 | Public Property Get NextControlLeft() As Long 58 | NextControlLeft = This.NextControlLeft 59 | End Property 60 | 61 | Public Property Let NextControlLeft(ByVal RHS As Long) 62 | This.NextControlLeft = RHS 63 | End Property 64 | 65 | Public Property Get Direction() As LayoutDirection 66 | Direction = This.Direction 67 | End Property 68 | 69 | Public Property Let Direction(ByVal RHS As LayoutDirection) 70 | This.Direction = RHS 71 | End Property 72 | 73 | Public Property Get Margin() As Long 74 | Margin = This.Margin 75 | End Property 76 | 77 | Public Property Let Margin(ByVal RHS As Long) 78 | This.Margin = RHS 79 | End Property 80 | 81 | Private Sub OffsetControlSize(ByVal Control As MSForms.Control, ByVal Margin As Long) 82 | Select Case This.Direction 83 | 84 | Case LayoutDirection.TopToBottom 85 | This.NextControlTop = Control.Top + Control.Height + Margin 86 | 87 | Case LayoutDirection.LeftToRight 88 | This.NextControlLeft = Control.Left + Control.Width + Margin 89 | 90 | Case Else 91 | Debug.Assert False ' not implemented... 92 | 93 | End Select 94 | End Sub 95 | 96 | Private Function IContainerLayout_Add(ByVal ProgID As String, Optional ByVal Height As Variant, Optional ByVal Width As Variant, Optional ByVal ApplyMargin As Boolean = True) As Object 97 | Dim Result As Control 98 | Set Result = This.Parent.Add(ProgID) 99 | 100 | Result.Top = This.NextControlTop 101 | Result.Left = This.NextControlLeft 102 | 103 | If Not IsMissing(Height) Then 104 | Result.Height = Height 105 | End If 106 | 107 | If Not IsMissing(Width) Then 108 | Result.Width = Width 109 | End If 110 | 111 | OffsetControlSize Result, IIf(ApplyMargin, This.Margin, 0) 112 | Set IContainerLayout_Add = Result 113 | 114 | End Function 115 | 116 | Private Sub IContainerLayout_SkipPosition(Optional ByVal Margin As Long) 117 | Select Case This.Direction 118 | 119 | Case LayoutDirection.TopToBottom 120 | This.NextControlTop = This.NextControlTop + IIf(Margin > 0, Margin, This.Margin * 2) 121 | 122 | Case LayoutDirection.LeftToRight 123 | This.NextControlLeft = This.NextControlLeft + IIf(Margin > 0, Margin, This.Margin * 2) 124 | 125 | End Select 126 | End Sub 127 | -------------------------------------------------------------------------------- /src/CustomErrors.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "CustomErrors" 2 | Attribute VB_Description = "Global, general-purpose procedures involving run-time errors." 3 | '@Folder MVVM.CustomErrors 4 | '@ModuleDescription("Global, general-purpose procedures involving run-time errors.") 5 | Option Explicit 6 | Option Private Module 7 | 8 | Public Const CustomError As Long = vbObjectError Or 32 'QUESTION: VF: why this value? 9 | 10 | '@Description("Re-raises the current error, if there is one.") 11 | Public Sub RethrowOnError() 12 | Attribute RethrowOnError.VB_Description = "Re-raises the current error, if there is one." 13 | With VBA.Information.Err 14 | If .Number <> 0 Then 15 | Debug.Print "Error " & .Number, .Description 16 | .Raise .Number 17 | End If 18 | End With 19 | End Sub 20 | -------------------------------------------------------------------------------- /src/DecimalKeyValidator.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "DecimalKeyValidator" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A key validator that allows numeric and decimal separator inputs." 11 | '@Folder MVVM.Common.Validators 12 | '@ModuleDescription "A key validator that allows numeric and decimal separator inputs." 13 | '@Exposed 14 | Option Explicit 15 | Implements IValueValidator 16 | 17 | Private SeparatorChar As String 18 | Private UpdtSourceTrigger As MVVM.BindingUpdateSourceTrigger 'avoid being called twice 19 | 20 | Private Sub Class_Initialize() 21 | SeparatorChar = VBA.Strings.Format$(0, ".") 22 | End Sub 23 | 24 | Private Function IValueValidator_IsValid(ByVal Value As Variant, ByVal Source As IBindingPath, ByVal Target As IBindingPath) As Boolean 25 | Dim Result As Boolean 26 | Result = IsNumeric(Value) 27 | 28 | If Value = SeparatorChar Then 29 | 30 | Dim SourceValue As String 31 | If Source.TryReadPropertyValue(outValue:=SourceValue) Then 32 | 'decimal separator character is legal if there aren't any already 33 | Dim TargetValue As String 34 | If Target.TryReadPropertyValue(outValue:=TargetValue) Then 35 | If SourceValue = 0 Or IsBindingTargetEmpty(Target) Then 36 | TargetValue = vbNullString 37 | End If 38 | Dim Separators As Long 39 | Separators = Len(TargetValue) - Len(Replace(TargetValue, SeparatorChar, vbNullString)) 40 | Result = Separators = 0 41 | End If 42 | End If 43 | End If 44 | 45 | IValueValidator_IsValid = Result 46 | End Function 47 | 48 | Private Function IsBindingTargetEmpty(ByVal Target As IBindingPath) As Boolean 49 | 'TargetValue may be string-formatted; if all the content is selected, treat it as empty. 50 | On Error Resume Next 51 | 'late-bound member calls should work against TextBox-like controls 52 | IsBindingTargetEmpty = Target.Context.SelLength = Target.Context.TextLength 53 | On Error GoTo 0 54 | End Function 55 | 56 | Private Property Get IValueValidator_Message() As String 57 | 'IValueValidator_Message = "Value must be numeric." 58 | 'VF: reworded to reflect different logic/trigger 59 | IValueValidator_Message = "Numeric value required." 60 | End Property 61 | 62 | Private Property Get IValueValidator_Trigger() As BindingUpdateSourceTrigger 63 | 'VF: funnel through OnChange to capture cut/paste and backspace/delete 64 | 'avoid being called twice 65 | If UpdtSourceTrigger = NotSetYet Then 66 | 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)) 67 | Case vbYes 68 | 'but deletes entire string ...as of now 69 | 'IValueValidator_Trigger = OnChange 70 | UpdtSourceTrigger = OnChange 71 | Case Else 72 | 'IValueValidator_Trigger = OnKeyPress 73 | UpdtSourceTrigger = OnKeyPress 74 | End Select 75 | Else 76 | IValueValidator_Trigger = UpdtSourceTrigger 77 | End If 78 | End Property 79 | -------------------------------------------------------------------------------- /src/DefaultErrorAdornerFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "DefaultErrorAdornerFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A factory that creates default validation error adorners." 11 | '@Folder MVVM.Infrastructure.View.Dynamic 12 | '@ModuleDescription "A factory that creates default validation error adorners." 13 | '@Exposed 14 | Option Explicit 15 | Implements IDynamicAdornerFactory 16 | 17 | Private Function IDynamicAdornerFactory_Create(ByVal Target As Object) As IDynamicAdorner 18 | Dim Result As IDynamicAdorner 19 | Select Case True 20 | 21 | Case TypeOf Target Is MSForms.TextBox 22 | Set Result = ValidationErrorAdorner.Create(Target, LabelPosition:=DynamicControlPosition.Create(AboveLeft, 0)) 23 | 24 | Case TypeOf Target Is MSForms.ComboBox 25 | Set Result = ValidationErrorAdorner.Create(Target, IconPosition:=DynamicControlPosition.Create(InsideRight, 0, TopMargin:=3, RightMargin:=12)) 26 | 27 | Case Else 28 | Debug.Print "A dynamic adorner was requested, but the target type isn't supported." 29 | 30 | End Select 31 | Set IDynamicAdornerFactory_Create = Result 32 | End Function 33 | -------------------------------------------------------------------------------- /src/Disposable.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "Disposable" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that encapsulates the necessary casting operation to invoke IDisposable.Dispose." 11 | '@Folder MVVM.Infrastructure 12 | '@ModuleDescription "An object that encapsulates the necessary casting operation to invoke IDisposable.Dispose." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "True if a Dispose method was successfully invoked (early-bound IDisposable.Dispose unless specified otherwise)." 18 | Public Function TryDispose(ByVal Target As Object, Optional ByVal TryLateBound As Boolean = False) As Boolean 19 | Attribute TryDispose.VB_Description = "True if a Dispose method was successfully invoked (early-bound IDisposable.Dispose unless specified otherwise)." 20 | Dim DisposableTarget As IDisposable 21 | If TryCastToDisposable(Target, outResult:=DisposableTarget) Then 22 | DisposableTarget.Dispose 23 | TryDispose = True 24 | ElseIf TryLateBound Then 25 | On Error Resume Next 26 | Target.Dispose 27 | TryDispose = (Err.Number = 0) 28 | On Error GoTo 0 29 | End If 30 | End Function 31 | 32 | Private Function TryCastToDisposable(ByVal Target As Object, ByRef outResult As IDisposable) As Boolean 33 | If TypeOf Target Is IDisposable Then 34 | Set outResult = Target 35 | TryCastToDisposable = True 36 | End If 37 | End Function 38 | -------------------------------------------------------------------------------- /src/DynamicControlPosition.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "DynamicControlPosition" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents the relative position and margin of a dynamic adorner component." 11 | '@Folder MVVM.Infrastructure.Validation.ErrorFormatting 12 | '@ModuleDescription "Represents the relative position and margin of a dynamic adorner component." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IDynamicPosition 17 | 18 | Private Type TState 19 | Position As MVVM.RelativePosition 20 | LeftMargin As Double 21 | TopMargin As Double 22 | RightMargin As Double 23 | BottomMargin As Double 24 | End Type 25 | 26 | Private This As TState 27 | 28 | Public Function Create(ByVal Position As RelativePosition, ByVal LeftMargin As Double, Optional ByVal TopMargin As Variant, Optional ByVal RightMargin As Variant, Optional ByVal BottomMargin As Variant) As IDynamicPosition 29 | GuardClauses.GuardNonDefaultInstance Me, MVVM.DynamicControlPosition 30 | 31 | Dim Result As MVVM.DynamicControlPosition 32 | Set Result = New MVVM.DynamicControlPosition 33 | Result.Position = Position 34 | 35 | 'if only left margin is specified, the margin applies to all sides. 36 | 'if only left and top margins are specified, left+right match, and top+bottom match. 37 | 'thus: Margin.Create(6) makes a margin of 6 units on all sides. 38 | ' Margin.Create(6, 3) makes a margin of 6 units left & right, and 3 units top & bottom. 39 | ' Margin.Create(6, 2, 3) makes a margin of 6 units left, 3 units right, and 2 units top & bottom. 40 | 41 | Result.Margin(LeftSide) = LeftMargin 42 | 43 | If IsMissing(RightMargin) Then 44 | 'if unspecified, assume same as left 45 | Result.Margin(RightSide) = Result.Margin(LeftSide) 46 | Else 47 | Result.Margin(RightSide) = RightMargin 48 | End If 49 | 50 | If IsMissing(TopMargin) Then 51 | 'if unspecified, assume same as left 52 | Result.Margin(TopSide) = Result.Margin(LeftSide) 53 | Else 54 | Result.Margin(TopSide) = TopMargin 55 | End If 56 | 57 | If IsMissing(BottomMargin) Then 58 | 'if unspecified, assume same as top 59 | Result.Margin(BottomSide) = Result.Margin(TopSide) 60 | Else 61 | Result.Margin(BottomSide) = BottomMargin 62 | End If 63 | 64 | Set Create = Result 65 | End Function 66 | 67 | Public Property Get Margin(ByVal Side As MarginSide) As Double 68 | Select Case Side 69 | Case MarginSide.BottomSide 70 | Margin = This.BottomMargin 71 | Case MarginSide.LeftSide 72 | Margin = This.LeftMargin 73 | Case MarginSide.RightSide 74 | Margin = This.RightMargin 75 | Case MarginSide.TopSide 76 | Margin = This.TopMargin 77 | End Select 78 | End Property 79 | 80 | Friend Property Let Margin(ByVal Side As MarginSide, ByVal RHS As Double) 81 | Select Case Side 82 | Case MarginSide.BottomSide 83 | This.BottomMargin = RHS 84 | Case MarginSide.LeftSide 85 | This.LeftMargin = RHS 86 | Case MarginSide.RightSide 87 | This.RightMargin = RHS 88 | Case MarginSide.TopSide 89 | This.TopMargin = RHS 90 | End Select 91 | End Property 92 | 93 | Public Property Get Position() As MVVM.RelativePosition 94 | Position = This.Position 95 | End Property 96 | 97 | Friend Property Let Position(ByVal RHS As MVVM.RelativePosition) 98 | This.Position = RHS 99 | End Property 100 | 101 | Private Property Get IDynamicPosition_Margin(ByVal Side As MarginSide) As Double 102 | IDynamicPosition_Margin = Me.Margin(Side) 103 | End Property 104 | 105 | Private Property Get IDynamicPosition_Position() As RelativePosition 106 | IDynamicPosition_Position = This.Position 107 | End Property 108 | -------------------------------------------------------------------------------- /src/Example.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Example" 2 | '@Folder MVVM.Example 3 | Option Explicit 4 | 5 | 'VF: Windows 10 is having a hard time handling multiple monitors, especially if different resolutions and more so if legacy applications like the VBE 6 | '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 7 | 'rendering engine was changed from 2010 to 2013 8 | 'should go into IView, shouldn't it? 9 | Public Type TViewDims 10 | Height As Long 11 | Width As Long 12 | End Type 13 | 14 | '@Description "Runs the MVVM example UI." 15 | Public Sub Run() 16 | Attribute Run.VB_Description = "Runs the MVVM example UI." 17 | 'here a more elaborate application would wire-up dependencies for complex commands, 18 | 'and then property-inject them into the ViewModel via a factory method e.g. SomeViewModel.Create(args). 19 | 20 | Dim ViewModel As ExampleViewModel 21 | Set ViewModel = ExampleViewModel.Create 22 | 23 | 'ViewModel properties can be set before or after it's wired to the View. 24 | 'ViewModel.SourcePath = "TEST" 25 | ViewModel.SomeOption = True 26 | 27 | Set ViewModel.SomeCommand = New BrowseCommand 28 | 29 | Dim App As AppContext 30 | Set App = AppContext.Create(DebugOutput:=True) 31 | 32 | ViewModel.BooleanProperty = False 33 | ViewModel.ByteProperty = 240 34 | ViewModel.DateProperty = VBA.DateTime.Now + 2 35 | ViewModel.DoubleProperty = 85 36 | ViewModel.StringProperty = "Beta" 37 | ViewModel.LongProperty = -42 38 | 39 | Dim View As IView 40 | Set View = ExampleView.Create(App, ViewModel) 41 | 42 | If View.ShowDialog Then 43 | Debug.Print ViewModel.SomeFilePath, ViewModel.SomeOption, ViewModel.SomeOtherOption 44 | Else 45 | Debug.Print "Dialog was cancelled." 46 | End If 47 | 48 | Disposable.TryDispose App 49 | 50 | End Sub 51 | 52 | Public Sub DynamicRun() 53 | Dim Context As IAppContext 54 | Set Context = AppContext.Create 55 | 56 | Dim ViewModel As ExampleViewModel 57 | Set ViewModel = ExampleViewModel.Create 58 | 59 | Dim View As IView 60 | Dim ViewDims As TViewDims 61 | '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, .... 62 | 'if sizing dynamically I would proceed likewise somehow with the (right bottom most) container <- is going to take quite an amount of code :-( 63 | With ViewDims 64 | .Height = 180 'some value that work in 2019, and somehow in 2010, too 65 | .Width = 230 66 | End With 67 | Set View = ExampleDynamicView.Create(Context, ViewModel, ViewDims) 68 | 'or keep factory .Create 'clean'? 69 | ' With ExampleDynamicView.Create(Context, ViewModel, ViewDims) 70 | ' .SizeView 'not implemented 71 | ' .ShowDialog 72 | ' 'payload DoSomething if not cancelled 73 | ' End With 74 | 75 | Debug.Print View.ShowDialog 76 | 77 | End Sub 78 | 79 | -------------------------------------------------------------------------------- /src/ExampleDynamicView.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ExampleDynamicView 3 | Caption = "ExampleDynamicView" 4 | ClientHeight = 288 5 | ClientLeft = -456 6 | ClientTop = -1512 7 | ClientWidth = 84 8 | OleObjectBlob = "ExampleDynamicView.frx":0000 9 | StartUpPosition = 1 'CenterOwner 10 | End 11 | Attribute VB_Name = "ExampleDynamicView" 12 | Attribute VB_GlobalNameSpace = False 13 | Attribute VB_Creatable = False 14 | Attribute VB_PredeclaredId = True 15 | Attribute VB_Exposed = False 16 | '@Folder MVVM.Example 17 | Option Explicit 18 | Implements IView 19 | Implements ICancellable 20 | 21 | Private Type TState 22 | Context As MVVM.IAppContext 23 | ViewModel As ExampleViewModel 24 | IsCancelled As Boolean 25 | End Type 26 | 27 | Private This As TState 28 | 29 | '@Description "Creates a new instance of this form." 30 | Public Function Create(ByVal Context As MVVM.IAppContext, ByVal ViewModel As ExampleViewModel, ViewDims As TViewDims) As IView 31 | Attribute Create.VB_Description = "Creates a new instance of this form." 32 | Dim Result As ExampleDynamicView 33 | Set Result = New ExampleDynamicView 34 | Set Result.Context = Context 35 | Set Result.ViewModel = ViewModel 36 | With Result 37 | .Height = ViewDims.Height 38 | .Width = ViewDims.Width 39 | End With 40 | Set Create = Result 41 | End Function 42 | 43 | Public Property Get Context() As MVVM.IAppContext 44 | Set Context = This.Context 45 | End Property 46 | 47 | Public Property Set Context(ByVal RHS As MVVM.IAppContext) 48 | Set This.Context = RHS 49 | End Property 50 | 51 | Public Property Get ViewModel() As Object 52 | Set ViewModel = This.ViewModel 53 | End Property 54 | 55 | Public Property Set ViewModel(ByVal RHS As Object) 56 | Set This.ViewModel = RHS 57 | End Property 58 | 59 | Public Sub SizeView(Height As Long, Width As Long) 60 | With Me 61 | .Height = Height 62 | .Width = Width 63 | End With 64 | End Sub 65 | 66 | Private Sub OnCancel() 67 | This.IsCancelled = True 68 | Me.Hide 69 | End Sub 70 | 71 | Private Sub InitializeView() 72 | 73 | Dim Layout As IContainerLayout 74 | Set Layout = ContainerLayout.Create(Me.Controls, TopToBottom) 75 | 76 | With DynamicControls.Create(This.Context, Layout) 77 | 78 | With .LabelFor("All controls on this form are created at run-time.") 79 | .Font.Bold = True 80 | End With 81 | 82 | .LabelFor BindingPath.Create(This.ViewModel, "Instructions") 83 | 84 | 'VF: refactor free string to some enum PropertyName ("StringProperty", "CurrencyProperty") throughout (?) [when I frame a question mark in parentheses is not really a question but a rhetorical question, meaning I am pretty sure of the correct answer] 85 | .TextBoxFor BindingPath.Create(This.ViewModel, "StringProperty"), _ 86 | Validator:=New RequiredStringValidator, _ 87 | TitleSource:="Some String:" 88 | 89 | .TextBoxFor BindingPath.Create(This.ViewModel, "CurrencyProperty"), _ 90 | FormatString:="{0:C2}", _ 91 | Validator:=New DecimalKeyValidator, _ 92 | TitleSource:="Some Amount:" 93 | 94 | 'ToDo: 'VF: needs validation .CanExecute(This.Context) before .Show 95 | '(as textbox1 has focus and is empty and when moving to this close button, tb1 is validated and OnClick is disabled leaving the user out in the rain) 96 | .CommandButtonFor AcceptCommand.Create(Me, This.Context.Validation), This.ViewModel, "Close" 97 | 98 | End With 99 | 100 | This.Context.Bindings.Apply This.ViewModel 101 | End Sub 102 | 103 | Private Property Get ICancellable_IsCancelled() As Boolean 104 | ICancellable_IsCancelled = This.IsCancelled 105 | End Property 106 | 107 | Private Sub ICancellable_OnCancel() 108 | OnCancel 109 | End Sub 110 | 111 | Private Sub IView_Hide() 112 | Me.Hide 113 | End Sub 114 | 115 | Private Sub IView_Show() 116 | InitializeView 117 | Me.Show vbModal 118 | End Sub 119 | 120 | Private Function IView_ShowDialog() As Boolean 121 | InitializeView 122 | Me.Show vbModal 123 | IView_ShowDialog = Not This.IsCancelled 124 | End Function 125 | 126 | Private Property Get IView_ViewModel() As Object 127 | Set IView_ViewModel = This.ViewModel 128 | End Property 129 | 130 | Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 131 | If CloseMode = VbQueryClose.vbFormControlMenu Then 132 | Cancel = True 133 | OnCancel 134 | End If 135 | End Sub 136 | -------------------------------------------------------------------------------- /src/ExampleDynamicView.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/src/ExampleDynamicView.frx -------------------------------------------------------------------------------- /src/ExampleView.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/src/ExampleView.frx -------------------------------------------------------------------------------- /src/ExploreTextboxEvents.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ExploreTextboxEvents 3 | Caption = "UserForm1" 4 | ClientHeight = 1404 5 | ClientLeft = -48 6 | ClientTop = -192 7 | ClientWidth = 744 8 | OleObjectBlob = "ExploreTextboxEvents.frx":0000 9 | StartUpPosition = 1 'CenterOwner 10 | End 11 | Attribute VB_Name = "ExploreTextboxEvents" 12 | Attribute VB_GlobalNameSpace = False 13 | Attribute VB_Creatable = False 14 | Attribute VB_PredeclaredId = True 15 | Attribute VB_Exposed = False 16 | '#VF_CanBeDeleted 17 | '@Description: "'VF: userform used for exploring textbox events to capture cut and paste to identify suitable validation trigger; turned out to be _Change" 18 | Option Explicit 19 | 20 | Private Sub TextBox1_AfterUpdate() 21 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_AfterUpdate" 22 | End Sub 23 | 24 | Private Sub TextBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) 25 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_BeforeDropOrPaste" 26 | End Sub 27 | 28 | Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) 29 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_BeforeUpdate" 30 | End Sub 31 | 32 | 'VF: implement OnChange for Textbox paste/delete/cut easiest captured by _change, alternatively fiddle with KeyCodes 33 | Private Sub TextBox1_Change() 34 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_Change" 35 | End Sub 36 | 37 | Private Sub TextBox1_Enter() 38 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_Enter" 39 | End Sub 40 | 41 | Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 42 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_Exit" 43 | End Sub 44 | 45 | Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 46 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_KeyDown" 47 | End Sub 48 | 49 | Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 50 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_KeyPress" 51 | End Sub 52 | 53 | Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 54 | Label1.Caption = Label1.Caption & vbLf & "TextBox1_KeyUp" 55 | End Sub 56 | 57 | -------------------------------------------------------------------------------- /src/ExploreTextboxEvents.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/src/ExploreTextboxEvents.frx -------------------------------------------------------------------------------- /src/FormsProgID.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "FormsProgID" 2 | '@Folder MVVM.Constants 3 | Option Explicit 4 | 5 | Public Const CheckBoxProgId As String = "Forms.CheckBox.1" 6 | Public Const CommandButtonProgId As String = "Forms.CommandButton.1" 7 | Public Const ComboBoxProgId As String = "Forms.ComboBox.1" 8 | Public Const FrameProgId As String = "Forms.Frame.1" 9 | Public Const ImageProgId As String = "Forms.Image.1" 10 | Public Const LabelProgId As String = "Forms.Label.1" 11 | Public Const ListBoxProgId As String = "Forms.ListBox.1" 12 | Public Const MultiPageProgId As String = "Forms.MultiPage.1" 13 | Public Const OptionButtonProgId As String = "Forms.OptionButton.1" 14 | Public Const ScrollBarProgId As String = "Forms.ScrollBar.1" 15 | Public Const SpinButtonProgId As String = "Forms.SpinButton.1" 16 | Public Const TabStripProgId As String = "Forms.TabStrip.1" 17 | Public Const TextBoxProgId As String = "Forms.TextBox.1" 18 | -------------------------------------------------------------------------------- /src/GuardClauses.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "GuardClauses" 2 | Attribute VB_Description = "Global procedures for throwing custom run-time errors in guard clauses." 3 | '@Folder MVVM.CustomErrors 4 | '@ModuleDescription("Global procedures for throwing custom run-time errors in guard clauses.") 5 | Option Explicit 6 | Option Private Module 7 | 8 | Public Enum GuardClauseErrors 9 | InvalidFromNonDefaultInstance = CustomError + 1 10 | InvalidFromDefaultInstance 11 | ObjectAlreadyInitialized 12 | ObjectCannotBeNothing 13 | StringCannotBeEmpty 14 | End Enum 15 | 16 | '@Description("Raises a run-time error if the specified Boolean expression is True.") 17 | Public Sub GuardExpression(ByVal Throw As Boolean, _ 18 | Optional ByVal Source As String = vbNullString, _ 19 | Optional ByVal Message As String = "Invalid procedure call or argument.", _ 20 | Optional ByVal ErrNumber As Long = CustomError) 21 | Attribute GuardExpression.VB_Description = "Raises a run-time error if the specified Boolean expression is True." 22 | If Throw Then VBA.Information.Err.Raise ErrNumber, Source, Message 23 | End Sub 24 | 25 | '@Description("Raises a run-time error if the specified instance isn't the default instance.") 26 | Public Sub GuardNonDefaultInstance(ByVal Instance As Object, ByVal defaultInstance As Object, _ 27 | Optional ByVal Source As String = vbNullString, _ 28 | Optional ByVal Message As String = "Method should be invoked from the default/predeclared instance of this class.") 29 | Attribute GuardNonDefaultInstance.VB_Description = "Raises a run-time error if the specified instance isn't the default instance." 30 | Debug.Assert TypeName(Instance) = TypeName(defaultInstance) 31 | GuardExpression Not Instance Is defaultInstance, IIf(Source = vbNullString, TypeName(Instance), Source), Message, InvalidFromNonDefaultInstance 32 | End Sub 33 | 34 | '@Description("Raises a run-time error if the specified instance is the default instance.") 35 | Public Sub GuardDefaultInstance(ByVal Instance As Object, ByVal defaultInstance As Object, _ 36 | Optional ByVal Source As String = vbNullString, _ 37 | Optional ByVal Message As String = "Method should be invoked from a new instance of this class.") 38 | Attribute GuardDefaultInstance.VB_Description = "Raises a run-time error if the specified instance is the default instance." 39 | Debug.Assert TypeName(Instance) = TypeName(defaultInstance) 40 | GuardExpression Instance Is defaultInstance, Source, Message, InvalidFromDefaultInstance 41 | End Sub 42 | 43 | '@Description("Raises a run-time error if the specified object reference is already set.") 44 | Public Sub GuardDoubleInitialization(ByVal Value As Variant, _ 45 | Optional ByVal Source As String = vbNullString, _ 46 | Optional ByVal Message As String = "Value is already initialized.") 47 | Attribute GuardDoubleInitialization.VB_Description = "Raises a run-time error if the specified object reference is already set." 48 | Dim Throw As Boolean 49 | If IsObject(Value) Then 50 | Throw = Not Value Is Nothing 51 | Else 52 | Throw = Value <> GetDefaultValue(VarType(Value)) 53 | End If 54 | GuardExpression Throw, Source, Message, ObjectAlreadyInitialized 55 | End Sub 56 | 57 | Private Function GetDefaultValue(ByVal VType As VbVarType) As Variant 58 | Select Case VType 59 | Case VbVarType.vbString 60 | GetDefaultValue = vbNullString 61 | Case VbVarType.vbBoolean 62 | GetDefaultValue = False 63 | Case VbVarType.vbByte, VbVarType.vbCurrency, VbVarType.vbDate, _ 64 | VbVarType.vbDecimal, VbVarType.vbDouble, VbVarType.vbInteger, _ 65 | VbVarType.vbLong, VbVarType.vbSingle 66 | GetDefaultValue = 0 67 | Case VbVarType.vbArray, VbVarType.vbEmpty, VbVarType.vbVariant 68 | GetDefaultValue = Empty 69 | Case VbVarType.vbNull 70 | GetDefaultValue = Null 71 | Case VbVarType.vbObject 72 | Set GetDefaultValue = Nothing 73 | #If VBA7 Then 74 | #If Win64 Then 75 | Case VbVarType.vbLongLong 'VF: include longptr(?) if using GuardClauses with WinAPIs 76 | GetDefaultValue = 0 77 | #End If 78 | #End If 79 | End Select 80 | End Function 81 | 82 | '@Description("Raises a run-time error if the specified object reference is Nothing.") 83 | Public Sub GuardNullReference(ByVal Instance As Object, _ 84 | Optional ByVal Source As String = vbNullString, _ 85 | Optional ByVal Message As String = "Object reference cannot be Nothing.") 86 | Attribute GuardNullReference.VB_Description = "Raises a run-time error if the specified object reference is Nothing." 87 | GuardExpression Instance Is Nothing, Source, Message, ObjectCannotBeNothing 88 | End Sub 89 | 90 | '@Description("Raises a run-time error if the specified string is empty.") 91 | Public Sub GuardEmptyString(ByVal Value As String, _ 92 | Optional ByVal Source As String = vbNullString, _ 93 | Optional ByVal Message As String = "String cannot be empty.") 94 | Attribute GuardEmptyString.VB_Description = "Raises a run-time error if the specified string is empty." 95 | GuardExpression Value = vbNullString, Source, Message, StringCannotBeEmpty 96 | End Sub 97 | -------------------------------------------------------------------------------- /src/IAppContext.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IAppContext" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object keeping command and property bindings in scope." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object keeping command and property bindings in scope." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets an object responsible for managing command bindings." 18 | Public Property Get Commands() As ICommandManager 19 | Attribute Commands.VB_Description = "Gets an object responsible for managing command bindings." 20 | End Property 21 | 22 | '@Description "Gets an object responsible for managing property bindings." 23 | Public Property Get Bindings() As MVVM.IBindingManager 24 | Attribute Bindings.VB_Description = "Gets an object responsible for managing property bindings." 25 | End Property 26 | 27 | '@Description "Gets an object responsible for managing binding validation errors." 28 | Public Property Get Validation() As MVVM.IValidationManager 29 | Attribute Validation.VB_Description = "Gets an object responsible for managing binding validation errors." 30 | End Property 31 | 32 | '@Description "Gets an abstract factory that creates objects that can format strings." 33 | Public Property Get StringFormatterFactory() As MVVM.IStringFormatterFactory 34 | Attribute StringFormatterFactory.VB_Description = "Gets an abstract factory that creates objects that can format strings." 35 | End Property 36 | -------------------------------------------------------------------------------- /src/IBindingManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IBindingManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents an object responsible for managing property bindings in an application context." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents an object responsible for managing property bindings in an application context." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Creates a new property binding for the specified path, source, and target." 18 | Public Function BindPropertyPath(ByVal Source As Object, ByVal PropertyPath As String, ByVal Target As Object, _ 19 | Optional ByVal TargetProperty As String, _ 20 | Optional ByVal Mode As BindingMode = BindingMode.TwoWayBinding, _ 21 | Optional ByVal UpdateTrigger As BindingUpdateSourceTrigger = BindingUpdateSourceTrigger.OnPropertyChanged, _ 22 | Optional ByVal Validator As IValueValidator, _ 23 | Optional ByVal Converter As IValueConverter, _ 24 | Optional ByVal StringFormat As String, _ 25 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 26 | Attribute BindPropertyPath.VB_Description = "Creates a new property binding for the specified path, source, and target." 27 | End Function 28 | 29 | '@Description "Gets a reference to an object that creates notification helper object instances." 30 | Public Property Get NotifierFactory() As INotifierFactory 31 | Attribute NotifierFactory.VB_Description = "Gets a reference to an object that creates notification helper object instances." 32 | End Property 33 | 34 | '@Description "Gets a reference to an object that creates string-formatting helper object instances." 35 | Public Property Get StringFormatterFactory() As IStringFormatterFactory 36 | Attribute StringFormatterFactory.VB_Description = "Gets a reference to an object that creates string-formatting helper object instances." 37 | End Property 38 | 39 | '@Description "Gets a value indicating whether bindings produce debugger output." 40 | Public Property Get DebugOutput() As Boolean 41 | Attribute DebugOutput.VB_Description = "Gets a value indicating whether bindings produce debugger output." 42 | End Property 43 | 44 | '@Description "Applies all property bindings." 45 | Public Sub Apply(ByVal Context As Object) 46 | Attribute Apply.VB_Description = "Applies all property bindings." 47 | End Sub 48 | -------------------------------------------------------------------------------- /src/IBindingPath.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IBindingPath" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that can resolve a string property path to a value." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that can resolve a string property path to a value." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets the context for resolving the Path." 18 | Public Property Get Context() As Object 19 | Attribute Context.VB_Description = "Gets the context for resolving the Path." 20 | End Property 21 | 22 | '@Description "Gets the property path of the binding." 23 | Public Property Get Path() As String 24 | Attribute Path.VB_Description = "Gets the property path of the binding." 25 | End Property 26 | 27 | '@Description "Gets a reference to the binding source object resolved from the Path." 28 | Public Property Get Object() As Object 29 | Attribute Object.VB_Description = "Gets a reference to the binding source object resolved from the Path." 30 | End Property 31 | 32 | '@Description "Gets the name of the bound property resolved from the Path." 33 | Public Property Get PropertyName() As String 34 | Attribute PropertyName.VB_Description = "Gets the name of the bound property resolved from the Path." 35 | End Property 36 | 37 | '@Description "Resolves the binding source." 38 | Public Sub Resolve() 39 | Attribute Resolve.VB_Description = "Resolves the binding source." 40 | End Sub 41 | 42 | '@Description "Reads and returns the property value; False on error, True if successful." 43 | Public Function TryReadPropertyValue(ByRef outValue As Variant) As Boolean 44 | Attribute TryReadPropertyValue.VB_Description = "Reads and returns the property value; False on error, True if successful." 45 | End Function 46 | 47 | '@Description "Writes the value to the bound property; False on error, True if successful." 48 | Public Function TryWritePropertyValue(ByVal Value As Variant) As Boolean 49 | Attribute TryWritePropertyValue.VB_Description = "Writes the value to the bound property; False on error, True if successful." 50 | End Function 51 | 52 | '@Description "Returns a string representing this binding path for debugging purposes." 53 | Public Function ToString() As String 54 | Attribute ToString.VB_Description = "Returns a string representing this binding path for debugging purposes." 55 | End Function 56 | -------------------------------------------------------------------------------- /src/IBindingTargetStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IBindingTargetStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A strategy for creating an IPropertyBinding " 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "A strategy for creating an IPropertyBinding " 13 | '@Interface 14 | Option Explicit 15 | 16 | '@Description "Infers the target property path from the runtime type of the specified Target." 17 | Public Function DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 18 | ByVal Mode As BindingMode, _ 19 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 20 | ByVal Validator As IValueValidator, _ 21 | ByVal Converter As IValueConverter, _ 22 | ByVal StringFormat As IStringFormatter, _ 23 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 24 | Attribute DefaultPropertyBindingFor.VB_Description = "Infers the target property path from the runtime type of the specified Target." 25 | End Function 26 | 27 | '@Description "Creates a property binding as specified." 28 | Public Function PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 29 | ByVal Mode As BindingMode, _ 30 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 31 | ByVal Validator As IValueValidator, _ 32 | ByVal Converter As IValueConverter, _ 33 | ByVal StringFormat As IStringFormatter, _ 34 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 35 | Attribute PropertyBindingFor.VB_Description = "Creates a property binding as specified." 36 | End Function 37 | -------------------------------------------------------------------------------- /src/ICancellable.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ICancellable" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Describes an object that encapsulates 'IsCancelled' state." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Describes an object that encapsulates 'IsCancelled' state." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets a value indicating whether the object is in a cancelled state." 18 | Public Property Get IsCancelled() As Boolean 19 | Attribute IsCancelled.VB_Description = "Gets a value indicating whether the object is in a cancelled state." 20 | End Property 21 | 22 | '@Description "Sets the IsCancelled flag to True." 23 | Public Sub OnCancel() 24 | Attribute OnCancel.VB_Description = "Sets the IsCancelled flag to True." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/ICommand.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ICommand" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that represents an executable command." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that represents an executable command." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Returns True if the command is enabled given the provided binding context (ViewModel)." 18 | Public Function CanExecute(ByVal Context As Object) As Boolean 19 | Attribute CanExecute.VB_Description = "Returns True if the command is enabled given the provided binding context (ViewModel)." 20 | End Function 21 | 22 | '@Description "Executes the command given the provided binding context (ViewModel)." 23 | Public Sub Execute(ByVal Context As Object) 24 | Attribute Execute.VB_Description = "Executes the command given the provided binding context (ViewModel)." 25 | End Sub 26 | 27 | '@Description "Gets a user-friendly description of the command." 28 | Public Property Get Description() As String 29 | Attribute Description.VB_Description = "Gets a user-friendly description of the command." 30 | End Property 31 | -------------------------------------------------------------------------------- /src/ICommandBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ICommandBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object responsible for binding a command to a UI element." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object responsible for binding a command to a UI element." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets the event source object bound to the command." 18 | Public Property Get Target() As Object 19 | Attribute Target.VB_Description = "Gets the event source object bound to the command." 20 | End Property 21 | 22 | '@Description "Gets the command bound to the event source." 23 | Public Property Get Command() As ICommand 24 | Attribute Command.VB_Description = "Gets the command bound to the event source." 25 | End Property 26 | 27 | '@Description "Evaluates whether the command can execute given the binding context." 28 | Public Sub EvaluateCanExecute(ByVal Context As Object) 29 | Attribute EvaluateCanExecute.VB_Description = "Evaluates whether the command can execute given the binding context." 30 | End Sub 31 | -------------------------------------------------------------------------------- /src/ICommandManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ICommandManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents an object responsible for managing command bindings in an application context." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents an object responsible for managing command bindings in an application context." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Binds the specified command to user interaction with the specified target UI element (e.g. a MSForms.CommandButton control)." 18 | Public Function BindCommand(ByVal BindingContext As Object, ByVal Target As Object, ByVal Command As ICommand) As ICommandBinding 19 | Attribute BindCommand.VB_Description = "Binds the specified command to user interaction with the specified target UI element (e.g. a MSForms.CommandButton control)." 20 | End Function 21 | 22 | '@Description "Causes all commands to evaluate whether they can be executed." 23 | Public Sub EvaluateCanExecute(ByVal BindingContext As Object) 24 | Attribute EvaluateCanExecute.VB_Description = "Causes all commands to evaluate whether they can be executed." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/IContainerLayout.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IContainerLayout" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Encapsulates the layout logic for dynamic UI components." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Encapsulates the layout logic for dynamic UI components." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Adds a new dynamic control to the layout." 18 | Public Function Add(ByVal ProgID As String, Optional ByVal Height As Variant, Optional ByVal Width As Variant, Optional ByVal ApplyMargin As Boolean = True) As Object 19 | Attribute Add.VB_Description = "Adds a new dynamic control to the layout." 20 | End Function 21 | 22 | '@Description "Moves the position of the next control by a margin." 23 | Public Sub SkipPosition(Optional ByVal Margin As Long) 24 | Attribute SkipPosition.VB_Description = "Moves the position of the next control by a margin." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/IControlEvents.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IControlEvents" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An observer that provides the infrastructure to relay MSForms.Control events." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An observer that provides the infrastructure to relay MSForms.Control events." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents) 18 | End Sub 19 | 20 | Public Sub OnEnter() 21 | End Sub 22 | 23 | Public Sub OnExit(ByVal Cancel As MSForms.IReturnBoolean) 24 | End Sub 25 | 26 | Public Sub OnAfterUpdate() 27 | End Sub 28 | 29 | Public Sub OnBeforeUpdate(ByVal Cancel As MSForms.IReturnBoolean) 30 | End Sub 31 | 32 | 'VF: event to capture BackSpace/Delete as well as Paste new tex /Cut all text in TextBox 33 | 'VF: paste/delete/cut easiest captured by _change, alternatively fiddle with KeyCodes 34 | 'see userform ExploreTextboxEvents 35 | 'Private Sub TextBox1_Change() 36 | ' Label1.Caption = Label1.Caption & vbLf & "TextBox1_Change" 37 | 'End Sub 38 | Public Sub OnChange() 39 | End Sub 40 | -------------------------------------------------------------------------------- /src/IDisposable.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDisposable" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents an object that can be (or must be) explicitly terminated." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents an object that can be (or must be) explicitly terminated." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Releases references held, prepares the object for eventual destruction." 18 | Public Sub Dispose() 19 | Attribute Dispose.VB_Description = "Releases references held, prepares the object for eventual destruction." 20 | End Sub 21 | -------------------------------------------------------------------------------- /src/IDynamicAdorner.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicAdorner" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Describes an object that can decorate a binding target with implementation-defined components." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Describes an object that can decorate a binding target with implementation-defined components." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Brings the adorner components into view." 18 | Public Sub Show(ByVal Message As String) 19 | Attribute Show.VB_Description = "Brings the adorner components into view." 20 | End Sub 21 | 22 | '@Description "Hides the adorner components from view." 23 | Public Sub Hide() 24 | Attribute Hide.VB_Description = "Hides the adorner components from view." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/IDynamicAdornerFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicAdornerFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An abstract factory that creates dynamic validation error adorners." 11 | '@Exposed 12 | '@Folder MVVM.Infrastructure.Abstract 13 | '@ModuleDescription "An abstract factory that creates dynamic validation error adorners." 14 | '@Interface 15 | Option Explicit 16 | 17 | '@Description "Creates a new dynamic validation error adorner for the specified target." 18 | Public Function Create(ByVal Target As Object) As IDynamicAdorner 19 | Attribute Create.VB_Description = "Creates a new dynamic validation error adorner for the specified target." 20 | End Function 21 | -------------------------------------------------------------------------------- /src/IDynamicContainerPanel.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicContainerPanel" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Describes a panel layout component." 11 | '@Exposed 12 | '@Folder MVVM.Infrastructure.Abstract 13 | '@ModuleDescription "Describes a panel layout component." 14 | '@Interface 15 | Option Explicit 16 | 17 | Public Enum LayoutDirection 18 | TopToBottom 19 | LeftToRight 20 | RightToLeft 21 | End Enum 22 | 23 | '@Description "Gets a value that controls how child controls are sized." 24 | Public Property Get Direction() As LayoutDirection 25 | Attribute Direction.VB_Description = "Gets a value that controls how child controls are sized." 26 | End Property 27 | 28 | '@Description "Gets the width of the panel." 29 | Public Property Get Width() As Single 30 | Attribute Width.VB_Description = "Gets the width of the panel." 31 | End Property 32 | 33 | '@Description "Gets the height of the panel." 34 | Public Property Get Height() As Single 35 | Attribute Height.VB_Description = "Gets the height of the panel." 36 | End Property 37 | -------------------------------------------------------------------------------- /src/IDynamicControlBuilder.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicControlBuilder" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Builds dynamic MSForms UI components from a binding source." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Builds dynamic MSForms UI components from a binding source." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Creates a multiline MSForms.TextBox control for the spercified String property binding path." 18 | Public Function TextAreaFor(ByVal SourceValue As IBindingPath, Optional ByVal Converter As IValueConverter, Optional ByVal Validator As IValueValidator, Optional ByVal ErrorAdorner As IDynamicAdorner, Optional ByVal TitleSource As Variant) As MSForms.TextBox 19 | Attribute TextAreaFor.VB_Description = "Creates a multiline MSForms.TextBox control for the spercified String property binding path." 20 | End Function 21 | 22 | '@Description "Creates a MSForms.TextBox control for the specified String property binding path." 23 | Public Function TextBoxFor(ByVal SourceValue As IBindingPath, Optional ByVal FormatString As String, Optional ByVal Converter As IValueConverter, Optional ByVal Validator As IValueValidator, Optional ByVal ErrorAdorner As IDynamicAdorner, Optional ByVal TitleSource As Variant) As MSForms.TextBox 24 | Attribute TextBoxFor.VB_Description = "Creates a MSForms.TextBox control for the specified String property binding path." 25 | End Function 26 | 27 | '@Description "Creates a MSForms.Label control for the specified Caption string or String property binding path." 28 | Public Function LabelFor(ByVal SourceCaption As Variant, Optional ByVal FormatString As String, Optional ByVal Converter As IValueConverter) As MSForms.Label 29 | Attribute LabelFor.VB_Description = "Creates a MSForms.Label control for the specified Caption string or String property binding path." 30 | End Function 31 | 32 | '@Description "Creates a MSForms.ComboBox control for the specified Value property binding path; SourceItems should be an array property." 33 | Public Function ComboBoxFor(ByVal SourceValue As IBindingPath, ByVal SourceItems As IBindingPath, Optional ByVal FormatString As String, Optional ByVal Converter As IValueConverter, Optional ByVal Validator As IValueValidator, Optional ByVal ErrorAdorner As IDynamicAdorner, Optional ByVal TitleSource As Variant) As MSForms.ComboBox 34 | Attribute ComboBoxFor.VB_Description = "Creates a MSForms.ComboBox control for the specified Value property binding path; SourceItems should be an array property." 35 | End Function 36 | 37 | '@Description "Creates a MSForms.ListBox control for the specified Value property binding path; SourceItems should be an array property." 38 | Public Function ListBoxFor(ByVal SourceValue As IBindingPath, ByVal SourceItems As IBindingPath, Optional ByVal TitleSource As Variant) As MSForms.ListBox 39 | Attribute ListBoxFor.VB_Description = "Creates a MSForms.ListBox control for the specified Value property binding path; SourceItems should be an array property." 40 | End Function 41 | 42 | '@Description "Creates a MSForms.OptionButton control for the specified Value (Boolean) property binding path; uses the specified Caption string or String property binding path for the control's Caption." 43 | Public Function OptionButtonFor(ByVal SourceValue As IBindingPath, ByVal SourceCaption As Variant) As MSForms.OptionButton 44 | Attribute OptionButtonFor.VB_Description = "Creates a MSForms.OptionButton control for the specified Value (Boolean) property binding path; uses the specified Caption string or String property binding path for the control's Caption." 45 | End Function 46 | 47 | '@Description "Creates a MSForms.CheckBoxButton control for the specified Value (Boolean) property binding path; uses the specified Caption string or String property binding path for the control's Caption." 48 | Public Function CheckBoxFor(ByVal SourceValue As IBindingPath, ByVal SourceCaption As Variant) As MSForms.CheckBox 49 | Attribute CheckBoxFor.VB_Description = "Creates a MSForms.CheckBoxButton control for the specified Value (Boolean) property binding path; uses the specified Caption string or String property binding path for the control's Caption." 50 | End Function 51 | 52 | '@Description "Creates a MSForms.CommandButton control for the specified ICommand, using the specified ViewModel context and Caption string or String property binding path." 53 | Public Function CommandButtonFor(ByVal Command As ICommand, ByVal BindingContext As Object, ByVal SourceCaption As Variant) As MSForms.CommandButton 54 | Attribute CommandButtonFor.VB_Description = "Creates a MSForms.CommandButton control for the specified ICommand, using the specified ViewModel context and Caption string or String property binding path." 55 | End Function 56 | -------------------------------------------------------------------------------- /src/IDynamicPanel.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicPanel" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Abstract 11 | '@Interface 12 | '@Exposed 13 | Option Explicit 14 | 15 | -------------------------------------------------------------------------------- /src/IDynamicPosition.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IDynamicPosition" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents the relative position and margin of a dynamic UI component." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents the relative position and margin of a dynamic UI component." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | Public Enum RelativePosition 18 | Default = 0 19 | AboveLeft 20 | AboveRight 21 | BelowLeft 22 | BelowRight 23 | InsideLeft 24 | InsideRight 25 | End Enum 26 | 27 | Public Enum MarginSide 28 | LeftSide = 1 29 | TopSide = 2 30 | RightSide = 4 31 | BottomSide = 8 32 | End Enum 33 | 34 | '@Description "Gets the position of the adorner relative to its target." 35 | Public Property Get Position() As RelativePosition 36 | Attribute Position.VB_Description = "Gets the position of the adorner relative to its target." 37 | End Property 38 | 39 | '@Description "Gets the margin value for the specified side." 40 | Public Property Get Margin(ByVal Side As MarginSide) As Double 41 | Attribute Margin.VB_Description = "Gets the margin value for the specified side." 42 | End Property 43 | -------------------------------------------------------------------------------- /src/IHandleControlEvents.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IHandleControlEvents" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that can be registered as a handler for IControlEvents callbacks." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that can be registered as a handler for IControlEvents callbacks." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "A callback that handles the 'Enter' event." 18 | Public Sub HandleEnter() 19 | Attribute HandleEnter.VB_Description = "A callback that handles the 'Enter' event." 20 | End Sub 21 | 22 | '@Description "A callback that handles the 'Exit' event." 23 | Public Sub HandleExit(ByRef Cancel As Boolean) 24 | Attribute HandleExit.VB_Description = "A callback that handles the 'Exit' event." 25 | End Sub 26 | 27 | '@Description "A callback that handles the 'AfterUpdate' event." 28 | Public Sub HandleAfterUpdate() 29 | Attribute HandleAfterUpdate.VB_Description = "A callback that handles the 'AfterUpdate' event." 30 | End Sub 31 | 32 | '@Description "A callback that handles the 'BeforeUpdate' event." 33 | Public Sub HandleBeforeUpdate(ByRef Cancel As Boolean) 34 | Attribute HandleBeforeUpdate.VB_Description = "A callback that handles the 'BeforeUpdate' event." 35 | End Sub 36 | 'VF: added: required to capture Cut/Paste and Backspace/Delete in TextBox 37 | '@Description "A callback that handles the 'Change' event." 38 | Public Sub HandleChange() 39 | End Sub 40 | -------------------------------------------------------------------------------- /src/IHandlePropertyChanged.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IHandlePropertyChanged" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that can be registered as an INotifyPropertyChanged handler." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that can be registered as an INotifyPropertyChanged handler." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "A callback invoked when a property value is set." 18 | Public Sub HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 19 | Attribute HandlePropertyChanged.VB_Description = "A callback invoked when a property value is set." 20 | End Sub 21 | -------------------------------------------------------------------------------- /src/IHandleValidationError.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IHandleValidationError" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that can be registered as a listener for data validation errors." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that can be registered as a listener for data validation errors." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "A callback invoked when a validation error is added or removed from the validation manager." 18 | Public Sub HandleValidationErrorsChanged(ByVal BindingPath As IBindingPath, Optional ByVal ValidationError As IValidationError) 19 | Attribute HandleValidationErrorsChanged.VB_Description = "A callback invoked when a validation error is added or removed from the validation manager." 20 | End Sub 21 | -------------------------------------------------------------------------------- /src/INotifierFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "INotifierFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An abstract factory that creates INotifyPropertyChanged helper objects." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An abstract factory that creates INotifyPropertyChanged helper objects." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Creates and returns a new notifier object." 18 | Public Function Create() As INotifyPropertyChanged 19 | Attribute Create.VB_Description = "Creates and returns a new notifier object." 20 | End Function 21 | -------------------------------------------------------------------------------- /src/INotifyPropertyChanged.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "INotifyPropertyChanged" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents a subject that can notify observers when a property value changes." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents a subject that can notify observers when a property value changes." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Registers the specified handler." 18 | Public Sub RegisterHandler(ByVal Handler As IHandlePropertyChanged) 19 | Attribute RegisterHandler.VB_Description = "Registers the specified handler." 20 | End Sub 21 | 22 | '@Description "Notifies all registered handlers of a property value change." 23 | Public Sub OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 24 | Attribute OnPropertyChanged.VB_Description = "Notifies all registered handlers of a property value change." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/INotifyValidationError.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "INotifyValidationError" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An observer that can notify registered handlers when applying a binding throws a validation error." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An observer that can notify registered handlers when applying a binding throws a validation error." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Registers the specified handler." 18 | Public Sub RegisterHandler(ByVal Handler As IHandleValidationError) 19 | Attribute RegisterHandler.VB_Description = "Registers the specified handler." 20 | End Sub 21 | 22 | '@Description "Notifies registered handlers." 23 | Public Sub OnValidationErrorsChanged(ByVal BindingContext As Object, Optional ByVal ValidationError As IValidationError) 24 | Attribute OnValidationErrorsChanged.VB_Description = "Notifies registered handlers." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/IPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object responsible for binding a ViewModel property path to a UI element." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object responsible for binding a ViewModel property path to a UI element." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | Public Enum BindingMode 18 | TwoWayBinding 19 | OneWayBinding 20 | OneWayToSource 21 | OneTimeBinding 22 | End Enum 23 | 24 | Public Enum BindingUpdateSourceTrigger 25 | 'VF: added NotSetYet and renumbered enums 26 | NotSetYet = 0 ''avoid being called twice, for runtime optimization 27 | Never = 1 28 | OnPropertyChanged = 2 ' 29 | OnKeyPress = 3 ' 30 | OnExit = 4 ' 31 | 32 | 'VF: added: required to capture Cut/Paste and Backspace/Delete in TextBox 33 | OnChange = 5 34 | 35 | End Enum 36 | 37 | '@Description "Gets a value indicating the binding mode/direction." 38 | Public Property Get Mode() As BindingMode 39 | Attribute Mode.VB_Description = "Gets a value indicating the binding mode/direction." 40 | End Property 41 | 42 | '@Description "Gets a value indicating the binding update trigger." 43 | Public Property Get UpdateSourceTrigger() As BindingUpdateSourceTrigger 44 | Attribute UpdateSourceTrigger.VB_Description = "Gets a value indicating the binding update trigger." 45 | End Property 46 | 47 | '@Description "Gets the binding path resolving to the binding source." 48 | Public Property Get Source() As IBindingPath 49 | Attribute Source.VB_Description = "Gets the binding path resolving to the binding source." 50 | End Property 51 | 52 | '@Description "Gets the binding path resolving to the binding target." 53 | Public Property Get Target() As IBindingPath 54 | Attribute Target.VB_Description = "Gets the binding path resolving to the binding target." 55 | End Property 56 | 57 | '@Description "Gets the name of the target property implicitly bound for the Target class type." 58 | Public Property Get DefaultTargetProperty() As String 59 | Attribute DefaultTargetProperty.VB_Description = "Gets the name of the target property implicitly bound for the Target class type." 60 | End Property 61 | 62 | '@Description "Gets the converter (if any) used when applying the binding." 63 | Public Property Get Converter() As IValueConverter 64 | Attribute Converter.VB_Description = "Gets the converter (if any) used when applying the binding." 65 | End Property 66 | 67 | '@Description "Gets the value validator (if any) used when applying the binding." 68 | Public Property Get Validator() As IValueValidator 69 | Attribute Validator.VB_Description = "Gets the value validator (if any) used when applying the binding." 70 | End Property 71 | 72 | '@Description "Gets the string formatter (if any) used when applying the binding to the target." 73 | Public Property Get StringFormat() As IStringFormatter 74 | Attribute StringFormat.VB_Description = "Gets the string formatter (if any) used when applying the binding to the target." 75 | End Property 76 | 77 | '@Description "Determines whether the binding prevents focus leaving the control with invalid data." 78 | Public Property Get CancelExitOnValidationError() As Boolean 79 | Attribute CancelExitOnValidationError.VB_Description = "Determines whether the binding prevents focus leaving the control with invalid data." 80 | End Property 81 | 82 | '@Description "Applies the binding." 83 | Public Sub Apply() 84 | Attribute Apply.VB_Description = "Applies the binding." 85 | End Sub 86 | -------------------------------------------------------------------------------- /src/IStringFormatter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IStringFormatter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents an object with the ability to format a string value." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents an object with the ability to format a string value." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets the format string used when formatting values." 18 | Public Property Get FormatString() As String 19 | Attribute FormatString.VB_Description = "Gets the format string used when formatting values." 20 | End Property 21 | 22 | '@Description "Formats the specified values as per the FormatString." 23 | Public Function Format(ParamArray Values() As Variant) As String 24 | Attribute Format.VB_Description = "Formats the specified values as per the FormatString." 25 | End Function 26 | -------------------------------------------------------------------------------- /src/IStringFormatterFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IStringFormatterFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A factory that creates instances of a particular IStringFormatter implementation." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "A factory that creates instances of a particular IStringFormatter implementation." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Creates a new instance of a string formatter." 18 | Public Function Create(ByVal FormatString As String) As IStringFormatter 19 | Attribute Create.VB_Description = "Creates a new instance of a string formatter." 20 | End Function 21 | -------------------------------------------------------------------------------- /src/ITestStub.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ITestStub" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that stubs an interface for testing purposes." 11 | '@Exposed 12 | '@Folder Tests.Stubs 13 | '@ModuleDescription "An object that stubs an interface for testing purposes." 14 | '@Interface 15 | Option Explicit 16 | 17 | '@Description "Gets the number of times the specified member was invoked in the lifetime of the object." 18 | Public Property Get MemberInvokes(ByVal MemberName As String) As Long 19 | Attribute MemberInvokes.VB_Description = "Gets the number of times the specified member was invoked in the lifetime of the object." 20 | End Property 21 | 22 | '@Description "Gets a string representation of the object's internal state, for debugging purposes (not intended for asserts!)." 23 | Public Function ToString() As String 24 | Attribute ToString.VB_Description = "Gets a string representation of the object's internal state, for debugging purposes (not intended for asserts!)." 25 | End Function 26 | 27 | '@Description "Fails a test when the member invokes for the specified member name don't match the expected count." 28 | Public Sub Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 29 | Attribute Verify.VB_Description = "Fails a test when the member invokes for the specified member name don't match the expected count." 30 | End Sub 31 | -------------------------------------------------------------------------------- /src/IValidationError.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IValidationError" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object representing a binding validation error." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object representing a binding validation error." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "The validation error message." 18 | Public Property Get Message() As String 19 | Attribute Message.VB_Description = "The validation error message." 20 | End Property 21 | 22 | '@Description "The binding that failed to validate." 23 | Public Property Get Binding() As IPropertyBinding 24 | Attribute Binding.VB_Description = "The binding that failed to validate." 25 | End Property 26 | -------------------------------------------------------------------------------- /src/IValidationErrorFormatter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IValidationErrorFormatter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that describes how a control changes its appearance given a validation error." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that describes how a control changes its appearance given a validation error." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Applies error styling to the target given the specified validation error message." 18 | Public Sub Apply(ByVal Target As Object, ByVal Message As String) 19 | Attribute Apply.VB_Description = "Applies error styling to the target given the specified validation error message." 20 | End Sub 21 | 22 | '@Description "Removes error styling on the target." 23 | Public Sub Restore(ByVal Target As Object) 24 | Attribute Restore.VB_Description = "Removes error styling on the target." 25 | End Sub 26 | -------------------------------------------------------------------------------- /src/IValidationManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IValidationManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Represents an object responsible for managing the validation errors in a ViewModel." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Represents an object responsible for managing the validation errors in a ViewModel." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "True if there are no validation errors, False otherwise." 18 | Public Property Get IsValid(ByVal Context As Object, Optional ByVal PropertyName As String) As Boolean 19 | Attribute IsValid.VB_Description = "True if there are no validation errors, False otherwise." 20 | End Property 21 | 22 | '@Description "Gets the IValidationError for the specified binding path, if it exists." 23 | Public Property Get ValidationError(ByVal BindingPath As IBindingPath) As IValidationError 24 | Attribute ValidationError.VB_Description = "Gets the IValidationError for the specified binding path, if it exists." 25 | End Property 26 | 27 | '@Description "Gets the factory used for creating the default validation error adorners." 28 | Public Property Get AdornerFactory() As IDynamicAdornerFactory 29 | Attribute AdornerFactory.VB_Description = "Gets the factory used for creating the default validation error adorners." 30 | End Property 31 | 32 | '@Description "Adds the specified validation error to the validation context." 33 | Public Sub OnValidationError(ByVal Context As Object, ByVal ValidationError As IValidationError) 34 | Attribute OnValidationError.VB_Description = "Adds the specified validation error to the validation context." 35 | End Sub 36 | 37 | '@Description "Removes the validation error for the specified binding path, if it exists." 38 | Public Sub ClearValidationError(ByVal BindingPath As IBindingPath) 39 | Attribute ClearValidationError.VB_Description = "Removes the validation error for the specified binding path, if it exists." 40 | End Sub 41 | -------------------------------------------------------------------------------- /src/IValueConverter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IValueConverter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that can convert a binding value to/from a type or value that is applicable to the binding target." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object that can convert a binding value to/from a type or value that is applicable to the binding target." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Converts the source-provided value to a value that is applicable to the binding target." 18 | Public Function Convert(ByVal Value As Variant) As Variant 19 | Attribute Convert.VB_Description = "Converts the source-provided value to a value that is applicable to the binding target." 20 | End Function 21 | 22 | '@Description "Converts the target-provided value to a value that is applicable to the binding source, for 2-way bindings." 23 | Public Function ConvertBack(ByVal Value As Variant) As Variant 24 | Attribute ConvertBack.VB_Description = "Converts the target-provided value to a value that is applicable to the binding source, for 2-way bindings." 25 | End Function 26 | -------------------------------------------------------------------------------- /src/IValueValidator.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IValueValidator" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object responsible for validating the value before a binding is applied." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "An object responsible for validating the value before a binding is applied." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Using this validator in a property binding will coerce it into using this update trigger." 18 | Public Property Get Trigger() As BindingUpdateSourceTrigger 19 | Attribute Trigger.VB_Description = "Using this validator in a property binding will coerce it into using this update trigger." 20 | End Property 21 | 22 | '@Description "A user-friendly message describing the validation rule(s)." 23 | Public Property Get Message() As String 24 | Attribute Message.VB_Description = "A user-friendly message describing the validation rule(s)." 25 | End Property 26 | 27 | '@Description "True if the specified value is valid in itself or in the context of the binding source and target." 28 | Public Function IsValid(ByVal Value As Variant, ByVal Source As IBindingPath, ByVal Target As IBindingPath) As Boolean 29 | Attribute IsValid.VB_Description = "True if the specified value is valid in itself or in the context of the binding source and target." 30 | End Function 31 | -------------------------------------------------------------------------------- /src/IView.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "IView" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "Describes a View." 11 | '@Folder MVVM.Infrastructure.Abstract 12 | '@ModuleDescription "Describes a View." 13 | '@Interface 14 | '@Exposed 15 | Option Explicit 16 | 17 | '@Description "Gets the ViewModel / binding Source." 18 | Public Property Get ViewModel() As Object 19 | Attribute ViewModel.VB_Description = "Gets the ViewModel / binding Source." 20 | End Property 21 | 22 | '@Description "Displays the View modally and returns a value indicating confirmation (True) or cancellation (False)." 23 | Public Function ShowDialog() As Boolean 24 | Attribute ShowDialog.VB_Description = "Displays the View modally and returns a value indicating confirmation (True) or cancellation (False)." 25 | End Function 26 | 27 | '@Description "Displays the View." 28 | Public Sub Show() 29 | Attribute Show.VB_Description = "Displays the View." 30 | End Sub 31 | 32 | '@Description "Hides the View." 33 | Public Sub Hide() 34 | Attribute Hide.VB_Description = "Hides the View." 35 | End Sub 36 | -------------------------------------------------------------------------------- /src/InverseBooleanConverter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "InverseBooleanConverter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A value converter that inverts a Boolean value." 11 | '@Folder MVVM.Common.Converters 12 | '@ModuleDescription "A value converter that inverts a Boolean value." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IValueConverter 17 | 18 | Private Function IValueConverter_Convert(ByVal Value As Variant) As Variant 19 | IValueConverter_Convert = Not CBool(Value) 20 | End Function 21 | 22 | Private Function IValueConverter_ConvertBack(ByVal Value As Variant) As Variant 23 | IValueConverter_ConvertBack = Not CBool(Value) 24 | End Function 25 | -------------------------------------------------------------------------------- /src/LayoutPanel.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "LayoutPanel" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.View.Dynamic 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | 15 | Private Type TState 16 | Frame As MSForms.Frame 17 | Direction As LayoutDirection 18 | NextControlTop As Long 19 | NextControlLeft As Long 20 | Margin As Long 21 | End Type 22 | 23 | Private This As TState 24 | 25 | Public Function Create(ByVal ParentForm As MSForms.UserForm, _ 26 | Optional ByVal Parent As MSForms.Controls, _ 27 | Optional ByVal Height As Single, _ 28 | Optional ByVal Width As Single) As LayoutPanel 29 | 30 | Dim Result As LayoutPanel 31 | Set Result = New LayoutPanel 32 | 33 | If Parent Is Nothing Then Set Parent = ParentForm.Controls 34 | 35 | Dim FrameControl As MSForms.Control 36 | Set FrameControl = Parent.Add(FormsProgID.FrameProgId, Visible:=False) 37 | If Height <> 0 Then 38 | FrameControl.Height = Height 39 | Else 40 | FrameControl.Height = ParentForm.Height '<~ RHS member call is late-bound 41 | End If 42 | If Width <> 0 Then 43 | FrameControl.Width = Width 44 | Else 45 | FrameControl.Width = ParentForm.Width '<~ RHS member call is late-bound 46 | End If 47 | 48 | Set Result.Frame = FrameControl 49 | Result.Frame.BorderStyle = fmBorderStyleNone 50 | Result.Frame.Caption = vbNullString 51 | Result.Frame.BackColor = ParentForm.BackColor 52 | Result.Frame.ScrollBars = fmScrollBarsBoth 53 | Result.Frame.KeepScrollBarsVisible = fmScrollBarsNone 54 | 55 | Set Create = Result 56 | End Function 57 | 58 | Public Property Get Frame() As MSForms.Frame 59 | Set Frame = This.Frame 60 | End Property 61 | 62 | Friend Property Set Frame(ByVal RHS As MSForms.Frame) 63 | Set This.Frame = RHS 64 | End Property 65 | -------------------------------------------------------------------------------- /src/ListBoxBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ListBoxBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = ListBoxPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = ListBoxPropertyBinding. _ 40 | Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/MultiPageBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "MultiPageBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = MultiPagePropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = MultiPagePropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/NotifierBaseFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "NotifierBaseFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A factory that creates PropertyChangeNotifierBase instances." 11 | '@Folder MVVM.Infrastructure.Bindings 12 | '@ModuleDescription "A factory that creates PropertyChangeNotifierBase instances." 13 | Option Explicit 14 | Implements INotifierFactory 15 | 16 | Private Function INotifierFactory_Create() As INotifyPropertyChanged 17 | Set INotifierFactory_Create = New PropertyChangeNotifierBase 18 | End Function 19 | -------------------------------------------------------------------------------- /src/OneWayPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "OneWayPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A property binding that binds any property of any source, one-way to any property of a UI element target." 11 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 12 | '@ModuleDescription "A property binding that binds any property of any source, one-way to any property of a UI element target." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IPropertyBinding 17 | Implements IDisposable 18 | Implements IHandlePropertyChanged 19 | 20 | Private Type TState 21 | Base As PropertyBindingBase 22 | Notifier As INotifyPropertyChanged 23 | Handler As IHandlePropertyChanged 24 | End Type 25 | 26 | Private This As TState 27 | 28 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 29 | Optional ByVal Validator As IValueValidator, _ 30 | Optional ByVal Converter As IValueConverter, _ 31 | Optional ByVal StringFormat As IStringFormatter, _ 32 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 33 | 34 | Dim BindingBase As PropertyBindingBase 35 | Set BindingBase = PropertyBindingBase _ 36 | .Create(Context, Source, Target.Context, Target.Path, _ 37 | Mode:=MVVM.BindingMode.OneWayBinding, _ 38 | UpdateSource:=MVVM.BindingUpdateSourceTrigger.Never, _ 39 | Validator:=Validator, _ 40 | Converter:=Converter, _ 41 | StringFormat:=StringFormat, _ 42 | ValidationAdorner:=ValidationAdorner) 43 | 44 | Dim Result As OneWayPropertyBinding 45 | Set Result = New OneWayPropertyBinding 46 | 47 | If Not Validator Is Nothing Then 48 | BindingBase.AsINotifyValidationError.RegisterHandler ValidationManager 49 | End If 50 | 51 | Result.InjectBindingInfo BindingBase 52 | Set Create = Result 53 | 54 | End Function 55 | 56 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 57 | GuardClauses.GuardDefaultInstance Me, OneWayPropertyBinding, TypeName(Me) 58 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 59 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 60 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 61 | Set This.Base = BindingInfo 62 | Set This.Handler = BindingInfo 63 | End Sub 64 | 65 | Private Property Get IsDefaultInstance() As Boolean 66 | IsDefaultInstance = Me Is TextBoxPropertyBinding 67 | End Property 68 | 69 | Private Sub IDisposable_Dispose() 70 | Set This.Handler = Nothing 71 | Disposable.TryDispose This.Base 72 | Set This.Base = Nothing 73 | End Sub 74 | 75 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 76 | This.Handler.HandlePropertyChanged Source, PropertyName 77 | End Sub 78 | 79 | Private Sub IPropertyBinding_Apply() 80 | This.Base.ApplyToTarget 81 | End Sub 82 | 83 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 84 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 85 | End Property 86 | 87 | Private Property Get IPropertyBinding_Converter() As IValueConverter 88 | Set IPropertyBinding_Converter = This.Base.Converter 89 | End Property 90 | 91 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 92 | IPropertyBinding_DefaultTargetProperty = vbNullString 93 | End Property 94 | 95 | Private Property Get IPropertyBinding_Mode() As BindingMode 96 | IPropertyBinding_Mode = This.Base.Mode 97 | End Property 98 | 99 | Private Property Get IPropertyBinding_Source() As IBindingPath 100 | Set IPropertyBinding_Source = This.Base.Source 101 | End Property 102 | 103 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 104 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 105 | End Property 106 | 107 | Private Property Get IPropertyBinding_Target() As IBindingPath 108 | Set IPropertyBinding_Target = This.Base.Target 109 | End Property 110 | 111 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 112 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 113 | End Property 114 | 115 | Private Property Get IPropertyBinding_Validator() As IValueValidator 116 | Set IPropertyBinding_Validator = This.Base.Validator 117 | End Property 118 | 119 | -------------------------------------------------------------------------------- /src/OptionButtonBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "OptionButtonBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = OptionButtonPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = OptionButtonPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/PropertyChangeNotifierBase.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "PropertyChangeNotifierBase" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "Provides a base implementation for the INotifyPropertyChanged observer interface." 11 | '@Folder MVVM.Infrastructure.Bindings 12 | '@ModuleDescription "Provides a base implementation for the INotifyPropertyChanged observer interface." 13 | Option Explicit 14 | Implements INotifyPropertyChanged 15 | Implements IDisposable 16 | 17 | Private Type TState 18 | Handlers As Collection 19 | End Type 20 | Private This As TState 21 | 22 | Private Sub Class_Initialize() 23 | Set This.Handlers = New Collection 24 | End Sub 25 | 26 | Private Sub IDisposable_Dispose() 27 | Set This.Handlers = Nothing 28 | End Sub 29 | 30 | Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 31 | Dim Handler As IHandlePropertyChanged 32 | For Each Handler In This.Handlers 33 | Handler.HandlePropertyChanged Source, PropertyName 34 | Next 35 | End Sub 36 | 37 | Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged) 38 | This.Handlers.Add Handler 39 | End Sub 40 | -------------------------------------------------------------------------------- /src/RequiredStringValidator.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/src/RequiredStringValidator.cls -------------------------------------------------------------------------------- /src/Resources.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Resources 3 | Caption = "Resources" 4 | ClientHeight = 804 5 | ClientLeft = -96 6 | ClientTop = -252 7 | ClientWidth = 624 8 | OleObjectBlob = "Resources.frx":0000 9 | StartUpPosition = 1 'CenterOwner 10 | End 11 | Attribute VB_Name = "Resources" 12 | Attribute VB_GlobalNameSpace = False 13 | Attribute VB_Creatable = False 14 | Attribute VB_PredeclaredId = True 15 | Attribute VB_Exposed = False 16 | '@Folder MVVM.Resources 17 | Option Explicit 18 | -------------------------------------------------------------------------------- /src/Resources.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rubberduck-vba/MVVM/02a486f04be79c5fcff468b055f422d95cb6633c/src/Resources.frx -------------------------------------------------------------------------------- /src/ScrollBarBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ScrollBarBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = ScrollBarPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = ScrollBarPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/ScrollBarPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ScrollBarPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | Implements IPropertyBinding 15 | Implements IDisposable 16 | Implements IHandlePropertyChanged 17 | 18 | Private WithEvents TargetEventSource As MSForms.ScrollBar 19 | Attribute TargetEventSource.VB_VarHelpID = -1 20 | 21 | Private Const DefaultTargetControlProperty As String = "Value" 22 | Private Const FormsControlProgId As String = "Forms.ScrollBar.1" 23 | 24 | Private Type TState 25 | Base As PropertyBindingBase 26 | Handler As IHandlePropertyChanged 27 | End Type 28 | 29 | Private This As TState 30 | 31 | Public Property Get DefaultTargetProperty() As String 32 | DefaultTargetProperty = DefaultTargetControlProperty 33 | End Property 34 | 35 | Public Property Get ProgID() As String 36 | ProgID = FormsControlProgId 37 | End Property 38 | 39 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As MSForms.ScrollBar, _ 40 | Optional ByVal TargetProperty As String = DefaultTargetControlProperty, _ 41 | Optional ByVal Mode As BindingMode = BindingMode.TwoWayBinding, _ 42 | Optional ByVal UpdateSource As BindingUpdateSourceTrigger = OnPropertyChanged, _ 43 | Optional ByVal Validator As IValueValidator, _ 44 | Optional ByVal Converter As IValueConverter, _ 45 | Optional ByVal StringFormat As IStringFormatter, _ 46 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 47 | 48 | Dim BindingBase As PropertyBindingBase 49 | Set BindingBase = PropertyBindingBase _ 50 | .Create(Context, Source, Target, TargetProperty, _ 51 | Mode:=Mode, _ 52 | UpdateSource:=UpdateSource, _ 53 | Validator:=Validator, _ 54 | Converter:=Converter, _ 55 | StringFormat:=StringFormat, _ 56 | ValidationAdorner:=ValidationAdorner) 57 | 58 | Dim Result As ScrollBarPropertyBinding 59 | Set Result = New ScrollBarPropertyBinding 60 | 61 | If Not Validator Is Nothing Then 62 | BindingBase.AsINotifyValidationError.RegisterHandler ValidationManager 63 | End If 64 | 65 | Result.InjectBindingInfo BindingBase 66 | Set Create = Result 67 | 68 | End Function 69 | 70 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 71 | GuardClauses.GuardDefaultInstance Me, ScrollBarPropertyBinding, TypeName(Me) 72 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 73 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 74 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 75 | Set This.Base = BindingInfo 76 | Set This.Handler = BindingInfo 77 | End Sub 78 | 79 | Private Property Get IsDefaultInstance() As Boolean 80 | IsDefaultInstance = Me Is ScrollBarPropertyBinding 81 | End Property 82 | 83 | Private Sub IDisposable_Dispose() 84 | Set This.Handler = Nothing 85 | Disposable.TryDispose This.Base 86 | Set This.Base = Nothing 87 | End Sub 88 | 89 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 90 | This.Handler.HandlePropertyChanged Source, PropertyName 91 | End Sub 92 | 93 | Private Sub IPropertyBinding_Apply() 94 | This.Base.Apply 95 | End Sub 96 | 97 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 98 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 99 | End Property 100 | 101 | Private Property Get IPropertyBinding_Converter() As IValueConverter 102 | Set IPropertyBinding_Converter = This.Base.Converter 103 | End Property 104 | 105 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 106 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 107 | End Property 108 | 109 | Private Property Get IPropertyBinding_Mode() As BindingMode 110 | IPropertyBinding_Mode = This.Base.Mode 111 | End Property 112 | 113 | Private Property Get IPropertyBinding_Source() As IBindingPath 114 | Set IPropertyBinding_Source = This.Base.Source 115 | End Property 116 | 117 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 118 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 119 | End Property 120 | 121 | Private Property Get IPropertyBinding_Target() As IBindingPath 122 | Set IPropertyBinding_Target = This.Base.Target 123 | End Property 124 | 125 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 126 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 127 | End Property 128 | 129 | Private Property Get IPropertyBinding_Validator() As IValueValidator 130 | Set IPropertyBinding_Validator = This.Base.Validator 131 | End Property 132 | 133 | Private Sub TargetEventSource_Change() 134 | If This.Base.UpdateSourceTrigger = OnPropertyChanged Then This.Base.ApplyToSource 135 | End Sub 136 | 137 | -------------------------------------------------------------------------------- /src/Sheet1.doccls: -------------------------------------------------------------------------------- 1 | Option Explicit 2 | -------------------------------------------------------------------------------- /src/Sheet2.doccls: -------------------------------------------------------------------------------- 1 | '@Folder ExcelHost 2 | Option Explicit 3 | -------------------------------------------------------------------------------- /src/Sheet3.doccls: -------------------------------------------------------------------------------- 1 | '@Folder ExcelHost 2 | Option Explicit 3 | -------------------------------------------------------------------------------- /src/SpinButtonBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "SpinButtonBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = SpinButtonPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | StringFormat:=StringFormat, _ 26 | Converter:=Converter, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = SpinButtonPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/SpinButtonPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "SpinButtonPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | Implements IPropertyBinding 15 | Implements IDisposable 16 | Implements IHandlePropertyChanged 17 | 18 | Private WithEvents TargetEventSource As MSForms.SpinButton 19 | Attribute TargetEventSource.VB_VarHelpID = -1 20 | 21 | Private Const DefaultTargetControlProperty As String = "Value" 22 | Private Const FormsControlProgId As String = "Forms.SpinButton.1" 23 | 24 | Private Type TState 25 | Base As PropertyBindingBase 26 | Handler As IHandlePropertyChanged 27 | End Type 28 | 29 | Private This As TState 30 | 31 | Public Property Get DefaultTargetProperty() As String 32 | DefaultTargetProperty = DefaultTargetControlProperty 33 | End Property 34 | 35 | Public Property Get ProgID() As String 36 | ProgID = FormsControlProgId 37 | End Property 38 | 39 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As MSForms.SpinButton, _ 40 | Optional ByVal TargetProperty As String = DefaultTargetControlProperty, _ 41 | Optional ByVal Mode As BindingMode = BindingMode.OneWayBinding, _ 42 | Optional ByVal UpdateSource As BindingUpdateSourceTrigger = OnPropertyChanged, _ 43 | Optional ByVal Validator As IValueValidator, _ 44 | Optional ByVal Converter As IValueConverter, _ 45 | Optional ByVal StringFormat As IStringFormatter, _ 46 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 47 | 48 | Dim BindingBase As PropertyBindingBase 49 | Set BindingBase = PropertyBindingBase _ 50 | .Create(Context, Source, Target, TargetProperty, _ 51 | Mode:=Mode, _ 52 | UpdateSource:=UpdateSource, _ 53 | Converter:=Converter, _ 54 | StringFormat:=StringFormat, _ 55 | Validator:=Validator, _ 56 | ValidationAdorner:=ValidationAdorner) 57 | 58 | Dim Result As SpinButtonPropertyBinding 59 | Set Result = New SpinButtonPropertyBinding 60 | 61 | Result.InjectBindingInfo BindingBase 62 | Set Create = Result 63 | 64 | End Function 65 | 66 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 67 | GuardClauses.GuardDefaultInstance Me, SpinButtonPropertyBinding, TypeName(Me) 68 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 69 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 70 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 71 | Set This.Base = BindingInfo 72 | Set This.Handler = BindingInfo 73 | End Sub 74 | 75 | Private Property Get IsDefaultInstance() As Boolean 76 | IsDefaultInstance = Me Is SpinButtonPropertyBinding 77 | End Property 78 | 79 | Private Sub IDisposable_Dispose() 80 | Set This.Handler = Nothing 81 | Disposable.TryDispose This.Base 82 | Set This.Base = Nothing 83 | End Sub 84 | 85 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 86 | This.Handler.HandlePropertyChanged Source, PropertyName 87 | End Sub 88 | 89 | Private Sub IPropertyBinding_Apply() 90 | This.Base.Apply 91 | End Sub 92 | 93 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 94 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 95 | End Property 96 | 97 | Private Property Get IPropertyBinding_Converter() As IValueConverter 98 | Set IPropertyBinding_Converter = This.Base.Converter 99 | End Property 100 | 101 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 102 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 103 | End Property 104 | 105 | Private Property Get IPropertyBinding_Mode() As BindingMode 106 | IPropertyBinding_Mode = This.Base.Mode 107 | End Property 108 | 109 | Private Property Get IPropertyBinding_Source() As IBindingPath 110 | Set IPropertyBinding_Source = This.Base.Source 111 | End Property 112 | 113 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 114 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 115 | End Property 116 | 117 | Private Property Get IPropertyBinding_Target() As IBindingPath 118 | Set IPropertyBinding_Target = This.Base.Target 119 | End Property 120 | 121 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 122 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 123 | End Property 124 | 125 | Private Property Get IPropertyBinding_Validator() As IValueValidator 126 | Set IPropertyBinding_Validator = This.Base.Validator 127 | End Property 128 | 129 | Private Sub TargetEventSource_Change() 130 | If This.Base.UpdateSourceTrigger = OnPropertyChanged Then This.Base.ApplyToSource 131 | End Sub 132 | 133 | -------------------------------------------------------------------------------- /src/StringFormatterNet.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringFormatterNet" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object representing a format string in a notation compatible for use with .NET String.Format()." 11 | '@Folder MVVM.Infrastructure.StringFormatting 12 | '@ModuleDescription "An object representing a format string in a notation compatible for use with .NET String.Format()." 13 | '@PredeclaredId 14 | '@Exposed 15 | 'NOTE: 'VF: renamed to StringFormatterNet from StringFormatter in parallel to StringFormatterVB 16 | Option Explicit 17 | Implements IStringFormatter 18 | 19 | Private Type TState 20 | FormatString As String 21 | End Type 22 | 23 | Private This As TState 24 | 25 | Public Function Create(ByVal FormatString As String) As IStringFormatter 26 | Dim Result As StringFormatterNet 27 | Set Result = New StringFormatterNet 28 | Result.FormatString = FormatString 29 | Set Create = Result 30 | End Function 31 | 32 | Public Property Get FormatString() As String 33 | FormatString = This.FormatString 34 | End Property 35 | 36 | Friend Property Let FormatString(ByVal RHS As String) 37 | GuardClauses.GuardDefaultInstance Me, StringFormatterNet 38 | This.FormatString = RHS 39 | End Property 40 | 41 | Private Function IStringFormatter_Format(ParamArray Values() As Variant) As String 42 | Dim LocalArgs() As Variant 43 | 'NOTE to myself: 'VF: rationale for taking lbound member as args? due use of .net stringbuilder? 44 | '?? where Set Context = AppContext.Create(FormatterFactory:=New VBStringFormatterFactory) 45 | If IsArray(Values(LBound(Values))) Then 46 | LocalArgs = Values(LBound(Values)) 47 | Else 48 | ReDim LocalArgs(LBound(Values) To UBound(Values)) 49 | Dim Index As Long 50 | For Index = LBound(Values) To UBound(Values) 51 | LocalArgs(Index) = Values(Index) 52 | Next 53 | End If 54 | With StringBuilderNet.AppendFormat(This.FormatString, LocalArgs) 55 | IStringFormatter_Format = .ToString 56 | End With 57 | End Function 58 | 59 | Private Property Get IStringFormatter_FormatString() As String 60 | IStringFormatter_FormatString = This.FormatString 61 | End Property 62 | -------------------------------------------------------------------------------- /src/StringFormatterNetFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringFormatterNetFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A factory that creates new .NET-syntax string formatters." 11 | '@Folder MVVM.Infrastructure.StringFormatting 12 | '@ModuleDescription "A factory that creates new .NET-syntax string formatters." 13 | Option Explicit 14 | Implements IStringFormatterFactory 15 | 16 | Private Function IStringFormatterFactory_Create(ByVal FormatString As String) As IStringFormatter 17 | Set IStringFormatterFactory_Create = StringFormatterNet.Create(FormatString) 18 | End Function 19 | -------------------------------------------------------------------------------- /src/StringFormatterVB.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringFormatterVB" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object representing a format string in a notation compatible for use with VBA.Strings.Format$()." 11 | '@Folder MVVM.Infrastructure.StringFormatting 12 | '@ModuleDescription "An object representing a format string in a notation compatible for use with VBA.Strings.Format$()." 13 | '@PredeclaredId 14 | '@Exposed 15 | 'NOTE: 'VF: renamed to StringFormatterVB from VBStringFormatter (in parallel to StringFormatterNet 16 | Option Explicit 17 | Implements IStringFormatter 18 | 19 | Private Type TState 20 | FormatString As String 21 | End Type 22 | 23 | Private This As TState 24 | 25 | Public Function Create(ByVal FormatString As String) As IStringFormatter 26 | Dim Result As StringFormatterVB 27 | Set Result = New StringFormatterVB 28 | Result.FormatString = FormatString 29 | Set Create = Result 30 | End Function 31 | 32 | Public Property Get FormatString() As String 33 | FormatString = This.FormatString 34 | End Property 35 | 36 | Friend Property Let FormatString(ByVal RHS As String) 37 | GuardClauses.GuardDefaultInstance Me, StringFormatterVB 38 | This.FormatString = RHS 39 | End Property 40 | 41 | Private Function IStringFormatter_Format(ParamArray Values() As Variant) As String 42 | GuardClauses.GuardExpression LBound(Values) <> UBound(Values), TypeName(Me), "This implementation only supports formatting a single value at a time." 43 | Dim LocalArgs() As Variant 44 | If IsArray(Values(LBound(Values))) Then 45 | LocalArgs = Values(LBound(Values)) 46 | Else 47 | ReDim LocalArgs(LBound(Values) To UBound(Values)) 48 | Dim Index As Long 49 | For Index = LBound(Values) To UBound(Values) 50 | LocalArgs(Index) = Values(Index) 51 | Next 52 | End If 53 | 'NOTE: to myself ToDo: 'VF: try out formatting string array like this separately 54 | IStringFormatter_Format = VBA.Strings.Format$(LocalArgs(LBound(LocalArgs)), This.FormatString) 55 | End Function 56 | 57 | Private Property Get IStringFormatter_FormatString() As String 58 | IStringFormatter_FormatString = This.FormatString 59 | End Property 60 | -------------------------------------------------------------------------------- /src/StringFormatterVBFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringFormatterVBFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A factory that creates new VB-syntax string formatters." 11 | '@Folder MVVM.Infrastructure.StringFormatting 12 | '@ModuleDescription "A factory that creates new VB-syntax string formatters." 13 | Option Explicit 14 | Implements IStringFormatterFactory 15 | 16 | Private Function IStringFormatterFactory_Create(ByVal FormatString As String) As IStringFormatter 17 | Set IStringFormatterFactory_Create = StringFormatterVB.Create(FormatString) 18 | End Function 19 | -------------------------------------------------------------------------------- /src/StringToDateConverter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringToDateConverter" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A value converter that can convert a String into a Date, or a Date into a String." 11 | '@Folder MVVM.Common.Converters 12 | '@ModuleDescription "A value converter that can convert a String into a Date, or a Date into a String." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IValueConverter 17 | 18 | Public Function Default() As IValueConverter 19 | GuardClauses.GuardNonDefaultInstance Me, StringToDateConverter 20 | Set Default = StringToDateConverter 21 | End Function 22 | 23 | Private Function IValueConverter_Convert(ByVal Value As Variant) As Variant 24 | IValueConverter_Convert = Convert(Value) 25 | End Function 26 | 27 | Private Function IValueConverter_ConvertBack(ByVal Value As Variant) As Variant 28 | IValueConverter_ConvertBack = Convert(Value) 29 | End Function 30 | 31 | Private Function Convert(ByVal Value As Variant) As Variant 32 | GuardClauses.GuardExpression Not IsDate(Value), TypeName(Me), "Value '" & Value & "' was not recognized as a valid date." 33 | If VarType(Value) = vbDate Then 34 | Convert = CStr(Value) 35 | Else 36 | Convert = CDate(Value) 37 | End If 38 | End Function 39 | -------------------------------------------------------------------------------- /src/TabStripBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TabStripBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = TabStripPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Validator:=Validator, _ 25 | Converter:=Converter, _ 26 | StringFormat:=StringFormat, _ 27 | ValidationAdorner:=ValidationAdorner) 28 | 29 | End Function 30 | 31 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 32 | ByVal Mode As BindingMode, _ 33 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 34 | ByVal Validator As IValueValidator, _ 35 | ByVal Converter As IValueConverter, _ 36 | ByVal StringFormat As IStringFormatter, _ 37 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 38 | 39 | Set IBindingTargetStrategy_PropertyBindingFor = TabStripPropertyBinding _ 40 | .Create(Context, Source, Target.Context, Target.Path, _ 41 | Mode:=Mode, _ 42 | UpdateSource:=UpdateTrigger, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/TabStripPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TabStripPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | Implements IPropertyBinding 15 | Implements IDisposable 16 | Implements IHandlePropertyChanged 17 | 18 | Private WithEvents TargetEventSource As MSForms.TabStrip 19 | Attribute TargetEventSource.VB_VarHelpID = -1 20 | 21 | Private Const DefaultTargetControlProperty As String = "Value" 22 | Private Const FormsControlProgId As String = "Forms.TabStrip.1" 23 | 24 | Private Type TState 25 | Base As PropertyBindingBase 26 | Handler As IHandlePropertyChanged 27 | End Type 28 | 29 | Private This As TState 30 | 31 | Public Property Get DefaultTargetProperty() As String 32 | DefaultTargetProperty = DefaultTargetControlProperty 33 | End Property 34 | 35 | Public Property Get ProgID() As String 36 | ProgID = FormsControlProgId 37 | End Property 38 | 39 | Public Function Create(ByVal Context As IAppContext, Source As IBindingPath, ByVal Target As MSForms.TabStrip, _ 40 | Optional ByVal TargetProperty As String = DefaultTargetControlProperty, _ 41 | Optional ByVal Mode As BindingMode = BindingMode.TwoWayBinding, _ 42 | Optional ByVal UpdateSource As BindingUpdateSourceTrigger = OnPropertyChanged, _ 43 | Optional ByVal Validator As IValueValidator, _ 44 | Optional ByVal Converter As IValueConverter, _ 45 | Optional ByVal StringFormat As IStringFormatter, _ 46 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 47 | 48 | Dim BindingBase As PropertyBindingBase 49 | Set BindingBase = PropertyBindingBase _ 50 | .Create(Context, Source, Target, TargetProperty, _ 51 | Mode:=Mode, _ 52 | UpdateSource:=UpdateSource, _ 53 | Validator:=Validator, _ 54 | Converter:=Converter, _ 55 | StringFormat:=StringFormat, _ 56 | ValidationAdorner:=ValidationAdorner) 57 | 58 | Dim Result As TabStripPropertyBinding 59 | Set Result = New TabStripPropertyBinding 60 | 61 | Result.InjectBindingInfo BindingBase 62 | Set Create = Result 63 | 64 | End Function 65 | 66 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 67 | GuardClauses.GuardDefaultInstance Me, TabStripPropertyBinding, TypeName(Me) 68 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 69 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 70 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 71 | Set This.Base = BindingInfo 72 | Set This.Handler = BindingInfo 73 | End Sub 74 | 75 | Private Property Get IsDefaultInstance() As Boolean 76 | IsDefaultInstance = Me Is TabStripPropertyBinding 77 | End Property 78 | 79 | Private Sub IDisposable_Dispose() 80 | Set This.Handler = Nothing 81 | Disposable.TryDispose This.Base 82 | Set This.Base = Nothing 83 | End Sub 84 | 85 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 86 | This.Handler.HandlePropertyChanged Source, PropertyName 87 | End Sub 88 | 89 | Private Sub IPropertyBinding_Apply() 90 | This.Base.Apply 91 | End Sub 92 | 93 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 94 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 95 | End Property 96 | 97 | Private Property Get IPropertyBinding_Converter() As IValueConverter 98 | Set IPropertyBinding_Converter = This.Base.Converter 99 | End Property 100 | 101 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 102 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 103 | End Property 104 | 105 | Private Property Get IPropertyBinding_Mode() As BindingMode 106 | IPropertyBinding_Mode = This.Base.Mode 107 | End Property 108 | 109 | Private Property Get IPropertyBinding_Source() As IBindingPath 110 | Set IPropertyBinding_Source = This.Base.Source 111 | End Property 112 | 113 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 114 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 115 | End Property 116 | 117 | Private Property Get IPropertyBinding_Target() As IBindingPath 118 | Set IPropertyBinding_Target = This.Base.Target 119 | End Property 120 | 121 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 122 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 123 | End Property 124 | 125 | Private Property Get IPropertyBinding_Validator() As IValueValidator 126 | Set IPropertyBinding_Validator = This.Base.Validator 127 | End Property 128 | 129 | Private Sub TargetEventSource_Change() 130 | If This.Base.UpdateSourceTrigger = OnPropertyChanged Then This.Base.ApplyToSource 131 | End Sub 132 | 133 | -------------------------------------------------------------------------------- /src/TestBindingManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestBindingManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder Tests.Stubs 11 | Option Explicit 12 | Implements ITestStub 13 | Implements IBindingManager 14 | Implements IHandlePropertyChanged 15 | 16 | Private Type TState 17 | Stub As TestStubBase 18 | Context As IAppContext 19 | PropertyBindings As Collection 20 | NotifierFactory As INotifierFactory 21 | StringFormatterFactory As IStringFormatterFactory 22 | DebugOutput As Boolean 23 | End Type 24 | 25 | Private This As TState 26 | 27 | Public Property Get NotifierFactory() As INotifierFactory 28 | Set NotifierFactory = This.NotifierFactory 29 | End Property 30 | 31 | Private Sub Class_Initialize() 32 | Set This.Stub = New TestStubBase 33 | 'Set This.Context = TestAppContext.Create 34 | Set This.NotifierFactory = New TestNotifierFactory 35 | Set This.PropertyBindings = New Collection 36 | End Sub 37 | 38 | Private Sub IBindingManager_Apply(ByVal Source As Object) 39 | This.Stub.OnInvoke "Apply" 40 | End Sub 41 | 42 | 'Private Function IBindingManager_BindPropertyPath(ByVal Source As Object, ByVal PropertyPath As String, ByVal Target As Object, _ 43 | Optional ByVal TargetProperty As String, _ 44 | Optional ByVal Mode As BindingMode = 0&, _ 45 | Optional ByVal UpdateTrigger As BindingUpdateSourceTrigger = 1&, _ 46 | Optional ByVal Validator As IValueValidator, _ 47 | Optional ByVal Converter As IValueConverter, _ 48 | Optional ByVal FormatString As String, _ 49 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 50 | 'VF: changed default UpdateTrigger due to revised enum BindingUpdateSourceTrigger 51 | Private Function IBindingManager_BindPropertyPath(ByVal Source As Object, ByVal PropertyPath As String, ByVal Target As Object, _ 52 | Optional ByVal TargetProperty As String, _ 53 | Optional ByVal Mode As BindingMode = 0&, _ 54 | Optional ByVal UpdateTrigger As BindingUpdateSourceTrigger = 2&, _ 55 | Optional ByVal Validator As IValueValidator, _ 56 | Optional ByVal Converter As IValueConverter, _ 57 | Optional ByVal FormatString As String, _ 58 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 59 | 60 | This.Stub.OnInvoke "BindPropertyPath" 61 | 62 | Dim Binding As IPropertyBinding 63 | Set Binding = TestPropertyBinding.Create(This.Context, BindingPath.Create(Source, PropertyPath), Target, TargetProperty, Mode, UpdateTrigger, Validator, Converter, This.StringFormatterFactory.Create(FormatString), ValidationAdorner) 64 | This.PropertyBindings.Add Binding 65 | 66 | Set IBindingManager_BindPropertyPath = Binding 67 | End Function 68 | 69 | Private Property Get IBindingManager_DebugOutput() As Boolean 70 | This.Stub.OnInvoke "DebugOutput.Get" 71 | IBindingManager_DebugOutput = This.DebugOutput 72 | End Property 73 | 74 | Private Property Get IBindingManager_NotifierFactory() As INotifierFactory 75 | This.Stub.OnInvoke "NotifierFactory.Get" 76 | Set IBindingManager_NotifierFactory = This.NotifierFactory 77 | End Property 78 | 79 | Private Property Get IBindingManager_StringFormatterFactory() As IStringFormatterFactory 80 | This.Stub.OnInvoke "StringFormatterFactory.Get" 81 | Set IBindingManager_StringFormatterFactory = This.StringFormatterFactory 82 | End Property 83 | 84 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 85 | This.Stub.OnInvoke "OnPropertyChanged" 86 | End Sub 87 | 88 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 89 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 90 | End Property 91 | 92 | Private Function ITestStub_ToString() As String 93 | ITestStub_ToString = This.Stub.ToString 94 | End Function 95 | 96 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 97 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 98 | End Sub 99 | 100 | -------------------------------------------------------------------------------- /src/TestBindingObject.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestBindingObject" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "An object that can stub a binding source or target for unit tests." 11 | '@Folder Tests.Stubs 12 | '@ModuleDescription "An object that can stub a binding source or target for unit tests." 13 | '@PredeclaredId 14 | Option Explicit 15 | Implements ITestStub 16 | Implements INotifyPropertyChanged 17 | Implements IHandlePropertyChanged ' intercept events handled in PropertyBindingBase 18 | 19 | Private Type TState 20 | Stub As TestStubBase 21 | Handlers As Collection 22 | TestStringProperty As String 23 | TestNumericProperty As Long 24 | TestBindingObjectProperty As TestBindingObject 25 | End Type 26 | 27 | Private This As TState 28 | 29 | Public Function Create() As TestBindingObject 30 | GuardClauses.GuardNonDefaultInstance Me, TestBindingObject, TypeName(Me) 31 | Dim Result As TestBindingObject 32 | Set Result = New TestBindingObject 33 | Set Create = Result 34 | End Function 35 | 36 | Public Property Get TestStringProperty() As String 37 | This.Stub.OnInvoke "TestStringProperty.Get" 38 | TestStringProperty = This.TestStringProperty 39 | End Property 40 | 41 | Public Property Let TestStringProperty(ByVal RHS As String) 42 | This.Stub.OnInvoke "TestStringProperty.Let" 43 | If This.TestStringProperty <> RHS Then 44 | This.TestStringProperty = RHS 45 | OnPropertyChanged Me, "TestStringProperty" 46 | End If 47 | End Property 48 | 49 | Public Property Get TestNumericProperty() As Long 50 | This.Stub.OnInvoke "TestNumericProperty.Get" 51 | TestNumericProperty = This.TestNumericProperty 52 | End Property 53 | 54 | Public Property Let TestNumericProperty(ByVal RHS As Long) 55 | This.Stub.OnInvoke "TestNumericProperty.Let" 56 | If This.TestNumericProperty <> RHS Then 57 | This.TestNumericProperty = RHS 58 | OnPropertyChanged Me, "TestNumericProperty" 59 | End If 60 | End Property 61 | 62 | Public Property Get TestBindingObjectProperty() As TestBindingObject 63 | This.Stub.OnInvoke "TestBindingObjectProperty.Get" 64 | Set TestBindingObjectProperty = This.TestBindingObjectProperty 65 | End Property 66 | 67 | Public Property Set TestBindingObjectProperty(ByVal RHS As TestBindingObject) 68 | This.Stub.OnInvoke "TestBindingObjectProperty.Set" 69 | If Not This.TestBindingObjectProperty Is RHS Then 70 | Set This.TestBindingObjectProperty = RHS 71 | OnPropertyChanged Me, "TestBindingObjectProperty" 72 | End If 73 | End Property 74 | 75 | Private Sub OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 76 | Dim Handler As IHandlePropertyChanged 77 | For Each Handler In This.Handlers 78 | Handler.HandlePropertyChanged Source, PropertyName 79 | Next 80 | End Sub 81 | 82 | Private Sub Class_Initialize() 83 | Set This.Stub = New TestStubBase 84 | Set This.Handlers = New Collection 85 | End Sub 86 | 87 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 88 | OnPropertyChanged Source, PropertyName 89 | End Sub 90 | 91 | Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 92 | OnPropertyChanged Source, PropertyName 93 | End Sub 94 | 95 | Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged) 96 | This.Handlers.Add Handler 97 | End Sub 98 | 99 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 100 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 101 | End Property 102 | 103 | Private Function ITestStub_ToString() As String 104 | ITestStub_ToString = This.Stub.ToString 105 | End Function 106 | 107 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 108 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 109 | End Sub 110 | -------------------------------------------------------------------------------- /src/TestCommand.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestCommand" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "An object that can stub an ICommand dependency in a unit test." 11 | '@Folder Tests.Stubs 12 | '@ModuleDescription "An object that can stub an ICommand dependency in a unit test." 13 | Option Explicit 14 | Implements ICommand 15 | Implements ITestStub 16 | 17 | Private Const CanExecuteDefaultValue As Boolean = True 18 | 19 | Private Type TState 20 | Stub As TestStubBase 21 | CanExecute As Boolean 22 | End Type 23 | 24 | Private This As TState 25 | 26 | '@Description "Controls the return value of ICommand.CanExecute. True by default." 27 | Public Property Get CanExecute() As Boolean 28 | Attribute CanExecute.VB_Description = "Controls the return value of ICommand.CanExecute. True by default." 29 | CanExecute = This.CanExecute 30 | End Property 31 | 32 | Public Property Let CanExecute(ByVal RHS As Boolean) 33 | This.CanExecute = RHS 34 | End Property 35 | 36 | Private Sub Class_Initialize() 37 | Set This.Stub = New TestStubBase 38 | This.CanExecute = CanExecuteDefaultValue 39 | End Sub 40 | 41 | Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean 42 | This.Stub.OnInvoke "CanExecute" 43 | ICommand_CanExecute = This.CanExecute 44 | End Function 45 | 46 | Private Property Get ICommand_Description() As String 47 | This.Stub.OnInvoke "Description.Get" 48 | ICommand_Description = "A " & TypeName(Me) & " instance tracks the number of times its members are invoked." 49 | End Property 50 | 51 | Private Sub ICommand_Execute(ByVal Context As Object) 52 | This.Stub.OnInvoke "Execute" 53 | End Sub 54 | 55 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 56 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 57 | End Property 58 | 59 | Private Function ITestStub_ToString() As String 60 | ITestStub_ToString = This.Stub.ToString 61 | End Function 62 | 63 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 64 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 65 | End Sub 66 | -------------------------------------------------------------------------------- /src/TestCommandManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestCommandManager" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder Tests.Stubs 11 | Option Explicit 12 | Implements ICommandManager 13 | Implements ITestStub 14 | 15 | Private Type TState 16 | Stub As TestStubBase 17 | End Type 18 | 19 | Private This As TState 20 | 21 | Private Sub Class_Initialize() 22 | Set This.Stub = New TestStubBase 23 | End Sub 24 | 25 | Private Function ICommandManager_BindCommand(ByVal BindingContext As Object, ByVal Target As Object, ByVal Command As ICommand) As ICommandBinding 26 | This.Stub.OnInvoke "BindCommand" 27 | End Function 28 | 29 | Private Sub ICommandManager_EvaluateCanExecute(ByVal BindingContext As Object) 30 | This.Stub.OnInvoke "EvaluateCanExecute" 31 | End Sub 32 | 33 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 34 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 35 | End Property 36 | 37 | Private Function ITestStub_ToString() As String 38 | ITestStub_ToString = This.Stub.ToString 39 | End Function 40 | 41 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 42 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 43 | End Sub 44 | 45 | 46 | -------------------------------------------------------------------------------- /src/TestNotifierFactory.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestNotifierFactory" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "A factory that creates TestPropertyChangeNotifier instances." 11 | '@Folder Tests.Stubs 12 | '@ModuleDescription "A factory that creates TestPropertyChangeNotifier instances." 13 | Option Explicit 14 | Implements INotifierFactory 15 | 16 | Private Function INotifierFactory_Create() As INotifyPropertyChanged 17 | Set INotifierFactory_Create = New TestPropertyChangeNotifier 18 | End Function 19 | -------------------------------------------------------------------------------- /src/TestPropertyChangeNotifier.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestPropertyChangeNotifier" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder("Tests.Stubs") 11 | Option Explicit 12 | Implements INotifyPropertyChanged 13 | Implements ITestStub 14 | 15 | Private Type TState 16 | Handlers As Collection 17 | Stub As TestStubBase 18 | End Type 19 | Private This As TState 20 | 21 | Public Property Get Handlers() As Collection 22 | Set Handlers = This.Handlers 23 | End Property 24 | 25 | Public Property Get Stub() As ITestStub 26 | Set Stub = This.Stub 27 | End Property 28 | 29 | Private Sub Class_Initialize() 30 | Set This.Handlers = New Collection 31 | Set This.Stub = New TestStubBase 32 | End Sub 33 | 34 | Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 35 | This.Stub.OnInvoke "OnPropertyChanged" 36 | Dim Handler As IHandlePropertyChanged 37 | For Each Handler In This.Handlers 38 | Handler.HandlePropertyChanged Source, PropertyName 39 | Next 40 | End Sub 41 | 42 | Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged) 43 | This.Stub.OnInvoke "RegisterHandler" 44 | This.Handlers.Add Handler 45 | End Sub 46 | 47 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 48 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 49 | End Property 50 | 51 | Private Function ITestStub_ToString() As String 52 | ITestStub_ToString = This.Stub.ToString 53 | End Function 54 | 55 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 56 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 57 | End Sub 58 | 59 | -------------------------------------------------------------------------------- /src/TestStubBase.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestStubBase" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder Tests.Stubs 11 | Option Explicit 12 | 13 | Private Type TState 14 | MemberInvokes As Dictionary 15 | End Type 16 | 17 | Private This As TState 18 | 19 | '@Description "Tracks a new invoke of the specified member." 20 | Public Sub OnInvoke(ByVal MemberName As String) 21 | Attribute OnInvoke.VB_Description = "Tracks a new invoke of the specified member." 22 | Dim NewValue As Long 23 | If This.MemberInvokes.Exists(MemberName) Then 24 | NewValue = This.MemberInvokes.Item(MemberName) + 1 25 | This.MemberInvokes.Remove MemberName 26 | Else 27 | NewValue = 1 28 | End If 29 | This.MemberInvokes.Add MemberName, NewValue 30 | Debug.Print TypeName(Me) & ": OnInvoke(" & MemberName & ") was invoked" 31 | End Sub 32 | 33 | '@Description "Gets the number of invokes made against the specified member in the lifetime of this object." 34 | Public Property Get MemberInvokes(ByVal MemberName As String) As Long 35 | Attribute MemberInvokes.VB_Description = "Gets the number of invokes made against the specified member in the lifetime of this object." 36 | If This.MemberInvokes.Exists(MemberName) Then 37 | MemberInvokes = This.MemberInvokes.Item(MemberName) 38 | Else 39 | MemberInvokes = 0 40 | End If 41 | End Property 42 | 43 | '@Description "Gets a string listing the MemberInvokes cache content." 44 | Public Function ToString() As String 45 | Attribute ToString.VB_Description = "Gets a string listing the MemberInvokes cache content." 46 | Dim MemberNames As Variant 47 | MemberNames = This.MemberInvokes.Keys 48 | 49 | With New StringBuilderNet 50 | Dim i As Long 51 | For i = LBound(MemberNames) To UBound(MemberNames) 52 | Dim Name As String 53 | Name = MemberNames(i) 54 | .AppendFormat "{0} was invoked {1} time(s)", Name, This.MemberInvokes.Item(Name) 55 | Next 56 | ToString = .ToString 57 | End With 58 | 59 | End Function 60 | 61 | Public Sub Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 62 | Dim Invokes As Long 63 | Invokes = MemberInvokes(MemberName) 64 | Assert.AreEqual ExpectedInvokes, Invokes, "Member was invoked " & Invokes & " time(s), but test expected " & ExpectedInvokes & "." 65 | End Sub 66 | 67 | Private Sub Class_Initialize() 68 | Set This.MemberInvokes = New Dictionary 69 | End Sub 70 | 71 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 72 | ITestStub_MemberInvokes = This.MemberInvokes.Item(MemberName) 73 | End Property 74 | 75 | Private Function ITestStub_ToString() As String 76 | ITestStub_ToString = ToString 77 | End Function 78 | 79 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 80 | Verify Assert, MemberName, ExpectedInvokes 81 | End Sub 82 | 83 | -------------------------------------------------------------------------------- /src/TestValueValidator.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestValueValidator" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder Tests.Stubs 11 | Option Explicit 12 | Implements IValueValidator 13 | Implements ITestStub 14 | 15 | Private Type TState 16 | Stub As TestStubBase 17 | IsValid As Boolean 18 | Message As String 19 | End Type 20 | 21 | Private This As TState 22 | 23 | '@Description "Gets/sets a value that determines whether this validator evaluates to True or False." 24 | Public Property Get IsValid() As Boolean 25 | Attribute IsValid.VB_Description = "Gets/sets a value that determines whether this validator evaluates to True or False." 26 | IsValid = This.IsValid 27 | End Property 28 | 29 | Public Property Let IsValid(ByVal RHS As Boolean) 30 | This.IsValid = RHS 31 | End Property 32 | 33 | '@Description "Gets/sets the validation error message for this validator." 34 | Public Property Get Message() As String 35 | Attribute Message.VB_Description = "Gets/sets the validation error message for this validator." 36 | Message = This.Message 37 | End Property 38 | 39 | Public Property Let Message(ByVal RHS As String) 40 | This.Message = RHS 41 | End Property 42 | 43 | Private Sub Class_Initialize() 44 | Set This.Stub = New TestStubBase 45 | End Sub 46 | 47 | Private Function IValueValidator_IsValid(ByVal Value As Variant, ByVal Source As IBindingPath, ByVal Target As IBindingPath) As Boolean 48 | This.Stub.OnInvoke "IsValid" 49 | IValueValidator_IsValid = This.IsValid 50 | End Function 51 | 52 | Private Property Get IValueValidator_Message() As String 53 | This.Stub.OnInvoke "Message" 54 | IValueValidator_Message = This.Message 55 | End Property 56 | 57 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 58 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 59 | End Property 60 | 61 | Private Function ITestStub_ToString() As String 62 | ITestStub_ToString = This.Stub.ToString 63 | End Function 64 | 65 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 66 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 67 | End Sub 68 | 69 | Private Property Get IValueValidator_Trigger() As BindingUpdateSourceTrigger 70 | IValueValidator_Trigger = OnExit 71 | End Property 72 | -------------------------------------------------------------------------------- /src/TestView.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TestView" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "An object that can stub an IView dependency in a unit test." 11 | '@Folder Tests.Stubs 12 | '@ModuleDescription "An object that can stub an IView dependency in a unit test." 13 | Option Explicit 14 | Implements ITestStub 15 | Implements IView 16 | Implements ICancellable 17 | 18 | Private Type TState 19 | Cancel As Boolean 20 | Stub As TestStubBase 21 | Shown As Boolean 22 | ViewModel As Object 23 | End Type 24 | 25 | Private This As TState 26 | 27 | '@Description "Gets a value indicating whether the stub IView is in a visible (shown) state or not." 28 | Public Property Get Visible() As Boolean 29 | Attribute Visible.VB_Description = "Gets a value indicating whether the stub IView is in a visible (shown) state or not." 30 | Visible = This.Shown 31 | End Property 32 | 33 | '@Description "Gets or sets the ViewModel object this stub is working with." 34 | Public Property Get ViewModel() As Object 35 | Attribute ViewModel.VB_Description = "Gets or sets the ViewModel object this stub is working with." 36 | Set ViewModel = This.ViewModel 37 | End Property 38 | 39 | Public Property Set ViewModel(ByVal RHS As Object) 40 | Set This.ViewModel = RHS 41 | End Property 42 | 43 | '@Description "Makes IView.ShowDialog return False (simulates a cancelled dialog)." 44 | Public Sub OnCancel() 45 | Attribute OnCancel.VB_Description = "Makes IView.ShowDialog return False (simulates a cancelled dialog)." 46 | This.Cancel = True 47 | This.Shown = False 48 | End Sub 49 | 50 | Private Sub Class_Initialize() 51 | Set This.Stub = New TestStubBase 52 | End Sub 53 | 54 | Private Property Get ICancellable_IsCancelled() As Boolean 55 | ICancellable_IsCancelled = This.Cancel 56 | End Property 57 | 58 | Private Sub ICancellable_OnCancel() 59 | This.Stub.OnInvoke "OnCancel" 60 | End Sub 61 | 62 | Private Property Get ITestStub_MemberInvokes(ByVal MemberName As String) As Long 63 | ITestStub_MemberInvokes = This.Stub.MemberInvokes(MemberName) 64 | End Property 65 | 66 | Private Function ITestStub_ToString() As String 67 | ITestStub_ToString = This.Stub.ToString 68 | End Function 69 | 70 | Private Sub ITestStub_Verify(ByVal Assert As Object, ByVal MemberName As String, ByVal ExpectedInvokes As Long) 71 | This.Stub.Verify Assert, MemberName, ExpectedInvokes 72 | End Sub 73 | 74 | Private Sub IView_Hide() 75 | This.Stub.OnInvoke "Hide" 76 | This.Shown = False 77 | End Sub 78 | 79 | Private Sub IView_Show() 80 | This.Stub.OnInvoke "Show" 81 | This.Shown = True 82 | End Sub 83 | 84 | Private Function IView_ShowDialog() As Boolean 85 | This.Stub.OnInvoke "ShowDialog" 86 | This.Shown = Not This.Cancel 87 | IView_ShowDialog = Not This.Cancel 88 | End Function 89 | 90 | Private Property Get IView_ViewModel() As Object 91 | This.Stub.OnInvoke "ViewModel.Get" 92 | Set IView_ViewModel = This.ViewModel 93 | End Property 94 | -------------------------------------------------------------------------------- /src/TextBoxBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "TextBoxBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = TextBoxPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Mode:=Mode, _ 25 | UpdateSource:=UpdateTrigger, _ 26 | Validator:=Validator, _ 27 | Converter:=Converter, _ 28 | StringFormat:=StringFormat, _ 29 | ValidationAdorner:=ValidationAdorner) 30 | 31 | End Function 32 | 33 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 34 | ByVal Mode As BindingMode, _ 35 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 36 | ByVal Validator As IValueValidator, _ 37 | ByVal Converter As IValueConverter, _ 38 | ByVal StringFormat As IStringFormatter, _ 39 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 40 | 41 | Set IBindingTargetStrategy_PropertyBindingFor = TextBoxPropertyBinding _ 42 | .Create(Context, Source, Target.Context, Target.Path, _ 43 | Mode:=Mode, _ 44 | UpdateSource:=UpdateTrigger, _ 45 | Validator:=Validator, _ 46 | Converter:=Converter, _ 47 | StringFormat:=StringFormat, _ 48 | ValidationAdorner:=ValidationAdorner) 49 | 50 | End Function 51 | -------------------------------------------------------------------------------- /src/ThisWorkbook.doccls: -------------------------------------------------------------------------------- 1 | '@Folder ExcelHost 2 | Option Explicit 3 | -------------------------------------------------------------------------------- /src/ValidationError.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ValidationError" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = False 10 | Attribute VB_Description = "Represents a binding validation error." 11 | '@Folder MVVM.Infrastructure.Validation 12 | '@ModuleDescription "Represents a binding validation error." 13 | '@PredeclaredId 14 | Option Explicit 15 | 16 | Implements IValidationError 17 | 18 | Private Type TState 19 | Binding As IPropertyBinding 20 | Message As String 21 | End Type 22 | 23 | Private This As TState 24 | 25 | '@Description "Creates a new instance of a validation error object." 26 | Public Function Create(ByVal Binding As IPropertyBinding, ByVal Message As String) As IValidationError 27 | Attribute Create.VB_Description = "Creates a new instance of a validation error object." 28 | GuardClauses.GuardNonDefaultInstance Me, ValidationError, TypeName(Me) 29 | Dim Result As ValidationError 30 | Set Result = New ValidationError 31 | Set Result.Binding = Binding 32 | Result.Message = Message 33 | Set Create = Result 34 | End Function 35 | 36 | '@Description "The validation error message." 37 | Public Property Get Message() As String 38 | Attribute Message.VB_Description = "The validation error message." 39 | Message = This.Message 40 | End Property 41 | 42 | Public Property Let Message(ByVal RHS As String) 43 | This.Message = RHS 44 | End Property 45 | 46 | '@Description "Gets the binding responsible for this validation error." 47 | Public Property Get Binding() As IPropertyBinding 48 | Attribute Binding.VB_Description = "Gets the binding responsible for this validation error." 49 | Set Binding = This.Binding 50 | End Property 51 | 52 | Public Property Set Binding(ByVal RHS As IPropertyBinding) 53 | Set This.Binding = RHS 54 | End Property 55 | 56 | Private Property Get IValidationError_Message() As String 57 | IValidationError_Message = This.Message 58 | End Property 59 | 60 | Private Property Get IValidationError_Binding() As IPropertyBinding 61 | Set IValidationError_Binding = This.Binding 62 | End Property 63 | -------------------------------------------------------------------------------- /src/ValidationErrors.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ValidationErrors" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A collection of IValidationError objects for a given binding context (ViewModel)." 11 | '@Folder MVVM.Infrastructure.Validation 12 | '@ModuleDescription "A collection of IValidationError objects for a given binding context (ViewModel)." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | 17 | Private Type TState 18 | BindingContext As Object 19 | ValidationErrors As Collection 20 | End Type 21 | Private This As TState 22 | 23 | '@Description "Creates a new collection of IValidationError objects for the specified binding context (ViewModel)." 24 | Public Function Create(ByVal BindingContext As Object) 25 | Attribute Create.VB_Description = "Creates a new collection of IValidationError objects for the specified binding context (ViewModel)." 26 | Dim Result As ValidationErrors 27 | Set Result = New ValidationErrors 28 | Set Result.BindingContext = BindingContext 29 | Set Create = Result 30 | End Function 31 | 32 | '@Description "Gets/sets the binding context (ViewModel) for this instance." 33 | Public Property Get BindingContext() As Object 34 | Attribute BindingContext.VB_Description = "Gets/sets the binding context (ViewModel) for this instance." 35 | Set BindingContext = This.BindingContext 36 | End Property 37 | 38 | Friend Property Set BindingContext(ByVal RHS As Object) 39 | Set This.BindingContext = RHS 40 | End Property 41 | 42 | '@DefaultMember 43 | '@Description "Gets the IValidationError for the specified property; returns Nothing if there is no validation error." 44 | Public Property Get Item(ByVal PropertyName As String) As IValidationError 45 | Attribute Item.VB_Description = "Gets the IValidationError for the specified property; returns Nothing if there is no validation error." 46 | Attribute Item.VB_UserMemId = 0 47 | 'QUESTION: 'VF: Can this be set via Ruberduck? Attribute Item.VB_UserMemId = 0 48 | 'I thought this were a trick I would be telling you as I think you did not mention it anywhere on your blog, well you know them all ;-) 49 | 'actually, this trick needs some explanations for other to understand how come this works 50 | Dim Result As IValidationError 51 | On Error Resume Next 52 | Set Result = This.ValidationErrors.Item(PropertyName) 53 | On Error GoTo 0 'key not found: returns Nothing 54 | Set Item = Result 55 | End Property 56 | 57 | '@Description "Gets the number of properties with a validation error in this binding context." 58 | Public Property Get Count() As Long 59 | Attribute Count.VB_Description = "Gets the number of properties with a validation error in this binding context." 60 | Count = This.ValidationErrors.Count 61 | End Property 62 | 63 | '@Enumerator 64 | '@Description "Provides custom collection support for For Each enumeration." 65 | Public Property Get NewEnum() As IUnknown 66 | Attribute NewEnum.VB_Description = "Provides custom collection support for For Each enumeration." 67 | Attribute NewEnum.VB_UserMemId = -4 68 | 'QUESTION: 'VF: Can this be set via Ruberduck? 69 | 'Attribute NewEnum.VB_Description = "Provides custom collection support for For Each enumeration." 70 | 'Attribute NewEnum.VB_UserMemId = -4 71 | 'I thought this were a trick I would be telling you as I think you did not mention it anywhere on your blog, well you know them all ;-) 72 | 'actually, this trick needs some explanations for other to understand how come this works 73 | 'regarding collections 74 | 'http://dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/ 75 | 'Attribute NewEnum.VB_MemberFlags = "40" 'for each/next in collection 76 | Set NewEnum = This.ValidationErrors.[_NewEnum] 77 | End Property 78 | 79 | '@Description "Adds (or replaces) a validation error." 80 | Public Sub Add(ByVal ValidationError As IValidationError) 81 | Attribute Add.VB_Description = "Adds (or replaces) a validation error." 82 | 83 | Dim PropertyName As String 84 | PropertyName = ValidationError.Binding.Source.PropertyName 85 | 86 | Remove PropertyName 87 | This.ValidationErrors.Add ValidationError, PropertyName 88 | 89 | End Sub 90 | 91 | '@Description "Removes validation error for the specified property if it exists. True if successful, False if nothing was done." 92 | Public Function Remove(ByVal PropertyName As String) As Boolean 93 | Attribute Remove.VB_Description = "Removes validation error for the specified property if it exists. True if successful, False if nothing was done." 94 | Dim Existing As IValidationError 95 | Set Existing = Item(PropertyName) 96 | If Not Existing Is Nothing Then 97 | This.ValidationErrors.Remove PropertyName 98 | Remove = True 99 | End If 100 | End Function 101 | 102 | Private Sub Class_Initialize() 103 | Set This.ValidationErrors = New Collection 104 | End Sub 105 | 106 | Private Sub Class_Terminate() 107 | Set This.ValidationErrors = Nothing 108 | End Sub 109 | -------------------------------------------------------------------------------- /src/ValidationManagerTests.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ValidationManagerTests" 2 | '@Folder Tests 3 | '@TestModule 4 | Option Explicit 5 | Option Private Module 6 | 7 | Private Type TState 8 | 9 | ExpectedErrNumber As Long 10 | ExpectedErrSource As String 11 | ExpectedErrorCaught As Boolean 12 | 13 | Validator As IValueValidator 14 | 15 | ConcreteSUT As ValidationManager 16 | NotifyValidationErrorSUT As INotifyValidationError 17 | HandleValidationErrorSUT As IHandleValidationError 18 | 19 | BindingManager As IBindingManager 20 | BindingManagerStub As ITestStub 21 | 22 | CommandManager As ICommandManager 23 | CommandManagerStub As ITestStub 24 | 25 | BindingSource As TestBindingObject 26 | BindingSourceStub As ITestStub 27 | BindingTarget As TestBindingObject 28 | BindingTargetStub As ITestStub 29 | 30 | SourcePropertyPath As String 31 | TargetPropertyPath As String 32 | Command As TestCommand 33 | 34 | End Type 35 | 36 | Private Test As TState 37 | 38 | #Const LateBind = LateBindTests 39 | #If LateBind Then 40 | Private Assert As Object 41 | #Else 42 | Private Assert As Rubberduck.AssertClass 43 | #End If 44 | 45 | '@ModuleInitialize 46 | Private Sub ModuleInitialize() 47 | #If LateBind Then 48 | 'requires HKCU registration of the Rubberduck COM library. 49 | Set Assert = CreateObject("Rubberduck.PermissiveAssertClass") 50 | #Else 51 | 'requires project reference to the Rubberduck COM library. 52 | Set Assert = New Rubberduck.PermissiveAssertClass 53 | #End If 54 | End Sub 55 | 56 | '@ModuleCleanup 57 | Private Sub ModuleCleanup() 58 | Set Assert = Nothing 59 | End Sub 60 | 61 | '@TestInitialize 62 | Private Sub TestInitialize() 63 | Set Test.ConcreteSUT = ValidationManager.Create(New TestNotifierFactory) 64 | Set Test.NotifyValidationErrorSUT = Test.ConcreteSUT 65 | Set Test.HandleValidationErrorSUT = Test.ConcreteSUT 66 | Set Test.BindingSource = TestBindingObject.Create(Test.ConcreteSUT) 67 | Set Test.BindingSourceStub = Test.BindingSource 68 | Set Test.BindingTarget = TestBindingObject.Create(Test.ConcreteSUT) 69 | Set Test.BindingTargetStub = Test.BindingTarget 70 | Set Test.Command = New TestCommand 71 | Set Test.CommandManager = New TestCommandManager 72 | Set Test.CommandManagerStub = Test.CommandManager 73 | Set Test.Validator = New TestValueValidator 74 | Dim Manager As TestBindingManager 75 | Set Manager = New TestBindingManager 76 | Set Test.BindingManager = Manager 77 | Set Test.BindingManagerStub = Test.BindingManager 78 | Test.SourcePropertyPath = "TestStringProperty" 79 | Test.TargetPropertyPath = "TestStringProperty" 80 | End Sub 81 | 82 | '@TestCleanup 83 | Private Sub TestCleanup() 84 | Set Test.ConcreteSUT = Nothing 85 | Set Test.NotifyValidationErrorSUT = Nothing 86 | Set Test.HandleValidationErrorSUT = Nothing 87 | Set Test.BindingSource = Nothing 88 | Set Test.BindingTarget = Nothing 89 | Set Test.Command = Nothing 90 | Set Test.Validator = Nothing 91 | Set Test.BindingManager = Nothing 92 | Set Test.BindingManagerStub = Nothing 93 | Test.SourcePropertyPath = vbNullString 94 | Test.TargetPropertyPath = vbNullString 95 | Test.ExpectedErrNumber = 0 96 | Test.ExpectedErrorCaught = False 97 | Test.ExpectedErrSource = vbNullString 98 | End Sub 99 | 100 | Private Sub ExpectError() 101 | Dim Message As String 102 | If Err.Number = Test.ExpectedErrNumber Then 103 | If (Test.ExpectedErrSource = vbNullString) Or (Err.Source = Test.ExpectedErrSource) Then 104 | Test.ExpectedErrorCaught = True 105 | Else 106 | Message = "An error was raised, but not from the expected source. " & _ 107 | "Expected: '" & TypeName(Test.ConcreteSUT) & "'; Actual: '" & Err.Source & "'." 108 | End If 109 | ElseIf Err.Number <> 0 Then 110 | Message = "An error was raised, but not with the expected number. Expected: '" & Test.ExpectedErrNumber & "'; Actual: '" & Err.Number & "'." 111 | Else 112 | Message = "No error was raised." 113 | End If 114 | 115 | If Not Test.ExpectedErrorCaught Then Assert.Fail Message 116 | End Sub 117 | 118 | -------------------------------------------------------------------------------- /src/ValueRangeValidator.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ValueRangeValidator" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "A validator that accepts values between set min and max values. Uses Text comparison for strings." 11 | '@Folder MVVM.Common.Validators 12 | '@ModuleDescription "A validator that accepts values between set min and max values. Uses Text comparison for strings." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Option Compare Text 17 | Implements IValueValidator 18 | 19 | Private Type TState 20 | Min As Variant 21 | Max As Variant 22 | End Type 23 | 24 | Private This As TState 25 | 26 | Public Function Create(ByVal Min As Variant, ByVal Max As Variant) As IValueValidator 27 | Dim Result As ValueRangeValidator 28 | Set Result = New ValueRangeValidator 29 | Result.Min = Min 30 | Result.Max = Max 31 | Set Create = Result 32 | End Function 33 | 34 | Public Property Get Min() As Variant 35 | Min = This.Min 36 | End Property 37 | 38 | Public Property Let Min(ByVal RHS As Variant) 39 | This.Min = RHS 40 | End Property 41 | 42 | Public Property Get Max() As Variant 43 | Max = This.Max 44 | End Property 45 | 46 | Public Property Let Max(ByVal RHS As Variant) 47 | This.Max = RHS 48 | End Property 49 | 50 | Private Function IValueValidator_IsValid(ByVal Value As Variant, ByVal Source As IBindingPath, ByVal Target As IBindingPath) As Boolean 51 | If IsObject(Value) Or IsArray(Value) Or IsEmpty(Value) Or IsError(Value) Then Exit Function 52 | IValueValidator_IsValid = Value >= This.Min And Value <= This.Max 53 | End Function 54 | 55 | Private Property Get IValueValidator_Message() As String 56 | IValueValidator_Message = StringBuilderNet.AppendFormat("A valid value is between {0} and {1}.", CStr(This.Min), CStr(This.Max)).ToString 57 | End Property 58 | 59 | Private Property Get IValueValidator_Trigger() As BindingUpdateSourceTrigger 60 | IValueValidator_Trigger = OnExit 61 | End Property 62 | -------------------------------------------------------------------------------- /src/WorksheetAreaPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "WorksheetAreaPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | Implements IPropertyBinding 15 | Implements IHandlePropertyChanged 16 | Implements IDisposable 17 | 18 | Private Const DefaultTargetPropertyName As String = "Value" 19 | Private WithEvents TargetEventSource As Excel.Worksheet 20 | Attribute TargetEventSource.VB_VarHelpID = -1 21 | 22 | Private Type TState 23 | Base As PropertyBindingBase 24 | Handler As IHandlePropertyChanged 25 | End Type 26 | 27 | Private This As TState 28 | 29 | Public Property Get DefaultTargetProperty() As String 30 | DefaultTargetProperty = DefaultTargetPropertyName 31 | End Property 32 | 33 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Excel.Range, _ 34 | Optional ByVal TargetProperty As String = DefaultTargetPropertyName, _ 35 | Optional ByVal Mode As BindingMode = BindingMode.TwoWayBinding, _ 36 | Optional ByVal Validator As IValueValidator, _ 37 | Optional ByVal Converter As IValueConverter, _ 38 | Optional ByVal StringFormat As IStringFormatter, _ 39 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 40 | 41 | GuardClauses.GuardExpression Target.Areas.Count > 1, TypeName(Me), "Target range must be contiguous." 42 | 43 | Dim BindingBase As PropertyBindingBase 44 | Set BindingBase = PropertyBindingBase _ 45 | .Create(Context, Source, Target, TargetProperty, _ 46 | Mode:=Mode, _ 47 | UpdateSource:=BindingUpdateSourceTrigger.OnPropertyChanged, _ 48 | Validator:=Validator, _ 49 | Converter:=Converter, _ 50 | StringFormat:=StringFormat, _ 51 | ValidationAdorner:=ValidationAdorner) 52 | 53 | Dim Result As WorksheetAreaPropertyBinding 54 | Set Result = New WorksheetAreaPropertyBinding 55 | 56 | Result.InjectBindingInfo BindingBase 57 | Set Create = Result 58 | 59 | End Function 60 | 61 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 62 | GuardClauses.GuardDefaultInstance Me, WorksheetAreaPropertyBinding, TypeName(Me) 63 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 64 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 65 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 66 | Set This.Base = BindingInfo 67 | Set This.Handler = BindingInfo 68 | Set TargetEventSource = BindingInfo.Target.Object.Parent 69 | End Sub 70 | 71 | Private Property Get IsDefaultInstance() As Boolean 72 | IsDefaultInstance = Me Is WorksheetCellPropertyBinding 73 | End Property 74 | 75 | Private Sub IDisposable_Dispose() 76 | Set This.Handler = Nothing 77 | Disposable.TryDispose This.Base 78 | Set This.Base = Nothing 79 | End Sub 80 | 81 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 82 | This.Handler.HandlePropertyChanged Source, PropertyName 83 | End Sub 84 | 85 | Private Sub IPropertyBinding_Apply() 86 | TargetEventSource.Application.EnableEvents = False 87 | This.Base.Apply 88 | TargetEventSource.Application.EnableEvents = True 89 | End Sub 90 | 91 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 92 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 93 | End Property 94 | 95 | Private Property Get IPropertyBinding_Converter() As IValueConverter 96 | Set IPropertyBinding_Converter = This.Base.Converter 97 | End Property 98 | 99 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 100 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 101 | End Property 102 | 103 | Private Property Get IPropertyBinding_Mode() As BindingMode 104 | IPropertyBinding_Mode = This.Base.Mode 105 | End Property 106 | 107 | Private Property Get IPropertyBinding_Source() As IBindingPath 108 | Set IPropertyBinding_Source = This.Base.Source 109 | End Property 110 | 111 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 112 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 113 | End Property 114 | 115 | Private Property Get IPropertyBinding_Target() As IBindingPath 116 | Set IPropertyBinding_Target = This.Base.Target 117 | End Property 118 | 119 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 120 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 121 | End Property 122 | 123 | Private Property Get IPropertyBinding_Validator() As IValueValidator 124 | Set IPropertyBinding_Validator = This.Base.Validator 125 | End Property 126 | 127 | Private Sub TargetEventSource_Change(ByVal Target As Range) 128 | If Not Target.Application.Intersect(This.Base.Target, Target) Is Nothing Then 129 | If This.Base.UpdateSourceTrigger = OnPropertyChanged Then This.Base.ApplyToSource 130 | End If 131 | End Sub 132 | 133 | -------------------------------------------------------------------------------- /src/WorksheetCellBindingStrategy.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "WorksheetCellBindingStrategy" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings.Strategies 11 | Option Explicit 12 | Implements IBindingTargetStrategy 13 | 14 | Private Function IBindingTargetStrategy_DefaultPropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Object, _ 15 | ByVal Mode As BindingMode, _ 16 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 17 | ByVal Validator As IValueValidator, _ 18 | ByVal Converter As IValueConverter, _ 19 | ByVal StringFormat As IStringFormatter, _ 20 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 21 | 22 | Set IBindingTargetStrategy_DefaultPropertyBindingFor = WorksheetCellPropertyBinding _ 23 | .Create(Context, Source, Target, _ 24 | Mode:=Mode, _ 25 | Validator:=Validator, _ 26 | Converter:=Converter, _ 27 | StringFormat:=StringFormat, _ 28 | ValidationAdorner:=ValidationAdorner) 29 | 30 | End Function 31 | 32 | Private Function IBindingTargetStrategy_PropertyBindingFor(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As IBindingPath, _ 33 | ByVal Mode As BindingMode, _ 34 | ByVal UpdateTrigger As BindingUpdateSourceTrigger, _ 35 | ByVal Validator As IValueValidator, _ 36 | ByVal Converter As IValueConverter, _ 37 | ByVal StringFormat As IStringFormatter, _ 38 | ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 39 | 40 | Set IBindingTargetStrategy_PropertyBindingFor = WorksheetCellPropertyBinding _ 41 | .Create(Context, Source, Target.Context, Target.Path, _ 42 | Mode:=Mode, _ 43 | Validator:=Validator, _ 44 | Converter:=Converter, _ 45 | StringFormat:=StringFormat, _ 46 | ValidationAdorner:=ValidationAdorner) 47 | 48 | End Function 49 | -------------------------------------------------------------------------------- /src/WorksheetCellPropertyBinding.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "WorksheetCellPropertyBinding" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | '@Folder MVVM.Infrastructure.Bindings.PropertyBindings 11 | '@PredeclaredId 12 | '@Exposed 13 | Option Explicit 14 | Implements IPropertyBinding 15 | Implements IHandlePropertyChanged 16 | Implements IDisposable 17 | 18 | Private Const DefaultTargetPropertyName As String = "Value" 19 | Private WithEvents TargetEventSource As Excel.Worksheet 20 | Attribute TargetEventSource.VB_VarHelpID = -1 21 | 22 | Private Type TState 23 | Base As PropertyBindingBase 24 | Handler As IHandlePropertyChanged 25 | End Type 26 | 27 | Private This As TState 28 | 29 | Public Property Get DefaultTargetProperty() As String 30 | DefaultTargetProperty = DefaultTargetPropertyName 31 | End Property 32 | 33 | Public Function Create(ByVal Context As IAppContext, ByVal Source As IBindingPath, ByVal Target As Excel.Range, _ 34 | Optional ByVal TargetProperty As String = DefaultTargetPropertyName, _ 35 | Optional ByVal Mode As BindingMode = BindingMode.TwoWayBinding, _ 36 | Optional ByVal Validator As IValueValidator, _ 37 | Optional ByVal Converter As IValueConverter, _ 38 | Optional ByVal StringFormat As IStringFormatter, _ 39 | Optional ByVal ValidationAdorner As IDynamicAdorner) As IPropertyBinding 40 | 41 | Dim BindingBase As PropertyBindingBase 42 | Set BindingBase = PropertyBindingBase _ 43 | .Create(Context, Source, Target, TargetProperty, _ 44 | Mode:=Mode, _ 45 | UpdateSource:=BindingUpdateSourceTrigger.OnPropertyChanged, _ 46 | Validator:=Validator, _ 47 | Converter:=Converter, _ 48 | StringFormat:=StringFormat, _ 49 | ValidationAdorner:=ValidationAdorner) 50 | 51 | Dim Result As WorksheetCellPropertyBinding 52 | Set Result = New WorksheetCellPropertyBinding 53 | 54 | Result.InjectBindingInfo BindingBase 55 | Set Create = Result 56 | 57 | End Function 58 | 59 | Public Sub InjectBindingInfo(ByVal BindingInfo As PropertyBindingBase) 60 | GuardClauses.GuardDefaultInstance Me, WorksheetCellPropertyBinding, TypeName(Me) 61 | GuardClauses.GuardNullReference BindingInfo, TypeName(Me) 62 | GuardClauses.GuardDoubleInitialization This.Base, TypeName(Me) 63 | GuardClauses.GuardDoubleInitialization This.Handler, TypeName(Me) 64 | Set This.Base = BindingInfo 65 | Set This.Handler = BindingInfo 66 | Set TargetEventSource = BindingInfo.Target.Object.Parent 67 | End Sub 68 | 69 | Private Property Get IsDefaultInstance() As Boolean 70 | IsDefaultInstance = Me Is WorksheetCellPropertyBinding 71 | End Property 72 | 73 | Private Sub IDisposable_Dispose() 74 | Set This.Handler = Nothing 75 | Disposable.TryDispose This.Base 76 | Set This.Base = Nothing 77 | End Sub 78 | 79 | Private Sub IHandlePropertyChanged_HandlePropertyChanged(ByVal Source As Object, ByVal PropertyName As String) 80 | This.Handler.HandlePropertyChanged Source, PropertyName 81 | End Sub 82 | 83 | Private Sub IPropertyBinding_Apply() 84 | TargetEventSource.Application.EnableEvents = False 85 | This.Base.Apply 86 | TargetEventSource.Application.EnableEvents = True 87 | End Sub 88 | 89 | Private Property Get IPropertyBinding_CancelExitOnValidationError() As Boolean 90 | IPropertyBinding_CancelExitOnValidationError = This.Base.CancelExitOnValidationError 91 | End Property 92 | 93 | Private Property Get IPropertyBinding_Converter() As IValueConverter 94 | Set IPropertyBinding_Converter = This.Base.Converter 95 | End Property 96 | 97 | Private Property Get IPropertyBinding_DefaultTargetProperty() As String 98 | IPropertyBinding_DefaultTargetProperty = DefaultTargetProperty 99 | End Property 100 | 101 | Private Property Get IPropertyBinding_Mode() As BindingMode 102 | IPropertyBinding_Mode = This.Base.Mode 103 | End Property 104 | 105 | Private Property Get IPropertyBinding_Source() As IBindingPath 106 | Set IPropertyBinding_Source = This.Base.Source 107 | End Property 108 | 109 | Private Property Get IPropertyBinding_StringFormat() As IStringFormatter 110 | Set IPropertyBinding_StringFormat = This.Base.StringFormat 111 | End Property 112 | 113 | Private Property Get IPropertyBinding_Target() As IBindingPath 114 | Set IPropertyBinding_Target = This.Base.Target 115 | End Property 116 | 117 | Private Property Get IPropertyBinding_UpdateSourceTrigger() As BindingUpdateSourceTrigger 118 | IPropertyBinding_UpdateSourceTrigger = This.Base.UpdateSourceTrigger 119 | End Property 120 | 121 | Private Property Get IPropertyBinding_Validator() As IValueValidator 122 | Set IPropertyBinding_Validator = This.Base.Validator 123 | End Property 124 | 125 | Private Sub TargetEventSource_Change(ByVal Target As Range) 126 | If Not Target.Application.Intersect(This.Base.Target.Context, Target) Is Nothing Then 127 | If This.Base.UpdateSourceTrigger = OnPropertyChanged Then This.Base.ApplyToSource 128 | End If 129 | End Sub 130 | -------------------------------------------------------------------------------- /src/WorksheetValidationAdorner.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "WorksheetValidationAdorner" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Attribute VB_Description = "An object that dynamically decorates a target Excel.Range object." 11 | '@Folder MVVM.Infrastructure.Validation.ErrorFormatting 12 | '@ModuleDescription "An object that dynamically decorates a target Excel.Range object." 13 | '@PredeclaredId 14 | '@Exposed 15 | Option Explicit 16 | Implements IDynamicAdorner 17 | 18 | Private Type TState 19 | Target As Excel.Range 20 | TargetFormatter As MVVM.IValidationErrorFormatter 21 | End Type 22 | 23 | Private This As TState 24 | 25 | Public Function Create(ByVal Target As Excel.Range, ByVal Formatter As MVVM.IValidationErrorFormatter) As IDynamicAdorner 26 | Dim Result As WorksheetValidationAdorner 27 | Set Result = New WorksheetValidationAdorner 28 | Set Result.Target = Target 29 | Set Result.Formatter = Formatter 30 | Set Create = Result 31 | End Function 32 | 33 | Friend Property Get Formatter() As MVVM.IValidationErrorFormatter 34 | Set Formatter = This.TargetFormatter 35 | End Property 36 | 37 | Friend Property Set Formatter(ByVal RHS As MVVM.IValidationErrorFormatter) 38 | Set This.TargetFormatter = RHS 39 | End Property 40 | 41 | Friend Property Get Target() As Excel.Range 42 | Set Target = This.Target 43 | End Property 44 | 45 | Friend Property Set Target(ByVal RHS As Excel.Range) 46 | GuardClauses.GuardDefaultInstance Me, WorksheetValidationAdorner 47 | GuardClauses.GuardDoubleInitialization This.Target, TypeName(Me) 48 | GuardClauses.GuardNullReference RHS 49 | Set This.Target = RHS 50 | End Property 51 | 52 | Private Sub IDynamicAdorner_Hide() 53 | This.TargetFormatter.Restore This.Target 54 | End Sub 55 | 56 | Private Sub IDynamicAdorner_Show(ByVal Message As String) 57 | This.TargetFormatter.Apply This.Target, Message 58 | End Sub 59 | --------------------------------------------------------------------------------