📄 +
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Operator_Frm
BorderStyle = 3 'Fixed Dialog
Caption = "操作员权限设置"
ClientHeight = 5070
ClientLeft = 45
ClientTop = 330
ClientWidth = 7275
HelpContextID = 2212007
Icon = "基础设置_操作员权限设置.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5070
ScaleWidth = 7275
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Interval = 1
Left = 1410
Top = 4800
End
Begin VB.Frame Frame2
Height = 690
Left = 105
TabIndex = 10
Top = 60
Width = 7020
Begin MSComctlLib.ImageCombo ImgCbo_Ope
Height = 315
Left = 915
TabIndex = 11
Top = 240
Width = 5985
_ExtentX = 10557
_ExtentY = 556
_Version = 393216
ForeColor = -2147483640
BackColor = -2147483643
Text = "ImageCombo1"
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "操作员"
Height = 180
Left = 165
TabIndex = 12
Top = 285
Width = 540
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 540
Top = 4590
_ExtentX = 1005
_ExtentY = 1005
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 = "基础设置_操作员权限设置.frx":1042
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "基础设置_操作员权限设置.frx":13DC
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "基础设置_操作员权限设置.frx":1776
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "基础设置_操作员权限设置.frx":27C8
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "基础设置_操作员权限设置.frx":2C1A
Key = ""
EndProperty
EndProperty
End
Begin VB.CommandButton Cmd_Cancel
Caption = "取消(&C)"
Height = 300
Left = 6030
TabIndex = 8
Top = 4665
Width = 1120
End
Begin VB.CommandButton Cmd_Save
Caption = "保存(&S)"
Height = 300
Left = 4815
TabIndex = 7
Top = 4665
Width = 1120
End
Begin VB.CommandButton Cmd_All
Caption = "全选(&A)"
Height = 300
Left = 1320
TabIndex = 6
Top = 4665
Width = 1120
End
Begin VB.CommandButton Cmd_Qing
Caption = "全清(&L)"
Height = 300
Left = 105
TabIndex = 5
Top = 4665
Width = 1120
End
Begin VB.Frame Frame1
Caption = "操作员权限"
Height = 3765
Left = 90
TabIndex = 0
Top = 810
Width = 7065
Begin VB.PictureBox Pic
BorderStyle = 0 'None
Height = 2985
Left = 4980
ScaleHeight = 2985
ScaleWidth = 135
TabIndex = 9
Top = 720
Width = 135
End
Begin MSComctlLib.TreeView Tre_Dept
Height = 3105
Left = 2490
TabIndex = 2
Top = 540
Width = 4440
_ExtentX = 7832
_ExtentY = 5477
_Version = 393217
Indentation = 529
LabelEdit = 1
LineStyle = 1
Style = 7
Checkboxes = -1 'True
ImageList = "ImageList1"
Appearance = 1
End
Begin MSComctlLib.TreeView Tre_Sort
Height = 3105
Left = 120
TabIndex = 1
Top = 540
Width = 2280
_ExtentX = 4022
_ExtentY = 5477
_Version = 393217
Indentation = 529
LabelEdit = 1
LineStyle = 1
Style = 7
Checkboxes = -1 'True
ImageList = "ImageList1"
Appearance = 1
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "组织机构"
Height = 240
Left = 2490
TabIndex = 4
Top = 270
Width = 4440
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "工资类别"
Height = 240
Left = 120
TabIndex = 3
Top = 270
Width = 2280
End
End
End
Attribute VB_Name = "Operator_Frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'* 模 块 名 称 :操作员权限设置
'* 功 能 描 述 :设置操作员对部门的操作权限、对工资类别的操作权限
'* 程序员姓名 :田建秀
'* 最后修改人 :田建秀
'* 最后修改时间:2001/12/06
'* 备 注:
'*******************************************************
Option Explicit
Dim Rsc As New ADODB.Recordset
Dim Sql As String
Dim NodX As Node
Dim CzyBm As String
Dim I As Integer
Dim T1r As Single 'tre_sort的右边界
Dim T2r As Single 'tre_dept的右边界
Dim pw As Single
Dim CanMove As Boolean 'pic可移动否
Dim Str_RightEdit As String '编辑(新增、修改、删除)权限索引
Private Sub Cmd_All_Click()
With Tre_Sort
For I = 1 To .Nodes.Count
.Nodes(I).Checked = True
Next
End With
With Tre_Dept
For I = 1 To .Nodes.Count
.Nodes(I).Checked = True
Next
End With
End Sub
Private Sub Cmd_Cancel_Click()
Unload Me
End Sub
Private Sub Cmd_Qing_Click()
With Tre_Sort
For I = 1 To .Nodes.Count
.Nodes(I).Checked = False
Next
End With
With Tre_Dept
For I = 1 To .Nodes.Count
.Nodes(I).Checked = False
Next
End With
End Sub
Private Sub Cmd_Save_Click()
Dim SqlSort As String
Dim SqlDept As String
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
With Tre_Sort
For I = 1 To .Nodes.Count
If .Nodes(I).Checked = True Then
SqlSort = SqlSort & " insert Pm_OpeSort values('" & _
Trim(CzyBm) & "','" & _
Right(Trim(.Nodes(I).Key), Len(Trim(.Nodes(I).Key)) - 1) & "')"
End If
Next
End With
SqlSort = " delete pm_OpeSort where czybm='" & CzyBm & "'" & SqlSort
With Tre_Dept
For I = 1 To .Nodes.Count
If .Nodes(I).Checked = True Then
SqlDept = SqlDept & " insert Pm_OpeDept values('" & _
Trim(CzyBm) & "','" & _
Right(Trim(.Nodes(I).Key), Len(Trim(.Nodes(I).Key)) - 1) & "')"
End If
Next
End With
SqlDept = " delete pm_OpeDept where czybm='" & CzyBm & "'" & SqlDept
On Error GoTo Err1
Cw_DataEnvi.DataConnect.BeginTrans
Cw_DataEnvi.DataConnect.Execute SqlSort
Cw_DataEnvi.DataConnect.Execute SqlDept
Cw_DataEnvi.DataConnect.CommitTrans
Call Xtxxts("保存成功!", 0, 4)
Exit Sub
Err1:
Cw_DataEnvi.DataConnect.RollbackTrans
Call Xtxxts("保存不成功!", 0, 1)
End Sub
Private Sub Form_Load()
T2r = Tre_Dept.Left + Tre_Dept.Width
T1r = Tre_Sort.Left + Tre_Sort.Width
pw = Tre_Dept.Left - (Tre_Sort.Left + Tre_Sort.Width)
Pic.Move Tre_Sort.Left + Tre_Sort.Width, Tre_Sort.Top, pw, Tre_Sort.Height
Tre_Sort.Checkboxes = True
Tre_Dept.Checkboxes = True
Call FillImageCombo(ImgCbo_Ope, "PM_Operator", 0)
CzyBm = GetComboKey(ImgCbo_Ope, 0)
'填充工资类别树
If Rsc.State = 1 Then Rsc.Close
Sql = "select SortId,SortName from Pm_Sort order by SortId"
Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
With Tre_Sort
Do While Not Rsc.EOF
Set NodX = .Nodes.Add(, 4, "s" & Trim(Rsc!SortId), Trim(Rsc!SortName), 4)
Rsc.MoveNext
Loop
End With
'填充部门树
If Rsc.State = 1 Then Rsc.Close
Sql = "select * from Gy_Department where RsPmFlag=1 order by DeptCode"
Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
With Tre_Dept
Do While Not Rsc.EOF
If Trim(Rsc!ParentCode) & "" = "" Then '第一级
Set NodX = .Nodes.Add(, 4, "B" & Trim(Rsc!DeptCode), Trim(Rsc!DeptName), 5)
Else
Set NodX = .Nodes.Add("B" & Trim(Rsc!ParentCode), 4, "B" & Trim(Rsc!DeptCode), Trim(Rsc!DeptName), 3)
End If
Rsc.MoveNext
Loop
If Rsc.RecordCount <> 0 Then
NodX.EnsureVisible
End If
End With
With Tre_Dept
For I = 1 To .Nodes.Count
If .Nodes(I).Children = 0 Then
.Nodes(I).Image = 4
End If
Next
End With
Timer1.Enabled = True
'编辑(新增、修改、删除)权限索引
Str_RightEdit = "Pm_OpePope_edit"
End Sub
Private Sub PopeDom(CzyBm As String) '权限设置
'将操作员对部门、类别的权限显示出来。
Call Cmd_Qing_Click '将树中的全部选中清空
If Rsc.State = 1 Then Rsc.Close
Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from Pm_OpeSort where CzyBm='" & CzyBm & "' order by SortId")
With Tre_Sort
Do While Not Rsc.EOF
For I = 1 To .Nodes.Count
If Trim(Rsc!SortId) = Right(Trim(.Nodes(I).Key), Len(Trim(.Nodes(I).Key)) - 1) Then
.Nodes(I).Checked = True
Exit For
End If
Next
Rsc.MoveNext
Loop
End With
If Rsc.State = 1 Then Rsc.Close
Set Rsc = Cw_DataEnvi.DataConnect.Execute("select * from Pm_OpeDept where CzyBm='" & CzyBm & "' order by DeptCode")
With Tre_Dept
Do While Not Rsc.EOF
For I = 1 To .Nodes.Count
If Trim(Rsc!DeptCode) = Right(Trim(.Nodes(I).Key), Len(Trim(.Nodes(I).Key)) - 1) Then
.Nodes(I).Checked = True
Exit For
End If
Next
Rsc.MoveNext
Loop
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Rsc = Nothing
End Sub
Private Sub ImgCbo_Ope_Click()
CzyBm = GetComboKey(ImgCbo_Ope, 0)
Call PopeDom(CzyBm)
End Sub
Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
CanMove = True
End If
End Sub
Private Sub Pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CanMove = False
End Sub
Private Sub Timer1_Timer()
Call PopeDom(CzyBm)
Timer1.Enabled = False
End Sub
Private Sub Tre_Dept_NodeCheck(ByVal Node As MSComctlLib.Node)
With Tre_Dept
For I = Node.Index To .Nodes.Count
If InStr(Trim(.Nodes(I).Key), Trim(Node.Key)) = 1 Then
.Nodes(I).Checked = True
End If
Next
End With
End Sub
Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Pic.MousePointer = 9
If CanMove = False Then
Exit Sub
End If
T1r = Tre_Sort.Left + Tre_Sort.Width
If X < 0 And Tre_Sort.Width > 1000 Then
Tre_Sort.Move Tre_Sort.Left, Tre_Sort.Top, X + Tre_Sort.Width
Pic.Move Tre_Sort.Left + Tre_Sort.Width
Tre_Dept.Move Pic.Left + pw, Tre_Dept.Top, T2r - (Pic.Left + pw)
End If
If X > 0 And Tre_Dept.Width > 1000 Then
Tre_Dept.Move Pic.Left + X + pw, Tre_Sort.Top, T2r - (Pic.Left + pw + X)
Pic.Move Tre_Dept.Left - pw
Tre_Sort.Move Tre_Sort.Left, Tre_Sort.Top, Pic.Left - Tre_Sort.Left
End If
Label2.Move Tre_Sort.Left, Label2.Top, Tre_Sort.Width
Label3.Move Tre_Dept.Left, Label3.Top, Tre_Dept.Width
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -