📄 frmqxgl.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmQXGL
BorderStyle = 3 'Fixed Dialog
Caption = "权限管理"
ClientHeight = 5940
ClientLeft = 45
ClientTop = 330
ClientWidth = 7140
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5940
ScaleWidth = 7140
ShowInTaskbar = 0 'False
Begin VB.Frame Frame4
Height = 5760
Left = 5625
TabIndex = 7
Top = 90
Width = 1425
Begin VB.CommandButton cmdClose
Caption = "确 定"
Height = 405
Left = 165
TabIndex = 8
Top = 930
Width = 1080
End
End
Begin VB.Frame Frame1
Height = 765
Left = 120
TabIndex = 0
Top = 90
Width = 5535
Begin VB.TextBox txtUserName
BackColor = &H80000018&
CausesValidation= 0 'False
Enabled = 0 'False
Height = 315
IMEMode = 1 'ON
Left = 3780
TabIndex = 2
Top = 285
Width = 1590
End
Begin VB.TextBox txtUserID
BackColor = &H80000018&
Enabled = 0 'False
Height = 315
IMEMode = 3 'DISABLE
Left = 1065
Locked = -1 'True
MaxLength = 4
TabIndex = 1
Top = 270
Width = 1590
End
Begin VB.Label Label5
Caption = "用户代码"
ForeColor = &H00000000&
Height = 270
Left = 150
TabIndex = 4
Top = 315
Width = 810
End
Begin VB.Label Label8
Caption = "姓 名"
ForeColor = &H00000000&
Height = 270
Left = 2850
TabIndex = 3
Top = 315
Width = 810
End
End
Begin VB.Frame Frame2
Caption = "系统权限列表"
Height = 4935
Left = 120
TabIndex = 5
Top = 915
Width = 2565
Begin MSComctlLib.ListView lstCdlb
Height = 4530
Left = 90
TabIndex = 9
Top = 210
Width = 2385
_ExtentX = 4207
_ExtentY = 7990
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
Icons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483624
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin VB.Frame Frame3
Caption = "用户已拥有权限"
Height = 4935
Left = 2655
TabIndex = 6
Top = 915
Width = 3000
Begin MSComctlLib.ListView lstQxlb
Height = 4530
Left = 90
TabIndex = 10
Top = 210
Width = 2805
_ExtentX = 4948
_ExtentY = 7990
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
Icons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483624
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 12
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":005E
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":00BC
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":011A
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":0178
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":01D6
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":0234
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":0292
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":02F0
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":034E
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":03AC
Key = ""
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQXGL.frx":040A
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmQXGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim rs As New ADODB.Recordset
Dim strMSG As String
On Error GoTo errform
' If sFileSkin <> "" Then
' Skin1.LoadSkin sFileSkin
' Skin1.ApplySkin hwnd
' Else
' Skin1.ApplySkin hwnd
' End If
If Me.WindowState = 0 Then Me.Move 0, 0
txtUserID.Text = frmUser.txtUserID.Text
If rs.State = 1 Then rs.Close
rs.Open "select 菜单名称_C as 菜单名称,菜单名称_E from cdlb where 菜单名称_C not in (select 菜单名称_C from qxlb where 用户代码='" & txtUserID.Text & "') order by 菜单名称_C", gCnn, adOpenStatic, adLockReadOnly
strMSG = ShowListView(lstCdlb, rs, False, "2000,0")
If strMSG <> "0" Then MsgBox strMSG, vbCritical, "系统提示"
If rs.State = 1 Then rs.Close
rs.Open "select 菜单名称_C as 菜单名称,用户代码,id from QXLB where 用户代码='" & txtUserID.Text & "' order by 菜单名称_C", gCnn, adOpenStatic, adLockReadOnly
' If rs.RecordCount < 1 Then: Exit Sub
strMSG = ShowListView(lstQxlb, rs, False, "2400,0,0")
If strMSG <> "0" Then MsgBox strMSG, vbCritical, "系统提示"
Set rs = Nothing
Exit Sub
errform:
MsgBox "初始化菜单权限错误，请关闭本窗体后重新设置！", vbInformation, "系统提示"
MsgBox Err.Description, vbCritical, "系统提示"
Set rs = Nothing
End Sub
Private Sub lstCdlb_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If lstCdlb.Sorted And ColumnHeader.Index - 1 = lstCdlb.SortKey Then
lstCdlb.SortOrder = lvwDescending
Else
lstCdlb.SortOrder = lvwAscending
lstCdlb.SortKey = ColumnHeader.Index - 1
End If
' lstCard.SortOrder = 1 - lstCard.SortOrder
lstCdlb.Sorted = True
End Sub
Private Sub lstCdlb_DblClick()
Dim i As Integer
If lstCdlb.ListItems.count < 1 Then: Exit Sub
For i = 1 To lstCdlb.ListItems.count
If lstCdlb.ListItems(i).Selected Then
gCnn.Execute "insert qxlb(菜单名称_C,菜单名称_E,用户代码) VALUES('" & Trim(lstCdlb.ListItems(i).Text) & "','" & Trim(lstCdlb.ListItems(i).ListSubItems.Item(1)) & "','" & txtUserID.Text & "')"
' lstCdlb.ListItems.Remove i
Exit For
End If
Next
Call Form_Load
Exit Sub
End Sub
Private Sub lstQxlb_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If lstQxlb.Sorted And ColumnHeader.Index - 1 = lstQxlb.SortKey Then
lstQxlb.SortOrder = lvwDescending
Else
lstQxlb.SortOrder = lvwAscending
lstQxlb.SortKey = ColumnHeader.Index - 1
End If
' lstCard.SortOrder = 1 - lstCard.SortOrder
lstQxlb.Sorted = True
End Sub
Private Sub lstQxlb_DblClick()
Dim i As Integer
If lstQxlb.ListItems.count < 1 Then: Exit Sub
For i = 1 To lstQxlb.ListItems.count
If lstQxlb.ListItems(i).Selected Then
gCnn.Execute "delete QXLB where id='" & Trim(lstQxlb.ListItems(i).ListSubItems.Item(2)) & "'"
' lstQxlb.ListItems(i).ListSubItems.Remove
Exit For
End If
Next
Call Form_Load
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -