Imports System.Reflection
Public Class Form1
Private TypeDisplayed As New List(Of String)
Private Relations As New List(Of InheritanceRelation)
Private Function GetRelation(ByVal CBox As ClassBox) As InheritanceRelation
Dim Base As Type = DirectCast(CBox.Tag, Type)
'If Base Is GetType(Object) Then
'Return Nothing
'End If
For Each C As Control In splitMain.Panel1.Controls
If TypeOf C Is ClassBox Then
Dim Box As ClassBox = DirectCast(C, ClassBox)
Dim Typ As Type = DirectCast(C.Tag, Type)
Dim BaseType As Type = DirectCast(Box.Tag, Type).BaseType
If BaseType Is Base Then
Dim R As New InheritanceRelation(CBox, Box)
R.Color = Color.LightBlue
If Not Relations.Contains(R) Then Return R
End If
If Base.IsInterface And Base.IsAssignableFrom(Typ) Then
Dim R As New InheritanceRelation(CBox, Box)
R.Color = Color.Fuchsia
If Not Relations.Contains(R) Then Return R
End If
End If
Next
Return Nothing
End Function
Private Function AddClassBox(ByVal T As Type, Optional ByVal ControlRelation As Boolean = False) As ClassBox
Dim CBox As New ClassBox
If Not TypeDisplayed.Contains(T.FullName) Then
TypeDisplayed.Add(T.FullName)
CBox.SetTypeName(T)
CBox.Name = T.Name
CBox.ForeColor = Color.White
CBox.Font = New Font("Microsoft Sans Serif", 10, FontStyle.Regular)
CBox.Tag = T
CBox.ContextMenuStrip = cntScanType
splitMain.Panel1.Controls.Add(CBox)
AddHandler CBox.ItemClicked, AddressOf ClassBoxes_ItemClicked
AddHandler CBox.DoubleClick, AddressOf ClassBoxes_DoubleClick
AddHandler CBox.Move, AddressOf ClassBoxes_Move
If ControlRelation Then
Dim R As InheritanceRelation = GetRelation(CBox)
If R IsNot Nothing Then
Relations.Add(R)
End If
End If
Return CBox
Else
Return Nothing
End If
End Function
Private Sub strLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strLoad.Click
Dim Open As New OpenFileDialog
Open.Filter = "Assemblies .NET|*.exe;*.dll"
If Open.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim Asm As Assembly
Dim X, Y As Int32
Asm = Assembly.LoadFile(Open.FileName)
X = 20
Y = 40
For Each T As Type In Asm.GetTypes
Dim CBox As New ClassBox
If Not TypeDisplayed.Contains(T.FullName) Then
CBox = AddClassBox(T)
If X + 5 + CBox.Width > splitMain.Panel1.Width - 10 Then
X = 20
Y += 80
End If
CBox.Location = New Point(X, Y)
X += CBox.Width + 5
End If
Next
For Each C As Control In splitMain.Panel1.Controls
If TypeOf C Is ClassBox Then
Dim R As InheritanceRelation = GetRelation(C)
If R IsNot Nothing Then
Relations.Add(R)
End If
End If
Next
End If
End Sub
Private Sub strAnalyze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strAnalyze.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
Box.ScanClass(Box.Tag)
End Sub
Private Sub strCompress_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strCompress.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
Box.Minimize()
End Sub
Private Sub strExpand_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strExpand.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
Box.ScanClass(Box.Tag, True)
End Sub
Private Sub strClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strClear.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
Box.ClearAll()
End Sub
Private Sub ClassBoxes_ItemClicked(ByVal sender As Object, ByVal e As ClassBox.ItemClickedArgs)
Dim StartType As Type = DirectCast(sender, ClassBox).Tag
Dim MI As MemberInfo = e.Item.Tag
Dim Desc As New System.Text.StringBuilder
Dim RelatedTypes As New List(Of Type)
Desc.AppendLine("Informazioni sul tipo: ")
Desc.AppendLine(AssemblyScanner.GetTypeInfo(StartType))
Desc.AppendLine()
Desc.AppendLine("Informazioni sul membro: ")
Desc.AppendLine(AssemblyScanner.GetMemberInfo(MI))
Desc.AppendLine()
If e.Item.ExposedMembers.Count > 0 Then
Desc.AppendFormat("Questo membero espone anche {0} overloads:{1}", e.Item.ExposedMembers.Count, vbCrLf)
Desc.AppendLine()
For I As Int16 = 0 To e.Item.ExposedMembers.Count - 1
Desc.AppendFormat("Informazioni sull'overload [{0}]:{1}", I, vbCrLf)
Desc.AppendLine(AssemblyScanner.GetMemberInfo(e.Item.ExposedMembers(I)))
Desc.AppendLine()
Next
End If
If MI.GetCustomAttributes(False).Length > 0 Then
Desc.AppendLine()
Desc.AppendLine("Inoltre, il tipo espone anche i seguenti attributi:")
Desc.AppendLine(AssemblyScanner.GetMemberAttributes(MI))
End If
txtDescription.Text = Desc.ToString
RelatedTypes = AssemblyScanner.GetMemberRelatedTypes(MI)
lstRelatedTypes.Items.Clear()
For Each T As Type In RelatedTypes
If Not lstRelatedTypes.Items.Contains(T) Then
lstRelatedTypes.Items.Add(T)
End If
Next
For Each C As Control In splitMain.Panel1.Controls
If TypeOf C Is ClassBox Then
If MI.Equals(C.Tag) Then
With DirectCast(C, ClassBox)
.Color = Color.SeaGreen
.Refresh()
End With
End If
End If
Next
End Sub
Private Sub ClassBoxes_DoubleClick(ByVal sender As Object, ByVal e As EventArgs)
Dim StartType As Type = DirectCast(sender, ClassBox).Tag
Dim Desc As New System.Text.StringBuilder
Desc.AppendLine("Informazioni sul tipo: ")
Desc.AppendLine(AssemblyScanner.GetTypeInfo(StartType))
If StartType.GetCustomAttributes(False).Length > 0 Then
Desc.AppendLine()
Desc.AppendLine("Inoltre, il tipo espone anche i seguenti attributi:")
Desc.AppendLine(AssemblyScanner.GetMemberAttributes(StartType))
End If
txtDescription.Text = Desc.ToString
End Sub
Private Sub ClassBoxes_Move(ByVal sender As Object, ByVal e As EventArgs)
If Relations.Count > 0 Then
For Each R As InheritanceRelation In Relations
If sender Is R.Base Or sender Is R.Derived Then
splitMain.Panel1.Refresh()
End If
Next
End If
End Sub
Private Sub lstRelatedTypes_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lstRelatedTypes.DoubleClick
If lstRelatedTypes.SelectedIndex >= 0 Then
Dim CBox As ClassBox = AddClassBox(lstRelatedTypes.SelectedItem, True)
If CBox Is Nothing Then
MessageBox.Show("Questo tipo è già presente nell'explorer!", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
CBox.Location = New Point(splitMain.Panel1.Width / 2 - CBox.Width / 2, splitMain.Panel1.Height / 2 - CBox.Height / 2)
End If
End Sub
Private Sub strDeleteAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strDeleteAll.Click
splitMain.Panel1.Controls.Clear()
End Sub
Private Sub strDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strDelete.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
splitMain.Panel1.Controls.Remove(Box)
RemoveHandler Box.Move, AddressOf ClassBoxes_Move
RemoveHandler Box.DoubleClick, AddressOf ClassBoxes_DoubleClick
RemoveHandler Box.ItemClicked, AddressOf ClassBoxes_ItemClicked
Dim ToRemove As New List(Of InheritanceRelation)
For Each R As InheritanceRelation In Relations
If R.Derived Is Box Or R.Base Is Box Then
ToRemove.Add(R)
End If
Next
For Each R As InheritanceRelation In ToRemove
Relations.Remove(R)
Next
Box.Dispose()
splitMain.Panel1.Refresh()
End Sub
Private Sub splitMain_Panel1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles splitMain.Panel1.Paint
If Relations.Count > 0 Then
Dim Pen As Pen
Dim BCenter, DCenter As Point
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
For Each R As InheritanceRelation In Relations
Pen = New Pen(Color.FromArgb(190, R.Color), 6)
BCenter = New Point(R.Base.Location.X + R.Base.Width / 2, R.Base.Location.Y + R.Base.Height / 2)
DCenter = New Point(R.Derived.Location.X + R.Derived.Width / 2, R.Derived.Location.Y + R.Derived.Height / 2)
e.Graphics.DrawLine(Pen, BCenter, DCenter)
Next
End If
End Sub
Private Sub strLimitHeight_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles strLimitHeight.Click
If Not TypeOf sender Is ToolStripMenuItem Then Exit Sub
Dim ToolStrip As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim ContextMenu As ContextMenuStrip = ToolStrip.Owner
Dim Box As ClassBox = ContextMenu.SourceControl
If Not Box.Collapsed And Box.Height < splitMain.Panel1.Height Then
Box.Height = splitMain.Panel1.Height * 4 / 5
Me.Refresh()
End If
End Sub
End Class
