企业管理

开发平台：
Visual Basic

+：源码内容
							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

						