树和自联表(五)

Posted on 2006-11-11 20:27 水如烟(LzmTW) 阅读(1616) 评论() 收藏举报

关于数据实体类的定义：
注意使用Serializable修饰，那是复制和存储数据文件所必需的。
属性值不要使用数组。
保留New()构造函数。
形式已限定为属性类型。

例如菜单项信息，可以定样定义：
<Serializable()> _
Public Class MenuItem
Inherits LzmTW.uSystem.uCollection.SinceLink.SinceLinkItemBase(Of Integer)

    Private gText As String
    Private gToolTipText As String
    Private gShortcut As Integer
    Private gClickAction As String
    Private gVisible As Boolean
    Private gEnabled As Boolean

    Public Property Text() As String
        Get
            Return gText
        End Get
        Set(ByVal value As String)
            gText = value
        End Set
    End Property

    Public Property ToolTipText() As String
        Get
            Return gToolTipText
        End Get
        Set(ByVal value As String)
            gToolTipText = value
        End Set
    End Property

    Public Property Shortcut() As Integer
        Get
            Return gShortcut
        End Get
        Set(ByVal value As Integer)
            gShortcut = value
        End Set
    End Property

    Public Property ClickAction() As String
        Get
            Return gClickAction
        End Get
        Set(ByVal value As String)
            gClickAction = value
        End Set
    End Property

    Public Property Visible() As Boolean
        Get
            Return gVisible
        End Get
        Set(ByVal value As Boolean)
            gVisible = value
        End Set
    End Property

    Public Property Enabled() As Boolean
        Get
            Return gEnabled
        End Get
        Set(ByVal value As Boolean)
            gEnabled = value
        End Set
    End Property
End Class

以下为树和自联表（正式叫法应该是关联表吧）部分的全部代码。它现在可以处理树、(Code,Name)、自联表三种情形的数据。
在后面一篇中，将分别对这三种情形给出示例代码。

如果代码需要修改补充，我也将在此文中进行更新。

如果您使用了这个类，有什么建议，敬请在此回贴指出。

辅助类：

Namespace LzmTW.uSystem.uReflection
    Public Class CommonFunction
        Private Sub New()
        End SubPublic Shared Function TypeHasFields(ByVal t As Type) As Boolean
            Return t.GetFields.Length > 0
        End FunctionPublic Shared Function TypeHasMember(ByVal t As Type, ByVal memberName As String) As Boolean
            Return t.GetMember(memberName) IsNot Nothing
        End FunctionPublic Shared Function CreateTableFromType(ByVal t As Type) As DataTable
            Dim tmpTable As New DataTableIf TypeHasFields(t) Then
                For Each f As Reflection.FieldInfo In t.GetFields
                    tmpTable.Columns.Add(f.Name, f.FieldType)
                Next
            Else
                For Each p As Reflection.PropertyInfo In t.GetProperties
                    If p.CanRead Then tmpTable.Columns.Add(p.Name, p.PropertyType)
                Next
            End IfReturn tmpTable
        End FunctionPublic Shared Function ItemToDataRow(Of T)(ByVal item As T, ByVal table As DataTable) As DataRow
            Dim tmpRow As DataRow = table.NewRowDim mName As String
            Dim mType As Type = GetType(T)For Each c As DataColumn In table.Columns
                mName = c.ColumnNameIf TypeHasFields(mType) Then
                    tmpRow(mName) = mType.GetField(mName).GetValue(item)
                Else
                    tmpRow(mName) = mType.GetProperty(mName).GetValue(item, Nothing)
                End If
            NextReturn tmpRow
        End FunctionPublic Shared Sub ItemAppendToTable(Of T)(ByVal item As T, ByVal table As DataTable)
            table.Rows.Add(ItemToDataRow(Of T)(item, table))
        End SubPublic Shared Sub ItemAppendToTable(Of T)(ByVal items() As T, ByVal table As DataTable)
            For Each item As T In items
                ItemAppendToTable(Of T)(item, table)
            Next
        End SubPublic Shared Function ItemsToTable(Of T)(ByVal items() As T) As DataTable
            Dim mTable As DataTable = CreateTableFromType(GetType(T))If items Is Nothing Then Return mTable

ItemAppendToTable(

Of T)(items, mTable)Return mTable
End FunctionEnd Class
End Namespace

Namespace LzmTW.uSystem.uRuntime.uSerializationPublic Class SerializeHelperPrivate Sub New()
        End Sub<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Function ItemToXml(Of T)(ByVal obj As T) As String
            Dim mResult As String = ""
            Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
            Dim mStringWriter As New System.IO.StringWriter
            Using mStringWriter
                mSerializer.Serialize(mStringWriter, obj)
                mResult = mStringWriter.ToString
                mStringWriter.Close()
            End Using
            Return mResult
        End Function<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Function XmlToItem(Of T)(ByVal xml As String) As T
            Dim mSerializer As New System.Xml.Serialization.XmlSerializer(GetType(T))
            Dim mStringReader As New System.IO.StringReader(xml)
            Return CType(mSerializer.Deserialize(mStringReader), T)
        End Function<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Sub ItemToXmlFile(Of T)(ByVal filename As String, ByVal obj As T)
            Dim XmlWriter As New System.IO.StreamWriter(filename, False, System.Text.Encoding.Default)
            Using XmlWriter
                XmlWriter.Write(ItemToXml(obj))
                XmlWriter.Close()
            End Using
        End Sub<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Function XmlFileToItem(Of T)(ByVal filename As String) As T
            Dim XmlReader As New System.IO.StreamReader(filename, System.Text.Encoding.Default)
            Dim mObj As T
            Using XmlReader
                mObj = XmlToItem(Of T)(XmlReader.ReadToEnd)
                XmlReader.Close()
            End Using
            Return mObj
        End Function<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Sub ItemToFormatterFile(Of T)(ByVal filename As String, ByVal formatter As System.Runtime.Serialization.IFormatter, ByVal obj As T)
            Dim mFileStream As System.IO.Stream = System.IO.File.Open(filename, System.IO.FileMode.Create)
            Using mFileStream
                formatter.Serialize(mFileStream, obj)
                mFileStream.Close()
            End Using
        End Sub<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Advanced)> _
        Public Shared Function FormatterFileToItem(Of T)(ByVal FileName As String, ByVal formatter As System.Runtime.Serialization.IFormatter) As T
            Dim mFileStream As System.IO.Stream = System.IO.File.Open(FileName, System.IO.FileMode.Open)
            Dim mObj As T
            Using mFileStream
                mObj = CType(formatter.Deserialize(mFileStream), T)
                mFileStream.Close()
            End Using
            Return mObj
        End FunctionPublic Shared Function Clone(Of T)(ByVal obj As T) As T
            Dim tmpT As T
            Dim mFormatter As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
            Dim mMemoryStream As New System.IO.MemoryStream
            Using mMemoryStream
                mFormatter.Serialize(mMemoryStream, obj)
                mMemoryStream.Position = 0
                tmpT = CType(mFormatter.Deserialize(mMemoryStream), T)
                mMemoryStream.Close()
            End Using
            Return tmpT
        End FunctionPublic Shared Sub Save(Of T)(ByVal filename As String, ByVal formattype As FormatType, ByVal obj As T)
            SyncLock InternalSyncObject
                Select Case formattype
                    Case formattype.Binary
                        ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter, obj)
                    Case formattype.Soap
                        ItemToFormatterFile(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter, obj)
                    Case formattype.Xml
                        ItemToXmlFile(filename, obj)
                End Select
            End SyncLock
        End SubPublic Shared Function Load(Of T)(ByVal filename As String, ByVal formattype As FormatType) As T
            SyncLock InternalSyncObject
                Select Case formattype
                    Case formattype.Binary
                        Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter)
                    Case formattype.Soap
                        Return FormatterFileToItem(Of T)(filename, New System.Runtime.Serialization.Formatters.Soap.SoapFormatter)
                    Case formattype.Xml
                        Return XmlFileToItem(Of T)(filename)
                End Select
            End SyncLock
        End FunctionPrivate Shared ReadOnly Property InternalSyncObject() As Object
            Get
                If gInternalSyncObject Is Nothing Then
                    Dim tmpObj As New Object
                    System.Threading.Interlocked.CompareExchange(gInternalSyncObject, tmpObj, Nothing)
                End If
                Return gInternalSyncObject
            End Get
        End PropertyPrivate Shared gInternalSyncObject As Object
    End ClassPublic Enum FormatType
        Xml
        Binary
        Soap
    End EnumEnd Namespace

树类：

Namespace LzmTW.uSystem.uCollection
    ''' <summary>
    ''' 树节点
    ''' </summary>
    ''' <remarks>LzmTW 20061111</remarks>
    <Serializable()> _
    Public Class Node(Of T)Friend gIsRoot As Boolean = True
        Friend gParent As Node(Of T)''' <summary>
        ''' 当前节点的父节点
        ''' </summary>
        Public ReadOnly Property Parent() As Node(Of T)
            Get
                If Me.IsRoot Then
                    Return Nothing
                End If
                Return gParent
            End Get
        End Property''' <summary>
        ''' 树的深度
        ''' </summary>
        Public ReadOnly Property Level() As Integer
            Get
                If Me.IsRoot Then
                    Return 0
                End If
                Return Me.Parent.Level + 1
            End Get
        End Property''' <summary>
        ''' 当前节点是否是根节点
        ''' </summary>
        Public ReadOnly Property IsRoot() As Boolean
            Get
                Return gIsRoot
            End Get
        End PropertyPrivate gUserData As Object''' <summary>
        ''' 获取或设置包含树节点有关数据的对象
        ''' </summary>
        Public Property Tag() As Object
            Get
                Return gUserData
            End Get
            Set(ByVal value As Object)
                gUserData = value
            End Set
        End PropertyPrivate gItem As T
        Public Property Item() As T
            Get
                Return gItem
            End Get
            Set(ByVal value As T)
                gItem = value
            End Set
        End PropertyFriend gChildren As NodeCollection(Of T)''' <summary>
        ''' 获取第一个子树节点
        ''' </summary>
        Public ReadOnly Property FirstNode() As Node(Of T)
            Get
                If gChildren.Count = 0 Then
                    Return Nothing
                End If
                Return gChildren(0)
            End Get
        End Property''' <summary>
        ''' 获取最后一个子树节点
        ''' </summary>
        Public ReadOnly Property LastNode() As Node(Of T)
            Get
                If gChildren.Count = 0 Then
                    Return Nothing
                End If
                Return gChildren(gChildren.Count - 1)
            End Get
        End PropertyPrivate gNodes As NodeCollection(Of T)''' <summary>
        ''' 当前节点的节点集合
        ''' </summary>
        Public ReadOnly Property Nodes() As NodeCollection(Of T)
            Get
                Return gNodes
            End Get
        End Property''' <summary>
        ''' 当前节点在节点集合中的位置
        ''' </summary>
        Public ReadOnly Property Index() As Integer
            Get
                Return GetIndex()
            End Get
        End PropertyPrivate Function GetIndex() As Integer
            If Me.IsRoot Then
                Return 0
            End IfReturn Me.Parent.Nodes.IndexOf(Me)
        End Function''' <summary>
        ''' 获取下一个同级树节点
        ''' </summary>
        Public ReadOnly Property NextNode() As Node(Of T)
            Get
                If Me.IsRoot OrElse Me.Index + 1 > Me.Parent.Nodes.Count Then
                    Return Nothing
                End IfReturn Me.Parent.Nodes.Item(Me.Index + 1)
            End Get
        End Property''' <summary>
        ''' 获取上一个同级树节点
        ''' </summary>
        Public ReadOnly Property PrevNode() As Node(Of T)
            Get
                If Me.IsRoot OrElse Me.Index - 1 < 0 Then
                    Return Nothing
                End IfReturn Me.Parent.Nodes.Item(Me.Index - 1)
            End Get
        End PropertyPrivate Sub Initialzie()
            gNodes = New NodeCollection(Of T)(Me)
            gChildren = New NodeCollection(Of T)(Me)
            gByProperty = Not uSystem.uReflection.CommonFunction.TypeHasFields(GetType(T))
        End SubSub New()
            Initialzie()
        End SubSub New(ByVal item As T)
            gItem = item

Initialzie()

End SubPublic Function GetNodeCount(ByVal includeSubNodes As Boolean) As Integer
            Dim mCount As Integer = gChildren.Count
            If includeSubNodes Then
                Dim mIndex As Integer = 0
                Do While mIndex < gChildren.Count
                    mCount += gChildren(mIndex).GetNodeCount(True)
                    mIndex += 1
                Loop
            End IfReturn mCount
        End FunctionPublic Sub Remove()
            If Me.IsRoot Then
                Throw New Exception("不能移除根节点")
            End If
            Me.Parent.Nodes.RemoveAt(Me.Index)
        End SubPrivate gTable As DataTable
        Private gByProperty As Boolean''' <summary>
        ''' 将当前节点树转换为表
        ''' </summary>
        ''' <param name="includeSubNodes">是否包括子节点的T对象</param>
        Public Function ConvertToDataTable(ByVal includeSubNodes As Boolean) As DataTable
            gTable = uSystem.uReflection.CommonFunction.CreateTableFromType(GetType(T))If gTable.Columns.Count = 0 Then
                If gByProperty Then
                    Throw New Exception("对象无属性列")
                Else
                    Throw New Exception("对象无字段列")
                End If
            End IfMe.ForEach(New Action(Of T)(AddressOf GetDataTableDatasAction), includeSubNodes)

gTable.AcceptChanges()

