frmmenuright.frm

用VB6.0编写的关于车辆运输调度的系统

                Call AddNode(Trim("" & rst.Fields("Position")), "" & rst.Fields("MenuInforID"), _
                     Trim("" & rst.Fields("MenuCaption")), rst!SystemID)
            End If
            rst.MoveNext
        Wend
        Call rst.Close
        Set rst = Nothing
    End If
    
    sql = "Select menuinforid,Position,Name,rowindex From C_MenuTkt "
    Set rst = gComMesaStub.Query(sql)
    If Not rst Is Nothing Then
        While Not rst.EOF
            Call AddOPNode(Trim("" & rst.Fields("Position") & Format(rst!RowIndex, "0#")), "" & rst.Fields("MenuInforID"), _
                     Trim("" & rst.Fields("name")))
            rst.MoveNext
        Wend
        Call rst.Close
        Set rst = Nothing
    End If
    
    tvwMenu.Nodes.Item("r").Expanded = True
    If Val(usTktRight) > 1 Then
        Ini = True
        chkBaseInfor.Value = IIf(Val(usTktRight) Mod Cst_System_BaseInfo = 0 And Val(usTktRight) \ Cst_System_BaseInfo > 0, CHECKED, UNCHECKED)
        chkCG.Value = IIf(Val(usTktRight) Mod Cst_System_CG = 0, CHECKED, UNCHECKED)
        chkKC.Value = IIf(Val(usTktRight) Mod Cst_System_KC = 0, CHECKED, UNCHECKED)
        chkXS.Value = IIf(Val(usTktRight) Mod Cst_System_XS = 0, CHECKED, UNCHECKED)
        chkCW.Value = IIf(Val(usTktRight) Mod Cst_System_CW = 0, CHECKED, UNCHECKED)
        chkSystem.Value = IIf(Val(usTktRight) Mod Cst_System_System = 0 And Val(usTktRight) \ Cst_System_System > 0, CHECKED, UNCHECKED)
        Ini = False
    End If
    
    Exit Sub
Fail:
    err.Raise err.Number, , err.Description
End Sub
'保存权限数据
Private Function SaveData() As Boolean
    Dim tNode As node
    Dim usSysRight As Long
    Dim i As Integer
    On Error GoTo ErrH
    
    Set tNode = tvwMenu.Nodes("r").Child
    usMenuRight = SplitOperator
    While Not tNode Is Nothing
        If tNode.Image = 2 Then
            usMenuRight = usMenuRight & GetRight(tNode) & SplitOperator
            If Right(usMenuRight, 2) = SplitOperator & SplitOperator Then _
                    usMenuRight = Left(usMenuRight, Len(usMenuRight) - 1)
        End If
        Set tNode = tNode.Next
    Wend
    usSysRight = 1
    If chkBaseInfor.Value = 1 Then usSysRight = usSysRight * Cst_System_BaseInfo
    If chkCG.Value = 1 Then usSysRight = usSysRight * Cst_System_CG
    If chkKC.Value = 1 Then usSysRight = usSysRight * Cst_System_KC
    If chkXS.Value = 1 Then usSysRight = usSysRight * Cst_System_XS
    If chkCW.Value = 1 Then usSysRight = usSysRight * Cst_System_CW
    If chkSystem.Value = 1 Then usSysRight = usSysRight * Cst_System_System
    usTktRight = Format(usSysRight, "#####0")
    SaveData = True
    Exit Function
ErrH:
    MsgBox "保存权限数据错误。", vbOKOnly Or vbExclamation, "错误"
    SaveData = False
End Function
'设置节点及其子节点的Image
Private Sub SetNodeImage(ByVal mNode As node, ByVal nImg As Integer)
    Dim tNode As node, i As Integer
    If mNode Is Nothing Then Exit Sub
    If mNode.Key = "r" Then Exit Sub
    If mNode.Children > 0 Then
        Set tNode = mNode.Child
        Call SetNodeImage(tNode, nImg)
        For i = 1 To mNode.Children - 1
            Set tNode = tNode.Next
            Call SetNodeImage(tNode, nImg)
        Next i
    End If
    If mNode.Image = 2 Or mNode.Image = 3 Then
        mNode.Image = nImg
    Else
        If nImg = 2 Then
            mNode.Image = 4
        ElseIf nImg = 3 Then
            mNode.Image = 5
        ElseIf nImg = 5 Then
            mNode.Image = 5
        ElseIf nImg = 4 Then
            mNode.Image = 4
        End If
    End If
End Sub
Private Sub SetOPState()
    cmdCancel.Caption = IIf(mCanModify, "取 消(&X)", "退 出(&X)")
    cmdOK.Enabled = mCanModify
    cmdGrant.Enabled = mCanModify
    cmdGrantAll.Enabled = mCanModify
    cmdQush.Enabled = mCanModify
    cmdQushAll.Enabled = mCanModify
End Sub
'本模块的私有方法（结束）
'***************************************************************

Private Sub chkCG_Click()
    RefreshForm
End Sub

Private Sub chkCW_Click()
    RefreshForm
End Sub

Private Sub chkKC_Click()
    RefreshForm
End Sub

Private Sub chkSystem_Click()
    RefreshForm
End Sub

Private Sub chkBaseInfor_Click()
    RefreshForm
End Sub

Private Sub chkXS_Click()
    RefreshForm
End Sub

Private Sub cmdCancel_Click()
    mRet = vbCancel
    Hide
End Sub

Private Sub cmdGrant_Click()
Dim i As Integer, tNode As node
Dim MenuCaption As String
    If tvwMenu.Nodes("r").Children <= 0 Then Exit Sub
    MenuCaption = tvwMenu.SelectedItem.Text
    If tvwMenu.Nodes("r").Children <= 0 Then Exit Sub
    Set tNode = tvwMenu.Nodes("r").Child
    Call SetLikeNodeImage(tNode, MenuCaption, 4)
    For i = 1 To tvwMenu.Nodes("r").Children - 1
        Set tNode = tNode.Next
            Call SetLikeNodeImage(tNode, MenuCaption, 4)
    Next i
End Sub

Private Sub cmdGrantAll_Click()
    Dim i As Integer, tNode As node
    If tvwMenu.Nodes("r").Children <= 0 Then Exit Sub
    Set tNode = tvwMenu.Nodes("r").Child
    Call SetNodeImage(tNode, 2)
    For i = 1 To tvwMenu.Nodes("r").Children - 1
        Set tNode = tNode.Next
        Call SetNodeImage(tNode, 2)
    Next i
End Sub

Private Sub cmdOK_Click()
    mRet = vbOK
    If SaveData Then Hide
End Sub

Private Sub cmdQush_Click()
Dim i As Integer, tNode As node
Dim MenuCaption As String
    If tvwMenu.Nodes("r").Children <= 0 Then Exit Sub
    MenuCaption = tvwMenu.SelectedItem.Text
    Set tNode = tvwMenu.Nodes("r").Child
    Call SetLikeNodeImage(tNode, MenuCaption, 5)
    For i = 1 To tvwMenu.Nodes("r").Children - 1
        Set tNode = tNode.Next
            Call SetLikeNodeImage(tNode, MenuCaption, 5)
    Next i
End Sub

Private Sub cmdQushAll_Click()
    Dim i As Integer, tNode As node
    If tvwMenu.Nodes("r").Children <= 0 Then Exit Sub
    Set tNode = tvwMenu.Nodes("r").Child
    Call SetNodeImage(tNode, 3)
    For i = 1 To tvwMenu.Nodes("r").Children - 1
        Set tNode = tNode.Next
        Call SetNodeImage(tNode, 3)
    Next i
End Sub

Private Sub Form_Activate()
On Error GoTo Fail
    Call InitForm
    Call SetOPState
    Exit Sub
Fail:
    MsgBox err.Description, vbCritical, gCST_MsgBoxTitle
End Sub

Private Sub tvwMenu_Expand(ByVal node As MSComctlLib.node)
    tvwMenu.SelectedItem = node
End Sub

Private Sub tvwMenu_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeySpace And mCanModify Then
        If Not mCanModify Then Exit Sub
        If tvwMenu.SelectedItem Is Nothing Then Exit Sub
        If tvwMenu.SelectedItem.Key = "r" Then Exit Sub
        Dim nImg As Integer
        nImg = tvwMenu.SelectedItem.Image
        If nImg = 2 Then
            Call SetNodeImage(tvwMenu.SelectedItem, 3)
        ElseIf nImg = 3 Then
            Call SetNodeImage(tvwMenu.SelectedItem, 2)
        ElseIf nImg = 4 Then
            Call SetNodeImage(tvwMenu.SelectedItem, 5)
        ElseIf nImg = 5 Then
            Call SetNodeImage(tvwMenu.SelectedItem, 4)
        End If
    End If
End Sub


'***************************************************************
'本模块的私有方法（开始）
'增加一个操作权限节点
Private Sub AddOPNode(ByVal sCode As String, lID As Long, sText As String)
Dim sParent As String, tNode As node, nImg As Integer
Dim BeginLen As Long
Dim RightStr As String
Dim ss As String
    If Trim(sText) <> "-" Then
        sParent = FindParent(sCode)
        nImg = 5
        BeginLen = InStr(usMenuRight, SplitOperator & Left(sCode, Len(sCode) - 2) & SplitOperator1)
        If BeginLen > 0 Then
            ss = Right(usMenuRight, Len(usMenuRight) - BeginLen)
            ss = Split(ss, SplitOperator)(0)
            RightStr = Split(ss, SplitOperator1)(1)
            nImg = GetImgByText(sCode, RightStr)
        End If
        If Len(sParent) + 2 = Len("r" & sCode) Then
            Set tNode = tvwMenu.Nodes.Add(sParent, tvwChild, "r" & sCode, _
                    sText, nImg)
            tNode.Tag = lID
        End If
    End If
End Sub


Private Function GetImgByText(ByVal ss As String, ByVal RightStr As String) As Integer
Dim RowIndex As Long

    On Error Resume Next
    RowIndex = Val(Right(ss, 2))
    GetImgByText = 5
    If Right(Left(RightStr, RowIndex), 1) = "1" Then
        GetImgByText = 4
    End If

End Function





Private Sub RefreshForm()
Dim usSysRight As Long
    If Ini Then Exit Sub

On Error GoTo Fail
    Call SaveData
    Dim sql As String, rst As ADODB.Recordset
    txtCode.Text = mCode
    txtName.Text = mName
    With tvwMenu
        .Nodes.Clear
        .Nodes.Add , , "r", "根节点", 1
    End With
    sql = "Select MenuInforID,MenuName,MenuCaption,Position,IsTkt,SystemID,visibled From C_MenuInfor "
    
    Set rst = gComMesaStub.Query(sql)
    If Not rst Is Nothing Then
        While Not rst.EOF
            If rst!Visibled = "T" Then
                Call AddNode(Trim("" & rst.Fields("Position")), "" & rst.Fields("MenuInforID"), _
                     Trim("" & rst.Fields("MenuCaption")), rst!SystemID)
            End If
            rst.MoveNext
        Wend
        Call rst.Close
        Set rst = Nothing
    End If
    
    sql = "Select menuinforid,Position,Name,rowindex From C_MenuTkt "
    Set rst = gComMesaStub.Query(sql)
    If Not rst Is Nothing Then
        While Not rst.EOF
            Call AddOPNode(Trim("" & rst.Fields("Position") & Format(rst!RowIndex, "0#")), "" & rst.Fields("MenuInforID"), _
                     Trim("" & rst.Fields("name")))
            rst.MoveNext
        Wend
        Call rst.Close
        Set rst = Nothing
    End If
    tvwMenu.Nodes.Item("r").Expanded = True
    Exit Sub
Fail:
    err.Raise err.Number, , err.Description
    
End Sub


'设置节点及其子节点的Image,以接点的TEXT为检查标准
Private Sub SetLikeNodeImage(ByVal mNode As node, ByVal MenuText As String, ByVal nImg As Integer)
    Dim tNode As node, i As Integer
    If mNode Is Nothing Then Exit Sub
    If mNode.Key = "r" Then Exit Sub
    If mNode.Children > 0 Then
        Set tNode = mNode.Child
        Call SetLikeNodeImage(tNode, MenuText, nImg)
        For i = 1 To mNode.Children - 1
            Set tNode = tNode.Next
            Call SetLikeNodeImage(tNode, MenuText, nImg)
        Next i
    End If
    If mNode.Image = 2 Or mNode.Image = 3 Then
    Else
        If nImg = 5 And mNode.Text = MenuText Then
            mNode.Image = nImg
        ElseIf nImg = 4 And mNode.Text = MenuText Then
            mNode.Image = nImg
        End If
    End If
End Sub

Private Sub tvwMenu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not mCanModify Then Exit Sub
    If Button <> 2 Then Exit Sub
    If tvwMenu.SelectedItem Is Nothing Then Exit Sub
    If tvwMenu.SelectedItem.Key = "r" Then Exit Sub
    Dim nImg As Integer
    nImg = tvwMenu.SelectedItem.Image
    If nImg = 2 Then
        Call SetNodeImage(tvwMenu.SelectedItem, 3)
    ElseIf nImg = 3 Then
        Call SetNodeImage(tvwMenu.SelectedItem, 2)
    ElseIf nImg = 4 Then
        Call SetNodeImage(tvwMenu.SelectedItem, 5)
    ElseIf nImg = 5 Then
        Call SetNodeImage(tvwMenu.SelectedItem, 4)
    End If

End Sub