📄 frmmenuright.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMenuRight
BorderStyle = 1 'Fixed Single
Caption = "权限设置"
ClientHeight = 5184
ClientLeft = 36
ClientTop = 336
ClientWidth = 5820
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMenuRight.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5184
ScaleWidth = 5820
StartUpPosition = 1 'CenterOwner
Begin VB.Frame Frame4
Caption = "所属系统"
Height = 1032
Left = 0
TabIndex = 14
Top = 4152
Width = 5748
Begin VB.CheckBox chkSystem
Caption = "系统维护"
Height = 180
Left = 3240
TabIndex = 20
Top = 600
Width = 1524
End
Begin VB.CheckBox chkCW
Caption = "财务管理系统"
Height = 180
Left = 1728
TabIndex = 19
Top = 624
Width = 1524
End
Begin VB.CheckBox chkXS
Caption = "销售管理系统"
Height = 180
Left = 216
TabIndex = 18
Top = 600
Width = 1356
End
Begin VB.CheckBox chkCG
Caption = "采购管理系统"
Height = 180
Left = 1728
TabIndex = 17
Top = 288
Width = 1452
End
Begin VB.CheckBox chkKC
Caption = "库存管理系统"
Height = 180
Left = 3240
TabIndex = 16
Top = 312
Width = 1356
End
Begin VB.CheckBox chkBaseInfor
Caption = "基本信息系统"
Height = 180
Left = 216
TabIndex = 15
Top = 288
Width = 1428
End
End
Begin VB.Frame Frame3
Caption = "(请用鼠标右键设定权限）"
Height = 3540
Left = 0
TabIndex = 12
Top = 570
Width = 4044
Begin MSComctlLib.TreeView tvwMenu
Height = 3192
Left = 72
TabIndex = 13
Top = 264
Width = 3900
_ExtentX = 6879
_ExtentY = 5630
_Version = 393217
HideSelection = 0 'False
Indentation = 176
LabelEdit = 1
Style = 7
ImageList = "imglstMenu"
Appearance = 1
End
End
Begin VB.Frame Frame1
Height = 3552
Left = 4068
TabIndex = 0
Top = 570
Width = 1710
Begin VB.CommandButton cmdCancel
Caption = "取 消(&C)"
Height = 420
Left = 120
TabIndex = 6
Top = 180
Width = 1485
End
Begin VB.CommandButton cmdGrant
Caption = "类似全授予(&G)"
Height = 420
Left = 120
TabIndex = 5
ToolTipText = "将系统中类似的功能全部授予"
Top = 1344
Width = 1485
End
Begin VB.CommandButton cmdQush
Caption = "类似全撤消(&D)"
Height = 420
Left = 120
TabIndex = 4
ToolTipText = "将系统中类似的功能全部撤消"
Top = 1824
Width = 1485
End
Begin VB.CommandButton cmdGrantAll
Caption = "全授予"
Height = 420
Left = 120
TabIndex = 3
Top = 2508
Width = 1485
End
Begin VB.CommandButton cmdQushAll
Caption = "全撤消"
Height = 420
Left = 120
TabIndex = 2
Top = 2988
Width = 1485
End
Begin VB.CommandButton cmdOK
Caption = "确 定(&O)"
Height = 420
Left = 120
TabIndex = 1
Top = 660
Width = 1485
End
End
Begin VB.Frame Frame2
Height = 570
Left = 30
TabIndex = 7
Top = 0
Width = 5724
Begin VB.TextBox txtCode
BackColor = &H80000004&
Height = 300
Left = 915
Locked = -1 'True
TabIndex = 9
Text = "txtCode"
Top = 180
Width = 1545
End
Begin VB.TextBox txtName
BackColor = &H80000004&
Height = 300
Left = 3450
Locked = -1 'True
TabIndex = 8
Text = "txtName"
Top = 180
Width = 1545
End
Begin VB.Label Label1
Caption = "人员代码："
Height = 225
Left = 45
TabIndex = 11
Top = 240
Width = 900
End
Begin VB.Label Label2
Caption = "人员名称："
Height = 225
Left = 2535
TabIndex = 10
Top = 255
Width = 900
End
End
Begin MSComctlLib.ImageList imglstMenu
Left = 150
Top = 100
_ExtentX = 804
_ExtentY = 804
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMenuRight.frx":27A2
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMenuRight.frx":2AF4
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMenuRight.frx":2E46
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMenuRight.frx":3398
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMenuRight.frx":37EC
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmMenuRight"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'***************************************************************
'使用P_Clerk表中的Tag6，Tag7，Tag8三个字段存储
'该人员的菜单权限
' PMX加入 1999.12.09
'***************************************************************
Public usMenuRight As String
Public usTktRight As String
Private mRet As VbMsgBoxResult '本模块的返回值
Private mCanModify As Boolean '标明是否权限可以更改
Private mCode As String '人员代码
Private mName As String '人员名称
Private Ini As Boolean '是否初始化，chkbaseinfor等空间使用
'***************************************************************
'本模块供外部使用的属性（开始）
Public Property Let usCanModify(ByVal v As Boolean)
mCanModify = v
End Property
Public Property Let usCode(ByVal v As String)
mCode = v
End Property
Public Property Let usName(ByVal v As String)
mName = v
End Property
Public Property Get usReturn() As VbMsgBoxResult
usReturn = mRet
End Property
'本模块供外部使用的属性（结束）
'***************************************************************
'***************************************************************
'本模块的私有方法（开始）
'增加一个节点
Private Sub AddNode(ByVal sCode As String, lID As Long, sText As String, ByVal SystemID As Long)
Dim sParent As String, tNode As node, nImg As Integer
If Trim(sText) <> "-" Then
sParent = FindParent(sCode)
nImg = 3
If InStr(usMenuRight, SplitOperator & sCode) > 0 Then nImg = 2
If InOneSystem(SystemID, Val(usTktRight)) Then
Set tNode = tvwMenu.Nodes.Add(sParent, tvwChild, "r" & sCode, _
sText, nImg)
tNode.Tag = lID
End If
End If
End Sub
'查找一个节点的父亲
Private Function FindParent(ByVal sCode As String)
Dim tNode As node, tLen As Integer, oldK As String
tLen = Len(sCode)
For Each tNode In tvwMenu.Nodes
oldK = tNode.Key
oldK = Right(oldK, Len(oldK) - 1)
If Len(oldK) < tLen And oldK = Left$(sCode, Len(oldK)) Then
FindParent = tNode.Key
End If
Next
End Function
'获取一个节点及其子节点的权限
Private Function GetRight(ByVal mNode As node) As String
Dim tNode As node, i As Integer
Set tNode = mNode
If tNode.Image = 3 Then
GetRight = ""
Else
If tNode.Children <= 0 Then
GetRight = Right(tNode.Key, Len(tNode.Key) - 1)
Else
GetRight = Right(tNode.Key, Len(tNode.Key) - 1)
Set mNode = tNode.Child
For i = 1 To tNode.Children
If tNode.Image = 2 And (mNode.Image = 2 Or mNode.Image = 3) Then GetRight = GetRight & SplitOperator & GetRight(mNode)
If mNode.Image = 4 Or mNode.Image = 5 Then
If i = 1 Then
GetRight = GetRight & SplitOperator1
End If
If mNode.Image = 5 Then
GetRight = GetRight & "0"
End If
If mNode.Image = 4 Then
GetRight = GetRight & "1"
End If
End If
Set mNode = mNode.Next
Next i
End If
End If
End Function
'初始化Form
Private Sub InitForm()
On Error GoTo Fail
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -