Windows Forms - de la liaison de données à la liaison d'objets

Public Sub New(ByVal sp As IServiceProvider)
    MyBase.New()
    If sp Is Nothing Then Throw New ArgumentNullException("sp")
    Me._ServiceProvider = sp.GetOrCreateEventBindingServiceProvider
    Me._ServiceProvider.RetrieveServicesFromHostView()
End Sub

Public Overrides Function CanExtend(ByVal extendee As Object) As Boolean
    Return Me.DiscoveryService.HasEvents(extendee)
End Function

Public Overrides Function GetDefaultProperty(ByVal component As Object) As PropertyDescriptor
    Return Me.DiscoveryService.GetDefaultEventProperty(component)
End Function

Public Overloads Overrides Function GetProperties(
    ByVal component As Object, 
    ByVal attributes() As Attribute) As PropertyDescriptorCollection
    
    Return Me.DiscoveryService.GetEventProperties(component, attributes)
End Function
Public Overrides Function GetProperties(ByVal component As Object) As PropertyDescriptorCollection
    Return Me.DiscoveryService.GetEventProperties(component)
End Function

Public Overrides Function GetProperties(
    ByVal context As ITypeDescriptorContext, 
    ByVal component As Object, 
    ByVal attributes() As Attribute) As PropertyDescriptorCollection
    
    If context.IsRootComponent(component) Then
        Return Me.DiscoveryService.GetEventProperties(component, attributes)
    ElseIf TypeOf component Is EventBinding() Then
        Dim Converter As New ArrayConverter
        Return Converter.GetProperties(context, component, attributes)
    Else
        Return TypeDescriptor.GetProperties(component, attributes)
    End If
End Function

Public Event Standard As EventHandler
Private Sub OnStandardEvent(ByVal sender As Object, ByVal e As EventArgs)
End Sub
Dim StandardHandler As New EventHandler(AddressOf OnStandardEvent)

Public Event Generic As EventHandler(Of MouseEventArgs)
Private Sub OnGenericEvent(ByVal sender As Object, ByVal e As MouseEventArgs)
End Sub
Dim GenericHandler As New EventHandler(Of MouseEventArgs)(AddressOf OnGenericEvent)

Public Delegate Sub CustomEventHandler(ByVal sender As Object, ByVal e As MouseEventArgs)
Public Event Custom As CustomEventHandler
Private Sub OnCustomEvent(ByVal sender As Object, ByVal e As MouseEventArgs)
End Sub
Dim CustomHandler As New CustomEventHandler(AddressOf OnCustomEvent)

Public Delegate Sub ExoticEventHandler(ByVal x As Int32, ByVal y As Int32, ByRef cancel As Boolean)
Public Event Exotic As ExoticEventHandler
Private Sub OnExoticEvent(ByVal x As Int32, ByVal y As Int32, ByRef cancel As Boolean)
End Sub
Dim ExoticHandler As New ExoticEventHandler(AddressOf OnExoticEvent)

Public Class MethodMediatorFactory
    Implements IEventMediatorFactory

    Public Synchronizer As ISynchronizeInvoke

    Public Function SupportMediationFor(ByVal [event] As EventData, 
        ByVal handling As HandlingData, 
        ByVal mediationMode As MediationMode) As Boolean 
        Implements IEventMediatorFactory.SupportMediationFor
        
        If mediationMode = EventBindings.MediationMode.Synchronized AndAlso 
            Me.Synchronizer Is Nothing Then Return False
        If Not Me.IsSupportedEvent([event].EventDescriptor) Then Return False
        If handling Is Nothing Then Return False
        Return handling.EventHandlerType.IsType(Of MethodInfo)()
    End Function
    Private Function IsSupportedEvent(ByVal descriptor As EventDescriptor) As Boolean
        If descriptor Is Nothing Then Return False
        If descriptor.IsEventHandler Then Return True
        If descriptor.IsGenericEventHandler Then Return True
        If descriptor.IsCustomEventHandler Then Return True
        Return False
    End Function

    Public Function CreateMediator(ByVal [event] As EventData, 
        ByVal handling As HandlingData, 
        ByVal mediationMode As MediationMode) As IEventMediator 
        Implements IEventMediatorFactory.CreateMediator
        
        Dim Mediator = Me.CreateMediator([event])
        If Mediator Is Nothing Then Throw New NotSupportedException
        Mediator.Initialize([event])
        Mediator.Initialize(DirectCast(handling.EventHandler, MethodInfo), 
            handling.EventHandlerSource)
        Mediator.Initialize(mediationMode, Me.Synchronizer)
        Return Mediator
    End Function
    Private Function CreateMediator(ByVal [event] As EventData) As IMethodMediator
        If [event].EventDescriptor.IsEventHandler Then Return Me.CreateStandardMediator
        If [event].EventDescriptor.IsGenericEventHandler Then Return Me.CreateGenericMediator([event])
        Return Me.TryCreateCustomMediator([event])
    End Function
    Private Function CreateStandardMediator() As IMethodMediator
        Return New MethodMediator
    End Function
    Private Function CreateGenericMediator(ByVal [event] As EventData) As IMethodMediator
        Dim MediatorArg = [event].EventDescriptor.EventType.GetGenericArguments(0)
        Dim MediatorGenDef = GetType(MethodMediator(Of ))
        Dim MediatorType = MediatorGenDef.MakeGenericType(New Type() {MediatorArg})
        Dim Mediator = DirectCast(Activator.CreateInstance(MediatorType), IMethodMediator)
        Return Mediator
    End Function
    Private Function TryCreateCustomMediator(ByVal [event] As EventData) As IMethodMediator
        Dim MediatorArg = [event].EventDescriptor.GetCustomEventArgsType
        If MediatorArg Is Nothing Then Return Nothing
        Dim MediatorGenDef = GetType(CustomMethodMediator(Of ))
        Dim MediatorType = MediatorGenDef.MakeGenericType(New Type() {MediatorArg})
        Dim Mediator = DirectCast(Activator.CreateInstance(MediatorType), IMethodMediator)
        Return Mediator
    End Function

End Class

<Extension()>
Public Function IsEventHandler(ByVal ED As EventDescriptor) As Boolean
    Return ED.EventType Is GetType(EventHandler)
End Function

<Extension()>
Public Function IsGenericEventHandler(ByVal ED As EventDescriptor) As Boolean
    If Not ED.EventType.IsGenericType Then Return False
    Dim GenDefinition = ED.EventType.GetGenericTypeDefinition
    Return GenDefinition Is GetType(EventHandler(Of ))
End Function

<Extension()>
Public Function IsCustomEventHandler(ByVal ED As EventDescriptor) As Boolean
    Dim InvokeMethod = ED.EventType.GetMethod("Invoke")
    If InvokeMethod Is Nothing Then Return False
    If InvokeMethod.ReturnType IsNot GetType(Void) Then Return False
    Dim Parameters = InvokeMethod.GetParameters
    If Parameters.IsNullOrEmpty Then Return False
    If Parameters.Count <> 2 Then Return False
    Return Parameters(0).ParameterType Is GetType(Object) AndAlso 
        Parameters(1).ParameterType.IsType(Of EventArgs)()
End Function

Public Class MethodMediator(Of TEventArgs As EventArgs)
    Implements IMethodMediator

    Public Sub [AddHandler]() Implements IEventMediator.AddHandler
        If Me._Handler IsNot Nothing Then Exit Sub
        Me._Handler = Me.CreateHandler
        Me._Event.AddEventHandler(Me._Handler)
    End Sub
    Public Sub [RemoveHandler]() Implements IEventMediator.RemoveHandler
        If Me._Handler Is Nothing Then Exit Sub
        Me._Event.RemoveEventHandler(Me._Handler)
        Me._Handler = Nothing
    End Sub

    Protected Overridable Function CreateHandler() As [Delegate]
        If Me.IsSynchronized Then
            Return New EventHandler(Of TEventArgs)(AddressOf Me.OnSynchronizedEvent)
        ElseIf Me.IsAsynchronous Then
            Return New EventHandler(Of TEventArgs)(AddressOf Me.OnAsynchronousEvent)
        Else
            Return New EventHandler(Of TEventArgs)(AddressOf Me.OnSynchronousEvent)
        End If
    End Function
    Protected Function IsSynchronized() As Boolean
        Return Me._Synchronizer IsNot Nothing
    End Function
    Protected Function IsAsynchronous() As Boolean
        Return Me._Asynchronous
    End Function

    Protected Sub OnSynchronousEvent(ByVal sender As Object, ByVal e As TEventArgs)
        Dim Arguments = Me.GetMethodArguments(sender, e)
        Me._Method.Invoke(Me._MethodSource, Arguments)
    End Sub
    Protected Sub OnAsynchronousEvent(ByVal sender As Object, ByVal e As TEventArgs)
        Static Invoker As New EventHandler(Of TEventArgs)(AddressOf Me.OnSynchronousEvent)
        Invoker.BeginInvoke(sender, e, Nothing, Nothing)
    End Sub
    Protected Sub OnSynchronizedEvent(ByVal sender As Object, ByVal e As TEventArgs)
        If Me._Synchronizer.InvokeRequired Then
            Static Invoker As New EventHandler(Of TEventArgs)(AddressOf Me.OnSynchronousEvent)
            Me._Synchronizer.Invoke(Invoker, New Object() {sender, e})
        Else
            Me.OnSynchronousEvent(sender, e)
        End If
    End Sub
    Private Function GetMethodArguments(ByVal sender As Object, ByVal e As TEventArgs) As Object()
        If Not Me._Method.HasParameters Then Return Nothing
        Dim Parameters = Me._Method.GetParameters
        Select Case Parameters.Count
            Case 1
                Dim Parameter = Parameters(0)
                Dim Argument = Parameter.GetArgumentValue(sender, e)
                Return New Object() {Argument}
            Case 2
                Dim Argument1 = Parameters(0).GetArgumentValue(sender, e)
                Dim Argument2 = Parameters(1).GetArgumentValue(sender, e)
                Return New Object() {Argument1, Argument2}
            Case Else
                Throw New NotSupportedException
        End Select
    End Function

End Class

Public Class MethodMediator
    Inherits MethodMediator(Of EventArgs)

    Protected Overrides Function CreateHandler() As System.Delegate
        If Me.IsSynchronized Then
            Return New EventHandler(AddressOf Me.OnSynchronizedEvent)
        ElseIf Me.IsAsynchronous Then
            Return New EventHandler(AddressOf Me.OnAsynchronousEvent)
        Else
            Return New EventHandler(AddressOf Me.OnSynchronousEvent)
        End If
    End Function

End Class

Public Class CustomMethodMediator(Of TEventArgs As EventArgs)
    Inherits MethodMediator(Of TEventArgs)

    Private Function GetHandlerMethod() As MethodInfo
        Dim Flags = Reflection.BindingFlags.Instance Or Reflection.BindingFlags.NonPublic
        If Me.IsSynchronized Then
            Return Me.GetType.GetMethod("OnSynchronizedEvent", Flags)
        ElseIf Me.IsAsynchronous Then
            Return Me.GetType.GetMethod("OnAsynchronousEvent", Flags)
        Else
            Return Me.GetType.GetMethod("OnSynchronousEvent", Flags)
        End If
    End Function
    Protected Overrides Function CreateHandler() As [Delegate]
        Dim HandlerMethod = Me.GetHandlerMethod
        Return [Delegate].CreateDelegate(Me.EventType, Me, HandlerMethod)
    End Function

End Class

Public Class MethodBindingProvider
    Implements IEventHandlerProvider
    Implements IEventMediatorFactory

    Private _Factory As New MethodMediatorFactory

    Public Property AllowSpecialNamedMethod As Boolean = True
    Public Property Synchronizer As ISynchronizeInvoke
        Get
            Return Me._Factory.Synchronizer
        End Get
        Set(ByVal value As ISynchronizeInvoke)
            Me._Factory.Synchronizer = value
        End Set
    End Property

    Public Function CanResolveHandler(ByVal eventHandlerID As Object, 
        ByVal eventHandlerSource As Object) As Boolean 
        Implements IEventHandlerProvider.CanResolveHandler
        
        If eventHandlerSource Is Nothing Then Return False
        If Not TypeOf eventHandlerID Is String Then Return False
        Dim SupportedMethods = Me.GetSupportedMethods(eventHandlerSource)
        Dim Name = DirectCast(eventHandlerID, String)
        Return SupportedMethods.Contains(Function(M)
                                             Return String.Equals(M.Name, Name, 
                                                StringComparison.InvariantCultureIgnoreCase)
                                         End Function)
    End Function
    Public Function GetEventHandlerIDs(ByVal eventHandlerSource As Object) As IEnumerable 
        Implements IEventHandlerProvider.GetEventHandlerIDs
        
        If eventHandlerSource Is Nothing Then Return Nothing
        Dim SupportedMethods = Me.GetSupportedMethods(eventHandlerSource)
        Dim Names As New Specialized.StringCollection
        For Each method In SupportedMethods
            Names.Add(method.Name)
        Next
        Return Names
    End Function

    Public Function GetEventHandlerSources() As IEnumerable 
        Implements IEventHandlerProvider.GetEventHandlerSources
        
        If Me.Site Is Nothing Then Return Nothing
        Dim Host = Me.Site.GetService(Of IDesignerHost)()
        If Host Is Nothing Then Return Nothing
        Return Host.Container.Components
    End Function

    Public Function ResolveHandler(ByVal eventHandlerID As Object, 
        ByVal eventHandlerSource As Object) As Object 
        Implements IEventHandlerProvider.ResolveHandler
        
        If Not TypeOf eventHandlerID Is String Then Return False
        Return Me.GetMethod(eventHandlerSource, DirectCast(eventHandlerID, String))
    End Function
    Public Function ResolveHandlerType(ByVal eventHandlerID As Object, 
        ByVal eventHandlerSource As Object) As Type 
        Implements IEventHandlerProvider.ResolveHandlerType
        
        If Not TypeOf eventHandlerID Is String Then Return Nothing
        Dim Handler = Me.GetMethod(eventHandlerSource, DirectCast(eventHandlerID, String))
        If Handler Is Nothing Then Return Nothing
        Return Handler.GetType
    End Function

    Private Function GetSupportedMethods(ByVal source As Object) As IEnumerable(Of MethodInfo)
        Dim SupportedMethods As New List(Of MethodInfo)
        Dim Names As New Specialized.StringCollection
        Dim Methods = source.GetType.GetMethods
        For Each method In Methods
            If Names.Contains(method.Name) Then Continue For
            If method.IsAbstract Then Continue For
            If method.IsConstructor Then Continue For
            If method.IsGenericMethodDefinition Then Continue For
            If method.ContainsGenericParameters Then Continue For
            If Not Me.AllowSpecialNamedMethod AndAlso method.IsSpecialName Then Continue For
            If Not Me.IsSupportedMethod(method) Then Continue For
            SupportedMethods.Add(method)
            Names.Add(method.Name)
        Next
        Return SupportedMethods
    End Function
    Private Function IsSupportedMethod(ByVal mi As MethodInfo) As Boolean
        Dim Parameters = mi.GetParameters
        If Parameters.IsNullOrEmpty Then Return True
        Return Parameters.Count <= 2
    End Function
    Private Function GetMethod(ByVal source As Object, ByVal name As String) As MethodInfo
        If source Is Nothing Then Return Nothing
        Dim SupportedMethods = Me.GetSupportedMethods(source)
        Return SupportedMethods.Take(Function(M)
                                         Return String.Equals(M.Name, name, 
                                            StringComparison.InvariantCultureIgnoreCase)
                                     End Function)
    End Function

    Public Function SupportMediationFor(ByVal [event] As EventData, 
                                        ByVal handling As HandlingData, 
                                        ByVal mediationMode As MediationMode) As Boolean 
                                        Implements IEventMediatorFactory.SupportMediationFor
        
        Return Me._Factory.SupportMediationFor([event], handling, mediationMode)
    End Function
    Public Function CreateMediator(ByVal [event] As EventData, 
                                    ByVal handling As HandlingData, 
                                    ByVal mediationMode As MediationMode) As IEventMediator 
                                    Implements IEventMediatorFactory.CreateMediator
                                    
        Return Me._Factory.CreateMediator([event], handling, mediationMode)
    End Function

End Class

Public Class SampleForm

    Public Sub New()

        ' Cet appel est requis par le concepteur.
        InitializeComponent()

        ' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
        If Me.DesignMode Then Exit Sub
        Me.SampleDataSource.Owner = Me
        Me.SampleDataSourceBindingSource.DataSource = Me.SampleDataSource
    End Sub

    Public Sub SetText(ByVal value As String)
        If Me.InvokeRequired Then
            Static Del As New Action(Of String)(AddressOf SetText)
            Me.Invoke(Del, New Object() {value})
            Exit Sub
        End If
        Me.Text = value
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.SampleDataSource.BindHandlers()
    End Sub

End Class

'
'EventBindingSource
'
Me.EventBindingSource.Add("MouseHover", Me.GroupBox3, "TraceMouseHover", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("MouseHover", Me, "TraceMouseHover", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("MouseMove", Me, "TraceMouseMove", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("Click", Me, "TraceClick", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("Click", Me.TextBox1, "TraceClick", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("MouseMove", Me.TextBox1, "TraceMouseMove", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)
Me.EventBindingSource.Add("MouseHover", Me.TextBox1, "TraceMouseHover", 
    Me.MethodBindingProvider, Me.SampleDataSource, Me.MethodBindingProvider, 
    EventBindings.MediationMode.Synchronous)

<PropertyTab(GetType(Design.EventBindingsPropertyTab), PropertyTabScope.Document)>
Public Class SampleDataSource
    Implements INotifyPropertyChanged

    Public Event PropertyChanged(ByVal sender As Object, ByVal e As PropertyChangedEventArgs) 
        Implements INotifyPropertyChanged.PropertyChanged

    Private _LastClickedSender As Object
    Private _LastMouseHoverSender As Object
    Private _LastMouseMoveSender As Object

    Public Property Owner As SampleForm
    Public Property Binder As IEventBinder
    Public Property TraceTextBox As TextBox
    Public Property LongMethodIteration As Int32 = 50000
    Public Property StopLongMethod As Boolean
    Public ReadOnly Property CanBindHandlers As Boolean
        Get
            Return Not Me._Binder.Handled
        End Get
    End Property
    Public ReadOnly Property CanUnbindHandlers As Boolean
        Get
            Return Me._Binder.Handled
        End Get
    End Property
    Public ReadOnly Property LastClickedSender As String
        Get
            Return Me.TryGetName(Me._LastClickedSender)
        End Get
    End Property
    Public ReadOnly Property LastMouseHoverSender As String
        Get
            Return Me.TryGetName(Me._LastMouseHoverSender)
        End Get
    End Property
    Public ReadOnly Property LastMouseMoveSender As String
        Get
            Return Me.TryGetName(Me._LastMouseMoveSender)
        End Get
    End Property

    Private Function TryGetName(ByVal sender As Object) As String
        If TypeOf sender Is Control Then
            Return DirectCast(sender, Control).Name
        End If
        Return String.Empty
    End Function
    Private Sub NotifyPropertyChanged(ByVal propertyName As String)
        RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs(propertyName))
    End Sub

    Public Sub ClearTraces()
        Me._TraceTextBox.Clear()
    End Sub
    Public Sub BindHandlers()
        Me._Binder.AddHandlers()
        Me.NotifyPropertyChanged("CanBindHandlers")
        Me.NotifyPropertyChanged("CanUnbindHandlers")
    End Sub
    Public Sub UnbindHandlers()
        Me._Binder.RemoveHandlers()
        Me.NotifyPropertyChanged("CanBindHandlers")
        Me.NotifyPropertyChanged("CanUnbindHandlers")
    End Sub

    Private Sub AddTrace(ByVal eventName As String, ByVal senderName As String, ByVal args As String)
        If Not String.IsNullOrEmpty(senderName) Then
            Me.AddTrace(String.Format("{0} on {1}: {2}", eventName, senderName, args))
        Else
            Me.AddTrace(String.Format("{0}: {2}", eventName, args))
        End If
    End Sub
    Public Sub AddTrace(ByVal value As String)
        Me._TraceTextBox.AppendText(value + ControlChars.CrLf)
    End Sub
    Public Sub TraceClick(ByVal sender As Object)
        Me.AddTrace("Click", Me.TryGetName(sender), "")
        Me._LastClickedSender = sender
        Me.NotifyPropertyChanged("LastClickedSender")
    End Sub
    Public Sub TraceMouseHover(ByVal sender As Object, ByVal e As EventArgs)
        Me.AddTrace("Mouse Hover", Me.TryGetName(sender), e.ToString)
        Me._LastMouseHoverSender = sender
        Me.NotifyPropertyChanged("LastMouseHoverSender")
    End Sub
    Public Sub TraceMouseMove(ByVal e As MouseEventArgs, ByVal sender As Object)
        Me.AddTrace("Mouse Move", Me.TryGetName(sender), e.Location.ToString)
        Me._LastMouseMoveSender = sender
        Me.NotifyPropertyChanged("LastMouseMoveSender")
    End Sub

    Public Sub InterromptLongMethod()
        Me.StopLongMethod = True
    End Sub
    Public Sub LongMethod()
        Me.StopLongMethod = False
        If Me.LongMethodIteration < 0 Then Me.LongMethodIteration = -Me.LongMethodIteration
        For i = 0 To Me.LongMethodIteration
            Me._Owner.SetText(
                String.Format("Commande longue, étape: {0}/{1}", i, Me.LongMethodIteration))
            If Me.StopLongMethod Then
                Me._Owner.SetText("Stopped")
                Exit For
            End If
        Next
        Me.StopLongMethod = True
    End Sub
End Class