The Netron Project For vb.net

核心提示：Netron是一个用于实现类似简单Visio图形化功能的C#开源项目，作者在2006年停止了2.5版的更新，The Netron Project For vb.net，随后在2007年发布了3.0版，网络上也出现了基于2.5版的轻量版，(魏滔序原创，转帖请注明出处，相对来说简单很多，虽然可以用来入门学习

Netron是一个用于实现类似简单Visio图形化功能的C#开源项目，作者在2006年停止了2.5版的更新，随后在2007年发布了3.0版。网络上也出现了基于2.5版的轻量版，相对来说简单很多，虽然可以用来入门学习，但被阉割过的项目总显得有些无味。3.0版相对2.5版来说是质的飞跃，但的的确确确确实实实实在在太“重量”了，所以研究学习2.5版是最折中的选择。

我已经把原版的C#源码转换成VB.net，这样对VBFans来说也许是件令人鼓舞的事情。除了语言上的转换之外，还对项目中原有的bug和不足做了如下的小范围修改。

(魏滔序原创，转帖请注明出处。)

DiagramControl：删除选中的项目

添加方法：

　　Public Sub RemoveSelectedItems()

　　　　　　For i As Int32 = SelectedItems.Count - 1 To 0 Step -1

　　　　　　　　Controller.Model.Remove(SelectedItems(i))

　　　　　　Next

　　　　　　Me.Invalidate()

　　　　End Sub



Selecttion：执行DiagramControl.SelectedItems.Clear时反选

　　　　PRivate Shared Sub RaiSEOnNewSelection()

　　　　　　RemoveHandler mSelection.OnClear, AddressOf OnShowTracker

　　　　　　RemoveHandler mSelection.OnItemRemoved, AddressOf OnShowTracker

　　　　　　AddHandler mSelection.OnClear, AddressOf OnShowTracker

　　　　　　AddHandler mSelection.OnItemRemoved, AddressOf OnShowTracker

　　　　　　RaiseEvent OnNewSelection(Nothing, EventArgs.Empty)

　　　　End Sub



　　　　Private Shared Sub OnShowTracker(ByVal sender As Object, ByVal e As EventArgs)

　　　　　　Controller.View.ShowTracker()

　　　　End Sub



CollectionBase：从索引移除项目时触发OnItemRemoved事件

　　　　Public Sub RemoveAt(ByVal index As Integer)

　　　　　　Dim Item As T = Me.innerList(index)

　　　　　　Me.innerList.RemoveAt(index)

　　　　　　RaiseOnItemRemoved(Item)

　　　　End Sub



Connection：禁止连线缩放(去除缩放点和选中矩形框)

　　　　Public Sub New(ByVal mFrom As Point, ByVal mTo As Point, ByVal model As IModel)

　　　　　　MyBase.New(model)

　　　　　　MyBase.Resizable = False

　　　　　　Me.From = New Connector(mFrom, model)

　　　　　　Me.From.Name = "From"

　　　　　　Me.From.Parent = Me

　　　　　　Me.To = New Connector(mTo, model)

　　　　　　Me.To.Name = "To"

　　　　　　Me.To.Parent = Me

　　　　End Sub



View：Resizable = False 时去除获得焦点的选中矩形框

　　　　Public Shared Function GetTracker(ByVal rectangle As Rectangle, ByVal type As TrackerTypes, ByVal showHandles As Boolean) As ITracker

　　　　　　Select Case type

　　　　　　　　Case TrackerTypes.Default

　　　　　　　　　　If defTracker Is Nothing Then

　　　　　　　　　　　　defTracker = New DefaultTracker()

　　　　　　　　　　End If

　　　　　　　　　　If showHandles Then

　　　　　　　　　　　　defTracker.Transform(rectangle)

　　　　　　　　　　Else

　　　　　　　　　　　　defTracker.Transform(Nothing)

　　　　　　　　　　End If

　　　　　　　　　　defTracker.ShowHandles = showHandles

　　　　　　　　　　Return defTracker

　　　　　　　　Case Else

　　　　　　　　　　Return Nothing

　　　　　　End Select

　　　　End Function



TransformTool：实现鼠标移动时自动变换指针图标

在 Public Sub MouseMove(ByVal e As MouseEventArgs) Implements IMouseListener.MouseMove 的过程中添加：

　　　　　　If e.Button = MouseButtons.None AndAlso Enabled AndAlso (Not IsSuspended) Then

　　　　　　　　If Selection.SelectedItems.Count > 0 Then

　　　　　　　　　　Dim gripPoint As Point = Me.Controller.View.Tracker.Hit(e.Location)

　　　　　　　　　　Dim c As Cursor = Nothing

　　　　　　　　　　Select Case gripPoint.X

　　　　　　　　　　　　Case -1

　　　　　　　　　　　　　　Select Case gripPoint.Y

　　　　　　　　　　　　　　　　Case -1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNWSE

　　　　　　　　　　　　　　　　Case 0

　　　　　　　　　　　　　　　　　　c = Cursors.SizeWE

　　　　　　　　　　　　　　　　Case 1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNESW

　　　　　　　　　　　　　　End Select

　　　　　　　　　　　　Case 0

　　　　　　　　　　　　　　Select Case gripPoint.Y

　　　　　　　　　　　　　　　　Case -1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNS

　　　　　　　　　　　　　　　　Case 1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNS

　　　　　　　　　　　　　　End Select

　　　　　　　　　　　　Case 1

　　　　　　　　　　　　　　Select Case gripPoint.Y

　　　　　　　　　　　　　　　　Case -1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNESW

　　　　　　　　　　　　　　　　Case 0

　　　　　　　　　　　　　　　　　　c = Cursors.SizeWE

　　　　　　　　　　　　　　　　Case 1

　　　　　　　　　　　　　　　　　　c = Cursors.SizeNWSE

　　　　　　　　　　　　　　End Select

　　　　　　　　　　End Select

　　　　　　　　　　Controller.View.CurrentCursor = c

　　　　　　　　End If

　　　　　　End If



TransformTool：缩放图形完成时刷新视图

　　　　Public Sub MouseUp(ByVal e As MouseEventArgs) Implements IMouseListener.MouseUp

　　　　　　If IsActive Then

　　　　　　　　DeactivateTool()

　　　　　　　　Dim cmd As New TransformCommand(Me.Controller, origin, scalex, scaley, transformers)

　　　　　　　　　　　Me.Controller.UndoManager.AddUndoCommand(cmd)

　　　　　　　　　　　Me.Controller.View.Invalidate()

　　　　　　End If

　　　　End Sub



ShapeBase：限制图形的最小高度和宽度为10像素

　　　　Public Overridable Sub Transform(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) Implements IShape.Transform

　　　　　　Dim a, b As Double

　　　　　　Dim p As Point

　　　　　　If width <= 10 Or height <= 10 Then Exit Sub

　　　　　　For Each cn As IConnector In Me.mConnectors

　　　　　　　　a = Math.Round((CDbl(cn.Point.X) - CDbl(mRectangle.X)) / CDbl(mRectangle.Width), 1) * width + x - cn.Point.X

　　　　　　　　b = Math.Round((CDbl(cn.Point.Y) - CDbl(mRectangle.Y)) / CDbl(mRectangle.Height), 1) * height + y - cn.Point.Y

　　　　　　　　p = New Point(Convert.ToInt32(a), Convert.ToInt32(b))

　　　　　　　　cn.Move(p)

　　　　　　Next cn

　　　　　　mRectangle = New Rectangle(x, y, width, height)

　　　　End Sub



本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/Modest/archive/2009/12/22/5057971.aspx