📄 ++
字号:
End If
End If
Next Jsqte
If Lrzt = 1 Then '增 加
'[>>判断编码是否重复
If .State = 1 Then .Close
.Open "SELECT * FROM Kh_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
Tsxx = "类别编码重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(0).SetFocus
Bclrsj = False
Exit Function
End If
'判断名称是否重复
If .State = 1 Then .Close
.Open "SELECT * FROM Kh_Title WHERE TitleName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
Tsxx = "类别名称重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(1).SetFocus
Bclrsj = False
Exit Function
End If
'判断记录内容无误后,将记录内容写入数据表
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
.AddNew
.Fields("TitleCode") = Trim(LrText(0).Text) '类别编码
.Fields("TitleName") = Trim(LrText(1).Text) '类别名称
.Fields("CreateTime") = Trim(LrText(2).Text) '创建日期
.Fields("CheckCode") = Trim(LrText(3).Tag) '测评规则
.Fields("TitleDigit") = Trim(LrText(4).Text) '保留小数
If Opt_LockFlag(0).Value = True Then
.Fields("LockFlag") = 0 '下限封闭
Else
.Fields("LockFlag") = 1 '上限封闭
End If
.Fields("Remark") = Trim(LrText(5).Text) '备注
.Fields("ParentCode") = ParentCode '上级编码
.Fields("CodeLevel") = CodeLevel '编码级次
.Fields("ComputeFlag") = 0 '计算标志
.Fields("CloseFlag") = 0 '关闭标志
.Update
Cw_DataEnvi.DataConnect.Execute "update Kh_Title set EndFlag=0 where TitleCode='" & ParentCode & "'"
Cw_DataEnvi.DataConnect.CommitTrans
If CodeLevel <> 1 Then
Set nodX = TreeView.Nodes.Add("T" & ParentCode, 4, "T" & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
nodX.EnsureVisible
Else
Set nodX = TreeView.Nodes.Add("T", 4, "T" & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
End If
ParentCode = "": CodeLevel = 0
'将记录加入网格
Call Cxnrtcwg
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
LrText(0).SetFocus
'将网格按编码排序
With CzxsGrid
.Col = Sydz("001", GridStr(), Szzls)
CzxsGrid.Sort = flexSortStringAscending
End With
'<<]
Else '否则为修改记录
If .State = 1 Then .Close
.Open "SELECT * FROM Kh_Title WHERE TitleName= '" + Trim(LrText(1).Text) + "' and TitleCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
Tsxx = "类别名称重复!"
Call Xtxxts(Tsxx, 0, 1)
LrText(1).SetFocus
Bclrsj = False
Exit Function
End If
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
If .State = 1 Then .Close
.Open "SELECT * FROM Kh_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
.Fields("TitleName") = Trim(LrText(1).Text) '类别名称
.Fields("CreateTime") = Trim(LrText(2).Text) '创建日期
.Fields("CheckCode") = Trim(LrText(3).Tag) '测评规则
.Fields("TitleDigit") = Trim(LrText(4).Text) '保留小数
If Opt_LockFlag(0).Value = True Then
.Fields("LockFlag") = 0 '下限封闭
Else
.Fields("LockFlag") = 1 '上限封闭
End If
.Fields("Remark") = Trim(LrText(5).Text) '备注
.Update
End If
TreeView.Nodes("T" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))).Text = "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text)
Cw_DataEnvi.DataConnect.CommitTrans
'刷新当前网格
Sqlstr = "SELECT * FROM Kh_v_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
Call Jltcwg(Cxnrrec, .Row)
End With
End If
'保存记录成功,函数返回真值
Bclrsj = True
Exit Function
End With
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
Private Function Cshlrxx(lrztxx As Integer) As Boolean '初始化录入字段信息
TextChangeLock = True '关闭文本框Chang事件
If lrztxx = 1 Then
'增加新记录时将文本框清空
For Jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
LrText(Jsqte).Text = ""
LrText(Jsqte).Tag = ""
End If
TextValiJudgeLock(Jsqte) = True
Next Jsqte
'[>>
'在此处可添加新增记录时初始化设置
'<<]
Else
'修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
With RecTemp
Sqlstr = "SELECT * FROM Kh_v_Title Where TitleCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
'记录如存在则读入其内容,否则提示记录已被其他人删除
If Not RecTemp.EOF Then
LrText(0).Text = Trim(.Fields("TitleCode") & "") '类别编码
LrText(1).Text = Trim(.Fields("TitleName") & "") '类别名称
LrText(2).Text = Trim(.Fields("CreateTime") & "") '创建时间
LrText(3).Tag = Trim(.Fields("CheckCode") & "") '测评规则编码
LrText(3).Text = Trim(.Fields("CheckName") & "") '测评规则名称
LrText(4).Text = Trim(.Fields("TitleDigit") & "") '小数位数
If Trim(.Fields("LockFlag") & "") = False Then '封闭类型
Opt_LockFlag(0).Value = True
Else
Opt_LockFlag(1).Value = True
End If
LrText(5).Text = Trim(.Fields("Remark") & "") '备注
Else
Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
Call Xtxxts(Tsxx, 0, 4)
Call Cancel
TextChangeLock = False
Exit Function
End If
End With
End If
Cshlrxx = True
TextChangeLock = False
End Function
Private Sub Scdqjl() '删 除 当 前 记 录
Dim yhAnswer As Integer
Dim aDo_Rec As New Recordset
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
Exit Sub
End If
'非数据行不能删除
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
If Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls)))) = 1 Then
Tsxx = "该考核类别已经关闭,不能删除"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
'用户确认是否删除记录
Tsxx = "请确认是否删除当前记录?"
yhAnswer = Xtxxts(Tsxx, 2, 2)
If yhAnswer = 2 Then
Exit Sub
End If
Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Kh_Title where ParentCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'")
If aDo_Rec.RecordCount > 0 Then
aDo_Rec.Close
Tsxx = "该项有下级,不能删除!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
aDo_Rec.Close
On Error GoTo Cwcl
Cw_DataEnvi.DataConnect.BeginTrans
'[>>以下需自定义部分
'<<张洪军增加于2001.1.30
Cw_DataEnvi.DataConnect.Execute "delete Kh_Object where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
Cw_DataEnvi.DataConnect.Execute "delete Kh_Appraise where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
Cw_DataEnvi.DataConnect.Execute "delete Kh_ValMark where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
Cw_DataEnvi.DataConnect.Execute "delete Kh_Target where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
'张洪军增加于2001.1.30 >>
Cw_DataEnvi.DataConnect.Execute "delete Kh_Title where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
'=================
Dim i As Integer, LevelLeng As Integer
For i = 1 To Len(CodScheme)
LevelLeng = LevelLeng + Val(Mid(CodScheme, i, 1))
If Len(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))) = LevelLeng Then
If i = 1 Then Exit For
'----------------
Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Kh_Title where ParentCode='" & Mid(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))), 1, LevelLeng - Val(Mid(CodScheme, i, 1))) & "'")
If aDo_Rec.RecordCount = 0 Then
Cw_DataEnvi.DataConnect.Execute ("update Kh_Title set EndFlag=1 where TitleCode='" & Mid(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))), 1, LevelLeng - Val(Mid(CodScheme, i, 1))) & "'")
End If
Exit For
End If
Next i
'=================
Add_Tree
'以上为自定义部分<<]
Cw_DataEnvi.DataConnect.CommitTrans
'将记录加入网格
Call Cxnrtcwg
Exit Sub
Cwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
If Err.Number = -2147217873 Then '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
Tsxx = "该考核类别已经被使用,不能删除!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
Else
Tsxx = "出现未知情况,该类别不能被删除!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
End Sub
'*******************以下区域为编写自定义过程区域**********************
Private Sub toolkhlb()
Dim int_endflag As Integer '末级标志
Dim int_CodeLevel As Integer '编码级次
Dim int_ComputeFlag As Integer '计算标志
Dim int_CloseFlag As Integer '关闭标志
'控制指标、要素、测评、对象、关闭按钮是否可用
With SzToolbar
If CzxsGrid.Row > 0 Then
int_CodeLevel = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("008", GridStr(), Szzls))))
int_endflag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("009", GridStr(), Szzls))))
int_ComputeFlag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("010", GridStr(), Szzls))))
int_CloseFlag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls))))
If int_CodeLevel = 1 Then
.Buttons("zb").Enabled = True
.Buttons("ys").Enabled = True
.Buttons("cp").Enabled = True
Else
.Buttons("zb").Enabled = False
.Buttons("ys").Enabled = False
.Buttons("cp").Enabled = False
End If
If int_endflag = 1 And int_CloseFlag = 0 Then
.Buttons("dx").Enabled = True
Else
.Buttons("dx").Enabled = False
End If
If int_ComputeFlag = 1 And int_endflag = 1 And int_CloseFlag = 0 Then
.Buttons("gb").Enabled = True
Else
.Buttons("gb").Enabled = False
End If
Else
.Buttons("zb").Enabled = False
.Buttons("ys").Enabled = False
.Buttons("cp").Enabled = False
.Buttons("dx").Enabled = False
.Buttons("gb").Enabled = False
End If
End With
End Sub
'函数dykhlb，调用考核类别的指标、要素、测评、对象窗体
'参数考核类别索引khlbsy，有效值为zb,ys,cp,dx。
Private Sub dykhlb(khlbsy As String)
Dim str_Temp As String '考核类别编码
Dim rec_Recordset As New Recordset '临时记录集
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -