⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmrights.frm

📁 针对农资系统的商品进销存管理系统软件
💻 FRM
📖 第 1 页 / 共 2 页
字号:
        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 + -