📄 frmrights.frm
字号:
TreeLeft.Nodes(1).Selected = True
MsgBox "请您先将新操作员改名保存!", vbInformation + vbOKOnly, "提示:"
End If
End Sub
Private Sub cmdDel_Click()
Dim nYes As Integer, nIndex As Integer
nYes = MsgBox("您真的要删除<" & cobOperator.Text & ">吗?", vbYesNo + vbQuestion, "提示:")
If nYes = vbNo Then Exit Sub
m_gDBCnn.Execute "Delete * From OperatorPower Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "'"
m_gDBCnn.Execute "Delete * From Operator Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "'"
nIndex = cobOperator.ListIndex
cobOperator.RemoveItem (cobOperator.ListIndex)
If cobOperator.ListCount > 0 Then
If nIndex < cobOperator.ListCount Then
cobOperator.ListIndex = nIndex
Else
cobOperator.ListIndex = nIndex - 1
End If
Else
TreeLeft.Nodes.Clear
TreeRight.Nodes.Clear
ChangeMode
End If
End Sub
Private Sub cmdExit_Click()
Me.MousePointer = vbDefault
Unload Me
End Sub
'///////////////////////////////////////////////////////
'//
Private Sub cmdAddPower_Click()
EditFunctionItem TreeRight, TreeLeft, True
ChangeMode
End Sub
Private Sub cmdDelPower_Click()
EditFunctionItem TreeLeft, TreeRight, False
ChangeMode
End Sub
'///////////////////////////////////////////////
'//bMode=True, 增加; bMode=False, 删除
'///////////////////////////////////////////////
Private Sub EditFunctionItem(ByRef TreeSource As TreeView, ByRef TreeTarget As TreeView, bMode As Boolean)
Dim nNodeIndex As Integer, nSelectIndex As Integer
Dim bIsMenuNode As Boolean, nodX As Node
Dim sMenuName As String, nPower As Integer
If TreeSource.Nodes.Count <= 1 Then
Exit Sub
ElseIf TreeSource.SelectedItem Is Nothing Then
TreeSource.Nodes(2).Selected = True
ElseIf TreeSource.SelectedItem.Index <= 1 Then
TreeSource.Nodes(2).Selected = True
End If
nSelectIndex = TreeSource.SelectedItem.Index
With TreeSource.Nodes
If .Item(nSelectIndex).Parent.Index = 1 Then ' 父是根节点!
nNodeIndex = nSelectIndex
bIsMenuNode = True
Else ' 父是Menu节点!
nNodeIndex = .Item(nSelectIndex).Parent.Index
bIsMenuNode = False
End If
If Not CheckExistMenuNode(TreeTarget, .Item(nNodeIndex).Key) Then
Set nodX = TreeTarget.Nodes.Add(TreeTarget.Nodes.Item(1).Key, tvwChild, .Item(nNodeIndex).Key, .Item(nNodeIndex).Text, 2, 2)
nodX.EnsureVisible
End If
If bIsMenuNode Then
Do While .Item(nNodeIndex).Children > 0
'更新数据库
GetFunctionItem sMenuName, nPower, .Item(nNodeIndex).Child.Key
If Not AddDelFuncItem(bMode, cobOperator.Text, sMenuName, nPower) Then Exit Sub
Set nodX = TreeTarget.Nodes.Add(.Item(nNodeIndex).Key, tvwChild, .Item(nNodeIndex).Child.Key, .Item(nNodeIndex).Child.Text, 3, 3)
nodX.Parent.Selected = True
.Remove (.Item(nNodeIndex).Child.Index)
Loop
.Remove (nNodeIndex)
Else
'更新数据库
GetFunctionItem sMenuName, nPower, .Item(nSelectIndex).Key
If Not AddDelFuncItem(bMode, cobOperator.Text, sMenuName, nPower) Then Exit Sub
Set nodX = TreeTarget.Nodes.Add(.Item(nNodeIndex).Key, tvwChild, .Item(nSelectIndex).Key, .Item(nSelectIndex).Text, 3, 3)
nodX.Selected = True
.Remove (nSelectIndex)
If .Item(nNodeIndex).Children = 0 Then
.Remove (nNodeIndex)
End If
End If
End With
End Sub
Private Function CheckExistMenuNode(myTree As TreeView, myKey As String) As Boolean
CheckExistMenuNode = False
Dim i As Integer
With myTree.Nodes
For i = 2 To .Count
If .Item(i).Parent.Index = 1 And .Item(i).Key = myKey Then
CheckExistMenuNode = True
Exit For
End If
Next
End With
End Function
Private Function AddDelFuncItem(bMode As Boolean, sOperator As String, sMenuName As String, nPower As Integer)
Dim nAffected As Integer
If bMode Then '增加
m_gDBCnn.Execute "Insert Into OperatorPower (FDepartCode, FOperatorName, FMenuName, FPowerAttrib) Values ('" & m_gsDepartCode & "','" & sOperator & "','" & sMenuName & "'," & nPower & ")", nAffected
Else '删除
m_gDBCnn.Execute "Delete * From OperatorPower Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & sOperator & "' And FMenuName = '" & sMenuName & "' And FPowerAttrib = " & nPower, nAffected
End If
AddDelFuncItem = (nAffected = 1)
End Function
Private Sub GetFunctionItem(ByRef sMenuName As String, ByRef nPower As Integer, sKey As String)
Dim nPos As Integer
nPos = InStr(1, sKey, ":")
sMenuName = Left(sKey, nPos - 1)
nPower = Val(Mid(sKey, nPos + 1))
End Sub
'////////////////////////////////////////////////
'//
Private Sub cobOperator_Click()
If cobOperator.Text = m_sOldOperator Then
Exit Sub
End If
m_sOldOperator = cobOperator.Text
Me.MousePointer = vbHourglass
Dim sSqlStr As String, sField As String
Dim TempRs As ADODB.Recordset
sField = GetDepartFunctionField()
sSqlStr = "Select DISTINCT Function.FID, OperatorPower.FMenuName, Function.FMenuDescribe, OperatorPower.FPowerAttrib, MenuAttrib.FPowerDescribe " & _
" From (OperatorPower Inner Join Function On OperatorPower.FMenuName = Function.FMenuName) Inner Join MenuAttrib On OperatorPower.FPowerAttrib = MenuAttrib.FPowerAttrib " & _
" Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "' " & _
" And Function." & sField & " And Function.FMenuAttrib <> 0 Order by Function.FID, OperatorPower.FPowerAttrib"
Set TempRs = New ADODB.Recordset
TempRs.Open sSqlStr, m_gDBCnn
BuildTree TreeLeft, "L", cobOperator.Text, TempRs
TempRs.Close
sSqlStr = "Select FID, FMenuName, FMenuDescribe, MenuAttrib.FPowerAttrib, MenuAttrib.FPowerDescribe " & _
" From Function Inner Join MenuAttrib On Function.FMenuAttrib = MenuAttrib.FMenuAttrib " & _
" Where Function." & sField & " And Function.FMenuAttrib <> 0 " & _
" And FMenuName & ':' & MenuAttrib.FPowerAttrib Not In (Select FMenuName & ':' & FPowerAttrib " & _
" From OperatorPower Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "')" & _
" Order by FID, MenuAttrib.FPowerAttrib"
TempRs.Open sSqlStr, m_gDBCnn
BuildTree TreeRight, "R", "权限管理", TempRs
Set TempRs = Nothing
ChangeMode
Me.MousePointer = vbDefault
End Sub
Private Sub cobOperator_GotFocus()
m_sOldOperator = cobOperator.Text
End Sub
'////////////////////////////////////////////////
'//
Private Sub BuildTree(ByRef myTree As TreeView, sRootKey As String, sRootText As String, Rs As ADODB.Recordset)
Dim nodX As Node, sPrevItem As String, sKey As String
myTree.Nodes.Clear
Set nodX = myTree.Nodes.Add(, , sRootKey, sRootText, 1, 1)
nodX.EnsureVisible
With Rs
sPrevItem = ""
Do While Not .EOF
sKey = ![FMenuName]
If Not (sPrevItem = ![FMenuName]) Then
Set nodX = myTree.Nodes.Add(sRootKey, tvwChild, sKey, ![FMenuDescribe], 2, 2)
nodX.EnsureVisible
sPrevItem = ![FMenuName]
End If
Set nodX = myTree.Nodes.Add(sKey, tvwChild, ![FMenuName] & ":" & ![FPowerAttrib], ![FPowerDescribe], 3, 3)
.MoveNext
Loop
End With
myTree.Nodes.Item(1).EnsureVisible
End Sub
'////////////////////////////////////////////////
'//
Private Sub Form_Load()
Me.MousePointer = vbHourglass
SetForm Me, 9
Dim TempRs As ADODB.Recordset
Set TempRs = New ADODB.Recordset
TempRs.Open "Select FOperatorName From Operator Where FDepartCode = '" & m_gsDepartCode & "'", m_gDBCnn
With TempRs
Do While Not .EOF
cobOperator.AddItem ![FOperatorName]
.MoveNext
Loop
End With
m_sOldOperator = ""
ChangeMode
Me.MousePointer = vbDefault
End Sub
'////////////////////////////////////////////////////////////////
'//
Private Sub TreeLeft_AfterLabelEdit(Cancel As Integer, NewString As String)
If NewString = cobOperator.Text Then
Exit Sub
End If
Dim nAffected As Integer
If Not RsIsEmpty("Select * From Operator Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & NewString & "'") Then
MsgBox "已有<" & NewString & ">操作员!", vbInformation + vbOKOnly, "提示:"
Cancel = True
Else
m_gDBCnn.Execute "Update Operator Set FOperatorName = '" & NewString & "' Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "'", nAffected
If nAffected <> 1 Then
MsgBox "操作员姓名输入超长, 请修改!", vbInformation + vbOKOnly, "提示:"
Cancel = True
Else
m_gDBCnn.Execute "Update OperatorPower Set FOperatorName = '" & NewString & "' Where FDepartCode = '" & m_gsDepartCode & "' And FOperatorName = '" & cobOperator.Text & "'"
cobOperator.List(cobOperator.ListIndex) = NewString
End If
End If
End Sub
Private Sub TreeLeft_BeforeLabelEdit(Cancel As Integer)
If TreeLeft.SelectedItem.Index <> 1 Then
Cancel = True
End If
End Sub
Private Sub TreeLeft_DblClick()
If TreeLeft.SelectedItem.Index = 1 Or Not cmdDelPower.Enabled Then
Exit Sub
Else
cmdDelPower_Click
End If
End Sub
Private Sub TreeRight_DblClick()
If TreeRight.SelectedItem.Index = 1 Or Not cmdAddPower.Enabled Then
Exit Sub
Else
cmdAddPower_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -