2020-01-14 16:27:16 +01:00

298 lines
11 KiB
VB.net

Imports System.ComponentModel
Imports DevExpress.XtraEditors
Imports DevExpress.Utils.Serializing
Imports DevExpress.XtraLayout
Imports DevExpress.Utils.Serializing.Helpers
Imports System.IO
Imports DigitalData.Modules.Logging
Public Class LayoutControlSerializer
Private appName As String = System.Reflection.Assembly.GetExecutingAssembly().FullName
Private serializer As XmlXtraSerializer = New MyXmlXtraSerializer()
Private LogConfig As LogConfig
Private Logger As Logger
Public Sub New(LogConfig As LogConfig)
Me.LogConfig = LogConfig
Logger = LogConfig.GetLogger
End Sub
'Public Sub SaveLayoutExToXml(ByVal layoutControl As LayoutControl, ByVal filePath As String)
' Try
' Dim objects As New ObjectInfoCollection()
' For Each ctrl As Control In layoutControl.Controls
' If layoutControl.GetItemByControl(ctrl) IsNot Nothing Then
' objects.Collection.Add(New ObjectInfo(ctrl))
' End If
' Next ctrl
' Dim filePathForControls As String = filePath.Replace(".xml", "Controls.xml")
' layoutControl.SaveLayoutToXml(filePath)
' serializer.SerializeObject(objects, filePathForControls, appName)
' Catch ex As Exception
' Logger.Error(ex)
' End Try
'End Sub
Public Sub SaveLayoutExToStream(ByVal LayoutControl As LayoutControl, ByVal LayoutStream As Stream, ByVal ControlStream As Stream)
Try
Dim objects As New ObjectInfoCollection()
For Each ctrl As Control In LayoutControl.Controls
If LayoutControl.GetItemByControl(ctrl) IsNot Nothing Then
objects.Collection.Add(New ObjectInfo(ctrl))
End If
Next ctrl
LayoutControl.SaveLayoutToStream(LayoutStream)
serializer.SerializeObject(objects, ControlStream, appName)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
'Public Sub RestoreLayoutExFromXml(ByVal layoutControl As LayoutControl, ByVal filePath As String)
' Try
' Dim objects As New ObjectInfoCollection()
' Dim filePathForControls As String = filePath.Replace(".xml", "Controls.xml")
' serializer.DeserializeObject(objects, filePathForControls, appName)
' For Each info As ObjectInfo In objects.Collection
' Dim ctrl As Control = TryCast(info.SerializableObject, Control)
' If ctrl IsNot Nothing Then
' Dim controls() As Control = layoutControl.Controls.Find(ctrl.Name, False)
' If controls.Length > 0 Then
' layoutControl.Controls.Remove(controls(0))
' End If
' layoutControl.Controls.Add(ctrl)
' End If
' Next info
' layoutControl.RestoreLayoutFromXml(filePath)
' Catch ex As Exception
' Logger.Error(ex)
' End Try
'End Sub
Public Sub RestoreLayoutExFromStream(ByVal layoutControl As LayoutControl, ByVal LayoutStream As Stream, ByVal ControlStream As Stream)
Try
Dim objects As New ObjectInfoCollection()
serializer.DeserializeObject(objects, ControlStream, appName)
For Each info As ObjectInfo In objects.Collection
Dim ctrl As Control = TryCast(info.SerializableObject, Control)
If ctrl IsNot Nothing Then
Dim controls() As Control = layoutControl.Controls.Find(ctrl.Name, False)
If controls.Length > 0 Then
layoutControl.Controls.Remove(controls(0))
End If
layoutControl.Controls.Add(ctrl)
End If
Next info
layoutControl.RestoreLayoutFromStream(LayoutStream)
Catch ex As Exception
Logger.Error(ex)
End Try
End Sub
End Class
Public Class MyXmlXtraSerializer
Inherits XmlXtraSerializer
Public Sub New()
End Sub
Protected Overrides Function CreateSerializeHelper(ByVal rootObj As Object, ByVal useRootObj As Boolean) As SerializeHelper
Return If(useRootObj, New MySerializeHelper(rootObj), New MySerializeHelper())
End Function
Protected Overrides Function CreateDeserializeHelper(ByVal rootObj As Object, ByVal useRootObj As Boolean) As DeserializeHelper
Return If(useRootObj, New MyDeserializeHelper(rootObj), New MyDeserializeHelper())
End Function
End Class
Public Class ObjectInfoCollection
Implements IXtraSupportDeserializeCollectionItem
Public Sub New()
_Collection = New List(Of ObjectInfo)()
End Sub
' Fields...
Private _Collection As List(Of ObjectInfo)
<XtraSerializableProperty(XtraSerializationVisibility.Collection, True)>
Public Property Collection() As List(Of ObjectInfo)
Get
Return _Collection
End Get
Set(ByVal value As List(Of ObjectInfo))
_Collection = value
End Set
End Property
Public Function CreateCollectionItem(ByVal propertyName As String, ByVal e As XtraItemEventArgs) As Object Implements IXtraSupportDeserializeCollectionItem.CreateCollectionItem
Dim info As New ObjectInfo()
Collection.Add(info)
Return info
End Function
Public Sub SetIndexCollectionItem(ByVal propertyName As String, ByVal e As XtraSetItemIndexEventArgs) Implements IXtraSupportDeserializeCollectionItem.SetIndexCollectionItem
End Sub
End Class
Public Class ObjectInfo
Public Sub New(ByVal serializableObject As Object)
Me.SerializableObject = serializableObject
End Sub
Public Sub New()
End Sub
' Fields...
Private _type As String
Private _SerializableObject As Object
<XtraSerializableProperty>
Public Property Type1() As String
Get
Return _type
End Get
Set(ByVal value As String)
_type = value
Try
If _SerializableObject Is Nothing Then
Dim index As Integer = _type.LastIndexOf("."c)
Dim [nameSpace] = _type.Substring(0, index)
Dim type = System.Type.GetType(_type & ", " & [nameSpace])
_SerializableObject = Activator.CreateInstance(type)
End If
Catch
End Try
End Set
End Property
<XtraSerializableProperty(XtraSerializationVisibility.Content)>
Public Property SerializableObject() As Object
Get
Return _SerializableObject
End Get
Set(ByVal value As Object)
_SerializableObject = value
_type = _SerializableObject.GetType().ToString()
End Set
End Property
<XtraSerializableProperty(2)>
Public Property SerializableObjectName() As String
Get
Dim ctrl As Control = TryCast(SerializableObject, Control)
If ctrl IsNot Nothing Then
Return ctrl.Name
End If
Return String.Empty
End Get
Set(ByVal value As String)
Dim ctrl As Control = TryCast(SerializableObject, Control)
If ctrl IsNot Nothing Then
ctrl.Name = value
End If
End Set
End Property
End Class
Public Class MySerializeHelper
Inherits SerializeHelper
Public Sub New()
End Sub
Public Sub New(ByVal rootObject As Object)
MyBase.New(rootObject)
End Sub
Public Sub New(ByVal rootObject As Object, ByVal context As SerializationContext)
MyBase.New(rootObject, context)
End Sub
Protected Overrides Sub SerializeProperty(ByVal store As XtraPropertyInfoCollection, ByVal obj As Object, ByVal pair As SerializablePropertyDescriptorPair, ByVal parentFlags As XtraSerializationFlags, ByVal options As DevExpress.Utils.OptionsLayoutBase)
Dim name = pair.Property.Name
If name = "Tag" Then
Console.WriteLine()
End If
Dim prop As PropertyDescriptor = pair.Property
Dim attr As XtraSerializableProperty = pair.Attribute
If attr Is Nothing AndAlso prop.IsBrowsable AndAlso prop.ShouldSerializeValue(obj) Then
If prop.PropertyType IsNot GetType(String) AndAlso prop.PropertyType.IsClass Then
pair = New SerializablePropertyDescriptorPair(prop, New XtraSerializableProperty(XtraSerializationVisibility.Content))
Else
pair = New SerializablePropertyDescriptorPair(prop, New XtraSerializableProperty())
End If
End If
MyBase.SerializeProperty(store, obj, pair, parentFlags, options)
End Sub
End Class
Public Class MyDeserializeHelper
Inherits DeserializeHelper
Public Sub New(ByVal rootObject As Object)
MyBase.New(rootObject)
End Sub
Public Sub New(ByVal rootObject As Object, ByVal resetProperties As Boolean)
MyBase.New(rootObject, resetProperties)
End Sub
Public Sub New(ByVal rootObject As Object, ByVal resetProperties As Boolean, ByVal context As SerializationContext)
MyBase.New(rootObject, resetProperties, context)
End Sub
Public Sub New()
End Sub
Protected Overrides Function CreateSerializationContext() As SerializationContext
Return New MySerializationContext()
End Function
End Class
Public Class MySerializationContext
Inherits SerializationContext
Public Sub New()
End Sub
Protected Overrides Sub CustomGetSerializableProperties(ByVal obj As Object, ByVal pairsList As List(Of SerializablePropertyDescriptorPair), ByVal props As PropertyDescriptorCollection)
MyBase.CustomGetSerializableProperties(obj, pairsList, props)
Dim i As Integer = 0
Do While i < pairsList.Count
Dim pair As SerializablePropertyDescriptorPair = pairsList(i)
Dim prop As PropertyDescriptor = pair.Property
Dim attr As XtraSerializableProperty = pair.Attribute
If attr Is Nothing AndAlso prop.IsBrowsable Then
If prop.PropertyType IsNot GetType(String) AndAlso prop.PropertyType.IsClass Then
pair = New SerializablePropertyDescriptorPair(prop, New XtraSerializableProperty(XtraSerializationVisibility.Content))
Else
pair = New SerializablePropertyDescriptorPair(prop, New XtraSerializableProperty())
End If
pairsList.RemoveAt(i)
pairsList.Insert(i, pair)
End If
i += 1
Loop
End Sub
Protected Overrides Function GetProperties(ByVal obj As Object, ByVal store As IXtraPropertyCollection) As PropertyDescriptorCollection
Dim propertyDescriptors As PropertyDescriptorCollection = MyBase.GetProperties(obj, store)
If store Is Nothing Then
Return propertyDescriptors
End If
Dim newPropertyDescriptors As New PropertyDescriptorCollection(Nothing)
For Each info As XtraPropertyInfo In store
Dim pd As PropertyDescriptor = propertyDescriptors(info.Name)
If pd IsNot Nothing Then
newPropertyDescriptors.Add(pd)
End If
Next info
Return newPropertyDescriptors
End Function
End Class