gdrightfrm.frm

本系统是一个报表分析查询系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{54FC599E-9611-11D2-8350-E97AACC90D73}#1.1#0"; "SpltrBar.ocx"
Begin VB.Form gdRightFrm 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Form1"
   ClientHeight    =   6555
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7545
   Icon            =   "gdRightFrm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6555
   ScaleWidth      =   7545
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.TreeView TreeRight 
      Height          =   5415
      Left            =   1920
      TabIndex        =   2
      Top             =   720
      Width           =   5295
      _ExtentX        =   9340
      _ExtentY        =   9551
      _Version        =   393217
      Style           =   7
      Checkboxes      =   -1  'True
      SingleSel       =   -1  'True
      ImageList       =   "ImgSource"
      BorderStyle     =   1
      Appearance      =   0
   End
   Begin SplitterBars.VSplitterBar Vsp 
      Height          =   5415
      Left            =   1680
      Top             =   720
      Width           =   30
      _ExtentX        =   53
      _ExtentY        =   9551
      BackColor       =   16744576
   End
   Begin MSComctlLib.TreeView TreeUser 
      Height          =   5295
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   9340
      _Version        =   393217
      Style           =   7
      SingleSel       =   -1  'True
      ImageList       =   "ImgSource"
      BorderStyle     =   1
      Appearance      =   0
   End
   Begin MSComctlLib.Toolbar TBar 
      Align           =   1  'Align Top
      Height          =   540
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7545
      _ExtentX        =   13309
      _ExtentY        =   953
      ButtonWidth     =   820
      ButtonHeight    =   953
      Style           =   1
      ImageList       =   "ImgSource"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   3
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "授权"
            Object.ToolTipText     =   "授权确认"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Object.ToolTipText     =   "退出授权操作"
            ImageIndex      =   7
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImgSource 
      Left            =   1800
      Top             =   3000
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   7
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":030A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":0624
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":093E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":1218
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":429A
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":4B74
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "gdRightFrm.frx":510E
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "gdRightFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim selUserID() As Long
Dim SelUser As Long

Private Sub Form_Load()
 FrmInit
 LoadFrm
 LoadUserDet
 LoadRight
End Sub

Private Sub FrmInit()
 With Me
  .Caption = "金软报表管理系统权限管理组件"
  .Width = Screen.Width * 0.9
  .Height = Screen.Height * 0.9
 End With
End Sub

Private Sub LoadFrm()
 With TreeUser
  .Top = TBar.Top + TBar.Height
  .Left = 0
  .Height = Me.ScaleHeight - .Top
  .Width = Me.ScaleWidth * 0.3
 End With
 With Vsp
  .Top = TreeUser.Top
  .Left = TreeUser.Left + TreeUser.Width
  .Height = TreeUser.Height
 End With
 With TreeRight
  .Top = Vsp.Top
  .Left = Vsp.Left + Vsp.Width
  .Height = Vsp.Height
  .Width = Me.ScaleWidth - Vsp.Width - TreeUser.Width
 End With
End Sub

Private Sub TBar_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Index
  Case 1
   SetRight
  Case 3
   Unload Me
 End Select
End Sub
Private Sub SetRight()
 Dim RightListColl As String
 If SelUser = 0 Then
  MsgBox "请选择用户", vbCritical + vbOKOnly, "金软提示"
  Exit Sub
 End If
 RightListColl = GetRightList()
 Dim Sql As String
 Dim DaCn As New ADODB.Connection
 Sql = "update Js_User set Js_RightList='" & RightListColl & "' where Js_UserID=" & SelUser
 DaCn.ConnectionString = myCls.BaseInfo.getConStr
 DaCn.Open
 DaCn.Execute Sql
 DaCn.Close
 Set DaCn = Nothing
 MsgBox "用户权限设置完成", vbInformation + vbOKOnly, "金软提示"
End Sub

Private Sub TreeUser_NodeClick(ByVal Node As MSComctlLib.Node)
 On Error GoTo ErrHandle
 SelUser = selUserID(Node.Index)
 SetOldRight
 Exit Sub
ErrHandle:
 SelUser = 0
End Sub

Private Sub TreeRight_NodeCheck(ByVal Node As MSComctlLib.Node)
 Dim iCount As Integer
 Dim iLoop As Integer
 Dim iStart As Integer
 iCount = Node.Children
 If iCount = 0 Then Exit Sub
 Node.Child.Checked = Node.Checked
 iStart = Node.Index + 1
 For iLoop = iStart To iStart + iCount - 1
  TreeRight.Nodes(iLoop).Checked = Node.Checked
 Next
End Sub

Private Function GetRightList() As String
 Dim NodeCount As Integer
 Dim chNodeCount As Integer
 Dim iLoop, jLoop As Integer
 Dim iRes As String
 NodeCount = TreeRight.Nodes.Count
 For iLoop = 1 To NodeCount
  chNodeCount = TreeRight.Nodes(iLoop).Children
  If chNodeCount = 0 Then
   If TreeRight.Nodes(iLoop).Checked = True Then
    iRes = iRes & "1"
   Else
    iRes = iRes & "0"
   End If
  End If
  DoEvents
 Next
 GetRightList = iRes
End Function

Private Sub SetOldRight()
 Dim OldRight As String
 Dim Sql As String
 Dim iByte As String
 Dim iLoop, jLoop As Integer
 Dim NodeCount, chNodeCount As Integer
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Sql = "select Js_RightList from Js_User where Js_UserID=" & SelUser
 DaCn.ConnectionString = myCls.BaseInfo.getConStr
 DaCn.Open
 Set DaRs = DaCn.Execute(Sql)
 If Not DaRs.EOF And Not IsNull(DaRs(0)) Then OldRight = Trim(DaRs(0))
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 '//
 OldRight = Trim(OldRight)
 NodeCount = TreeRight.Nodes.Count
 If OldRight = "" Then
  For iLoop = 1 To NodeCount
   chNodeCount = TreeRight.Nodes(iLoop).Children
    If chNodeCount = 0 Then
     TreeRight.Nodes(iLoop).Checked = False
    End If
  Next
 Else
  jLoop = 1
  For iLoop = 1 To NodeCount
   chNodeCount = TreeRight.Nodes(iLoop).Children
   If chNodeCount = 0 Then
    iByte = Mid(OldRight, jLoop, 1)
    If iByte = "1" Then
     TreeRight.Nodes(iLoop).Checked = True
    Else
     TreeRight.Nodes(iLoop).Checked = False
    End If
    jLoop = jLoop + 1
   End If
  Next
 End If
End Sub

Private Sub Vsp_EndMoving()
 With TreeUser
  .Width = Vsp.Left - TreeUser.Left
 End With
 With TreeRight
  .Left = Vsp.Left + Vsp.Width
  .Width = Me.ScaleWidth - Vsp.Width - TreeUser.Width
 End With
End Sub

'//装在用户列表
Private Sub LoadUserDet()
 Dim DeptID As Long
 Dim DepUserID As Long
 Dim iLoop As Integer
 Dim DeptName As String
 Dim DeptUserName As String
 Dim NodeItem As String
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim sbRs As New ADODB.Recordset
 Dim Sql As String
 Sql = "select Js_UserID,Js_UserName from Js_User  order by Js_UserName asc"
 DaCn.ConnectionString = myCls.BaseInfo.getConStr
 DaCn.Open
 Set DaRs = DaCn.Execute(Sql)
 iLoop = 0
 If Not DaRs.EOF Then
  While Not DaRs.EOF
   iLoop = iLoop + 1
   If Not IsNull(DaRs(0)) Then DepUserID = DaRs(0) Else DepUserID = 0
   If Not IsNull(DaRs(1)) Then DeptUserName = DaRs(1) Else DeptUserName = "金软科技"
   TreeUser.Nodes.Add , , "k" & DepUserID, DeptUserName, 1, 2
   ReDim Preserve selUserID(1 To iLoop)
   selUserID(iLoop) = DepUserID
   DaRs.MoveNext
   DoEvents
  Wend
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
End Sub

'//装载权限数据到列表
Private Sub LoadRight()
 Dim Quser As UserRightLists
 Dim Sql As String
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim iLoop As Integer
 Sql = "select fparkey,fnodetype,fkey,fdesc,fimg,fselimg,fdispose from Js_RightData  order by fpos asc"
 DaCn.ConnectionString = myCls.BaseInfo.getConStr
 DaCn.Open
 Set DaRs = DaCn.Execute(Sql)
 If Not DaRs.EOF Then
  While Not DaRs.EOF
   With Quser
    If Not IsNull(DaRs(0)) Then .fParKey = Trim(DaRs(0))
    If Not IsNull(DaRs(1)) Then .fNodeType = Trim(DaRs(1))
    If Not IsNull(DaRs(2)) Then .fKey = Trim(DaRs(2))
    If Not IsNull(DaRs(3)) Then .fDesc = Trim(DaRs(3))
    If Not IsNull(DaRs(4)) Then .fImg = Trim(DaRs(4))
    If Not IsNull(DaRs(5)) Then .fSelImg = Trim(DaRs(5))
    If Not IsNull(DaRs(6)) Then .fDisPose = Trim(DaRs(6))
    If .fDisPose = 0 Then
     TreeRight.Nodes.Add , , .fKey, .fDesc, .fImg, .fSelImg
    Else
     TreeRight.Nodes.Add .fParKey, tvwChild, .fKey, .fDesc, .fImg, .fSelImg
    End If
   End With
   DoEvents
   iLoop = iLoop + 1
   DaRs.MoveNext
  Wend
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
End Sub