mdlopuser.bas

VB数据库设计的代码。需要根据自己的数据库再作调整

Attribute VB_Name = "mdlOpUser"
Option Explicit

Private Const RANK1 = "总经理"
Private Const RANK2 = "公司管理层"
Private Const RANK3 = "公司库管"
Private Const RANK4 = "连锁店操作员"

'***********************************************************************
'* 过程名：IniListViewInOpUser
'* 功  能：以操作人员列表初始化ListView
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Public Sub IniListViewInOpUser(ByRef lvListViewCtl As ListView)
    If g_listViewState = USERLIST Then
        UpdateListViewInOpUser lvListViewCtl
    Else
        '变量定义
        Dim userSet As clsUserSet
        Dim opUser As clsOpuser
        Dim curListItem As ListItem
        Dim rankName As String
        
        '取得操作员集合
        Set userSet = New clsUserSet
        userSet.LoadSet g_currentUser
        
        '清除现有显示
        lvListViewCtl.ColumnHeaders.Clear
        lvListViewCtl.ListItems.Clear
        
        '设定表头
        lvListViewCtl.ColumnHeaders.Add , "登录名", "登录名"
        lvListViewCtl.ColumnHeaders.Add , "权限级别", "权限级别"
        lvListViewCtl.ColumnHeaders.Add , "所属连锁店", "所属连锁店"
        
        '明细显示
        For Each opUser In userSet
            Set curListItem = lvListViewCtl.ListItems.Add(, , opUser.userName)
            Select Case opUser.userRank
            Case 1
                rankName = RANK1
            Case 2
                rankName = RANK2
            Case 3
                rankName = RANK3
            Case 4
                rankName = RANK4
            End Select
            curListItem.SubItems(1) = rankName
            curListItem.SubItems(2) = opUser.shopName
        Next
    End If
    g_listViewState = USERLIST
    
End Sub

'***********************************************************************
'* 过程名：UpdateListViewInOpUser
'* 功  能：更新操作人员列表
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Public Sub UpdateListViewInOpUser(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim userSet As clsUserSet
    Dim opUser As clsOpuser
    Dim curListItem As ListItem
    Dim rankName As String
    Dim iLoop As Integer
    
    '取得操作员集合
    Set userSet = New clsUserSet
    userSet.LoadSet g_currentUser
    
    '明细更新
    For Each opUser In userSet
        For iLoop = 1 To lvListViewCtl.ListItems.Count
            If opUser.userName = lvListViewCtl.ListItems.Item(iLoop).Text Then
                GoTo CHECKAGAIN
            End If
        Next
        
        Set curListItem = lvListViewCtl.ListItems.Add(, , opUser.userName)
        Select Case opUser.userRank
        Case 1
            rankName = RANK1
        Case 2
            rankName = RANK2
        Case 3
            rankName = RANK3
        Case 4
            rankName = RANK4
        End Select
        curListItem.SubItems(1) = rankName
        curListItem.SubItems(2) = opUser.shopName
CHECKAGAIN:
    Next
End Sub

'***********************************************************************
'* 过程名：RemoveOpUser
'* 功  能：删除操作人员
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Public Sub RemoveOpUser(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim opUserName As String    '操作员名
    Dim opUser As clsOpuser     '操作员
    Dim opUserObj As clsOpUserInfo '操作员对象
    
    If Not lvListViewCtl.SelectedItem Is Nothing Then
        opUserName = lvListViewCtl.SelectedItem.Text
        If MsgBox("删除操作员[" & opUserName & "]吗？", vbQuestion Or _
                vbYesNo, "询问") = vbYes Then
            Set opUser = New clsOpuser
            If opUser.LoadByUserName(opUserName) = DbOpRecExist Then
                Set opUserObj = New clsOpUserInfo
                If opUserObj.RemoveUser(opUser, g_currentUser) Then
                    lvListViewCtl.ListItems.Remove lvListViewCtl.SelectedItem.Index
                    Exit Sub
                End If
            End If
            MsgBox "删除操作员失败！", vbExclamation Or vbOKOnly, "警告"
        End If
    Else
        MsgBox "请先选择要删除的操作员！", vbExclamation Or vbOKOnly, "警告"
    End If
End Sub

'***********************************************************************
'* 过程名：EditOpUser
'* 功  能：编辑操作人员
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Public Sub EditOpUser(ByRef lvListViewCtl As ListView)
    '变量定义
    Dim currentSelUserName As String    '当前选择用户登录名
    Dim currentSelUser As clsOpuser     '当前选择用户
    Dim opUserInfo As clsOpUserInfo     '用户信息操作对象
    
    '取得当前选择
    If lvListViewCtl.SelectedItem Is Nothing Then
         MsgBox "请选择要编辑的操作员！", vbExclamation Or vbOKOnly, "警告"
    Else
        currentSelUserName = Trim(lvListViewCtl.SelectedItem.Text)
        Set currentSelUser = New clsOpuser
        If currentSelUser.LoadByUserName(currentSelUserName) = DbOpRecExist Then
            Set opUserInfo = New clsOpUserInfo
            opUserInfo.EditUser currentSelUser, g_currentUser
            lvListViewCtl.ListItems.Remove lvListViewCtl.SelectedItem.Index
            UpdateListViewInOpUser lvListViewCtl
        Else
            MsgBox "读取操作员信息失败！", vbExclamation Or vbOKOnly, "警告"
        End If
    End If
End Sub

'***********************************************************************
'* 过程名：AppendNewUser
'* 功  能：追加操作人员
'* 参  数：ListView                 列表控件
'* 版  本：2006.01.02 颜志军 初版
'***********************************************************************
Public Sub AppendNewUser(ByRef lvListViewCtl As ListView)
    Dim opUser As clsOpUserInfo
    Set opUser = New clsOpUserInfo
    opUser.AppendNewUser g_currentUser
    UpdateListViewInOpUser lvListViewCtl
End Sub