VB开发的ERP系统

            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "tc"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
   Begin VB.Label Label1 
      Caption         =   "操作员:"
      Height          =   180
      Left            =   90
      TabIndex        =   3
      Top             =   720
      Width           =   720
   End
   Begin VB.Menu menuSelect 
      Caption         =   "menuSelect"
      Visible         =   0   'False
      Begin VB.Menu All 
         Caption         =   "全选"
         Shortcut        =   ^A
      End
      Begin VB.Menu fgf 
         Caption         =   "-"
      End
      Begin VB.Menu Cancel 
         Caption         =   "取消"
         Shortcut        =   ^Q
      End
   End
End
Attribute VB_Name = "Gy_WarehousePersonPower"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :仓库人员权限设置
'*    功 能 描 述 :
'*    程序员姓名  :徐强
'*    最后修改人  :徐强
'*    最后修改时间:2001/11/27
'*    备        注:
'*******************************************************
Option Explicit


Private Sub Cmb_Person_Click()
    ShowPower
End Sub

Private Sub Cmb_Person_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If JudgePerson Then
            ShowPower
            Cmb_Person.SelStart = 0
            Cmb_Person.SelLength = Len(Cmb_Person.Text)
        End If
    End If
End Sub

Private Sub Cmb_Person_LostFocus()
    If JudgePerson Then
        ShowPower
        Cmb_Person.SelStart = 0
        Cmb_Person.SelLength = Len(Cmb_Person.Text)
    End If
End Sub

Private Function JudgePerson() As Boolean   '判断操作员有效性
    Dim Czyrec As New ADODB.Recordset
    Dim Tsxx As String
    Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From Gy_czygl where czybm='" + Trim(Cmb_Person.Text) + "' or czymc='" & Trim(Cmb_Person.Text) & "' or rtrim(czybm)+'-'+rtrim(czymc)='" & Trim(Cmb_Person.Text) & "'")
    With Czyrec
        If Not .EOF Then
            Cmb_Person.Text = Trim(.Fields("czybm")) + "-" + Trim(.Fields("czymc"))
            JudgePerson = True
        Else
            Tsxx = "无此操作员!"
            Call Xtxxts(Tsxx, 0, 1)
            Cmb_Person.SetFocus
            JudgePerson = False
        End If
    End With
    Czyrec.Close
    Set Czyrec = Nothing
    
End Function



Private Sub Form_Activate()
    Cmb_Person.ListIndex = 0  '显示第一条记录，并调Cmb_Person_Click
End Sub

Private Sub Form_Load()
    LoadPerson
    LoadWarehouse
    
    TreeView.TabIndex = 0
    Cmb_Person.TabIndex = 1
End Sub

Private Sub LoadPerson()      '加载操作员
    Dim str_temp As String
    Dim Rec_Temp As New Recordset
    
    str_temp = "select czybm,czymc from Gy_Czygl order by czybm"
    Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(str_temp)
    Do While Not Rec_Temp.EOF
        Cmb_Person.AddItem Trim(Rec_Temp.Fields("czybm")) + "-" + Trim(Rec_Temp.Fields("czymc"))

        Rec_Temp.MoveNext
    Loop
End Sub

Private Sub LoadWarehouse()  '加载仓库
    Dim aDo_Sort As New Recordset
    Dim rs As New ADODB.Recordset
    Dim nodX As Node
    TreeView.Nodes.Clear
    TreeView.Nodes.Add , 4, "T", "仓库", "T"

    Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gy_warehouse order by whcode")
    
    With aDo_Sort
        Do While Not .EOF
            Set nodX = TreeView.Nodes.Add("T", 4, "T" & Trim(.Fields("whcode")), "(" & Trim(.Fields("whcode")) & ")" & Trim(.Fields("whName")), "C")
            nodX.Tag = "T" & Trim(!WhCode)

            .MoveNext
        Loop
    End With
    TreeView.Nodes(1).Expanded = True
End Sub
Private Sub ShowPower()  '显示权限
    Dim i As Long
    Dim rs As New ADODB.Recordset
    
    If Not JudgePerson Then Exit Sub
    
    Set rs = Cw_DataEnvi.DataConnect.Execute("select * from gy_v_warehousepower where czybm='" & Trim(Mid(Cmb_Person.Text, 1, InStr(1, Cmb_Person.Text & "-", "-") - 1)) & "'")
    For i = 1 To TreeView.Nodes.count           '先清除
        TreeView.Nodes.Item(i).Checked = False
    Next
    If Not rs.EOF Then                          '如有记录,选中根结点
        TreeView.Nodes.Item(1).Checked = True
    End If
    Do While Not rs.EOF                         '选中有权限的节点
        TreeView.Nodes.Item("T" & Trim(rs("whcode"))).Checked = True
        rs.MoveNext
    Loop
End Sub
Private Sub SavePower()   '存权限
    Dim SSql As String
    Dim i As Long
    Dim Tsxx  As String
On Error GoTo ErrMsg

    If Not JudgePerson Then Exit Sub
    
    Cw_DataEnvi.DataConnect.BeginTrans

    '删除此操作员以前的权限
    SSql = "delete from gy_whlimit where czybm='" & Trim(Mid(Cmb_Person.Text, 1, InStr(1, Cmb_Person.Text & "-", "-") - 1)) & "'"
    Cw_DataEnvi.DataConnect.Execute SSql
    '增加权限
    For i = 2 To TreeView.Nodes.count
        If TreeView.Nodes(i).Checked Then
            SSql = "insert into gy_whlimit (czybm,whcode) values('" & Trim(Mid(Cmb_Person.Text, 1, InStr(1, Cmb_Person.Text & "-", "-") - 1)) & " ','" & Right(TreeView.Nodes(i).Key, Len(TreeView.Nodes(i).Key) - 1) & "')"
            Cw_DataEnvi.DataConnect.Execute SSql
        End If
    Next
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Tsxx = "保存完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub
ErrMsg:
    Cw_DataEnvi.DataConnect.RollbackTrans
    
    Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim Tsxx As String
    Dim i As Long
    Dim SSql As String
    Select Case Button.Key
        Case "bc"      '保存
            SavePower
        Case "sx"      '刷新
            ShowPower
        Case "tc"      '退出
            Unload Me
    End Select
       
End Sub

Private Sub TreeView_NodeCheck(ByVal Node As MSComctlLib.Node)
    
    Dim i As Integer
    Dim ParentCode As String

    If Node.Key = "T" Then             '如选中根结点,则同时选中所有子节点;取消选中根结点,则同时取消选中所有子节点
        For i = 2 To TreeView.Nodes.count
            TreeView.Nodes.Item(i).Checked = Node.Checked
        Next
    Else
        If Node.Checked Then           '如果选中子节点,则同时选中父节点
            TreeView.Nodes(1).Checked = True
        Else
            TreeView.Nodes(1).Checked = False  '取消选中子节点,则同时取消选中父节点
            For i = 2 To TreeView.Nodes.count  '但如其它选中的子节点,则选中父节点
                If TreeView.Nodes.Item(i).Checked Then
                    TreeView.Nodes(1).Checked = True
                    Exit For
                End If
            Next
        End If
    End If

End Sub