📄 设置_项目相关明细设置.frm
字号:
End If
jsqte = CzxsGrid.FixedRows
Do While Not .EOF
If jsqte >= CzxsGrid.Rows Then
CzxsGrid.AddItem ""
End If
Call Jltcwg(Cxnrrec, jsqte)
CzxsGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
'[以下为自定义部分
With Jlbrec
CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Listcode")) '明细编码
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ListName")) '明细名称
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "" & .Fields("YNStop") '是否停用
End With
'以上为自定义部分]
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Height < 5000 Then Me.Height = 5000
If Me.Width < 8805 Then Me.Width = 8805
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
Set Cxnrrec = Nothing
Unload Dyymctbl
End Sub
Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
Dim jsqte As Integer
With RecDigest
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 8) = 1 Then '字段不能为空
If Len(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为空!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Bclrsj = False
Exit Function
End If
Else
If Textint(jsqte, 8) = 2 Then '字段不能为零
If Val(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为零!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Bclrsj = False
Exit Function
End If
End If
End If
Next jsqte
'对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
For jsqte = 0 To Max_Text_Index
If Textboolean(jsqte, 2) Then
If Not TextYxxpd(jsqte) Then
Exit Function
End If
End If
Next jsqte
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
On Error GoTo Swcwcl
If Lrzt = 1 Then '增 加
If .State = 1 Then .Close
.Open "SELECT * FROM DEV_CorrelationList WHERE Listcode='" & Trim(LrText(0)) & "'", 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_CorrelationList WHERE ListName= '" + 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
Cw_DataEnvi.DataConnect.Execute "insert into DEV_CorrelationList(Sortcode,ListName,YNstop,listcode) values('" & Trim(F_Sort.Tag) & "'," _
& "'" & Trim(LrText(1).Text) & "','" & A_YNStop.Value & "','" & Trim(LrText(0).Text) & "')"
Sqlstr = "SELECT * FROM DEV_CorrelationList where ListName='" & Trim(LrText(1).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
Cxnrrec.Close
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
LrText(0).SetFocus
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Else
If .State = 1 Then .Close
.Open "SELECT * FROM DEV_CorrelationList WHERE ListName= '" + Trim(LrText(1).Text) + "' and Listcode<>'" & 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
Cw_DataEnvi.DataConnect.Execute "update DEV_CorrelationList set ListName='" _
& Trim(LrText(1).Text) & "',YNStop='" & A_YNStop.Value & "'" _
& "Where listcode = " & Trim(LrText(0).Text)
Sqlstr = "SELECT * FROM DEV_CorrelationList where listcode='" & Trim(LrText(0).Text) & "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If Not Cxnrrec.EOF Then
With CzxsGrid
Call Jltcwg(Cxnrrec, .Row)
End With
End If
End If
Bclrsj = True
Exit Function
End With
Swcwcl:
Tsxx = "存盘过程中出现错误,请退出后重新进入!"
If Err.Number = -2147217900 Then
Tsxx = "编码不能重复"
End If
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
Private Sub Cshlrxx(lrztxx As Integer) '初始化录入字段信息
If lrztxx = 1 Then
For jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
TextChangeLock = True
LrText(jsqte).Text = ""
LrText(jsqte).Tag = ""
TextChangeLock = False
End If
TextValiJudgeLock(jsqte) = True
Next jsqte
Else
With CzxsGrid
LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) '明细编码
LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) '明细名称
A_YNStop.Value = Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)))
End With
End If
End Sub
Private Sub Scdqjl() '删 除 当 前 记 录
Dim Yhanswer As Integer
If Not Security_Log("Dev_ItemListEdit", 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.Execute "delete DEV_CorrelationList where Listcode = " + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
'以上为自定义部分]
CzxsGrid.RemoveItem CzxsGrid.Row
Exit Sub
Cwcl:
If Err.Number = -2147217900 Then
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 打印
Call bbyl(False)
Case "I" 'Ctrl+I 增加
If Not Security_Log("Dev_ItemListEdit", Xtczybm, 1, True) Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).SetFocus
LrText(0).Locked = False
Case "D" 'Ctrl+D 删除
Call Scdqjl
End Select
End If
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Key <> "fh" And Button.Key <> "bz" Then
If Trim(F_Sort.Tag) = "" Then MsgBox "没有选定类别！ ", 32: Exit Sub
End If
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_ItemListEdit", Xtczybm, 1, True) Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).SetFocus
LrText(0).Locked = False
Case "xg" '修 改
If CzxsGrid.Row < CzxsGrid.FixedRows Then MsgBox "没有选定明细！ ", 32: Exit Sub
Call Xgdqjl
Case "sc" '删 除
Call Scdqjl
Case "fq" '取 消
Call Toolfbjzt
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_ItemSetEdit", Xtczybm, 1, True, False) Then
BcCommand.Enabled = False
End If
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 2
Call Cshlrxx(Lrzt)
LrText(1).SetFocus
LrText(0).Locked = True
End Sub
Private Sub Toolbjzt() 'Toolbar状态(编辑状态)
StTab.TabEnabled(1) = True
A_YNStop.Value = 0
Tree_List.Enabled = False
StTab.Tab = 1
Frame1.Enabled = True
StTab.TabEnabled(0) = False
CzxsGrid.Enabled = False
With SzToolbar
.Buttons("ymsz").Enabled = False
.Buttons("dy").Enabled = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -