📄 frmauthoritygrp.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmAuthorityGrp
BorderStyle = 3 'Fixed Dialog
Caption = "权限组"
ClientHeight = 4485
ClientLeft = 1050
ClientTop = 1650
ClientWidth = 7440
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmAuthorityGrp.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4485
ScaleWidth = 7440
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton CmdRight
Caption = "删除权限组"
Height = 350
Index = 2
Left = 2580
TabIndex = 12
Top = 4080
UseMaskColor = -1 'True
Width = 1250
End
Begin VB.CommandButton CmdRight
Caption = "新增权限组"
Height = 350
Index = 1
Left = 1320
TabIndex = 11
Top = 4080
UseMaskColor = -1 'True
Width = 1250
End
Begin VB.CommandButton CmdRight
Caption = "重命名权限组"
Height = 350
Index = 0
Left = 60
TabIndex = 10
Top = 4080
UseMaskColor = -1 'True
Width = 1250
End
Begin VB.Frame Frame3
Caption = "权限作用范围"
Height = 1005
Left = 2415
TabIndex = 15
Top = 2745
Visible = 0 'False
Width = 4800
Begin VB.OptionButton optRange
Caption = "本 人"
Height = 180
Index = 0
Left = 210
TabIndex = 9
Top = 450
Value = -1 'True
Width = 1200
End
Begin VB.OptionButton optRange
Caption = "同组操作员"
Height = 180
Index = 1
Left = 1785
TabIndex = 17
Top = 450
Width = 1200
End
Begin VB.OptionButton optRange
Caption = "全体操作员"
Height = 180
Index = 2
Left = 3255
TabIndex = 16
Top = 450
Width = 1200
End
End
Begin VB.CommandButton cmdSel
Caption = "<<"
Height = 336
Index = 3
Left = 4515
MaskColor = &H00000000&
TabIndex = 6
Top = 3414
Width = 576
End
Begin VB.CommandButton cmdSel
Caption = "<"
Height = 336
Index = 2
Left = 4515
MaskColor = &H00000000&
TabIndex = 5
Top = 2486
Width = 576
End
Begin VB.CommandButton cmdSel
Caption = ">>"
Height = 336
Index = 1
Left = 4515
MaskColor = &H00000000&
TabIndex = 4
Top = 1558
Width = 576
End
Begin VB.CommandButton cmdSel
Caption = ">"
Height = 336
Index = 0
Left = 4515
MaskColor = &H00000000&
TabIndex = 3
Top = 630
Width = 576
End
Begin VB.ListBox lstAll
Height = 3120
ItemData = "frmAuthorityGrp.frx":0442
Left = 2415
List = "frmAuthorityGrp.frx":0444
TabIndex = 2
Top = 630
Width = 1935
End
Begin VB.ListBox lstSelected
Height = 3120
ItemData = "frmAuthorityGrp.frx":0446
Left = 5250
List = "frmAuthorityGrp.frx":0448
TabIndex = 8
Top = 630
Width = 1935
End
Begin ComctlLib.TreeView treModule
Height = 3180
Left = 210
TabIndex = 0
Top = 630
Width = 1770
_ExtentX = 3122
_ExtentY = 5609
_Version = 327682
Indentation = 176
LabelEdit = 1
LineStyle = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
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.Label lblAuther
Caption = "权限选择"
Height = 225
Index = 1
Left = 2310
TabIndex = 14
Top = 105
Width = 750
End
Begin VB.Label lblAuther
Caption = "权限组"
Height = 225
Index = 0
Left = 210
TabIndex = 13
Top = 105
Width = 540
End
Begin VB.Label lblAll
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000004&
Caption = "可选权限(&A)"
ForeColor = &H80000008&
Height = 180
Left = 2415
TabIndex = 1
Tag = "2406"
Top = 420
Width = 990
End
Begin VB.Label lblSelected
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000004&
Caption = "已选权限(&S)"
ForeColor = &H80000008&
Height = 180
Left = 5250
TabIndex = 7
Tag = "2407"
Top = 420
Width = 990
End
Begin ComctlLib.ImageList ImageList1
Left = 5130
Top = 4020
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 13
ImageHeight = 13
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 4
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmAuthorityGrp.frx":044A
Key = "Close"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmAuthorityGrp.frx":0544
Key = "Leaf"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmAuthorityGrp.frx":063E
Key = "Open"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmAuthorityGrp.frx":0738
Key = "Sele"
EndProperty
EndProperty
End
Begin VB.Menu mnuAuthority
Caption = "mnuAuthority"
Visible = 0 'False
Begin VB.Menu mnuAuthorityAdd
Caption = "新增权限组(&N)"
End
Begin VB.Menu mnuAuthorityEdit
Caption = "修改权限组(&E)"
End
Begin VB.Menu mnuAuthorityDelete
Caption = "删除权限组(&D) "
Shortcut = ^D
End
End
End
Attribute VB_Name = "frmAuthorityGrp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'权限组模块
' 作者：欧中建
' 日期：1998.6.10
'设置每一个操作员拥有的权限属于哪一个权限组
'（因为 权限被分为许多个组）
Option Explicit
Private Type RightInfo
RightID As Long
RightName As String
Range As Boolean
RightRange As Byte
inSelected As Boolean 'TRUE--初始时在本权限组中
fiSelected As Boolean 'TRUE--终止时在本权限组中
End Type
Private mblnInDrag As Boolean
Private mblnIsChanged As Boolean
Private mlngGroupID As Long
Private maryRight() As RightInfo '当前模块所有的权限
Private Sub cmdSel_Click(Index As Integer)
Dim i As Integer
Select Case Index
Case 0
If lstAll.ListIndex = -1 Then Exit Sub
i = lstAll.ListIndex
lstSelected.AddItem lstAll.list(i)
lstSelected.ItemData(lstSelected.NewIndex) = lstAll.ItemData(i)
maryRight(lstSelected.ItemData(lstSelected.NewIndex)).fiSelected = True
lstAll.RemoveItem i
If lstAll.ListCount > 0 Then
lstAll.ListIndex = lstAll.ListIndex + 1
End If
Case 1
For i = 0 To lstAll.ListCount - 1
lstSelected.AddItem lstAll.list(i)
lstSelected.ItemData(lstSelected.NewIndex) = lstAll.ItemData(i)
maryRight(lstSelected.ItemData(lstSelected.NewIndex)).fiSelected = True
Next
lstAll.Clear
lstSelected.ListIndex = 0
Case 2
If lstSelected.ListIndex = -1 Then Exit Sub
i = lstSelected.ListIndex
lstAll.AddItem lstSelected.list(i)
lstAll.ItemData(lstAll.NewIndex) = lstSelected.ItemData(i)
maryRight(lstAll.ItemData(lstAll.NewIndex)).fiSelected = False
lstSelected.RemoveItem i
If lstSelected.ListCount > 0 Then
lstSelected.ListIndex = lstSelected.ListIndex + 1
Else
Frame3.Visible = False
lstAll.Height = 3390
lstSelected.Height = lstAll.Height
cmdSel(1).top = 1530
cmdSel(2).top = 2430
cmdSel(3).top = 3330
End If
lstAll.ListIndex = lstAll.NewIndex
Case 3
For i = 0 To lstSelected.ListCount - 1
lstAll.AddItem lstSelected.list(i)
lstAll.ItemData(lstAll.NewIndex) = lstSelected.ItemData(i)
maryRight(lstAll.ItemData(lstAll.NewIndex)).fiSelected = False
Next
lstSelected.Clear
Frame3.Visible = False
lstAll.Height = 3390
lstSelected.Height = lstAll.Height
cmdSel(1).top = 1530
cmdSel(2).top = 2430
cmdSel(3).top = 3330
lstAll.ListIndex = lstAll.NewIndex
End Select
mblnIsChanged = True
RefreshButton
End Sub
Private Sub cmdRight_Click(Index As Integer)
Dim nodRG As Node
Dim recOperator As Recordset, Strsql As String
If treModule.SelectedItem Is Nothing Then Exit Sub
Set nodRG = treModule.SelectedItem
If Index = 2 Then
If Left$(nodRG.Key, 1) <> "C" Then Exit Sub
' If Mid$(nodRG.Key, 2) < "11" Then
' ShowMsg hwnd, "“ " & nodRG.Text & "”是 Manager使用权限组,不能删除!", _
' vbExclamation, "删除权限组"
' Exit Sub
' End If
Strsql = "SELECT * FROM OperatorRight WHERE lngRightGroupID=" _
& Mid$(nodRG.Key, 2)
Set recOperator = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenForwardOnly)
If Not recOperator.EOF Then
ShowMsg hwnd, "权限组“ " & nodRG.Text & "”已经分配给用户,不能删除!", _
vbExclamation, "删除权限组"
recOperator.Close
Exit Sub
End If
recOperator.Close
If ShowMsg(hwnd, "您确实要删除权限组“" & nodRG.Text & "”?", _
vbYesNo + vbQuestion, "删除权限组") _
= vbNo Then Exit Sub
Strsql = "DELETE FROM RightGroup WHERE lngRightGroupID=" & Mid$(nodRG.Key, 2)
gclsBase.BaseDB.Execute Strsql
treModule.Nodes.Remove nodRG.Key
ElseIf Index = 0 Then
treModule.StartLabelEdit
Else
If Left$(nodRG.Key, 1) <> "R" Then Exit Sub
treModule.Nodes.Add nodRG.Key, tvwChild, "CNewNode", "NewRight", _
"Leaf", "Sele"
Set treModule.SelectedItem = treModule.Nodes("CNewNode")
treModule.StartLabelEdit
SendKeys "{DEL}"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -