Option Strict On

Imports System.Reflection
Imports System.Windows.Forms

Namespace Mbark

    Public Module TypeUtilities

        Public Function FindNearestParentOfInterface(ByVal control As Control, ByVal soughtInterface As Type) As Control
            Dim providers As ArrayList = FindParentControlsOfInterface(control, soughtInterface)
            If providers.Count = 0 Then Return Nothing Else Return DirectCast(providers(0), control)
        End Function

        Public Function FindNearestParentOfType(ByVal start As Control, ByVal soughtType As Type) As Control
            Dim providers As ArrayList = FindParentControlsOfType(start, soughtType)
            If providers.Count = 0 Then Return Nothing Else Return DirectCast(providers(0), Control)
        End Function

        ' TODO: Make sure this combination is correct, and/or optimal
        Private AllFieldsFlag As Reflection.BindingFlags = _
            Reflection.BindingFlags.NonPublic Or _
            Reflection.BindingFlags.Public Or _
            Reflection.BindingFlags.FlattenHierarchy Or _
            Reflection.BindingFlags.Static Or _
            Reflection.BindingFlags.Instance


        Private Sub FindParentControlsOfType( _
    ByVal foundObjects As ArrayList, _
    ByVal startingControl As Control, _
    ByVal soughtType As Type, _
    ByVal recurseUp As Boolean)

            If startingControl.Parent Is Nothing Then Return

            If startingControl.Parent.GetType.Equals(soughtType) OrElse startingControl.Parent.GetType.IsSubclassOf(soughtType) Then
                foundObjects.Add(startingControl.Parent)
            End If

            If recurseUp Then
                FindParentControlsOfType(foundObjects, startingControl.Parent, soughtType, recurseUp)
            End If

        End Sub


        Private Sub FindParentControlsOfInterfaceImplementation( _
            ByVal foundObjects As ArrayList, _
            ByVal control As Control, _
            ByVal soughtInterface As Type, _
            ByVal recurseUp As Boolean)

            If control Is Nothing OrElse control.Parent Is Nothing Then Return

            Dim foundInterface As Type = control.Parent.GetType.GetInterface(soughtInterface.Name)
            If Not foundInterface Is Nothing And foundObjects.IndexOf(control.Parent) = -1 Then
                foundObjects.Add(control.Parent)
            End If

            ' Recurse on the parent.
            If recurseUp Then
                FindParentControlsOfInterfaceImplementation(foundObjects, control.Parent, soughtInterface, recurseUp)
            End If

        End Sub

        Private Sub FindChildControlsOfInterface( _
            ByVal foundControls As ArrayList, _
            ByVal target As Control, _
            ByVal soughtInterface As Type, _
            ByVal recursive As Boolean)

            If target Is Nothing Then Return

            For i As Integer = 0 To target.Controls.Count - 1
                Dim c As Control = target.Controls(i)
                Dim foundInterface As Type = c.GetType.GetInterface(soughtInterface.Name)
                If Not foundInterface Is Nothing Then
                    If foundControls.IndexOf(c) = -1 Then
                        foundControls.Add(c)
                    End If
                End If
                If recursive Then
                    FindChildControlsOfInterface(foundControls, c, soughtInterface, True)
                End If
            Next

        End Sub


        Public Function FindControlsOfInterface( _
            ByVal start As Windows.Forms.Control, _
            ByVal soughtInterface As Type, _
            ByVal recurseUp As Boolean, _
            ByVal recurseDown As Boolean) As ArrayList

            Dim objects As New ArrayList

            FindChildControlsOfInterface(objects, start, soughtInterface, recurseDown)
            FindParentControlsOfInterfaceImplementation(objects, start, soughtInterface, recurseUp)

            Return objects
        End Function

        Public Function FindParentControlsOfInterface(ByVal start As Control, ByVal soughtInterface As Type) As ArrayList
            Dim objects As New ArrayList
            FindParentControlsOfInterfaceImplementation(objects, start, soughtInterface, True)
            Return objects
        End Function


        Public Function FindParentControlsOfType(ByVal start As Control, ByVal soughtType As Type) As ArrayList
            Dim objects As New ArrayList
            FindParentControlsOfType(objects, start, soughtType, True)
            Return objects
        End Function



        ''' <summary><para>Gets a reference to the top control in a control 
        ''' hiearchy.</para></summary>
        ''' <param name="control"><para>The control from which to start the search.</para></param>
        Public Function ParentmostControl(ByVal control As Windows.Forms.Control) As Windows.forms.Control
            If control Is Nothing Then Throw New ArgumentNullException("control")
            If control.Parent Is Nothing Then Return control
            Return ParentmostControl(control.Parent)
        End Function

        ' Adapted from http://www.vbinfozine.com/t_bindevt.shtml
        Public Function DynamicEventBinding( _
            ByVal sender As Object, _
            ByVal receiver As Object, _
            ByVal bind As Boolean, _
            ByVal eventName As String, _
            ByVal handlerName As String) As Boolean

            If sender Is Nothing Then Throw New ArgumentNullException("sender")
            If receiver Is Nothing Then Throw New ArgumentNullException("receiver")

            ' Get the sender events
            Dim sendersEvents() As EventInfo = sender.GetType().GetEvents()
            Dim targetEvent As EventInfo

            ' Find the event that maches the sought name
            For i As Integer = 0 To sendersEvents.Length - 1
                Dim candidateEvent As EventInfo = _
                    CType(sendersEvents(i), EventInfo)
                If candidateEvent.Name = eventName Then
                    targetEvent = candidateEvent
                End If
            Next
            If targetEvent Is Nothing Then Return False

            Dim targetHandler As MethodInfo = receiver.GetType.GetMethod(handlerName, AllFieldsFlag)
            If targetHandler Is Nothing Then Return False

            ' Create the delegate
            Dim d As System.Delegate = [Delegate].CreateDelegate( _
                targetEvent.EventHandlerType, receiver, targetHandler.Name)


            If bind Then
                targetEvent.AddEventHandler(sender, d)
            Else
                targetEvent.RemoveEventHandler(sender, d)
            End If



            Return True
        End Function

    End Module

    <Serializable()> Public Class TypeDefinition

        Public Property ClassName() As String
            Get
                Return mClassName
            End Get
            Set(ByVal value As String)
                mClassName = value
            End Set
        End Property
        Public Property Subdirectory() As String
            Get
                Return mSubdirectoryName
            End Get
            Set(ByVal value As String)
                mSubdirectoryName = value
            End Set
        End Property
        Public Property LibraryFileName() As String
            Get
                Return mLibraryFilename
            End Get
            Set(ByVal value As String)
                mLibraryFilename = value
            End Set
        End Property

        Private mClassName As String
        Private mLibraryFilename As String
        Private mSubdirectoryName As String

        Public Shared Function Create(ByVal obj As Object) As TypeDefinition
            If obj Is Nothing Then Throw New ArgumentNullException("obj")
            Dim newDef As New TypeDefinition
            newDef.ClassName = obj.GetType.FullName
            newDef.LibraryFileName = IO.Path.GetFileName(obj.GetType.Assembly.Location)
            Return newDef
        End Function

        Public Overridable Function InstantiateObject() As Object
            Dim filename As String
            Dim currentPath As String = AppDomain.CurrentDomain.BaseDirectory
            If Subdirectory <> String.Empty Then currentPath = IO.Path.Combine(currentPath, Subdirectory)
            filename = IO.Path.Combine(currentPath, LibraryFileName)
            Try

                Dim assem As [Assembly] = System.Reflection.Assembly.LoadFile(filename)
                Return assem.CreateInstance(ClassName)
            Catch ex As IO.FileNotFoundException
                ' For some crazy reason, the filename doesn't get propogated, so we do it ourselves.
                Throw New IO.FileNotFoundException(ex.Message, filename)
            End Try

        End Function

        Public Overrides Function ToString() As String
            Return LibraryFileName & "+" & ClassName
        End Function



    End Class

End Namespace
