📄 frmoprinfo.frm
字号:
Begin CSCommand.Command cmdCancel
Height = 375
Left = 8370
TabIndex = 9
Top = 120
Width = 1425
_ExtentX = 2514
_ExtentY = 661
Icon = "frmOprInfo.frx":3A2C
Caption = "启用|停用(&N)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command cmdClose
Height = 375
Left = 9795
TabIndex = 10
Top = 120
Width = 1335
_ExtentX = 2355
_ExtentY = 661
Icon = "frmOprInfo.frx":3FC6
Caption = "关闭窗口(&C)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin ComctlLib.ImageList ImageList2
Left = 750
Top = 270
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 1
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":4560
Key = ""
EndProperty
EndProperty
End
Begin ComctlLib.ImageList ImageList1
Left = 60
Top = 330
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 5
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":473A
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":4914
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":4AEE
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":4CC8
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmOprInfo.frx":4EA2
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "操作员名称："
Height = 180
Index = 1
Left = 2940
TabIndex = 4
Top = 240
Width = 1080
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "操作员编码："
Height = 180
Index = 0
Left = 90
TabIndex = 2
Top = 240
Width = 1080
End
End
Attribute VB_Name = "frmOprInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
Dim iAff As Integer
Dim iChange As Integer
Dim rsTemp As New ADODB.Recordset
On Error GoTo ErrInfo
If strOpr_Update = "" Or Len(strOpr_Update) = 0 Then
MsgBox "没有选定操作员！", vbInformation, "提示："
Exit Sub
End If
Set rsTemp = DBCN.Execute("Select * from tbCcOper Where Oper_ID='" & strOpr_Update & "'")
If rsTemp.EOF = False Then
If rsTemp.Fields("Instate") = 1 Then
iChange = 0
Else
iChange = 1
End If
Else
iChange = 0
End If
If MsgBox("撤销|停用[" & strOpr_Update & "]所有权限吗？", vbInformation + vbYesNo, "提示：") = vbYes Then
DBCN.BeginTrans
DBCN.Execute "Update tbCcOper Set MainLimit='000000',TwoLimit='000000000000',Instate=" & iChange & " Where Oper_ID='" & strOpr_Update & "'", iAff
If iAff <> 1 Then
MsgBox "操作员信息错误或者多条信息被修改！" & Chr(13) & "将取消此次操作！", vbInformation, "提示："
DBCN.RollbackTrans
Exit Sub
End If
DBCN.CommitTrans
End If
'显示操作员信息
lstOpr.ListItems.Clear
Call getOprInfo
Exit Sub
ErrInfo:
MsgBox Err.Description, vbInformation, "提示："
End Sub
Private Sub cmdClose_Click()
'返回
tBackMain Me
End Sub
Private Sub cmdFunction_Click()
If Picture1.Visible = False Then Picture1.Visible = True
optMain.Value = True
txtName.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End Sub
Private Sub cmdGClose_Click()
Picture1.Visible = False
End Sub
Private Sub cmdMain_Click()
Dim strMaxCode As String
On Error GoTo ErrInfo
If optMain.Value = True Then
If tWhileCode("tbCCFunction", "fName", Trim(txtName.Text)) = False Then
MsgBox "信息重复！", vbInformation, "提示："
Exit Sub
End If
DBCN.Execute "Insert Into tbCCFunction(fCode,fName,fLevel) Select '" & tBigCode("tbCCFunction", "fCode") & "', " _
& " '" & txtName.Text & "',1 "
'显示主要权限
'显示基础信息
Call getMain
MsgBox "主功能添加完成！", vbInformation, "提示："
txtName.Text = ""
txtName.SetFocus
Exit Sub
End If
If optList.Value = True Then
If tWhileCode("tbCCFunction", "fName", Trim(txtName1.Text)) = False Then
MsgBox "信息重复！", vbInformation, "提示："
Exit Sub
End If
DBCN.Execute "Insert Into tbCCFunction(fCode,fName,fLevel) Select '" & tString(cmbMain.Text, "[", "]", 0) & getMaxCode("") & "'," _
& " '" & Trim(txtName1.Text) & "',2 "
MsgBox "功能添加完成！", vbInformation, "提示："
txtName1.Text = ""
txtName1.SetFocus
Exit Sub
End If
Exit Sub
ErrInfo:
MsgBox Err.Description, vbInformation, "提示："
End Sub
Private Sub cmdOK_Click()
On Error GoTo ErrInfo
If txtOpr(0).Text = "" Then
MsgBox "编码错误！", vbInformation, "提示："
txtOpr(0).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
If txtOpr(1).Text = "" Then
MsgBox "名称错误！", vbInformation, "提示："
txtOpr(1).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
With uShareInfo
.strCode = txtOpr(0).Text
.strName = txtOpr(1).Text
End With
If tOperator(uShareInfo, iAdd_Update) = False Then
MsgBox "数据添加失败！", vbInformation, "提示："
Exit Sub
End If
MsgBox "数据添加成功！", vbInformation, "提示："
txtOpr(0).Text = ""
txtOpr(1).Text = ""
'显示操作员信息
lstOpr.ListItems.Clear
Call getOprInfo
txtOpr(0).SetFocus
SendKeys "{Home}+{End}"
Exit Sub
ErrInfo:
MsgBox Err.Description, vbInformation, "提示："
End Sub
Private Sub Form_Load()
Picture1.Visible = False
'计算窗体显示位置
tFormSpace frmMain, Me, uWindows
'显示基础信息
Call getMain
'显示操作员信息
Call getOprInfo
End Sub
'显示操作员信息
Private Function getOprInfo()
Dim iIndex As Integer
Dim rsTemp As New ADODB.Recordset
Dim strSQL As String
Set rsTemp = DBCN.Execute("Select * from tbCcOper Order By Oper_id ")
If rsTemp.EOF = False Then
With lstOpr
.View = lvwIcon
.LabelEdit = lvwManual
End With
Set lstOpr.Icons = ImageList3
iIndex = 1
Do Until rsTemp.EOF
If rsTemp.Fields("Instate") = 0 Then
lstOpr.ListItems.Add iIndex, , rsTemp.Fields("Oper_Name") & "[" & rsTemp.Fields("Oper_ID") & "]", 3
Else
lstOpr.ListItems.Add iIndex, , rsTemp.Fields("Oper_Name") & "[" & rsTemp.Fields("Oper_ID") & "]", 7
End If
rsTemp.MoveNext
iIndex = iIndex + 1
Loop
End If
End Function
'显示一级权限
Private Function getLimited1()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -