Click here to Skip to main content
Click here to Skip to main content
Add your own
alternative version

Mole II Black Ops - Multifunction Visual Studio Visualizer For WPF - View Public, Private and Protected Data

, , , 17 Dec 2007 CPOL
A high octane multifunction visualizer that allows detailed inspection of the visual tree and logical trees. New feature of Mole II Black Ops allows viewing and drilling into non-public members of any element or sub-element in the visual or logical trees.
mole.visualizer_2_2_vs2005_release.zip
Mole.Visualizer.dll
mole.visualizer_2_2_vs2005_sourceandtestbench.zip
Mole.Visualizer
Custom Controls
Data Source
Image Processing
Data
Debugger Visualizer
Enums Constants
Event Args
Extended Controls
Images
MoleVisualUnavailable.gif
Mole.Visualizer.csi
Mole.Visualizer.suo
Mole.Visualizer.vbproj.user
My Project
Application.myapp
Settings.settings
Settings
Visualizer UI
XSLT
Mole.TestBench
bach.jpg
Mole.TestBench.csi
Mole.TestBench.suo
Mole.TestBench.vbproj.user
My Project
Settings.settings
mole.visualizer_2_2_vs2008_release.zip
Mole.Visualizer.dll
mole.visualizer_2_2_vs2008_sourceandtestbench.zip
MoleVisualUnavailable.gif
Mole.Visualizer.csi
Mole.Visualizer.suo
Mole.Visualizer.vbproj.user
Application.myapp
Settings.settings
bach.jpg
Mole.TestBench.csi
Mole.TestBench.suo
Mole.TestBench.vbproj.user
Settings.settings
Imports System.Windows
Imports System.Windows.Media
Imports System.Windows.Media.Media3D
Imports System.ComponentModel
Imports Microsoft.VisualStudio.DebuggerVisualizers
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.Reflection

Public Class MoleVisualizerObjectSource
    Inherits VisualizerObjectSource

#Region " Declarations "

    Private Const STRING_NAME As String = "Name"
    Private Const STRING_NULL As String = "null"
    Private Const STRING_STRING As String = "String"
    Private _dictAttachedProperties As New Dictionary(Of String, DependencyPropertyDescriptor)
    Private _dictDrillingOperations As New Dictionary(Of Integer, Object)
    Private _dictLogicalTree As Dictionary(Of Integer, Object)
    Private _dictVisualTree As Dictionary(Of Integer, DependencyObject)
    Private _intDrillingElementIdCounter As Integer
    Private _intLogicalElementIdCounter As Integer
    Private _intVisualElementIdCounter As Integer
    Private Shared _objBinaryFormatter As New BinaryFormatter

#End Region

#Region " Overridden Methods "

    '''' <summary>
    '''' Mole II does not use the GetData Sub anymore.  
    '''' Since Mole II makes heavy use of the TransferData Sub, we placed the code that normally gets called by most visualizers in TransferData so that Mole II would have a consistent API for requesting data.
    '''' </summary>
    ''Public Overrides Sub GetData(ByVal target As Object, ByVal outgoingData As System.IO.Stream)
    ''    MoleVisualizerObjectSource.Serialize(outgoingData, BuildVisualTreetarget))
    ''End Sub
    '
    '
    '
    ''' <summary>
    ''' Returns the data requested by incomingData
    ''' This sub is actually called by Visual Studio when the frmMole makes the .TransferData
    ''' call to the IVisualizerObjectProvider
    ''' </summary>
    ''' <param name="target">Original object selected by developer in Visual Studio</param>
    ''' <param name="incomingData">DataRequestObject</param>
    ''' <param name="outgoingData">Stream of data requested by incomingData</param>
    ''' <exception cref="NullReferenceException">Thrown when the Visual Tree Dictionary has not been initialized.  GetData must be called before TransferData</exception>
    ''' <remarks>This sub can blow up when requesting the XAML HTML.  This is because System.Windows.Markup.XamlWriter.Save gets into a condition that causes a stack overflow.  Maybe this function will be fixed in 3.5</remarks>
    Public Overrides Sub TransferData(ByVal target As Object, ByVal incomingData As System.IO.Stream, ByVal outgoingData As System.IO.Stream)

        Dim objTransferDataRequest As TransferDataRequest = CType(MoleVisualizerObjectSource.Deserialize(incomingData), TransferDataRequest)

        'this is the traffic cop.
        If objTransferDataRequest.TransferDataTreeTarget = TransferDataTreeTarget.LogicalTree Then
            ProcessLogicalTreeTransferDataRequest(target, objTransferDataRequest, outgoingData)

        ElseIf objTransferDataRequest.TransferDataTreeTarget = TransferDataTreeTarget.VisualTree Then
            ProcessVisualTreeTransferDataRequest(target, objTransferDataRequest, outgoingData)

        Else
            Throw New ArgumentOutOfRangeException("TransferDataTreeTarget", objTransferDataRequest.TransferDataTreeTarget, "This value was never programmed")
        End If

    End Sub

#End Region

#Region " TransferDataRequest Processors "

    Private Sub ClearDrillingOperation()

        If _dictDrillingOperations Is Nothing OrElse _dictDrillingOperations.Count > 0 Then
            _dictDrillingOperations.Clear()
            _intDrillingElementIdCounter = 0
        End If

    End Sub

    Private Function GetBlackOpsDrillingOperationProperties(ByVal objTransferDataRequest As TransferDataRequest, ByVal objPropertyParentObject As Object) As DrillingOperationResponse

        Dim objObject As Object = Nothing
        Dim prop As PropertyDescriptor
        Dim objNewParentObject As Object = Nothing
        Dim propertySource As Object

        'this means we are drilling into another child from at least one child, i.e. not the parent elements properties
        If objTransferDataRequest.LastDrillingOperationId <> 0 Then

            If Not _dictDrillingOperations.TryGetValue(objTransferDataRequest.LastDrillingOperationId, objObject) Then
                Throw New ArgumentOutOfRangeException("GetDrillingOperationProperties recieved an invalid LastDrillingOperationId.")
            End If

            propertySource = objObject

        Else

            propertySource = objPropertyParentObject
        End If

        Dim objFieldInfo As System.Reflection.FieldInfo = propertySource.GetType.GetField(objTransferDataRequest.PropertyNameToDrill, BindingFlags.Instance Or BindingFlags.NonPublic)

        If objFieldInfo IsNot Nothing Then
            objNewParentObject = objFieldInfo.GetValue(propertySource)

        Else
            prop = TypeDescriptor.GetProperties(propertySource)(objTransferDataRequest.PropertyNameToDrill)

            If prop IsNot Nothing Then
                objNewParentObject = prop.GetValue(propertySource)
            End If

        End If

        If objNewParentObject IsNot Nothing Then
            _intDrillingElementIdCounter += 1
            _dictDrillingOperations.Add(_intDrillingElementIdCounter, objNewParentObject)
            Return New DrillingOperationResponse(IsPropertyACollection(objNewParentObject), objTransferDataRequest.OriginalSelectedElementId, _intDrillingElementIdCounter, GetTreeElementProperties(objNewParentObject, objTransferDataRequest.MaxRowsInCollectionData), objNewParentObject.GetType.FullName)

        Else
            Return New DrillingOperationResponse(False, 0, 0, New List(Of TreeElementProperty), String.Empty)
        End If

    End Function

    Private Shared Function GetCollectionItem(ByVal objCollection As Object, ByVal intIndex As Integer) As Object

        Dim objList As IList = TryCast(objCollection, IList)

        If Not objList Is Nothing Then
            Return objList(intIndex)

        ElseIf TypeOf objCollection Is ICollection Then

            Dim intX As Integer

            For Each item As Object In DirectCast(objCollection, ICollection)

                If intIndex = intX Then
                    Return item
                End If

                intX += 1
            Next

        End If

        ' KS added this since it can drop through the If Block
        Return Nothing

    End Function

    Private Function GetDrillingOperationProperties(ByVal objTransferDataRequest As TransferDataRequest, ByVal objPropertyParentObject As Object) As DrillingOperationResponse

        Dim objObject As Object = Nothing
        Dim prop As PropertyDescriptor
        Dim objNewParentObject As Object = Nothing
        Dim propertySource As Object

        'this means we are drilling into another child from at least one child, i.e. not the parent elements properties
        If objTransferDataRequest.LastDrillingOperationId <> 0 Then

            If Not _dictDrillingOperations.TryGetValue(objTransferDataRequest.LastDrillingOperationId, objObject) Then
                Throw New ArgumentOutOfRangeException("GetDrillingOperationProperties recieved an invalid LastDrillingOperationId.")
            End If

            propertySource = objObject

        Else

            propertySource = objPropertyParentObject
        End If

        prop = TypeDescriptor.GetProperties(propertySource)(objTransferDataRequest.PropertyNameToDrill)

        If prop IsNot Nothing Then
            objNewParentObject = prop.GetValue(propertySource)

        ElseIf objTransferDataRequest.PropertyNameToDrill.StartsWith(STRING_LEFT_COLLECTION_INDEX_MARKER) Then

            'get the collection member
            Dim indexAsString As String = objTransferDataRequest.PropertyNameToDrill.Substring(1, objTransferDataRequest.PropertyNameToDrill.Length - 2)
            Dim index As Integer

            If Int32.TryParse(indexAsString, index) Then
                objNewParentObject = GetCollectionItem(propertySource, index)
            End If

        End If

        If objNewParentObject IsNot Nothing Then
            _intDrillingElementIdCounter += 1
            _dictDrillingOperations.Add(_intDrillingElementIdCounter, objNewParentObject)
            Return New DrillingOperationResponse(IsPropertyACollection(objNewParentObject), objTransferDataRequest.OriginalSelectedElementId, _intDrillingElementIdCounter, GetTreeElementProperties(objNewParentObject, objTransferDataRequest.MaxRowsInCollectionData), objNewParentObject.GetType.FullName)

        Else
            Return New DrillingOperationResponse(False, 0, 0, New List(Of TreeElementProperty), String.Empty)
        End If

    End Function

    Private Sub ProcessCommonTreeTransferDataRequest(Of T)(ByVal objDict As Dictionary(Of Integer, T), ByVal target As Object, ByVal objTransferDataRequest As TransferDataRequest, ByRef outgoingData As System.IO.Stream)

        'this normally gets called when records are being read from the cache 
        'this is the entire request 
        If objTransferDataRequest.TransferDataRequestType = TransferDataRequestType.ClearDrillingOperation Then
            ClearDrillingOperation()
            Exit Sub
        End If

        'this is part of the request 
        If objTransferDataRequest.ClearDrillingOperation Then
            ClearDrillingOperation()
        End If

        Dim objElement As T = Nothing

        If Not objDict.TryGetValue(objTransferDataRequest.OriginalSelectedElementId, objElement) Then
            Throw New ArgumentOutOfRangeException("ProcessCommonTreeTransferDataRequest received an invalid TreeElement Id.")
        End If

        Select Case objTransferDataRequest.TransferDataRequestType

            Case TransferDataRequestType.GetDataSet
                MoleVisualizerObjectSource.Serialize(outgoingData, GetDataSetFromIEnumerable(objTransferDataRequest))

            Case TransferDataRequestType.BlackOpsDrillingOperation
                MoleVisualizerObjectSource.Serialize(outgoingData, GetBlackOpsDrillingOperationProperties(objTransferDataRequest, objElement))

            Case TransferDataRequestType.DrillingOperation
                MoleVisualizerObjectSource.Serialize(outgoingData, GetDrillingOperationProperties(objTransferDataRequest, objElement))

            Case TransferDataRequestType.Image
                Using objBitMap As System.Drawing.Bitmap = VisualSnapshot.TakeSnapshot(objElement)
                    MoleVisualizerObjectSource.Serialize(outgoingData, objBitMap)
                End Using

            Case TransferDataRequestType.Properties
                MoleVisualizerObjectSource.Serialize(outgoingData, GetTreeElementProperties(objElement, objTransferDataRequest.MaxRowsInCollectionData))

            Case TransferDataRequestType.XAML
                LoadXAML(objElement, outgoingData)

            Case Else
                Throw New ArgumentOutOfRangeException("DataTransferRequestType", objTransferDataRequest.TransferDataRequestType, "Received DataTransferRequestType that has not yet been programmed.")
        End Select

    End Sub

    Private Sub ProcessLogicalTreeTransferDataRequest(ByVal target As Object, ByVal objTransferDataRequest As TransferDataRequest, ByRef outgoingData As System.IO.Stream)

        If objTransferDataRequest.TransferDataRequestType = TransferDataRequestType.LoadLogicalTree Then

            If objTransferDataRequest.ClearDrillingOperation Then
                ClearDrillingOperation()
            End If

            MoleVisualizerObjectSource.Serialize(outgoingData, BuildLogicalTree(objTransferDataRequest))
            Exit Sub
        End If

        Me.ProcessCommonTreeTransferDataRequest(_dictLogicalTree, target, objTransferDataRequest, outgoingData)

    End Sub

    Private Sub ProcessVisualTreeTransferDataRequest(ByVal target As Object, ByVal objTransferDataRequest As TransferDataRequest, ByRef outgoingData As System.IO.Stream)

        If objTransferDataRequest.TransferDataRequestType = TransferDataRequestType.InitialLoadVisualTree Then
            'never remove this line of code 
            ClearDrillingOperation()
            ' 
            MoleVisualizerObjectSource.Serialize(outgoingData, BuildVisualTree(target))
            Exit Sub
        End If

        Me.ProcessCommonTreeTransferDataRequest(_dictVisualTree, target, objTransferDataRequest, outgoingData)

    End Sub

#End Region

#Region " XAML Writter "

    Private Sub LoadXAML(ByVal target As Object, ByRef outgoingData As System.IO.Stream)

        'this code is problematic.  it normally works fine but does have issues.
        'when the user requests the run-time XAML a number of exceptions can be thrown by System.Windows.Markup.XamlWriter.Save
        '  Generic Type Serialization
        '  Stack Overflow
        '  More I don't know about yet.
        Dim objDependencyObject As DependencyObject = TryCast(target, DependencyObject)

        If objDependencyObject Is Nothing Then

            Dim encoding As New System.Text.ASCIIEncoding
            Dim strNoXMLAvailable As String = "<?xml version=|1.0|?><NoXAMLAvailable></NoXAMLAvailable>".Replace("|", Chr(34))
            outgoingData.Write(encoding.GetBytes(strNoXMLAvailable), 0, strNoXMLAvailable.Length)
            Exit Sub
        End If

        Try

            Dim objXMLWriterSettings As New System.Xml.XmlWriterSettings
            'this ensures that our stream has xml document header.
            objXMLWriterSettings.OmitXmlDeclaration = False
            Using objXMLWritter As Xml.XmlWriter = Xml.XmlWriter.Create(outgoingData, objXMLWriterSettings)
                'This sub can blow up when requesting the XAML HTML.  
                'This is because System.Windows.Markup.XamlWriter.Save gets into a condition that causes a stack overflow.  
                'Maybe this function will be fixed in 3.5
                System.Windows.Markup.XamlWriter.Save(objDependencyObject, objXMLWritter)
                objXMLWritter.Close()
            End Using

        Catch ex As Exception
            'nothing we can do so just let it go
            '
            'If a StackOverFlow has happened, we won't get here any way
            '
            'If Generic Type Serialization has happend, just ignore it and use what fragment that will be returned.
            '
        End Try

    End Sub

#End Region

#Region " Logical Tree Data Builder "

    Private Function BuildLogicalElement(ByVal objCurrent As Object, ByVal objInitial As DependencyObject, ByRef intInitialId As Integer) As TreeElement
        _intLogicalElementIdCounter += 1
        _dictLogicalTree.Add(_intLogicalElementIdCounter, objCurrent)

        Dim strObjectName As String = String.Empty

        If TypeOf objCurrent Is DependencyObject Then

            Dim objCurrentDepObj As DependencyObject = DirectCast(objCurrent, DependencyObject)
            strObjectName = CType(objCurrentDepObj.GetValue(FrameworkElement.NameProperty), String)
        End If

        Dim treeElem As New TreeElement(_intLogicalElementIdCounter, New List(Of TreeElement), strObjectName, objCurrent.GetType().FullName)

        If Object.ReferenceEquals(objInitial, objCurrent) Then
            intInitialId = _intLogicalElementIdCounter
        End If

        If TypeOf objCurrent Is DependencyObject Then

            For Each logicalChild As Object In LogicalTreeHelper.GetChildren(DirectCast(objCurrent, DependencyObject))
                treeElem.Children.Add(BuildLogicalElement(logicalChild, objInitial, intInitialId))
            Next

        End If

        Return treeElem

    End Function

    Private Function BuildLogicalTree(ByVal objTransferDataRequest As TransferDataRequest) As Tree
        _dictLogicalTree = New Dictionary(Of Integer, Object)

        Dim objTree As New Tree
        objTree.LoadingErrorMessage = String.Empty

        Dim objOriginalElement As DependencyObject = Nothing

        If Not _dictVisualTree.TryGetValue(objTransferDataRequest.OriginalSelectedElementId, objOriginalElement) Then
            Throw New ArgumentOutOfRangeException("LogicalTree TransferData received an invalid TreeElement.Id.")
        End If

        Dim objClosestLogicalAncestor As DependencyObject = GetClosestLogicalAncestor(objOriginalElement)
        Dim intInitialLogicalId As Integer
        objTree.RootElement = BuildLogicalElement(GetLogicalTreeRoot(objClosestLogicalAncestor), objClosestLogicalAncestor, intInitialLogicalId)
        objTree.InitialElementId = intInitialLogicalId
        ' Create the extra logical tree info bundle and give it to the Tree instance.
        objTree.LogicalTreeInfo = New LogicalTreeInfo(objOriginalElement, objClosestLogicalAncestor, GetTemplatedParent(objClosestLogicalAncestor))

        'this causes the Descendant Counts to populate
        Dim intX As Integer = objTree.RootElement.DescendantCount
        Return objTree

    End Function

    Private Function GetClosestLogicalAncestor(ByVal initial As DependencyObject) As DependencyObject

        Dim current As DependencyObject = initial
        Dim result As DependencyObject = initial

        While current IsNot Nothing

            Dim logicalParent As DependencyObject = LogicalTreeHelper.GetParent(current)

            If logicalParent IsNot Nothing Then
                result = current
                Exit While
            End If

            If TypeOf current Is Visual Or TypeOf current Is Visual3D Then
                current = VisualTreeHelper.GetParent(current)

            Else
                current = Nothing
            End If

        End While

        Return result

    End Function

    Private Function GetLogicalTreeRoot(ByVal initial As DependencyObject) As DependencyObject

        Dim current As DependencyObject = initial
        Dim result As DependencyObject = initial

        While current IsNot Nothing
            result = current
            current = LogicalTreeHelper.GetParent(current)
        End While

        Return result

    End Function

    Private Function GetTemplatedParent(ByVal depObj As DependencyObject) As DependencyObject

        Dim result As DependencyObject

        If TypeOf depObj Is FrameworkElement Then
            result = DirectCast(depObj, FrameworkElement).TemplatedParent

        ElseIf TypeOf depObj Is FrameworkContentElement Then
            result = DirectCast(depObj, FrameworkContentElement).TemplatedParent

        Else
            result = Nothing
        End If

        Return result

    End Function

