📄 基础设置_设备状态设置.frm
字号:
If .State = 1 Then .Close
.Open "SELECT * FROM Dev_StateSort WHERE StateCode= '" + 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 Dev_StateSort WHERE StateName= '" + 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("StateCode") = Trim(LrText(0).Text) '状态编码
.Fields("StateName") = Trim(LrText(1).Text) '状态名称
.Fields("Memo") = Trim(LrText(2).Text) '备注
If ChkGoodFlag.Value = 1 Then
.Fields("GoodFlag") = 1
End If
.Update
Cw_DataEnvi.DataConnect.CommitTrans
'将记录加入网格
Sqlstr = "SELECT * FROM Dev_StateSort WHERE StateCode= '" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
.Select .Rows - 1, Qslz
Call Jltcwg(Cxnrrec, .Rows - 1)
End With
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 Dev_StateSort WHERE StateName= '" + Trim(LrText(1).Text) + "' and StateCode<>'" & 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 Dev_StateSort WHERE StateCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
.Fields("StateName") = Trim(LrText(1).Text) '状态名称
.Fields("Memo") = Trim(LrText(2).Text) '备注
If ChkGoodFlag.Value = 1 Then
.Fields("GoodFlag") = 1
End If
.Update
End If
Cw_DataEnvi.DataConnect.CommitTrans
'刷新当前网格
Sqlstr = "SELECT * FROM Dev_StateSort WHERE StateCode= '" + 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 Dev_StateSort.* FROM Dev_StateSort Where StateCode='" & 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("StateCode") & "") '状态编码
LrText(1).Text = Trim(.Fields("StateName") & "") '状态名称
LrText(2).Text = Trim(.Fields("Memo") & "") '备注
If .Fields("GoodFlag") = True Then
ChkGoodFlag.Value = 1 '完好标志
Else
ChkGoodFlag.Value = 0
End If
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
If Not Security_Log("Dev_StateSetEdit", Xtczybm, 1, True) Then
Exit Sub
End If
'非数据行不能删除
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
'用户确认是否删除记录
Tsxx = "请确认是否删除当前记录?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 2 Then
Exit Sub
End If
On Error GoTo Cwcl
Cw_DataEnvi.DataConnect.BeginTrans
'[>>以下需自定义部分
Cw_DataEnvi.DataConnect.Execute "delete Dev_StateSort where StateCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
'以上为自定义部分<<]
Cw_DataEnvi.DataConnect.CommitTrans
CzxsGrid.RemoveItem CzxsGrid.Row
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 Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
If Shift = 2 Then
Select Case UCase(Chr(KeyCode))
Case "P" 'Ctrl+P 打印
If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
Call bbyl(False)
End If
Case "A" 'Ctrl+A 增加
If Not Security_Log("Dev_StateSetEdit", Xtczybm, 1, True) Then
Exit Sub
End If
If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).Enabled = True
LrText(0).SetFocus
End If
Case "D" 'Ctrl+D 删除
If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
Call Scdqjl
End If
End Select
End If
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
Call bbyl(True)
Case "dy" '打 印
Call bbyl(False)
Case "zj" '增 加
If Not Security_Log("Dev_StateSetEdit", Xtczybm, 1, True) Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).Enabled = True
LrText(0).SetFocus
Case "xg" '修 改
Call Xgdqjl
Case "sc" '删 除
Call Scdqjl
Case "sx" '刷 新
Call Cxnrtcwg
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
End Sub
Private Sub CzxsGrid_DblClick() '修改当前编码记录
Call Xgdqjl
End Sub
Private Sub Xgdqjl() '修改当前编码记录
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("Dev_StateSetEdit", Xtczybm, 1, True, False) Then
BcCommand.Enabled = False
End If
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 2
If Cshlrxx(Lrzt) Then
LrText(1).SetFocus
LrText(0).Enabled = False
End If
End Sub
Private Sub Toolbjzt() 'Toolbar状态(编辑状态)
StTab.TabEnabled(1) = True
StTab.Tab = 1
Frame1.Enabled = True
StTab.TabEnabled(0) = False
CzxsGrid.Enabled = False
With SzToolbar
.Buttons("ymsz").Enabled = False
.Buttons("dy").Enabled = False
.Buttons("yl").Enabled = False
.Buttons("zj").Enabled = False
.Buttons("xg").Enabled = False
.Buttons("sc").Enabled = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -