分享
 
 
 

The Netron Project For vb.net

王朝学院·作者佚名  2009-12-24
窄屏简体版  字體: |||超大  

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有