#End Region

#Region " Visual Tree Data Builders "

    Private Function BuildElement(ByVal root As DependencyObject, ByVal objFirstVisual As DependencyObject, ByRef intInitialElementId As Integer) As TreeElement
        'this is the value used to uniquely identify each element
        'allows both sides debugger and debuggie to refer to the same
        'object across process boundaries
        _intVisualElementIdCounter += 1
        'save dependency property for future calls to TransferData
        _dictVisualTree.Add(_intVisualElementIdCounter, root)

        'root.GetValue(FrameworkElement.
        Dim obj As New TreeElement(_intVisualElementIdCounter, New List(Of TreeElement), CType(root.GetValue(FrameworkElement.NameProperty), String), root.DependencyObjectType.SystemType.FullName)

        If root.Equals(objFirstVisual) Then
            intInitialElementId = _intVisualElementIdCounter
        End If

        'only visual and visual3d's have visual children
        If TypeOf root Is Visual OrElse TypeOf root Is Visual3D Then

            Dim intCountOfChildren As Integer = VisualTreeHelper.GetChildrenCount(root) - 1

            If intCountOfChildren > -1 Then

                For intX As Integer = 0 To intCountOfChildren
                    obj.Children.Add(BuildElement(VisualTreeHelper.GetChild(root, intX), objFirstVisual, intInitialElementId))
                Next

            End If

        End If

        Return obj

    End Function

    Private Function BuildVisualTree(ByVal target As Object) As Tree
        _dictVisualTree = New Dictionary(Of Integer, DependencyObject)

        Dim objTree As New Tree
        objTree.LoadingErrorMessage = String.Empty

        Dim obj As DependencyObject = TryCast(target, DependencyObject)

        If obj Is Nothing Then
            'this should not happen, but...
            objTree.LoadingErrorMessage = "Objected selected in debugger is not a dependency object."
            Return objTree
        End If

        Dim objFirstVisual As DependencyObject = TryGetFirstVisual(obj)
        Dim intInitialElementId As Integer
        objTree.RootElement = BuildElement(GetTreeRoot(objFirstVisual), objFirstVisual, intInitialElementId)
        objTree.InitialElementId = intInitialElementId

        'this causes the Descendant Counts to populate
        'I'm running this here because we are on the background thread, instead of making the UI thread do it later
        Dim intX As Integer = objTree.RootElement.DescendantCount
        Return objTree

    End Function

    Private Function GetColumns(ByVal obj As Object) As List(Of String)

        Dim objList As New List(Of String)

        If obj.GetType.IsValueType Or TypeOf obj Is String Then
            objList.Add("Value")

        Else

            For Each mi As MemberInfo In obj.GetType.GetMembers(BindingFlags.Public Or BindingFlags.Instance)

                If mi.MemberType = MemberTypes.Property Then
                    objList.Add(mi.Name)
                End If

            Next

            objList.Sort()
        End If

        Return objList

    End Function

    Private Function GetDataSetFromIEnumerable(ByVal objTransferDataRequest As TransferDataRequest) As DataSet

        Dim objObject As Object = Nothing
        Dim ds As New DataSet
        Dim intX As Integer
        Dim strActiveTableName As String = String.Empty

        If objTransferDataRequest.LastDrillingOperationId = 0 Then
            Throw New ArgumentOutOfRangeException("LastDrillingOperationId", 0, "LastDrillingOperationId can't be zero.")
        End If

        If Not _dictDrillingOperations.TryGetValue(objTransferDataRequest.LastDrillingOperationId, objObject) Then
            Throw New ArgumentOutOfRangeException("LastDrillingOperationId", 0, "LastDrillingOperationId was invalid and not in the dictionary.")
        End If

        ds.RemotingFormat = SerializationFormat.Binary

        Try

            Dim objType As Type = Nothing

            For Each objItem As Object In CType(objObject, IEnumerable)

                If objType Is Nothing OrElse String.Compare(objItem.GetType.Name, strActiveTableName, StringComparison.Ordinal) <> 0 Then

                    If strActiveTableName.Length > 0 Then
                        ds.Tables(strActiveTableName).AcceptChanges()
                    End If

                    objType = objItem.GetType
                    strActiveTableName = objType.Name

                    If Not ds.Tables.Contains(strActiveTableName) Then

                        Dim dt As New DataTable(strActiveTableName)
                        dt.RemotingFormat = SerializationFormat.Binary

                        For Each s As String In GetColumns(objItem)
                            dt.Columns.Add(s)
                        Next

                        If dt.Columns.Count = 0 Then
                            objType = Nothing
                            Continue For
                        End If

                        ds.Tables.Add(dt)
                    End If

                End If

                Dim dr As DataRow = ds.Tables(strActiveTableName).NewRow

                If objItem.GetType.IsValueType OrElse TypeOf objItem Is String Then
                    dr.Item(0) = objItem.ToString

                Else

                    For Each c As DataColumn In ds.Tables(strActiveTableName).Columns

                        Dim propInfo As PropertyInfo = objItem.GetType.GetProperty(c.ColumnName)

                        If propInfo IsNot Nothing Then

                            Dim value As Object = propInfo.GetValue(objItem, Nothing)

                            If value IsNot Nothing Then
                                dr.Item(c.ColumnName) = value.ToString

                            Else
                                dr.Item(c.ColumnName) = STRING_NULL
                            End If

                        End If

                    Next

                End If

                ds.Tables(strActiveTableName).Rows.Add(dr)
                intX += 1

                If intX > objTransferDataRequest.MaxRowsInCollectionData Then
                    Exit For
                End If

            Next

        Catch ex As Exception
            'during debugging you can place a breakpoint here to stop and troubleshoot
            'Debug.WriteLine(ex.ToString)
        End Try

        ds.Tables(strActiveTableName).AcceptChanges()
        ds.AcceptChanges()
        Return ds

    End Function

    Private Function GetTreeElementProperties(ByVal target As Object, ByVal intMaxRowsInCollection As Integer) As List(Of TreeElementProperty)

        Dim objList As New List(Of TreeElementProperty)

        If TypeOf target Is ICollection Then

            Dim intIndex As Integer
            Const STRING_DATA_CATEGORY As String = "Data"

            For Each item As Object In CType(target, ICollection)

                Dim strValue As String = STRING_NULL
                Dim bolIsDrillable As Boolean = False
                Dim strValueType As String = STRING_NULL

                If Not item Is Nothing Then
                    strValue = item.ToString()
                    strValueType = item.GetType().Name
                    bolIsDrillable = IsDrillableTest(item.GetType(), item)
                End If

                objList.Add(New TreeElementProperty(False, bolIsDrillable, STRING_DATA_CATEGORY, String.Format("{0}{1}{2}", STRING_LEFT_COLLECTION_INDEX_MARKER, intIndex.ToString.PadLeft(3, "0"c), STRING_RIGHT_COLLECTION_INDEX_MARKER), strValueType, strValue, String.Empty))
                intIndex += 1

                '
                ' this limits the number of rows of data that is returned
                If intIndex > intMaxRowsInCollection Then
                    Exit For
                End If

            Next item

        End If

        For Each objPropertyDescriptor As PropertyDescriptor In TypeDescriptor.GetProperties(target)

            Dim bolIsDepencencyProperty As Boolean = False

            'note the default value is set to null
            Dim strValue As String = STRING_NULL
            Dim strValueSource As String = String.Empty
            Dim bolIsDrillable As Boolean = False
            Dim objDependencyPropertyDescriptor As DependencyPropertyDescriptor = DependencyPropertyDescriptor.FromProperty(objPropertyDescriptor)

            If objDependencyPropertyDescriptor IsNot Nothing Then
                bolIsDepencencyProperty = True
                strValueSource = DependencyPropertyHelper.GetValueSource(CType(target, DependencyObject), objDependencyPropertyDescriptor.DependencyProperty).BaseValueSource.ToString

                Dim objValue As Object = objDependencyPropertyDescriptor.GetValue(target)

                If objValue IsNot Nothing Then
                    strValue = objValue.ToString
                    bolIsDrillable = IsDrillableTest(objPropertyDescriptor, target, objValue)
                End If

                If objDependencyPropertyDescriptor.IsAttached AndAlso Not _dictAttachedProperties.ContainsKey(objDependencyPropertyDescriptor.Name) Then
                    _dictAttachedProperties.Add(objDependencyPropertyDescriptor.Name, objDependencyPropertyDescriptor)
                End If

            Else

                Try

                    Dim objValue As Object = objPropertyDescriptor.GetValue(target)

                    If objValue IsNot Nothing Then
                        strValue = objValue.ToString
                        bolIsDrillable = IsDrillableTest(objPropertyDescriptor, target, objValue)
                    End If

                Catch ex As Exception
                    'just ignoring the exception
                End Try

            End If

            objList.Add(New TreeElementProperty(bolIsDepencencyProperty, bolIsDrillable, objPropertyDescriptor.Category, objPropertyDescriptor.Name, objPropertyDescriptor.PropertyType.Name, strValue, strValueSource))
        Next

        For Each obj As System.Reflection.FieldInfo In target.GetType.GetFields(BindingFlags.NonPublic Or BindingFlags.Instance)

            Dim bolIsDepencencyProperty As Boolean = False

            'note the default value is set to null
            Dim strValue As String = STRING_NULL
            Dim strValueSource As String = String.Empty
            Dim bolIsDrillable As Boolean = False

            Try

                Dim objValue As Object = obj.GetValue(target)

                If objValue IsNot Nothing Then
                    strValue = objValue.ToString
                    bolIsDrillable = IsDrillableTest(obj.ReflectedType, objValue)
                End If

            Catch ex As Exception
                'just ignoring the exception
            End Try

            objList.Add(New TreeElementProperty(bolIsDepencencyProperty, bolIsDrillable, String.Format(STRING_BLACK_OPS_INDICATOR_FORMAT, obj.Attributes.ToString), obj.Name, obj.FieldType.Name, strValue, strValueSource))
        Next

        Return objList

    End Function

    Private Function GetTreeRoot(ByVal target As DependencyObject) As DependencyObject

        Dim current As DependencyObject = target
        Dim result As DependencyObject = Nothing

        While current IsNot Nothing
            result = current

            If TypeOf current Is Visual OrElse TypeOf current Is Visual3D Then
                current = VisualTreeHelper.GetParent(current)

            Else
                current = LogicalTreeHelper.GetParent(current)
            End If

        End While

        Return result

    End Function

    Private Function IsDrillableTest(ByVal objPropertyDescriptor As PropertyDescriptor, ByVal objSource As Object, ByVal objValue As Object) As Boolean

        If Object.ReferenceEquals(objValue, objSource) Then
            Return False
        End If

        If TypeOf objValue Is GeneralTransform AndAlso objPropertyDescriptor.Name = "Inverse" Then
            Return False
        End If

        'note i'm using GetType here since the object returned as the value for a property
        'could be a derived type
        Return IsDrillableTest(objValue.GetType(), objValue)

    End Function

    Private Function IsDrillableTest(ByVal propertyType As Type, ByVal objValue As Object) As Boolean

        'perform the most likely and quickest tests first
        If propertyType.IsPrimitive OrElse propertyType.IsEnum Then
            Return False

        ElseIf TypeOf objValue Is String OrElse TypeOf objValue Is Decimal Then
            Return False

        ElseIf TypeDescriptor.GetProperties(objValue).Count = 0 Then
            Return False
        End If

        Return True

    End Function

    Private Function IsPropertyACollection(ByVal target As Object) As Boolean

        'all .Net strings are IEnumerable so bypass them
        If TypeOf target Is System.String Then
            Return False
        End If

        'this works with Generic and Non Generic types.
        Try

            'I know this looks strange but I couldn't find a better way to do this.
            'if the data is not IEnumerable, well...
            Dim objEnumerable As IEnumerable = TryCast(target, IEnumerable)

            If objEnumerable IsNot Nothing Then

                'need to get at least one item from the collection
                Dim objEnum As IEnumerator = objEnumerable.GetEnumerator
                objEnum.Reset()

                While objEnum.MoveNext

                    'NOTE : This loop only runs once just to verify that the collection has atleast one item
                    '
                    'OK, we have items, now, do our items actually have properties we can query?
                    'You have to check for this.  Example, the Rectangle.StrokeDashArray is a collection with no properties, just double structures
                    'this is the insurance policy.
                    'there are some IEnumerable objects that do not have any properties, only methods.
                    'our simple system just shows properties and values in a table
                    'so spend the time now so the user won't see an icon and then get an empty table.
                    For Each objItem As Object In objEnumerable

                        'we are actually using the above objEnumerable object
                        'wanted to wait until I was sure there were items before conducting this test.
                        If objItem IsNot Nothing AndAlso (objItem.GetType.IsValueType OrElse TypeDescriptor.GetProperties(objItem).Count > 0) Then
                            'cool, we are IEnumerable, we have items, our items have properties to query
                            Return True

                        Else
                            Exit For
                        End If

                    Next

                    Exit While
                End While

            End If

        Finally
            'Catch ex As Exception
            'during debugging you can place a breakpoint here to stop and troubleshoot
            'Debug.WriteLine(ex.ToString)
        End Try

        Return False

    End Function

    Private Function TryGetFirstVisual(ByVal target As DependencyObject) As DependencyObject

        If TypeOf target Is Visual OrElse TypeOf target Is Visual3D Then
            Return target
        End If

        Dim current As DependencyObject = target
        Dim result As DependencyObject = Nothing

        While current IsNot Nothing
            result = current

            If TypeOf current Is Visual OrElse TypeOf current Is Visual3D Then
                Return current

            Else
                current = LogicalTreeHelper.GetParent(current)
            End If

        End While

        Return result

    End Function

