frmuserinfo.frm

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

VERSION 5.00
Begin VB.Form frmUserInfo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "操作员信息"
   ClientHeight    =   2745
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3930
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   3930
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdCancle 
      Caption         =   "放弃"
      Height          =   375
      Left            =   2438
      TabIndex        =   9
      Top             =   2160
      Width           =   975
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   375
      Left            =   518
      TabIndex        =   8
      Top             =   2160
      Width           =   975
   End
   Begin VB.ComboBox cmbShop 
      Height          =   300
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   1440
      Width           =   2535
   End
   Begin VB.ComboBox cmbUserRank 
      Height          =   300
      ItemData        =   "frmUserInfo.frx":0000
      Left            =   1080
      List            =   "frmUserInfo.frx":0010
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   1020
      Width           =   2535
   End
   Begin VB.TextBox txtUserPwd 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1080
      MaxLength       =   15
      PasswordChar    =   "*"
      TabIndex        =   5
      Text            =   "txtUserPwd"
      Top             =   630
      Width           =   2535
   End
   Begin VB.TextBox txtUserName 
      Height          =   270
      Left            =   1080
      MaxLength       =   15
      TabIndex        =   4
      Text            =   "txtUserName"
      Top             =   240
      Width           =   2535
   End
   Begin VB.Label lblErrorInfo 
      Caption         =   "lblErrorInfo"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   1800
      Width           =   3495
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "连 锁 店"
      Height          =   180
      Left            =   240
      TabIndex        =   3
      Top             =   1500
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "权限级别"
      Height          =   180
      Left            =   240
      TabIndex        =   2
      Top             =   1080
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "密    码"
      Height          =   180
      Left            =   240
      TabIndex        =   1
      Top             =   675
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "登 录 名"
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   285
      Width           =   720
   End
End
Attribute VB_Name = "frmUserInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'模块变量
Private m_User As clsOpuser             '操作员信息
Private m_OpModiFlag As Boolean         '修改操作员操作标志
Private m_CurrentUser As clsOpuser      '当前操作用户

'***********************************************************************
'* 过程名：DspUserInfo
'* 功  能：显示操作员信息
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub DspUserInfo()
    '变量定义
    Dim iLoop As Integer                '循环变量
    Dim rankInList As Integer           '下拉框中级别
    
    '级别选择框初始化
    Select Case m_CurrentUser.userRank
    Case 1 '总经理
        '所有级别均可设定
    Case 2  '管理层
        cmbUserRank.RemoveItem 0    '删除总经理权限
    Case 3  '库管
        cmbUserRank.RemoveItem 0    '删除总经理权限
        cmbUserRank.RemoveItem 0    '删除管理层权限
        cmbUserRank.Enabled = False
    Case 4  '店操作员
        cmbUserRank.RemoveItem 0    '删除总经理权限
        cmbUserRank.RemoveItem 0    '删除管理层权限
        cmbUserRank.RemoveItem 0    '删除库管权限
        cmbUserRank.Enabled = False
    End Select
    
    '显示操作员信息
    If m_OpModiFlag Then
        '登录名
        txtUserName.Text = m_User.userName
        txtUserName.Enabled = False
        '登录密码
        txtUserPwd.Text = m_User.userPwd
        '权限级别
        For iLoop = 0 To cmbUserRank.ListCount - 1
            If cmbUserRank.ItemData(iLoop) = m_User.userRank Then
                Exit For
            End If
        Next
        cmbUserRank.ListIndex = iLoop
        
        '连锁店
        For iLoop = 0 To cmbShop.ListCount - 1
            If cmbShop.ItemData(iLoop) = m_User.shopId Then
                Exit For
            End If
        Next
        cmbShop.ListIndex = iLoop
        '连锁店下拉框可用状态
        If m_CurrentUser.userRank >= 3 Then
            cmbShop.Enabled = False
        End If
    Else
        txtUserName.Text = ""
        txtUserPwd.Text = ""
        cmbUserRank.ListIndex = cmbUserRank.ListCount - 1
        If cmbShop.ListCount > 0 Then
            cmbShop.ListIndex = cmbShop.ListCount - 1
        End If
    End If
    
    lblErrorInfo.Caption = ""
End Sub

'***********************************************************************
'* 过程名：ShowDlg
'* 功  能：显示操作员信息对话框
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Public Sub ShowDlg(ByRef opUser As clsOpuser, ByVal opFlag As Boolean, _
        ByVal currentUser As clsOpuser)
    Set m_User = opUser
    Set m_CurrentUser = currentUser
    m_OpModiFlag = opFlag
    DspUserInfo
    Me.Show vbModal
End Sub

'***********************************************************************
'* 过程名：cmdCancle_Click
'* 功  能：放弃按钮单击事件响应
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub cmdCancle_Click()
    Unload Me
End Sub

'***********************************************************************
'* 过程名：cmdOk_Click
'* 功  能：确认按钮单击事件响应
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub cmdOK_Click()
    '更新登录对象
    If Not UpdateObject() Then
        Exit Sub
    End If
    
    '变量定义
    Dim DbOpResult As DbOpResult
    
    '执行操作
    If m_OpModiFlag Then    '修改
        DbOpResult = m_User.Update()
    Else                    '追加
        If m_CurrentUser.userRank >= m_User.userRank Then
            lblErrorInfo = "不能追加与自己平级或更高级别的用户！"
            Exit Sub
        Else
            DbOpResult = m_User.AppendNew()
        End If
    End If
    
    '检查结果
    Select Case DbOpResult
    Case DbOpNG
        lblErrorInfo = "数据库操作失败！"
    Case DbOpRecExist
        lblErrorInfo = "登录名已存在！"
    Case DbOpRecNoExist
        lblErrorInfo = "登录名不存在！"
    Case DbOpOk
        Unload Me
    End Select
End Sub

'***********************************************************************
'* 函数名：UpdateObject
'* 功  能：更新设定信息到操作员对象
'* 参  数：
'* 返回值：Boolean
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Function UpdateObject() As Boolean
    If CheckInput() Then
        m_User.userName = Trim(txtUserName.Text)
        m_User.userPwd = Trim(txtUserPwd.Text)
        m_User.userRank = cmbUserRank.ItemData(cmbUserRank.ListIndex)
        If m_User.userRank >= 4 And cmbShop.ListCount > 0 Then
            m_User.shopId = cmbShop.ItemData(cmbShop.ListIndex)
        Else
            m_User.shopId = 1
        End If
        UpdateObject = True
    Else
        UpdateObject = False
    End If
End Function

'***********************************************************************
'* 函数名：CheckInput
'* 功  能：检查输入信息
'* 参  数：
'* 返回值：Boolean                  True 通过 False 未通过
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Function CheckInput() As Boolean
    CheckInput = False
    If IsEmpty(Trim(txtUserName.Text)) Or Trim(txtUserName.Text) = "" Then
        lblErrorInfo.Caption = "必须输入登录名！"
        Exit Function
    ElseIf IsEmpty(Trim(txtUserPwd.Text)) Or Trim(txtUserPwd.Text) = "" Then
        lblErrorInfo.Caption = "必须输入密码！"
        Exit Function
    ElseIf IsEmpty(Trim(cmbUserRank.Text)) Or Trim(cmbUserRank.Text) = "" Then
        lblErrorInfo.Caption = "请选择用户级别！"
        Exit Function
    ElseIf cmbUserRank.ItemData(cmbUserRank.ListIndex) >= 4 And _
            (IsEmpty(Trim(cmbShop.Text)) Or Trim(cmbShop.Text) = "") Then
        lblErrorInfo.Caption = "请选择连锁店！"
        Exit Function
    End If
    CheckInput = True
End Function

'***********************************************************************
'* 函数名：IniComboxShop
'* 功  能：初始化连锁店选择框
'* 参  数：
'* 版  本：2006.01.02 颜志军 初版
'***********************************************************************
Private Sub IniComboxShop()
    '变量定义
    Dim memShop As clsMembershop
    Dim shopSet As clsMembershopSet
    Dim index As Integer
    
    Set shopSet = New clsMembershopSet
    
    index = 0
    For Each memShop In shopSet
        cmbShop.AddItem memShop.shopName, index
        cmbShop.ItemData(index) = memShop.shopId
        index = index + 1
    Next
End Sub

'***********************************************************************
'* 过程名：Form_Load
'* 功  能：窗体LOAD事件响应
'* 参  数：
'* 版  本：2006.01.02 颜志军 初版
'***********************************************************************
Private Sub Form_Load()
    IniComboxShop
End Sub