Return gTable
        End FunctionPrivate Sub GetDataTableDatasAction(ByVal item As T)
            uSystem.uReflection.CommonFunction.ItemAppendToTable(Of T)(item, gTable)
        End Sub''' <summary>
        ''' 将当前节点树转换为TreeNode
        ''' </summary>
        ''' <param name="NameOfTreeNodeText">TreeNode的Text值对应的T对象属性名或字段名</param>
        ''' <param name="includeSubNodes">是否包括子节点</param>
        ''' <remarks>TreeNode的Tag存T对象值</remarks>
        Public Function ConvertToTreeNode(ByVal nameOfTreeNodeText As String, ByVal includeSubNodes As Boolean) As Windows.Forms.TreeNode
            CheckValid(gByProperty, nameOfTreeNodeText)Dim mTreeNode As System.Windows.Forms.TreeNode = ConvertToTreeNode(Me, gByProperty, nameOfTreeNodeText)If includeSubNodes Then AppendTreeNode(mTreeNode, Me, gByProperty, nameOfTreeNodeText)Return mTreeNode
        End FunctionPrivate Shared Sub AppendTreeNode(ByVal treeNode As Windows.Forms.TreeNode, ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
            For Each n As Node(Of T) In node.gChildrenDim mCurrentTreeNode As Windows.Forms.TreeNode = ConvertToTreeNode(n, byProperty, nameOfTreeNodeText)

treeNode.Nodes.Add(mCurrentTreeNode)

AppendTreeNode(mCurrentTreeNode, n, byProperty, nameOfTreeNodeText)

NextEnd SubPrivate Shared Function ConvertToTreeNode(ByVal node As Node(Of T), ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String) As System.Windows.Forms.TreeNode
            Dim mTextValue As ObjectIf byProperty Then
                mTextValue = GetType(T).GetProperty(nameOfTreeNodeText).GetValue(node.Item, Nothing)
            Else
                mTextValue = GetType(T).GetField(nameOfTreeNodeText).GetValue(node.Item)
            End IfIf mTextValue Is Nothing Then
                mTextValue = "Root"
            End IfDim mTreeNode As New System.Windows.Forms.TreeNode(mTextValue.ToString)
            mTreeNode.Tag = node.ItemReturn mTreeNode
        End FunctionPrivate Sub CheckValid(ByVal byProperty As Boolean, ByVal nameOfTreeNodeText As String)
            If byProperty Then
                Dim mPropertyInfo As System.Reflection.PropertyInfo = GetType(T).GetProperty(nameOfTreeNodeText)
                If mPropertyInfo Is Nothing Then
                    Throw New Exception("属性名无效")
                    If Not mPropertyInfo.CanRead Then
                        Throw New Exception("属性名不可读")
                    End If
                End If
            Else
                Dim mFieldInfo As System.Reflection.FieldInfo = GetType(T).GetField(nameOfTreeNodeText)
                If mFieldInfo Is Nothing Then
                    Throw New Exception("字段名无效")
                End If
            End If
        End Sub''' <summary>
        ''' 对每个节点执行指定操作
        ''' </summary>
        ''' <param name="action">对指定的对象执行操作的方法</param>
        ''' <param name="includeSubNodes">是否包括子节点</param>
        Public Sub ForEach(ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
            Node(Of T).ForEach(Me, action, includeSubNodes)
        End SubPublic Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of Node(Of T)), ByVal includeSubNodes As Boolean)
            For Each n As Node(Of T) In node.gChildren
                action.Invoke(n)If includeSubNodes Then ForEach(n, action, True)
            Next
        End Sub''' <summary>
        ''' 对每个T对象执行指定操作
        ''' </summary>
        ''' <param name="action">对指定的对象执行操作的方法</param>
        ''' <param name="includeSubNodes">是否包括子节点的T对象</param>
        Public Sub ForEach(ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
            Node(Of T).ForEach(Me, action, includeSubNodes)
        End SubPublic Shared Sub ForEach(ByVal node As Node(Of T), ByVal action As Action(Of T), ByVal includeSubNodes As Boolean)
            For Each n As Node(Of T) In node.gChildren
                action.Invoke(n.Item)If includeSubNodes Then ForEach(n, action, True)
            Next
        End SubPublic Function FindFirstNode(ByVal memberName As String, ByVal value As Object) As Node(Of T)
            Dim mType As Type = GetType(T)If Not uSystem.uReflection.CommonFunction.TypeHasMember(mType, memberName) Then
                Throw New Exception(String.Format("无此成员名 :{0}", memberName))
            End IfIf gByProperty Then
                If Not mType.GetProperty(memberName).CanRead Then
                    Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
                End If
            End IfDim mResult As Node(Of T) = Nothing
            FindFirstNode(mType, memberName, value, Me, mResult)Return mResult
        End FunctionPrivate Sub FindFirstNode(ByVal t As Type, ByVal memberName As String, ByVal Value As Object, ByVal node As Node(Of T), ByRef result As Node(Of T))For Each n As Node(Of T) In node.gChildren
                If gByProperty Then
                    If t.GetProperty(memberName).GetValue(n.Item, Nothing).Equals(Value) Then
                        result = n
                        Exit Sub
                    End If
                Else
                    If t.GetField(memberName).GetValue(n.Item).Equals(Value) Then
                        result = n
                        Exit Sub
                    End If
                End If

FindFirstNode(t, memberName, Value, n, result)

Next
        End SubPublic Function Clone() As Node(Of T)
            Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of Node(Of T))(Me)
        End FunctionEnd ClassEnd Namespace

Namespace LzmTW.uSystem.uCollection
    ''' <summary>
    ''' 树节点集合
    ''' </summary>
    ''' <remarks>LzmTW 20061111</remarks>
    <Serializable()> _
    Public Class NodeCollection(Of T)
        Inherits System.Collections.ObjectModel.Collection(Of Node(Of T))Private gOwner As Node(Of T)Friend Sub New(ByVal node As Node(Of T))
            gOwner = node
        End SubPublic Shadows Function Add(ByVal Value As T) As Node(Of T)
            Dim mNode As New Node(Of T)(Value)

Add(mNode)
gOwner.gChildren.Add(mNode)

Return mNode
        End FunctionPrivate Shadows Sub Add(ByVal item As Node(Of T))
            With item
                .gParent = gOwner
                .gIsRoot = False
            End WithMyBase.Add(item)
        End SubPublic Shadows Sub RemoveAt(ByVal index As Integer)
            If Not IsValidIndex(index) Then
                Throw New Exception("索引无效")
            End IfDim mNode As Node(Of T) = Me.Item(index)
            Remove(mNode)

gOwner.gChildren.Remove(mNode)

End SubPublic Shadows Sub Remove(ByVal index As Integer)
            Me.RemoveAt(index)
        End SubPrivate Shadows Function Remove(ByVal item As Node(Of T)) As Boolean
            Return MyBase.Remove(item)
        End FunctionPublic Shadows Sub Insert(ByVal index As Integer, ByVal Value As T)
            If Not IsValidIndex(index) Then
                Throw New Exception("索引无效")
            End IfDim mNode As New Node(Of T)(Value)

Insert(index, mNode)
gOwner.gChildren.Insert(index, mNode)

End SubPrivate Shadows Sub Insert(ByVal index As Integer, ByVal item As Node(Of T))
            With item
                .gParent = gOwner
                .gIsRoot = False
            End WithMyBase.Insert(index, item)
        End SubPublic Overloads Sub Clear()
            MyBase.Clear()
            If gOwner.gChildren.Count > 0 Then gOwner.gChildren.Clear()
        End SubPrivate Function IsValidIndex(ByVal index As Integer) As Boolean
            If index >= 0 Then
                Return index < Me.Count
            End IfReturn False
        End FunctionEnd Class
End Namespace

自联表数据实体派生类：

Namespace LzmTW.uSystem.uCollection.SinceLink
    ''' <summary>
    ''' 自联表数据类的派生类
    ''' </summary>
    ''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
    ''' <remarks>LzmTW 20061111</remarks>
    <Serializable()> _
    Public MustInherit Class SinceLinkItemBase(Of T_ID_DataType)Private gName As String
        Friend gCode As String<NonSerialized()> _
        Private gCodeInformation As SinceLinkCodeInformationSub New()
        End SubSub New(ByVal code As String, ByVal name As String)
            gName = name
            gCode = code
        End SubPublic ReadOnly Property Code() As String
            Get
                Return gCode
            End Get
        End PropertyPublic Property Name() As String
            Get
                Return gName
            End Get
            Set(ByVal value As String)
                gName = value
            End Set
        End PropertyFriend Sub UpdateInformations(ByVal codeFormat As String)
            gCodeInformation = New SinceLinkCodeInformation(codeFormat)
            gCodeInformation.SetCode(gCode)
        End SubFriend Function GetLevel() As Integer
            Return gCodeInformation.Level
        End FunctionFriend Function GetID() As T_ID_DataType
            Return CType(System.Convert.ChangeType(gCodeInformation.ID, GetType(T_ID_DataType)), T_ID_DataType)
        End FunctionFriend Function GetParentID() As T_ID_DataType
            Return CType(System.Convert.ChangeType(gCodeInformation.ParentID, GetType(T_ID_DataType)), T_ID_DataType)
        End FunctionFriend Function GetParentKey() As String
            Return gCodeInformation.ParentKey
        End FunctionFriend Function GetLevels() As Integer
            Return gCodeInformation.Levels
        End FunctionPublic Function Clone() As SinceLinkItemBase(Of T_ID_DataType)
            Return uSystem.uRuntime.uSerialization.SerializeHelper.Clone(Of SinceLinkItemBase(Of T_ID_DataType))(Me)
        End FunctionEnd ClassEnd Namespace

自联表数据集合：

Namespace LzmTW.uSystem.uCollection.SinceLink''' <summary>
    ''' 自联表数据集合。如果加载的数据是Code,Name形式,须调用New(codeFormat)构造函数以指定codeFormat形式.
    ''' </summary>
    ''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
    ''' <typeparam name="T">自联表数据类</typeparam>
    ''' <remarks>LzmTW 20061111</remarks>
    <Serializable()> _
    Public Class SinceLinkItemCollection(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
        Inherits System.Collections.ObjectModel.Collection(Of T)<NonSerialized()> _
        Private gNode As Node(Of T)Private gCodeFormat As String
        Private gFileName As String = AppDomain.CurrentDomain.BaseDirectory & "{0}.{1}s.dat"Sub New()
            gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
        End Sub''' <param name="codeFormat">形如“00,000,0000”</param>
        Sub New(ByVal codeFormat As String)
            gCodeFormat = codeFormat
            gFileName = String.Format(gFileName, System.Reflection.Assembly.GetEntryAssembly.ManifestModule.Name, GetType(T).Name)
        End SubPublic ReadOnly Property Node() As Node(Of T)
            Get
                If gNode Is Nothing Then
                    Me.RefleshNode()
                End If
                Return gNode
            End Get
        End PropertyPublic Shadows Function Add(ByVal code As String, ByVal name As String) As T
            Dim mItem As T = CType(System.Activator.CreateInstance(GetType(T), New Object() {code, name}), T)
            Me.Add(mItem)Return mItem
        End FunctionPublic Shadows Sub Add(ByVal items As T())
            For Each item As T In items
                Add(item)
            Next
        End SubPublic Shadows Function Add(ByVal item As T) As T
            item.UpdateInformations(gCodeFormat)MyBase.Add(item)Return item
        End Function''' <summary>
        ''' 从自联表加载数据,表必须有ID,ParentID,Name字段,并且,有一项数据Name字段的值为“Root”以申明为根。
        ''' </summary>
        Public Sub AppendFromSinceLinkTable(ByVal sinceLinkTable As DataTable)
            Dim mSinceLinkTable As New SinceLinkTable(Of T_ID_DataType, T)
            With mSinceLinkTable
                .Input(sinceLinkTable)

gCodeFormat

= .CodeFormat
                Add(.Items)
            End WithEnd Sub''' <summary>
        ''' 从树中加载数据
        ''' </summary>
        Public Sub AppendFromBlankCodeNode(ByVal node As Node(Of T))
            Dim mSinceLinkBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)
            With mSinceLinkBlankNode
                .SetNode(node)

gCodeFormat

= .CodeFormat
                Add(.Items)
            End With
        End SubPublic Sub RefleshNode()
            gNode = GetNode()
        End SubPrivate Function GetNode() As Node(Of T)
            If Me.Count = 0 Then Return NothingDim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
            With mItem
                .gCode = New String("0"c, gCodeFormat.Replace(","c, "").Length)
                .Name = "Root"
            End With

mItem.UpdateInformations(gCodeFormat)

Dim mNode As New Node(Of T)(mItem)Dim mCurrentNode As Node(Of T)
            '加首级
            For Each item As T In Me.ItemsIf item.GetLevel = 1 Then
                    mCurrentNode = mNode.Nodes.Add(item)'加子级
                    AppendItem(mCurrentNode)
                End IfNextReturn mNode
        End FunctionPrivate Sub AppendItem(ByRef node As Node(Of T))
            Dim mCurrentNode As Node(Of T)
            For Each item As T In GetChildItem(node.Item)
                mCurrentNode = node.Nodes.Add(item)

AppendItem(mCurrentNode)

NextEnd SubPublic Function GetChildItem(ByVal item As T) As System.Collections.ObjectModel.Collection(Of T)
            Dim mList As New System.Collections.ObjectModel.Collection(Of T)If item.GetLevel = item.GetLevels Then Return mList
            For Each value As T In Me.Items
                If item.Code.StartsWith(value.GetParentKey) AndAlso value.GetParentID.Equals(item.GetID) AndAlso item.GetLevel = value.GetLevel - 1 Then
                    mList.Add(value)
                End If
            NextReturn mList
        End FunctionPublic Function Find(ByVal memberName As String, ByVal Value As Object) As TDim mType As Type = GetType(T)
            Dim mPropertyInfo As Reflection.PropertyInfo = mType.GetProperty(memberName)If mPropertyInfo Is Nothing Then
                Throw New Exception(String.Format("无此成员名 :{0}", memberName))
            Else
                If Not mPropertyInfo.CanRead Then
                    Throw New Exception(String.Format("成员名不可读 :{0}", memberName))
                End If
            End IfDim mResult As T = NothingFor Each item As T In Me.Items
                If mPropertyInfo.GetValue(item, Nothing).Equals(Value) Then
                    mResult = item
                    Exit For
                End If
            NextReturn mResult
        End FunctionPublic Sub CopyFrom(ByVal collection As SinceLinkItemCollection(Of T_ID_DataType, T))
            With collection
                Me.Clear()
                Me.gCodeFormat = .gCodeFormat
                Me.gFileName = .gFileName
                For Each item As T In .Items
                    Me.Add(CType(item.Clone, T))
                Next
            End With
        End Sub#Region "文件数据的存储和读取"Public Sub Read(ByVal file As String)
            gFileName = file
            Read()
        End SubPublic Sub Save(ByVal file As String)
            gFileName = file
            Save()
        End SubPublic Sub Read()
            ReadInternal()
        End SubPublic Sub Save()
            SaveInternal()
        End SubPrivate Sub SaveInternal()
            uSystem.uRuntime.uSerialization.SerializeHelper.Save(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary, Me)
        End SubPrivate Sub ReadInternal()
            Dim tmp As SinceLinkItemCollection(Of T_ID_DataType, T)
            tmp = uSystem.uRuntime.uSerialization.SerializeHelper.Load(Of SinceLinkItemCollection(Of T_ID_DataType, T))(gFileName, uRuntime.uSerialization.FormatType.Binary)
            Me.CopyFrom(tmp)
            tmp.Clear()
            tmp = Nothing
        End Sub
#End RegionEnd ClassEnd Namespace

Namespace LzmTW.uSystem.uCollection.SinceLink''' <summary>
    ''' 处理数据本身是自联表
    ''' </summary>
    ''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
    ''' <typeparam name="T">自联表数据类</typeparam>
    ''' <remarks>LzmTW 20061111</remarks>
    Friend Class SinceLinkTable(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
        Private gDataTable As DataTablePrivate gFilterFormat As String
        Private gNode As Node(Of T)Private gBlankNode As New SinceLinkBlankCodeNode(Of T_ID_DataType, T)Public ReadOnly Property Items() As T()
            Get
                Return gBlankNode.Items
            End Get
        End PropertyPublic ReadOnly Property CodeFormat() As String
            Get
                Return gBlankNode.CodeFormat
            End Get
        End PropertySub New()
            If GetType(T).GetMethod("GetID", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance).ReturnType Is GetType(String) Then
                gFilterFormat = "ParentID = '{0}'"
            Else
                gFilterFormat = "ParentID = {0}"
            End If
        End SubPublic Sub Input(ByVal table As DataTable)
            If Not Me.IsSinceLinkTable(table) Then Throw New Exception("表不是自联表.若是,需有ID、ParentID字段和Name字段.")
            If table.Rows.Count = 0 Then Throw New Exception("无数据")Me.Copy(table)Me.CreateNode()

gBlankNode.SetNode(gNode)

Me.Clear()End SubPrivate Function IsSinceLinkTable(ByVal table As DataTable) As Boolean
            With table.Columns
                If .Contains("ID") Then
                    If .Contains("ParentID") Then
                        Return .Contains("Name")
                    End If
                End If
            End WithReturn False
        End FunctionPrivate Sub Copy(ByVal table As DataTable)
            gDataTable = table.Clone
            gDataTable.Load(table.CreateDataReader)
            gDataTable.AcceptChanges()
        End SubPrivate Sub CreateNode()Dim mMainView As DataView = New DataView(gDataTable, Nothing, "ID", DataViewRowState.CurrentRows)
            If Not mMainView.Item(0).Item("Name").ToString.ToLower.Equals("root") Then
                Throw New Exception("首位ID数据行的Name字段须有Root值示为根")
            End IfDim mItem As T = CType(System.Activator.CreateInstance(GetType(T)), T)
            mItem.Name = "Root"

gNode

= New Node(Of T)(mItem)

AppendNode(mMainView.Item(

0).Item("ID"), gNode)End SubPrivate Sub AppendNode(ByVal ParentID As Object, ByVal node As Node(Of T))
            Dim mDataView As DataView = GetDataView(ParentID)Dim mCount As Integer = mDataView.Count
            If mCount = 0 Then Exit SubDim mNode As Node(Of T) = NothingFor Each rowView As DataRowView In mDataView
                mNode = node.Nodes.Add(CreateItem(rowView))

AppendNode(rowView.Item(

"ID"), mNode)
            NextEnd SubPrivate Function GetDataView(ByVal ParentID As Object) As DataView
            Return New DataView(gDataTable, String.Format(gFilterFormat, ParentID), "ID", DataViewRowState.CurrentRows)
        End FunctionPrivate Function CreateItem(ByVal rowView As DataRowView) As T
            Dim mItem As T
            mItem = CType(System.Activator.CreateInstance(GetType(T)), T)For Each p As Reflection.PropertyInfo In GetType(T).GetProperties
                If p.CanWrite Then
                    If rowView.DataView.Table.Columns.Contains(p.Name) Then
                        p.SetValue(mItem, rowView.Item(p.Name), Nothing)
                    End If
                End If
            NextReturn mItem
        End FunctionPrivate Sub Clear()
            gDataTable.Clear()
            gDataTable.Dispose()

gNode.Nodes.Clear()

End Sub
End ClassEnd Namespace

Namespace LzmTW.uSystem.uCollection.SinceLink''' <summary>
    ''' 处理树情形的数据,转换为Code,Name形式
    ''' </summary>
    ''' <typeparam name="T_ID_DataType">自联表键类型,或是Integer或是String</typeparam>
    ''' <typeparam name="T">自联表数据类</typeparam>
    ''' <remarks>LzmTW 20061111</remarks>
    Friend Class SinceLinkBlankCodeNode(Of T_ID_DataType, T As SinceLinkItemBase(Of T_ID_DataType))
        Private gList As New ArrayList
        Private gItems As T()Private gCodeFormat As String
        Private gNode As Node(Of T)Private gLevelLengths(0) As IntegerPublic ReadOnly Property Items() As T()
            Get
                Return gItems
            End Get
        End PropertyPublic ReadOnly Property CodeFormat() As String
            Get
                Return gCodeFormat
            End Get
        End PropertyPublic Sub SetNode(ByVal node As Node(Of T))
            gNode = node

GetlevelLengths()

UpdateCode()

Clear()

End SubPrivate Sub GetlevelLengths()
Dim mLevels As Integer = 0

GetLevelLengths(

0, gNode, gLevelLengths, mLevels)Dim tmpFormat(mLevels - 1) As String
            For i As Integer = 0 To mLevels - 1
                gLevelLengths(i) = gLevelLengths(i).ToString.Length
                tmpFormat(i) = New String("0"c, gLevelLengths(i))
            Next

gCodeFormat

= String.Join(",", tmpFormat)
        End SubPrivate Sub GetLevelLengths(ByVal ParentID As Object, ByVal node As Node(Of T), ByRef levelengths() As Integer, ByRef levels As Integer)Dim mCount As Integer = node.Nodes.Count
            If mCount = 0 Then Exit SubDim mNode As Node(Of T) = NothingFor Each mNode In node.gChildren
                GetLevelLengths(node.Index, mNode, levelengths, levels)
            NextIf mNode.Level > node.Level Then
                If mNode.Level > levels Then
                    levels = mNode.Level
                    ReDim Preserve levelengths(levels - 1)
                    levelengths(mNode.Level - 1) = mCount
                Else
                    levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
                End If
            Else
                levelengths(mNode.Level - 1) = Math.Max(mCount, levelengths(mNode.Level - 1))
            End IfEnd SubPrivate Sub UpdateCode()
            gNode.Item.gCode = ""
            UpdateCode(gNode)
            gNode.Item.gCode = New String("0"c, RightLength(0))ReDim gItems(gList.Count - 1)
            gList.CopyTo(gItems)
        End SubPrivate Sub UpdateCode(ByVal node As Node(Of T))
            For Each n As Node(Of T) In node.Nodes
                n.Item.gCode = GetCode(n.Parent.Item.Code, n.Level, n.Index)
                gList.Add(n.Item)

UpdateCode(n)

Next
        End SubPrivate Function GetCode(ByVal parentCode As String, ByVal level As Integer, ByVal index As Integer) As StringReturn String.Concat(GetParentKey(parentCode, level), GetCurrentID(index, level))
        End FunctionPrivate Function GetParentKey(ByVal parentCode As String, ByVal level As Integer) As String
            Return parentCode.Substring(0, LeftLength(level - 1))
        End FunctionPrivate Function GetCurrentID(ByVal index As Integer, ByVal level As Integer) As String
            Return (index + 1).ToString.PadLeft(gLevelLengths(level - 1), "0"c).PadRight(RightLength(level - 1), "0"c)
        End FunctionPrivate Function LeftLength(ByVal level As Integer) As Integer
            Dim tmp As Integer = 0
            For i As Integer = 0 To level - 1
                tmp += gLevelLengths(i)
            Next
            Return tmp
        End FunctionPrivate Function RightLength(ByVal level As Integer) As Integer
            Dim tmp As Integer = 0
            For i As Integer = level To gLevelLengths.Length - 1
                tmp += gLevelLengths(i)
            Next
            Return tmp
        End FunctionPrivate Sub Clear()
            ' gNode.Nodes.Clear()

            gList.Clear()

gLevelLengths

= Nothing
End SubEnd ClassEnd Namespace

Namespace LzmTW.uSystem.uCollection.SinceLink
    ''' <summary>
    ''' 析取Code的信息以生成树
    ''' </summary>
    ''' <remarks>LzmTW 20061111</remarks>
    Friend Class SinceLinkCodeInformation
        Private gCode As String
        Private gCodeFormat As String = "00,00,00"'当前层级
        Private gLevel As Integer
        '层数
        Private gLevels As IntegerPrivate gID As String
        Private gParentID As String'代码的各组ID位数
        Private gIDLengths() As IntegerPrivate gParentKey As StringSub New(ByVal codeFormat As String)
            gCodeFormat = codeFormatDim mIDArray() As String = gCodeFormat.Split(","c)
            ReDim gIDLengths(mIDArray.Length - 1)
            For i As Integer = 0 To mIDArray.Length - 1
                gIDLengths(i) = mIDArray(i).Length
            Next

gLevels

= gIDLengths.Length
        End SubPublic ReadOnly Property Level() As Integer
            Get
                Return gLevel
            End Get
        End PropertyPublic ReadOnly Property Levels() As Integer
            Get
                Return gLevels
            End Get
        End PropertyPublic ReadOnly Property ID() As String
            Get
                Return gID
            End Get
        End PropertyPublic ReadOnly Property ParentID() As String
            Get
                Return gParentID
            End Get
        End PropertyPublic ReadOnly Property ParentKey() As String
            Get
                Return gParentKey
            End Get
        End PropertyPublic Sub SetCode(ByVal code As String)
            gCode = code
            GetIDInfos()
        End SubPrivate Sub GetIDInfos()
            Dim tmpIDInfos(gLevels - 1) As StringDim mCurrentIndex As Integer = 0
            For i As Integer = 0 To gLevels - 1
                tmpIDInfos(i) = gCode.Substring(mCurrentIndex, gIDLengths(i))
                mCurrentIndex += gIDLengths(i)
            NextFor i As Integer = gLevels - 1 To 0 Step -1
                If Not System.Text.RegularExpressions.Regex.IsMatch(tmpIDInfos(i), "^0+$") Then
                    gLevel = i + 1
                    gID = tmpIDInfos(i)
                    If i = 0 Then
                        gParentID = New String("0"c, gIDLengths(0))
                        gParentKey = New String("0"c, gIDLengths(0))
                    Else
                        gParentID = tmpIDInfos(i - 1)For k As Integer = 0 To i - 1
                            gParentKey += tmpIDInfos(k)
                        Next
                    End IfExit For
                End If
            NextEnd Sub
    End Class
End Namespace

LzmTW 20061111

推荐订阅源

博客园 - 水如烟(LzmTW)

树和自联表(五)