经过一段时间的努力,并参阅了很多大侠的源代码,重新改造了一下TreeView控件。现将所有的源代码全部公布,以和朋友们共享。
'主要的功能有:
' 根据数据表中的记录来添加节点;
' 每个节点都可以添加ToolTip提示;
' 可以得到当前选定节点的父节点或根节点,及其一些相关属性;
' 可以拖动节点,并可自由设置拖动后的数据处理办法;
' 可以通过编号直接定位到某个节点,也可以通过查找文本的办法找到节点
'还需要改进的是:
' 1、图片。根据记录TJ值的不同,各个节点,可以使用不同的图片;
' 2、复选框。如何控制各个节点的复选框:有些节点可以选中,有些则不选中;
' 如果父节点的复选框选中,则所有子节点都选中,取消父节点的复选框后,则所有的子节点都取消(还包括类似情况);
' 3、文本查找。在树中查找文本,如果找到后,应该将该节点展开,而目前,有时好象只能展开一部分;
' 4、加载速度。由于是根据数据表中记录来添加节点,所以加载的速度比较慢,需要优化;
Imports System.Windows.Forms
Imports System.Drawing
全新打造的最新的 TreeView 作者:钱波#Region " 全新打造的最新的 TreeView 作者:钱波 "
'主要的功能有:
' 根据数据表中的记录来添加节点;
' 每个节点都可以添加ToolTip提示;
' 可以得到当前选定节点的父节点或根节点,及其一些相关属性;
' 可以拖动节点,并可自由设置拖动后的数据处理办法;
' 可以通过编号直接定位到某个节点,也可以通过查找文本的办法找到节点
'主要的属性有:
' BqMini1gRow '初始化时,获取表的记录行
' BqPdragType '初始化时,是否需要进行拖动
' BqpTooltip '指定提示信息
' BqPdragNode '返回拖动的节点对象
' BqPdragNo '返回拖动过的节点的数量
' BqPoSelectNode '返回当前选中的节点对象
' BqPoTableOut '返回当前数据表
' BqPallCounts '返回所有的节点数
' BqPfinCount '返回找到的节点数
' BqPtagBH '设置或返回当前选定项的Tag值,即编号
' BqPFindCount '根据文本查找定位节点,并返回找到的节点数
'获取的节点 是我自己定义的一个的TreeNode对象,
'主要的属性有:
' BqBh '节点的 编号
' BqBhFull '节点的 编号全称
' BqImage '节点的 对应的ImageIndex的位置
' BqOneBh '节点的 根+末级编号
' BqOneText '节点的 根+末级名称
' BqOneTextJc '节点的 根+末级简称
' BqNodeBoot '节点的 根节点
' BqNodeParent '节点的 父节点
' BqBhBoot '当前节点的根节点编号
' BqBhParent '当前节点的父节点编号
'
'主要的方法有:
' BqMini1del '删除表中的记录
' BqMini2add '添加记录
' BqMini3node '开始添加节点
'主要的事件有:
' BqeSeNodeBar '外部设置,选择节点后显示节点信息
' BqeSeNodeBd '外部设置,选择节点后绑定数据
' BqeNodeDrop '拖动完成后应该执行的操作
' BqeNodeFind '完成查找后应该执行的操作
'
'例如:
' Dim r1, r0 As DataRow
' With Me.BqUTre1.BqUTreeView1
' r0 = .BqMini1gRow
' .BqMini1del() '先清除BqUTre中的表中记录
' For Each r1 In sMainTable.Rows
' r0("BP") = "" & r1.Item("BHparent").ToString '父编号
' r0("BH") = "" & r1.Item("BHmode").ToString'编号
' r0("MC") = "" & r1.Item("MCmode").ToString'名称
' r0("Jc") = "" & r1.Item("JCmode").ToString'简称
' r0("Ti") = "" & r1.Item("HelpTip").ToString'帮助提示
' r0("Im") = "" & r1.Item("Image").ToString'对应的ImageIndex的位置
' r0("TJ") = "" & r1.Item("K_dele").ToString'条件
' .BqMini2add(r0)
' Next
' .BqPdragType = 1 '不能拖动
' .BqpTooltip = "功能模块"
' .BqMini3node()
' End With
'还需要改进的是:
' 1、图片。根据记录TJ值的不同,各个节点,可以使用不同的图片;
' 2、复选框。如何控制各个节点的复选框:有些节点可以选中,有些则不选中;
' 如果父节点的复选框选中,则所有子节点都选中,取消父节点的复选框后,则所有的子节点都取消(还包括类似情况);
' 3、文本查找。在树中查找文本,如果找到后,应该将该节点展开,而目前,有时好象只能展开一部分;
' 4、加载速度。由于是根据数据表中记录来添加节点,所以加载的速度比较慢,需要优化;
Public Class BqUTreeViewClass BqUTreeView
Inherits System.Windows.Forms.TreeView
Dim oBoot, oPare As BqTreNodeEx
'Dim oBoot, oPare As BqTreNodeEx
'Dim oSelect As BqTreNodeEx
Dim oDragNode As BqTreNodeEx '被拖动的节点
Dim lBM As BindingManagerBase
Dim ltb As DataTable = New DataTable("kTreTab") '只用于初始化时,建立新的表,并从外部传入记录
Dim mTb As DataTable '主要用于节点的设置,临时表
Dim ltv As DataView
Dim lFGF As String '分隔符
''Dim lsFin As String '待查找的字符
Dim lsFins As Integer '查找结果的数量
''Dim lbFin As Boolean '是查找还是定位,lbFin = True '查找
''Dim lbSet As Boolean = True ',选择后,是否需要重新取
Dim lbynDrag As Integer '是否可以拖动,1 内部拖动,2外部拖动,其它,不可以拖动
Dim lRecnoCounts As Integer
Dim oTooltip As New ToolTip
Dim lTooltip As String
Dim lslDrag As Integer = 0
Dim oHashTable As Hashtable '为提高查找速度,而建立的
Public Sub New()Sub New()
MyBase.New()
Call TableCreat() '钱波加的,新建本类则就建立数据表
End Sub
Public Event BqeSeNodeBar() '外部设置,选择节点后显示节点信息
Public Event BqeSeNodeBd() '外部设置,选择节点后绑定数据
Public Event BqeNodeDrop() '拖动完成后应该执行的操作
Public Event BqeNodeFind() '完成查找后应该执行的操作
Dim kkk, n As Integer
Public Sub BqMini1del()Sub BqMini1del()
ltb.Rows.Clear()
End Sub '删除表中的记录
Public Sub BqMini3node()Sub BqMini3node()
kkk = System.Environment.TickCount
Debug.WriteLine(Me.Name + " 在tree中,TreNodesAdd 开始:" + kkk.ToString)
lRecnoCounts = ltb.Rows.Count
If lRecnoCounts > 0 Then
Call TreNodesAdd()
End If
'lbSet = True
If lbynDrag = 1 Or lbynDrag = 2 Then
Me.AllowDrop = True
Else
Me.AllowDrop = False
End If
Me.AllowDrop = IIf(lbynDrag = 1, True, False)
Me.SelectedNode = Me.TopNode ' Me.Nodes.Item(0)
Me.HideSelection = False
n = System.Math.Abs(System.Environment.TickCount - kkk)
Debug.WriteLine(Me.Name + "在tree中,TreNodesAdd 结束:" + n.ToString)
End Sub '第一次用 ,开始添加节点
Public Sub BqMini2add()Sub BqMini2add(ByVal oDataRow As DataRow)
Try
Dim r As Array
r = oDataRow.ItemArray
ltb.Rows.Add(r)
Catch ex As Exception
End Try
End Sub '添加记录
Public ReadOnly Property BqMini1gRow()Property BqMini1gRow() As DataRow
Get
Dim r As DataRow
r = ltb.Clone.NewRow
Return r
End Get
End Property '初始化时,获取表的记录行
Public ReadOnly Property BqPdragNode()Property BqPdragNode() As BqTreNodeEx
Get
Return oDragNode
End Get
End Property '返回拖动的节点对象
Public ReadOnly Property BqPdragNo()Property BqPdragNo() As Integer
Get
Return lslDrag
End Get
End Property '返回拖动过的节点的数量
Public ReadOnly Property BqPoSelectNode()Property BqPoSelectNode() As BqTreNodeEx
Get
Return Me.SelectedNode 'oSelect
End Get
End Property '返回当前选中的节点对象
Public ReadOnly Property BqPoTableOut()Property BqPoTableOut() As DataTable
Get
Return mTb
End Get
End Property '返回当前数据表
Public ReadOnly Property BqPallCounts()Property BqPallCounts() As Integer
Get
Return lRecnoCounts
End Get
End Property '返回所有的节点数
Public ReadOnly Property BqPfinCount()Property BqPfinCount() As Integer
Get
Return lsFins
End Get
End Property '返回找到的节点数
Public ReadOnly Property BqPFindCount()Property BqPFindCount(ByVal sText As String) As Integer
Get
Try
If Len(Trim(sText)) <= 0 Then
Exit Property '如果传入的值为空,则退出
End If
Me.CollapseAll()
Me.ForeColor = Color.Black '颜色设为默认:黑
Dim o, e As BqTreNodeEx
Dim lEnumerator As IDictionaryEnumerator = oHashTable.GetEnumerator()
lsFins = 0
lEnumerator.Reset()
While lEnumerator.MoveNext()
o = lEnumerator.Value
o.ForeColor = Color.Black '颜色设为默认:黑
If InStr(o.Text, Trim(sText)) > 0 Then
lsFins = lsFins + 1
Debug.WriteLine(o.Text)
If lsFins = 1 Then
e = o
End If
o.ForeColor = Color.Red
If IsNothing(o.BqNodeParent) Then
o.Expand()
Else
o.BqNodeParent.Expand()
End If
End If
End While
If lsFins > 0 Then
Me.SelectedNode = e '只选中第一个
RaiseEvent BqeNodeFind()
End If
Return lsFins
Catch ex As Exception
End Try
End Get
End Property
Public WriteOnly Property BqPdragType()Property BqPdragType() As Integer '设置是否可以拖动
Set(ByVal Value As Integer)
lbynDrag = IIf(Value = 1 Or 2, Value, 0) '0表示不能拖动,1自己内部拖动,2拖到外部
End Set
End Property '初始化时,是否需要进行拖动
Public Property BqpTooltip()Property BqpTooltip() As String
Get
Return lTooltip
End Get
Set(ByVal Value As String)
lTooltip = Value
Me.oTooltip.SetToolTip(Me, Value)
End Set
End Property '指定提示信息
Public WriteOnly Property BqPtagBH()Property BqPtagBH() As String
'Get
' If Not IsNothing(oSelect) Then
' Return oSelect.BqBh
' Else
' Return ""
' End If
'End Get
Set(ByVal Value As String)
'lsFin = Value
'lsFins = 0
'lbFin = False '定位
'lbSet = False
'Call SetT()
'lbSet = True
Try
If Len(Trim(Value)) <= 0 Then
Exit Property '如果传入的值为空,则退出
End If
Dim o As BqTreNodeEx
Dim lEnumerator As IDictionaryEnumerator = oHashTable.GetEnumerator()
lsFins = 0
lEnumerator.Reset()
While lEnumerator.MoveNext()
o = lEnumerator.Value
o.ForeColor = Color.Black '颜色设为默认:黑
End While
o = oHashTable.Item(Trim(Value))
Me.CollapseAll()
Me.SelectedNode = o
o.ForeColor = Color.Cyan.Blue '定位颜色设为:
o.Expand()
RaiseEvent BqeSeNodeBar()
Catch ex As Exception
End Try
End Set
End Property '设置或返回当前选定项的Tag值,即编号
'Public Function BqMTreFind(ByVal sTag As String) As Integer
' 'lsFin = sTag
' 'lsFins = 0
' 'lbFin = True '查找 文本
' 'lbSet = False '查找过程中,选择节点后不重新取数
' 'Call SetT()
' 'lbSet = True
' 'BqMTreFind = lsFins
' 'RaiseEvent BqeNodeFind()
'End Function
Private Sub TableCreat()Sub TableCreat() '建表
Try
ltb.Rows.Clear()
With ltb.Columns
.Add("BP", Type.GetType("System.String")) '父编号
.Add("BH", Type.GetType("System.String")) '编号
.Add("MC", Type.GetType("System.String")) '名称
.Add("Jc", Type.GetType("System.String")) '简称
.Add("Ti", Type.GetType("System.String")) '帮助提示
.Add("Im", Type.GetType("System.String")) '对应的ImageIndex的位置
.Add("TJ", Type.GetType("System.String")) '条件
'以下的字段,只在内部才进行设置其值
.Add("OB", Type.GetType("System.String")) '内部计算其值: 根+自己的编号
.Add("OJ", Type.GetType("System.String")) '内部计算其值: 根简称+自己的简称
.Add("OT", Type.GetType("System.String")) '内部计算其值: 根+自己的名称
.Add("BB", Type.GetType("System.String")) '内部计算其值: 根节点编号
.Add("FB", Type.GetType("System.String")) '内部计算其值: 编号全称
.Add("FT", Type.GetType("System.String")) '内部计算其值: 全称,字符
.Add("JB", Type.GetType("System.String")) '内部计算其值: 级别,从一开始算
.Add("MJ", Type.GetType("System.Boolean")) '内部计算其值: 末级标志
End With
Dim lc(0) As DataColumn
lc(0) = ltb.Columns("BH")
ltb.PrimaryKey = lc '编号必须唯一,这是每个节点的标志
Catch ex As Exception
End Try
End Sub
Private Sub TreNodesAdd()Sub TreNodesAdd()
Try
Me.Nodes.Clear()
Dim lDataset As New Data.DataSet
mTb = New DataTable
mTb.Rows.Clear()
mTb.Columns.Clear()
mTb = ltb.Copy '不能直接用lTb这个表,因为,重新添加节点时,会提示“表已经在另一个数据集DataSet中
oHashTable = New Hashtable(mTb.Rows.Count) '初始化集合大小
ltv = mTb.DefaultView
ltv.Sort = "BH"
lBM = BindingContext(ltv)
lDataset.Clear()
lDataset.Relations.Clear()
lDataset.EnforceConstraints = False '在尝试执行任何更新操作时是否遵循约束规则
lDataset.Tables.Add(mTb)
Dim dr1 As New DataRelation("self", mTb.Columns("BH"), mTb.Columns("BP"))
lDataset.Relations.Add(dr1)
'n = System.Math.Abs(System.Environment.TickCount - kkk)
'Debug.WriteLine(Me.Name + " 在tree中,建立关联:" + n.ToString)
Dim r1 As DataRow
Dim sP As String
lFGF = Me.PathSeparator.Trim
lFGF = IIf(lFGF.Length <> 1, "", lFGF)
For Each r1 In mTb.Rows
sP = "" & r1.Item("BP").ToString
If sP = "" Then '根
TreAdd(r1, Nothing)
End If
Next
'n = System.Math.Abs(System.Environment.TickCount - kkk)
'Debug.WriteLine(Me.Name + " 在tree中,结点加完:" + n.ToString)
'节点添加完成后,就可以显示记录的内容了
lDataset.Relations.Clear() ' 外传出记录时,不需要加关联
Catch ex As Exception
MMSeRRor(ex)
End Try
End Sub
Private Sub TreAdd()Sub TreAdd(ByVal r As DataRow, ByVal item As BqTreNodeEx)
Try
Dim mi As New BqTreNodeEx
Dim lmMc As String
lmMc = Trim("" & r.Item("MC").ToString) '名称,如果名称为 "减号 -",表示分隔符
If Microsoft.VisualBasic.Left(lmMc, 1) = "-" Then '在菜单名称中,左边第一个字符为 - ,则表示分隔符
mi.Text = "-----分隔符-----"
Else
mi.Text = lmMc
End If
mi.BqBh = "" & r.Item("BH").ToString '编号
'mi.BqParentBh = "" & r.Item("BP").ToString '上级编号
mi.BqImage = "" & r.Item("im").ToString
mi.BqTip = "" & r.Item("Ti").ToString
mi.Checked = IIf(r.Item("TJ").ToString = "True", True, False)
If item Is Nothing Then
Me.Nodes.Add(mi)
oHashTable.Add(mi.BqBh, mi)
oBoot = mi
'oPare = Nothing
'mi.BqBootBh = mi.BqBh
mi.BqBhFull = mi.BqBh
mi.BqOneBh = mi.BqBh
mi.BqOneText = mi.Text
mi.BqOneTextJc = "" & r.Item("Jc").ToString
mi.BqNodeBoot = Nothing
'mi.BqNodeParent = Nothing
Else
item.Nodes.Add(mi)
oHashTable.Add(mi.BqBh, mi)
oPare = item
'mi.BqBootBh = oBoot.BqBh
mi.BqBhFull = oPare.BqBhFull + lFGF + mi.BqBh
mi.BqOneBh = oBoot.BqBh + lFGF + mi.BqBh
mi.BqOneText = oBoot.Text + lFGF + mi.Text
mi.BqOneTextJc = IIf(oBoot.BqOneTextJc.Length < 1, oBoot.Text, oBoot.BqOneTextJc) + lFGF + mi.Text
mi.BqNodeBoot = oBoot
'mi.BqNodeParent = oPare
End If
Dim n As Integer = 0
Dim s As String
lmMc = mi.BqBhFull
s = Replace(lmMc, lFGF, "") '计算级别
n = lmMc.Length - s.Length
mi.BqPjb = (n + 1).ToString
r("OB") = mi.BqOneBh
r("OT") = mi.BqOneText
r("OJ") = mi.BqOneTextJc
r("BB") = mi.BqBhBoot
r("FB") = mi.BqBhFull
r("FT") = mi.FullPath
r("JB") = (n + 1).ToString
'r("Mj") = False
r("Mj") = IIf(r.GetChildRows("self", DataRowVersion.Current).GetUpperBound(0) > -1, False, True)
Dim r2 As DataRow
For Each r2 In r.GetChildRows("self")
TreAdd(r2, mi)
Next
Catch ex As Exception
End Try
End Sub
'Private Sub Sel(ByVal e As BqTreNodeEx)
' Try
' RaiseEvent BqeSeNodeBar()
' Catch ex As Exception
' End Try
'End Sub '选择后,得到当前选择项的信息
'Private Sub SelF(ByVal n1 As BqTreNodeEx)
' n1.ForeColor = Color.Black '颜色设为默认:黑
' Dim tj As Boolean = False
' If lbFin = False Then '定位
' If n1.BqBh = lsFin Then
' n1.ForeColor = Color.Cyan.Blue '定位颜色设为:
' n1.Expand()
' Me.SelectedNode = n1
' Call Sel(n1) '定位后可以得到当前节点的值
' Exit Sub
' End If
' Else '在文本中查找
' If InStr(n1.Text, lsFin) > 0 Then
' n1.ForeColor = Color.Red
' lsFins = lsFins + 1
' lbSet = IIf(lsFins = 1, True, False) '还是要选择中第一个
' n1.Expand()
' Me.SelectedNode = n1
' End If
' End If
' Dim n2 As BqTreNodeEx
' For Each n2 In n1.Nodes
' SelF(n2)
' Next
'End Sub
'Private Sub SetT()
' Dim n As BqTreNodeEx
' Me.Visible = False
' Me.CollapseAll()
' For Each n In Me.Nodes
' SelF(n)
' Next
' Me.Visible = True
'End Sub
Private Function TwoP()Function TwoP(ByVal node1 As BqTreNodeEx, ByVal node2 As BqTreNodeEx) As Boolean
' 检查第二个节点的父节点。
If node2.Parent Is Nothing Then
Return False
End If
If node2.Parent.Equals(node1) Then
Return True
End If
' 如果父节点并不是 Null 或是等于第一个节点,则使用
' 第二个节点的父节点来递回调用 TwoP 方法。
Return TwoP(node1, node2.Parent)
End Function
Private Sub BqUTreeView_AfterSelect()Sub BqUTreeView_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles MyBase.AfterSelect
'oSelect = Me.SelectedNode
RaiseEvent BqeSeNodeBar()
RaiseEvent BqeSeNodeBd()
'If lbSet Then
' Dim o As BqTreNodeEx
' o = CType(e.Node, BqTreNodeEx)
' oSelect = o '当前节点
' RaiseEvent BqeSeNodeBar()
' 'Call Sel(o)
' RaiseEvent BqeSeNodeBd()
'End If
End Sub
Private Sub BqUTreeView_MouseMove()Sub BqUTreeView_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove
Dim n As BqTreNodeEx
n = Me.GetNodeAt(e.X, e.Y) ' 确认鼠标指标目前是位于哪一个节点之上。
If Not (n Is Nothing) Then ' 检查鼠标指标所停驻之处是否真的是一个节点。
Dim s As String
s = n.BqTip
s = IIf(n.BqTip.Length < 1, n.FullPath, n.BqTip)
If (s <> oTooltip.GetToolTip(Me)) Then ' 只有在需要改变工具提示文字时才更新 TreeView 控制项的工具提示文字。
oTooltip.SetToolTip(Me, s)
End If
Else
oTooltip.SetToolTip(Me, "") ' 鼠标指标并非停驻在一个节点之上,因此清除 TreeView 控制项的工具提示文字。
End If
End Sub
Private Sub BqUTreeView_ItemDrag()Sub BqUTreeView_ItemDrag(ByVal sender As Object, ByVal e As ItemDragEventArgs) Handles MyBase.ItemDrag
' 如果用户是持续按着鼠标左键来拖曳节点,则将会移动节点。
If e.Button = MouseButtons.Left Then
DoDragDrop(e.Item, DragDropEffects.Move)
' 如果用户是持续按着鼠标右键来拖曳节点,则将会复制节点。
'ElseIf e.Button = MouseButtons.Right Then
' DoDragDrop(e.Item, DragDropEffects.Copy) '这句话不用了,只能拖动,不能复制
End If
End Sub
Private Sub BqUTreeView_DragEnter()Sub BqUTreeView_DragEnter(ByVal sender As Object, ByVal e As DragEventArgs) Handles MyBase.DragEnter
e.Effect = e.AllowedEffect
End Sub ' 将目标置放效果设定成在 ItemDrag 事件过程中所指定的效果。
Private Sub BqUTreeView_DragOver()Sub BqUTreeView_DragOver(ByVal sender As Object, ByVal e As DragEventArgs) Handles MyBase.DragOver
Dim targetPoint As Point ' 取得鼠标指标所在位置的工作区坐标(Client Coordinate)。
targetPoint = CType(sender, TreeView).PointToClient(New Point(e.X, e.Y))
' 选取鼠标指标所在位置之下的节点。
CType(sender, TreeView).SelectedNode = CType(sender, TreeView).GetNodeAt(targetPoint)
End Sub ' 将鼠标指标所在位置之下的节点选取起来,以便标示出预期的置放位置。
Private Sub BqUTreeView_DragDrop()Sub BqUTreeView_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs) Handles MyBase.DragDrop
Dim targetPoint As Point ' 取得置放位置的工作区坐标。
Dim targetNode As BqTreNodeEx ' 取得在置放位置的节点。
Dim draggedNode As BqTreNodeEx ' 取得被拖曳的节点。
oDragNode = Nothing
targetPoint = CType(sender, TreeView).PointToClient(New Point(e.X, e.Y))
targetNode = CType(sender, TreeView).GetNodeAt(targetPoint)
draggedNode = CType(e.Data.GetData(GetType(BqTreNodeEx)), BqTreNodeEx)
Dim lyn As Boolean = False '表示是否拖动成功
If targetNode Is Nothing Then '如果置放位置为空,则可以加到根
If e.Effect = DragDropEffects.Move Then
draggedNode.Remove()
Me.Nodes.Add(draggedNode)
Me.CollapseAll()
lyn = True
End If
' 确认在置放位置的节点并不是被拖曳的节点或被拖曳之节点的子系。
ElseIf Not draggedNode.Equals(targetNode) AndAlso Not TwoP(draggedNode, targetNode) Then
' 如果这是一项移动操作,则将节点从目前的位置移除并将它添加至置放位置的节点中。
If e.Effect = DragDropEffects.Move Then
draggedNode.Remove()
targetNode.Nodes.Add(draggedNode)
targetNode.Expand()
lyn = True
' 如果这是一项复制操作,则复制被拖曳的节点并将它添加至置放位置的节点中。
ElseIf e.Effect = DragDropEffects.Copy Then
'在自射拖动过程中,复制要得到好几份,所以不用这一个了 20060801钱波注明
Dim n As New BqTreNodeEx
n = CType(draggedNode.Clone(), BqTreNodeEx)
targetNode.Nodes.Add(n)
Me.CollapseAll()
targetNode.Expand()
lyn = True
End If
End If
If lyn = False Then Exit Sub '如果没有拖动成功,则不执行以下命令
Try
Dim m As String
Dim n As Integer
m = draggedNode.BqBh
ltv.Sort = "BH"
n = ltv.Find(m)
lBM.Position = n
Dim rv As DataRowView = ltv.Item(lBM.Position)
Dim o As BqTreNodeEx
o = CType(draggedNode.Parent, BqTreNodeEx)
If IsNothing(o) Then '则拖动到根节点下了
rv.Row("BP") = ""
With draggedNode
.BqNodeBoot = Nothing
'.BqNodeParent = Nothing
.BqTip = "已经移动到新的位置。重新进入后,数据生效!"
.BackColor = Color.Coral
End With
ElseIf Not o Is draggedNode.BqNodeParent Then '如果移动前后,父节点不相同,即表示移动成功
rv.Row("BP") = o.BqBh
With draggedNode
.BqNodeBoot = Nothing
'.BqNodeParent = o
'.BqParentBh = o.BqBh
.BqTip = "已经移动到新的位置。重新进入后,数据生效!"
.BackColor = Color.Coral
End With
End If
oDragNode = draggedNode
lslDrag = lslDrag + 1
RaiseEvent BqeNodeDrop()
Catch ex As Exception
End Try
End Sub
End Class
#End Region
这是我自己定义的一个treenode对象,可以再改一改后就可以用#Region " 这是我自己定义的一个treenode对象,可以再改一改后就可以用"
Public Class BqTreNodeExClass BqTreNodeEx
Inherits System.Windows.Forms.TreeNode
Implements IDictionaryEnumerator
Private nodeEntry As DictionaryEntry
Private enumerator As IEnumerator
Dim oToolTip As System.Windows.Forms.ToolTip
Public Sub New()Sub New()
enumerator = MyBase.Nodes.GetEnumerator()
End Sub
'加入以下的属性:编号,父编号,父节点(对象),全称,编号全称,根+末级编号,根+末级名称,级次,
'这样,可以对treeview中每一个节点进行设置,方便选择后的处理
Dim lBh, lBhparent As String
Dim lFullBh, lFullText As String
Dim lOneBh, lOneText As String
Dim lBootBh, lTip As String
Dim lImage, lParentS As String
Dim lbNode, lpNode As BqTreNodeEx
Dim lOneTextJc As String
Public Property BqBh()Property BqBh() As String
Get
Return lBh
End Get
Set(ByVal Value As String)
lBh = Value
End Set
End Property '节点的 编号
Public Property BqBhFull()Property BqBhFull() As String
Get
Return lFullBh
End Get
Set(ByVal Value As String)
lFullBh = Value
End Set
End Property '节点的 编号全称
Public Property BqImage()Property BqImage() As String
Get
Return lImage
End Get
Set(ByVal Value As String)
lImage = Value
End Set
End Property '节点的 对应的ImageIndex的位置
Public Property BqOneBh()Property BqOneBh() As String
Get
Return lOneBh
End Get
Set(ByVal Value As String)
lOneBh = Value
End Set
End Property '节点的 根+末级编号
Public Property BqOneText()Property BqOneText() As String
Get
Return lOneText
End Get
Set(ByVal Value As String)
lOneText = Value
End Set
End Property '节点的 根+末级名称
Public Property BqOneTextJc()Property BqOneTextJc() As String
Get
Return lOneTextJc
End Get
Set(ByVal Value As String)
lOneTextJc = Value
End Set
End Property '节点的 根+末级简称
Public Property BqNodeBoot()Property BqNodeBoot() As BqTreNodeEx
Get
Return lbNode
End Get
Set(ByVal Value As BqTreNodeEx)
lbNode = Value
End Set
End Property '节点的 根节点
Public ReadOnly Property BqNodeParent()Property BqNodeParent() As BqTreNodeEx
Get
'''Dim o As BqTreNodeEx
''o = CType(Me.Parent, BqTreNodeEx)
Return CType(Me.Parent, BqTreNodeEx) ' lpNode
End Get
'Set(ByVal Value As BqTreNodeEx)
' lpNode = Value
'End Set
End Property '节点的 父节点
Public ReadOnly Property BqBhBoot()Property BqBhBoot() As String
Get '因为有可能当前节点的根节点是nothing,所以将其编号设置为"",以便于外部调用比较方便
If IsNothing(Me.BqNodeBoot) Then
Return ""
Else
Return Me.BqNodeBoot.BqBh
End If
'Return lBootBh
End Get
'Set(ByVal Value As String)
' lBootBh = Value
'End Set
End Property '当前节点的根节点编号
Public ReadOnly Property BqBhParent()Property BqBhParent() As String
Get '因为有可能当前节点的父节点是nothing,所以将其编号设置为"",以便于外部调用比较方便
If IsNothing(Me.Parent) Then
Return ""
Else
Dim o As BqTreNodeEx
o = CType(Me.Parent, BqTreNodeEx)
Return o.BqBh
End If
Return lBhparent
End Get
'Set(ByVal Value As String)
' lBhparent = Value
'End Set
End Property '当前节点的父节点编号
Public Property BqPjb()Property BqPjb() As String '级别
Get
Return lParentS
End Get
Set(ByVal Value As String)
lParentS = Value
End Set
End Property
Public Property BqTip()Property BqTip() As String
Get
Return lTip
End Get
Set(ByVal Value As String)
lTip = Value
End Set
End Property '节点的 帮助提示
Public Property NodeKey()Property NodeKey() As String
Get
Return nodeEntry.Key.ToString()
End Get
Set(ByVal Value As String)
nodeEntry.Key = Value
End Set
End Property
Public Property NodeValue()Property NodeValue() As Object
Get
Return nodeEntry.Value
End Get
Set(ByVal Value As Object)
nodeEntry.Value = Value
End Set
End Property
Public Overridable Overloads ReadOnly Property Entry()Property Entry() As DictionaryEntry Implements IDictionaryEnumerator.Entry
Get
Return nodeEntry
End Get
End Property
Public Overridable Overloads Function MoveNext()Function MoveNext() As Boolean Implements IDictionaryEnumerator.MoveNext
Dim Success As Boolean
Success = enumerator.MoveNext()
Return Success
End Function
Public Overridable Overloads ReadOnly Property Current()Property Current() As Object Implements IEnumerator.Current
Get
Return enumerator.Current
End Get
End Property
Public Overridable Overloads ReadOnly Property Key()Property Key() As Object Implements IDictionaryEnumerator.Key
Get
Return nodeEntry.Key
End Get
End Property
Public Overridable Overloads ReadOnly Property Value()Property Value() As Object Implements IDictionaryEnumerator.Value
Get
Return nodeEntry.Value
End Get
End Property
Public Overridable Overloads Sub Reset()Sub Reset() Implements IEnumerator.Reset
enumerator.Reset()
End Sub
End Class
#End Region
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。