📄 controlvalidator.vb
字号:
Imports System.ComponentModel
Imports System.Drawing.Design
<ProvideProperty("Validate", GetType(Control))> _
Public Class ControlValidator
Inherits Component
Implements IExtenderProvider
#Region "Rules Validator"
Private Structure Validator
Public Rule As Predicate(Of IRulesList.RuleParams)
Public Information As ValidationAttribute
Public Sub New(ByVal r As Predicate(Of IRulesList.RuleParams), _
ByVal info As ValidationAttribute)
Me.Rule = r
Me.Information = info
End Sub
End Structure
#End Region
Private m_ErrorProvider As ErrorProvider
Private rulesHash As New Dictionary(Of String, Validator)
Public controlHash As New Dictionary(Of Control, Boolean)
Public Sub New(ByVal container As IContainer)
MyBase.New()
container.Add(Me)
End Sub
#Region "Error provider and Rules"
Public Property ErrorProvider() As ErrorProvider
Get
Return m_ErrorProvider
End Get
Set(ByVal value As ErrorProvider)
m_ErrorProvider = value
End Set
End Property
Public Sub AddRules(ByVal ruleslist As IRulesList)
For Each rule As Predicate(Of IRulesList.RuleParams) In ruleslist.Rules
Dim attributes As ValidationAttribute() = _
TryCast(rule.Method.GetCustomAttributes _
(GetType(ValidationAttribute), True), _
ValidationAttribute())
If Not attributes Is Nothing Then
For Each attrib As ValidationAttribute In attributes
rulesHash.Add(attrib.ColumnName.ToLower, _
New Validator(rule, attrib))
Next
End If
Next
End Sub
#End Region
#Region "Extender Provider to turn validation on"
Public Function CanExtend(ByVal extendee As Object) As Boolean _
Implements System.ComponentModel.IExtenderProvider.CanExtend
Return TypeOf (extendee) Is Control
End Function
Public Sub SetValidate(ByVal control As Control, _
ByVal shouldValidate As Boolean)
If shouldValidate Then
AddHandler control.Validating, AddressOf Validating
End If
controlHash.Item(control) = shouldValidate
End Sub
Public Function GetValidate(ByVal control As Control) As Boolean
If controlHash.ContainsKey(control) Then
Return controlHash.Item(control)
End If
Return False
End Function
#End Region
#Region "Validation"
Private ReadOnly Property ItemError(ByVal ctrl As Control) As String
Get
Try
If ctrl.DataBindings.Count = 0 Then Return ""
Dim key As String = ctrl.DataBindings.Item(0).BindingMemberInfo.BindingField
Dim bs As BindingSource = TryCast(ctrl.DataBindings.Item(0).DataSource, BindingSource)
If bs Is Nothing Then Return ""
Dim drv As DataRowView = TryCast(bs.Current, DataRowView)
If drv Is Nothing Then Return ""
Dim valfield As String = ctrl.DataBindings.Item(0).PropertyName
Dim val As Object = ctrl.GetType.GetProperty(valfield, _
New Type() {}).GetValue(ctrl, Nothing)
Return ItemError(drv, key, val)
Catch ex As Exception
Return ""
End Try
End Get
End Property
Private ReadOnly Property ItemError(ByVal drv As DataRowView, ByVal columnName As String, ByVal newValue As Object) As String
Get
columnName = columnName.ToLower
If Not rulesHash.ContainsKey(columnName) Then Return ""
Dim p As Validator = rulesHash.Item(columnName)
If p.Rule Is Nothing Then Return ""
If p.Rule(New IRulesList.RuleParams(drv.Row, newValue)) Then Return ""
If p.Information Is Nothing Then Return ""
Return p.Information.ErrorString
End Get
End Property
Private Sub Validating(ByVal sender As Object, ByVal e As CancelEventArgs)
Dim err As String = InternalValidate(sender)
e.Cancel = Not (err = "")
End Sub
Private Function InternalValidate(ByVal sender As Object) As String
If Me.m_ErrorProvider Is Nothing Then Return ""
Dim ctrl As Control = TryCast(sender, Control)
If ctrl Is Nothing Then Return ""
If Not Me.controlHash.ContainsKey(ctrl) OrElse Not Me.controlHash.Item(ctrl) Then Return ""
Dim err As String = Me.ItemError(ctrl)
Me.m_ErrorProvider.SetError(ctrl, err)
Return err
End Function
Private Sub ChangedItem(ByVal sender As Object, ByVal e As EventArgs)
InternalValidate(sender)
End Sub
#End Region
#Region "Validation Attribute"
<AttributeUsage(AttributeTargets.Method)> _
Public Class ValidationAttribute
Inherits Attribute
Private m_ColumnName As String
Private m_ErrorString As String
Public Sub New(ByVal columnName As String, ByVal errorString As String)
Me.ColumnName = columnName
Me.ErrorString = errorString
End Sub
Public Property ColumnName() As String
Get
Return m_ColumnName
End Get
Set(ByVal value As String)
m_ColumnName = value
End Set
End Property
Public Property ErrorString() As String
Get
Return m_ErrorString
End Get
Set(ByVal value As String)
m_ErrorString = value
End Set
End Property
End Class
#End Region
#Region "Rules Interface"
Public Interface IRulesList
Structure RuleParams
Public ExistingData As DataRow
Public NewData As Object
Public Sub New(ByVal data As DataRow, ByVal newStuff As Object)
Me.ExistingData = data
Me.NewData = newStuff
End Sub
End Structure
ReadOnly Property Rules() As Predicate(Of RuleParams)()
End Interface
#End Region
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -