📄 frmoperator.frm
字号:
Left = 2370
Top = 5160
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 12
ImageHeight = 13
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmOperator.frx":0058
Key = "FULL"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmOperator.frx":0548
Key = "EMPTY"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmOperator.frx":0A38
Key = "HALF"
EndProperty
EndProperty
End
Begin VB.CommandButton cmdOK
Caption = "业务配置(&A)"
Height = 350
Index = 3
Left = 6540
TabIndex = 20
Tag = "1004"
Top = 1410
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 2
Left = 6540
Style = 1 'Graphical
TabIndex = 18
Tag = "1009"
Top = 855
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 1
Left = 6540
Style = 1 'Graphical
TabIndex = 17
Tag = "1002"
Top = 495
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 0
Left = 6540
Style = 1 'Graphical
TabIndex = 16
Tag = "1001"
Top = 144
UseMaskColor = -1 'True
Width = 1215
End
Begin AtlEdit.TEdit txtUser
Height = 315
Index = 0
Left = 1290
TabIndex = 1
Top = 345
Width = 1665
_ExtentX = 2937
_ExtentY = 556
maxchar = 8
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
End
Begin ListRefer.ListText refOperatorGroup
Height = 300
Left = 4230
TabIndex = 3
Top = 345
Width = 1665
_ExtentX = 2937
_ExtentY = 529
BackColor = -2147483643
MaxLenth = 30
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 VB.CheckBox chkStop
Caption = "停用"
Height = 195
Left = 6540
TabIndex = 19
Top = 4896
Width = 690
End
Begin AtlEdit.TEdit txtUser
Height = 315
Index = 1
Left = 1290
TabIndex = 5
Top = 780
Width = 1665
_ExtentX = 2937
_ExtentY = 556
maxchar = 8
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
PasswordChar = "*"
End
Begin AtlEdit.TEdit txtUser
Height = 315
Index = 2
Left = 4230
TabIndex = 7
Top = 780
Width = 1665
_ExtentX = 2937
_ExtentY = 556
maxchar = 8
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
PasswordChar = "*"
End
Begin VB.Label Label1
Caption = "操作员名(&N)"
Height = 195
Index = 0
Left = 240
TabIndex = 0
Top = 420
Width = 1005
End
Begin VB.Label Label1
Caption = "口 令(&P)"
Height = 180
Index = 1
Left = 240
TabIndex = 4
Top = 810
Width = 900
End
Begin VB.Label Label1
Caption = "确认口令(&F)"
Height = 195
Index = 2
Left = 3150
TabIndex = 6
Top = 810
Width = 1005
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "操作员组(&G)"
Height = 180
Index = 3
Left = 3150
TabIndex = 2
Top = 420
Width = 990
End
End
Attribute VB_Name = "frmOperator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'操作员卡片模块
' 作者：欧中建
' 日期：1998.6.10
'用于修改，新增，某一操作员
Option Explicit
Private mblnIsInit As Boolean
Private mblnIsExist As Boolean
Private mblnIsNext As Boolean
Private mblnIsNew As Boolean 'TRUE--增加操作员 FALSE--编辑操作员
Private mblnIsChanged As Boolean
Private mblnGroupNameOK As Boolean
Private mblnSetActive As Boolean
Private mblnIsRefer As Boolean
Private mbytPreRight As Byte
Private mlngModuleID As Long
Private mlngOperatorGroupID As Long
Private mlngOpID As Long
Private mstrOperatorGroupName As String
Private mstrVersionNO As String
Private mstrPassword As String
Public Property Get getID() As Long
getID = mlngOpID
End Property
Public Sub AddCard()
mlngOpID = 0
mblnIsNew = True
mblnIsChanged = False
Me.Caption = "新增操作员"
cmdOK(2).Visible = True
InitCard
Show vbModal
End Sub
Public Function DelCard(lngID As Long) As Boolean
Dim recUser As rdoResultset, strSql As String, strUser As String
DelCard = False
If lngID = 1 Then
ShowMsg 0, "系统管理员，不能删除！", vbExclamation + MB_TASKMODAL, "删除操作员"
Exit Function
End If
strSql = "SELECT * FROM Operator WHERE lngOperatorID=" & lngID
Set recUser = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recUser.EOF Then
DelCard = True
recUser.Close
Exit Function
Else
strUser = recUser!strOperatorName
recUser.Close
End If
If IsWorking(lngID) Then
ShowMsg 0, "操作员“" & strUser & "”正在工作，不能删除！", vbExclamation + MB_TASKMODAL, "删除操作员"
Exit Function
End If
If Not IsCanDel(lngID) Then
ShowMsg 0, "操作员“" & strUser & "”已经发生业务，不能删除！", vbExclamation + MB_TASKMODAL, "删除操作员"
Exit Function
End If
If ShowMsg(0, "您确实要删除操作员“" & strUser & "”吗？", _
vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除操作员") = vbNo Then
Exit Function
End If
gclsBase.BaseWorkSpace.BeginTrans
strSql = "DELETE FROM Operator WHERE lngOperatorID=" & lngID
If Not gclsBase.ExecSQL(strSql) Then GoTo RollBacktrans
strSql = "DELETE FROM OperatorRight WHERE lngOperatorID=" & lngID
If Not gclsBase.ExecSQL(strSql) Then GoTo RollBacktrans
gclsBase.BaseWorkSpace.CommitTrans
DelCard = True
' frmActiveSet.DelOperator lngID
Exit Function
RollBacktrans:
gclsBase.BaseWorkSpace.RollBacktrans
End Function
Public Sub EditCard(lngID As Long, strName As String)
Dim recUser As rdoResultset, strSql As String
If Not CheckIDUsed("Operator", "lngOperatorID", lngID) Then
ShowMsg 0, "“" & strName & "”操作员不存在，不能进行修改！", vbExclamation + MB_TASKMODAL, "修改操作员"
Unload Me
Else
mblnIsChanged = False
mlngOpID = lngID
mblnIsNew = False
InitCard
RefreshButton
Me.Caption = "修改操作员"
cmdOK(2).Visible = False
Show vbModal
End If
End Sub
Private Function IsWorking(ByVal lngID As Long) As Boolean
Dim recLog As rdoResultset, strSql As String
strSql = "SELECT * FROM Log WHERE RTrim(strLogoutTime)='' AND lngOperatorID=" & lngID
Set recLog = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
IsWorking = Not recLog.EOF
recLog.Close
IsWorking = CheckIDUsed("Voucher", "lngOperatorID", lngID)
End Function
Private Function IsCanDel(ByVal lngID As Long) As Boolean
IsCanDel = False
If CheckIDUsed("Voucher", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("TransVoucher", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("Activity", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("ItemActivity", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("PurchaseOrder", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("SaleOrder", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("CostPrice", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("StockTaking", "lngOperatorID", lngID) Then Exit Function
If CheckIDUsed("SalaryList", "lngOperatorID", lngID) Then Exit Function
IsCanDel = True
End Function
Private Sub cboRightGroup_Click()
Dim NodX As msComctlLib.Node
With msgAuth
If cboRightGroup.ListIndex > -1 Then
.TextMatrix(.Row, 3) = cboRightGroup.Text
.TextMatrix(.Row, 4) = cboRightGroup.ItemData(cboRightGroup.ListIndex)
End If
End With
If TxtToDouble(msgAuth.TextMatrix(msgAuth.Row, 4)) < mbytPreRight And _
TxtToDouble(msgAuth.TextMatrix(msgAuth.Row, 4)) >= 0 Then
cmdOK(5).Enabled = False
Else
cmdOK(5).Enabled = True
End If
cmdOK(4).Enabled = False
txtUser(3).Text = Trim(cboRightGroup.Text)
If Trim(txtUser(3).Text) = "" Then
For Each NodX In tvwRight.Nodes
NodX.iMage = "EMPTY"
Next NodX
If tvwRight.Nodes.Count > 0 Then tvwRight.Nodes("Root").EnsureVisible
tvwRight.Nodes("Root").Text = cboRightGroup.list(0)
Else
InitRightTree
End If
If Not mblnIsInit Then mblnIsChanged = True
End Sub
Private Sub cboRightGroup_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If Shift = 0 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -