Select Case e.DataCol.Name '更改编码规则的重新定义开始
Case "编码规则"
If e.NewValue IsNot Nothing Then
Dim dr As DataRow = DataTables("分类编码方案").Find("基础档案名称 = '" & e.DataTable.Name & "'")
If dr IsNot Nothing Then
Dim sum As Integer
For i As Integer = 0 To dr("编码规则").Length - 1
sum += val(dr("编码规则")(i))
If e.NewValue.length = sum Then
e.DataRow("编码级次") = dr("编码级次")(i)
Exit For
End If
Next
End If
End If
End Select '更改编码规则的重新定义结束
If e.DataCol.Name = "编码规则" AndAlso e.NewValue <> Nothing Then '更改编码规则的是否末级的重新定义开始
Dim fdr As DataRow = DataTables("分类编码方案").Find("基础档案名称 = '" & e.DataTable.Name & "'")
If fdr IsNot Nothing Then
Dim reg As new System.Text.RegularExpressions.Regex(fdr("正则"))
If reg.Ismatch(e.NewValue) = False Then
e.Cancel = True
Else
e.DataRow("是否末级") = (fdr("字符数") = e.NewValue.length)'我加的
Dim count As Integer = 0
Dim prev As String = ""
For i As Integer = 0 To fdr("编码规则").length - 1
count += val(fdr("编码规则").chars(i))
Dim str As String = e.NewValue.Substring(0, count)
If count < e.NewValue.length Then
If e.DataTable.Find("编码规则 = '" & str & "'") Is Nothing Then
MessageBox.Show("缺少上级科目:" & str,"提示",MessageBoxButtons.OK)
e.Cancel = True
e.DataRow("是否末级")=False
Exit For
Else If e.OldValue = str Then
MessageBox.Show("缺少上级科目:" & str,"提示",MessageBoxButtons.OK)
e.Cancel = True
Exit For
End If
Else If count = e.NewValue.length Then
If i = fdr("编码规则").length - 1 Then
e.DataRow("是否末级") = True
e.DataTable.ReplaceFor("是否末级", False, "编码规则 = '" & prev & "'")
Else
Dim filter As String = "编码规则 <> '" & str & "' and 编码规则 like '" & str & "*'"
If e.DataTable.Find(filter) Is Nothing Then
e.DataRow("是否末级") = True
filter = "编码规则 = '" & prev & "'"
e.DataTable.ReplaceFor("是否末级", False, filter)
Else
e.DataRow("是否末级") = False
End If
Exit For
End If
End If
prev = str
Next
End If
End If
End If
'更改编码规则的是否末级的重新定义结束
加好友 
发短信
Post By：2015/1/28 22:03:00 [只看该作者]
