Bit of an esoteric title, but let me explain. I wanted to create an IComparer that can be supplied to a sorting algorithm, which rather than using the
>, <, = comparison operators on the two values, or some custom property of 2 objects like this fantastic PropertyComparer class, instead lets the user decide manually which of 2 items is "better" and should be ranked higher in the list.
At the same time I wanted to dip my toes in the MVVM framework that @Matt posted a while back by creating a really simple form that just presents the two options
y being compared and lets the user click on the one they want. Here's how it turned out:
By using mscorlib.ArrayList which implements the QuickSort algorithm, and adding a cache to save the result of every comparison in case it comes up again, a minimal number of comparisons is required to sort the list.
The simplest place to start is the View
'@Folder "ThingComparer" Option Explicit Implements IView Implements ICancellable Private Type TState Context As MVVM.IAppContext ViewModel As ThingComparisonViewModel IsCancelled As Boolean End Type Private this As TState Implements IThingComparisonViewFactory '@Description "Creates a new instance of this form." Private Function IThingComparisonViewFactory_Create(ByVal Context As MVVM.IAppContext, ByVal ViewModel As ThingComparisonViewModel) As IView Dim result As TextRepresentableThingsView Set result = New TextRepresentableThingsView Set result.Context = Context Set result.ViewModel = ViewModel Set IThingComparisonViewFactory_Create = result End Function Public Property Get Context() As MVVM.IAppContext Set Context = this.Context End Property Public Property Set Context(ByVal RHS As MVVM.IAppContext) Set this.Context = RHS End Property Friend Property Set ViewModel(ByVal RHS As Object) Set this.ViewModel = RHS End Property Private Sub OnCancel() this.IsCancelled = True Me.Hide End Sub Private Sub InitializeView() With this.Context.Bindings 'these are just captions so only need one way .BindPropertyPath this.ViewModel, "ThingX", Me.ThingXLabel, Mode:=OneTimeBinding .BindPropertyPath this.ViewModel, "ThingY", Me.ThingYLabel, Mode:=OneTimeBinding End With With this.Context.Commands .BindCommand this.ViewModel, Me.ThingXLabel, this.ViewModel.SelectXCommand(Me) .BindCommand this.ViewModel, Me.ThingYLabel, this.ViewModel.SelectYCommand(Me) End With this.Context.Bindings.Apply this.ViewModel End Sub Private Property Get ICancellable_IsCancelled() As Boolean ICancellable_IsCancelled = this.IsCancelled End Property Private Sub ICancellable_OnCancel() OnCancel End Sub Private Sub IView_Hide() Me.Hide End Sub Private Sub IView_Show() InitializeView Me.Show vbModal End Sub Private Function IView_ShowDialog() As Boolean InitializeView Me.Show vbModal IView_ShowDialog = Not this.IsCancelled End Function Private Property Get IView_ViewModel() As Object Set IView_ViewModel = this.ViewModel End Property Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = VbQueryClose.vbFormControlMenu Then Cancel = True OnCancel End If End Sub
It is a
ThingsView because I envisage an
ImagesView or a
ClassFooView could also be used which allow different things to be displayed*, whilst still sticking to the fundamental "choose one or the other" behaviour, defined, incidentally, in the ViewModel
'@Folder "ThingComparer" Option Explicit 'Implements INotifyPropertyChanged Private Type TState ThingX As String ThingY As String Handler As IHandlePropertyChanged Choice As ComparisonResult End Type Public Enum ComparisonResult xChosen yChosen CancelChosen End Enum Private this As TState Public Property Get Choice() As ComparisonResult Choice = this.Choice End Property Public Property Let Choice(ByVal RHS As ComparisonResult) this.Choice = RHS End Property '@Ignore ProcedureNotUsed: Called by name by MVVM framework Public Property Get ThingX() As String ThingX = this.ThingX End Property Public Property Let ThingX(ByVal RHS As String) this.ThingX = RHS End Property '@Ignore ProcedureNotUsed Public Property Get ThingY() As String ThingY = this.ThingY End Property Public Property Let ThingY(ByVal RHS As String) this.ThingY = RHS End Property Public Property Get SelectXCommand(ByVal View As IView) As ICommand Set SelectXCommand = SelectOptionCommand.Create(ThingXClick, View) End Property Public Property Get SelectYCommand(ByVal View As IView) As ICommand Set SelectYCommand = SelectOptionCommand.Create(ThingYClick, View) End Property 'Private Sub INotifyPropertyChanged_OnPropertyChanged(ByVal Source As Object, ByVal PropertyName As String) ' this.Handler.HandlePropertyChanged Source, PropertyName 'End Sub ' 'Private Sub INotifyPropertyChanged_RegisterHandler(ByVal Handler As IHandlePropertyChanged) ' Set this.Handler = Handler 'End Sub
Considering Matt's article says the ViewModel is where the bulk of the work is, I'm slightly worried there isn't much going on here. All it does is holds the two items being compared, and the result of the comparison. It provides some custom
Select[X|Y]Commands which are instances of the
'@Folder "ThingComparer" '@PredeclaredID Option Explicit Implements ICommand Public Enum CommandType ThingXClick ThingYClick End Enum Private Type TState View As IView ClickType As CommandType End Type Private this As TState Public Function Create(ByVal ClickType As CommandType, ByVal View As IView) As SelectOptionCommand Dim result As SelectOptionCommand Set result = New SelectOptionCommand result.ClickType = ClickType Set result.View = View Set Create = result End Function Friend Property Let ClickType(ByVal RHS As CommandType) this.ClickType = RHS End Property Friend Property Set View(ByVal RHS As IView) GuardClauses.GuardDefaultInstance Me, SelectOptionCommand GuardClauses.GuardDoubleInitialization this.View, TypeName(Me) Set this.View = RHS End Property Private Function ICommand_CanExecute(ByVal Context As Object) As Boolean ICommand_CanExecute = True End Function Private Property Get ICommand_Description() As String ICommand_Description = "Click to select" End Property Private Sub ICommand_Execute(ByVal Context As Object) Dim ViewModel As ThingComparisonViewModel Set ViewModel = Context 'REVIEW: Or this.View.ViewModel 'just need to save click result Select Case this.ClickType Case ThingXClick: ViewModel.Choice = xChosen Case ThingYClick: ViewModel.Choice = yChosen End Select this.View.Hide End Sub
I found a bit weird the way they need a reference to
View which might create a circular reference, but I guess it's okay as long as the View holds references to the Commands, the ViewModel just acts as a factory.
*my default instinct would be to make the things
IDrawable, but I think multiple views is closer to the MVVM paradigm?
Speaking of factories, I made the View implement its own strongly typed factory method
'@Folder "ThingComparer" Option Explicit Public Function Create(ByVal Context As MVVM.IAppContext, ByVal ViewModel As ThingComparisonViewModel) As IView End Function
... that way I know that all
IViews will really be more like
IView<ThingComparisonViewModel> as opposed to generic ones (this is something I find weird in MVVM, how do we enforce a View implementation will be compatible with a particular ViewModel?).
The factory is used by the MVVM coordinator which constructs the Context, ViewModel and View objects. It is also the top level API which implements
'@Folder "ThingComparer" '@PredeclaredId Option Explicit Implements mscorlib.IComparer Private Type TGUIComparer View As IView End Type Private this As TGUIComparer Private Property Get View() As IView Set View = this.View End Property Friend Property Set View(ByVal RHS As IView) Set this.View = RHS End Property Public Function Create(Optional ByVal ViewFactory As IThingComparisonViewFactory) As GUIComparer GuardClauses.GuardNonDefaultInstance Me, GUIComparer Dim result As GUIComparer Set result = New GUIComparer Dim Context As IAppContext Set Context = AppContext.Create() Dim ViewModel As ThingComparisonViewModel Set ViewModel = New ThingComparisonViewModel If ViewFactory Is Nothing Then Set ViewFactory = TextRepresentableThingsView Set result.View = ViewFactory.Create(Context, ViewModel) Set Create = result End Function Private Function IComparer_Compare(ByVal x As Variant, ByVal y As Variant) As Long GuardClauses.GuardDefaultInstance Me, GUIComparer 'cache won't be clear in the default instance GuardClauses.GuardNullReference View, Message:="Class must be Created with the .Create Method not `New`" 'short circuit default condition 'our list has no dupes but arraylist asserts x.compareTo(x) = 0 If x = y Then IComparer_Compare = 0: Exit Function 'only need to check x & y as reverse is already in cache by default Static cache As New Scripting.Dictionary If TryGetComparisonResult(cache, x, y, IComparer_Compare) Then Exit Function With View Dim ViewModel As ThingComparisonViewModel Set ViewModel = .ViewModel ViewModel.ThingX = x ViewModel.ThingY = y 'show dialog so we can capture cancellation If Not .ShowDialog Then Err.Raise 5, , "Cancelled" Select Case ViewModel.Choice Case xChosen IComparer_Compare = -1 Case yChosen IComparer_Compare = 1 Case Else Err.Raise 5, , "Invalid Selection" End Select End With CacheComparisonResult cache, x, y, IComparer_Compare End Function 'TODO revisit this cache. It wants to be a map<(variant,variant):bool> where the variants are commutative 'Right now this won't work with objects, only value types, so it is tightly coupled to the TextRepresentableThingsView Private Function TryGetComparisonResult(ByVal cache As Dictionary, ByVal x As Variant, ByVal y As Variant, ByRef outValue As Long) As Boolean Dim key As String key = x & vbNullChar & y If Not cache.Exists(key) Then Exit Function TryGetComparisonResult = True outValue = cache.Item(key) End Function Private Sub CacheComparisonResult(ByVal cache As Dictionary, ByVal x As Variant, ByVal y As Variant, ByVal result As Long) cache.Add x & vbNullChar & y, result cache.Add y & vbNullChar & x, -result End Sub
Using the IComparer is very simple as you could see in the video, but some example code:
Sub SortSelection() Dim list As New mscorlib.ArrayList Dim rangeToSort As Range Set rangeToSort = Selection Dim item As Range For Each item In rangeToSort list.Add item.Value Next item list.sort_2 GUIComparer.Create(ViewFactory:=TextRepresentableThingsView) dumpList list, dumpWhere:=rangeToSort End Sub Private Sub dumpList(ByVal list As ArrayList, Optional ByVal dumpWhere As Range) If dumpWhere Is Nothing Then Set dumpWhere = ThisWorkbook.Sheets.Add().Range("A1") dumpWhere.Resize(list.Count, 1).Value = WorksheetFunction.Transpose(list.ToArray) End Sub
Try it out in this download workbook
- MVVM framework is truly magic
- I was wondering, instead of having a
SelectOptionCommandto hide the view and update the state, I could just have an
AcceptCommandwired up to each label, then use a property binding to see what control has focus. Not sure how to do that or what is more idiomatic?
- As mentioned, not sure what's the best way to handle things that need a different kind of representation. For example if I am sorting a list of filepaths to photos, which need to be displayed differently.
- Should my View be clever enough to detect the types of
ViewModel.ThingXand draw accordingly
- Should I inject a different view for each type as I have outlined now
- Should I be getting
IDrawablethings fed into the Comparer so I only need one View implementation which can have drawing method dictated to it by the types supplied by the ViewModel (i.e.
Thing[X/Y]manage their own representation.)
- Should my View be clever enough to detect the types of
- Finally, I want to add some more GUI juice, specifically a hoverover animation - should this be in command bindings or property bindings?