#End Region

#Region " Helpers "

    ''' <summary>
    ''' Uses binary formatter to deserialize the incoming data
    ''' </summary>
    Public Overloads Shared Function Deserialize(ByVal incomingData As System.IO.Stream) As Object
        Return _objBinaryFormatter.Deserialize(incomingData)

    End Function

    ''' <summary>
    ''' Uses binary formatter to serialize the serializationStream data
    ''' </summary>
    Public Overloads Shared Sub Serialize(ByVal serializationStream As System.IO.Stream, ByVal target As Object)
        _objBinaryFormatter.Serialize(serializationStream, target)

    End Sub

    ''' <summary>
    ''' This function makes debugging a Visualizer a snap.  
    ''' 1.  Set desired breakpoints inside your Visualizer
    ''' 2.  Call this method from another project
    '''     Note, that other project will need to reference Microsoft.VisualStudio.DebuggerVisualizers and this project
    ''' 3.  Please see the following post if you have difficulties during debugging:
    '''     http://karlshifflett.wordpress.com/2007/12/01/systeminvalidcastexception-unable-to-cast-object-of-type-x-to-type-x/
    ''' </summary>
    Public Shared Sub TestMoleVisualizer(ByVal obj As DependencyObject)

        'TODO DEVELOPERS YOU SHOULD REMOVE THIS CODE FROM ANY PRODUCTION VISUALIZER
        Dim vdh As VisualizerDevelopmentHost = New VisualizerDevelopmentHost(obj, GetType(Mole.Burrow), GetType(Mole.MoleVisualizerObjectSource))
        vdh.ShowVisualizer()

    End Sub

#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Authors

Andrew Smith
Architect Infragistics, Inc.
United States United States
Andrew currently works as an architect for Infragistics working with windows forms and WPF. You can check out his blog here.

Josh Smith
Software Developer (Senior) Cynergy Systems
United States United States
Josh creates software, for iOS and Windows.
 
He works at Cynergy Systems as a Senior Experience Developer.
 
Read his iOS Programming for .NET Developers[^] book to learn how to write iPhone and iPad apps by leveraging your existing .NET skills.
 
Use his Master WPF[^] app on your iPhone to sharpen your WPF skills on the go.
 
Check out his Advanced MVVM[^] book.
 
Visit his WPF blog[^] or stop by his iOS blog[^].
Follow on   Twitter

Karl Shifflett
Architect Gayle Manufacturing Company
United States United States
Karl loves .NET, WPF, WCF, ASP.NET, VB.NET and C#.
 
Awards:
 
  • December 2008 VB.NET Code Project Article Award
  • 2009 Code Project MVP
  • 2008 Code Project MVP
  • 2008 Microsoft MVP - Client App Dev
  • December 2007 VB.NET Code Project Article Award
  • Gold Medal Winner at IBM's 1998 PROIV Programming Contest in Las Vegas
Click here to check out my Blog
 
Click here to learn about Mole 2010 debugging tool for Visual Studio 2010
 
Click here to read about XAML Power Toys
 

Just a grain of sand on the worlds beaches.

Follow on   Twitter

| Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.141223.1 | Last Updated 18 Dec 2007
Article Copyright 2007 by Andrew Smith, Josh Smith, Karl Shifflett
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid