frmuser.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

VERSION 5.00
Begin VB.Form frmUser 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户管理"
   ClientHeight    =   3210
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4575
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   3210
   ScaleWidth      =   4575
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame FrameBG 
      Height          =   3330
      Left            =   0
      TabIndex        =   7
      Top             =   -120
      Width           =   4575
      Begin VB.TextBox txt 
         Height          =   270
         Index           =   3
         Left            =   1320
         MaxLength       =   5
         TabIndex        =   3
         Top             =   1815
         Width           =   2715
      End
      Begin VB.CommandButton cmdCancel 
         Cancel          =   -1  'True
         Caption         =   "取消(&C)"
         Height          =   375
         Left            =   2925
         TabIndex        =   6
         Top             =   2730
         Width           =   1080
      End
      Begin VB.CommandButton cmdUser 
         Caption         =   "添加(&A)"
         Default         =   -1  'True
         Height          =   375
         Left            =   1620
         TabIndex        =   5
         Top             =   2730
         Width           =   1080
      End
      Begin VB.ComboBox cbo 
         Height          =   300
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   2175
         Width           =   2715
      End
      Begin VB.TextBox txt 
         Height          =   270
         IMEMode         =   3  'DISABLE
         Index           =   2
         Left            =   1320
         MaxLength       =   50
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   1455
         Width           =   2715
      End
      Begin VB.TextBox txt 
         Height          =   270
         IMEMode         =   3  'DISABLE
         Index           =   1
         Left            =   1320
         MaxLength       =   50
         PasswordChar    =   "*"
         TabIndex        =   1
         Top             =   1095
         Width           =   2715
      End
      Begin VB.TextBox txt 
         Height          =   270
         Index           =   0
         Left            =   1320
         MaxLength       =   50
         TabIndex        =   0
         Top             =   735
         Width           =   2715
      End
      Begin VB.PictureBox picTitle 
         Appearance      =   0  'Flat
         BackColor       =   &H00808080&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   360
         Left            =   30
         ScaleHeight     =   360
         ScaleWidth      =   4515
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   120
         Width           =   4515
         Begin VB.Label lblTitle 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "添加用户"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00FFFFFF&
            Height          =   210
            Left            =   255
            TabIndex        =   9
            Top             =   90
            Width           =   900
         End
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         Caption         =   "真实姓名"
         Height          =   180
         Left            =   465
         TabIndex        =   14
         Top             =   1875
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "用户类型"
         Height          =   180
         Left            =   465
         TabIndex        =   13
         Top             =   2235
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "确认密码"
         Height          =   180
         Left            =   465
         TabIndex        =   12
         Top             =   1515
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "密码"
         Height          =   180
         Left            =   465
         TabIndex        =   11
         Top             =   1155
         Width           =   360
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "用户名"
         Height          =   180
         Left            =   465
         TabIndex        =   10
         Top             =   780
         Width           =   540
      End
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim User As clsUser     '用户对象

Private Sub cmdCancel_Click()
  Unload Me
End Sub

'验证用户输入的有效性
Private Function IsOK() As Boolean
  '必须填写所有项目
  If txt(0) = "" Or txt(1) = "" Or txt(2) = "" Or txt(3) = "" Then
     MsgBox "请把所有项目填写完整！", vbInformation
     If txt(0).Enabled = True Then
        txt(0).SetFocus
     Else
        txt(1).SetFocus
     End If
     Exit Function
  End If
  
  '两次输入的密码必须匹配
  If txt(1) <> txt(2) Then
     MsgBox "两次输入的密码并不匹配，请重新输入！", vbInformation
     txt(1).SetFocus
     Exit Function
  End If
  
  '函数返回值
  IsOK = True
End Function

Private Sub cmdUser_Click()
  '用户输入无效则退出该过程的执行
  If Not IsOK Then Exit Sub
  
  '初始化用户对象
  Set User = New clsUser
  With User
    '为用户对象的属性赋值
    .UserName = Trim(txt(0))
    .Password = txt(1)
    .TrueName = Trim(txt(3))
    .LastLoginTime = #1/1/1900#
    .UserType = cbo.ListIndex
    '根据cmdType的Caption属性修改或添加用户对象
    Select Case cmdUser.Caption
      Case "修改(&M)": UpdateUser  '修改用户对象
      Case Else: AddNewUser        '添加用户对象
    End Select
  End With
  txt(1).SetFocus
End Sub

'更新用户对象
Private Sub UpdateUser()
  Dim UpdateResult As gxcUpdate    '更新结果
  '指定用户对象的ID属性
  User.ID = Me.Tag
  '更新用户对象并返回更新结果
  UpdateResult = User.Update
  '同步更新列表视图并弹出提示消息框
  ProcUpdateResult UpdateResult, User
End Sub

'添加用户对象
Private Sub AddNewUser()
  Dim AddNewResult As gxcAddNew    '添加结果
  '添加用户对象并返回添加结果
  AddNewResult = User.AddNew
  '添加成功之后的操作
  If AddNewResult = AddNewOK Then
     txt(0) = "": txt(1) = "": txt(2) = "": txt(3) = ""
     '当前操作处于浏览用户信息状态，则在列表视图上添加用户信息
     If CurrentOperation = BrowseUser Then ShowObjInLvw User
     MsgBox "添加成功！", vbInformation
     Exit Sub
  End If
  '添加失败后的操作（消息框提示用户）
  ProcAddNewResult AddNewResult
End Sub

Private Sub Form_Load()
  cbo.AddItem "普通用户"
  cbo.AddItem "系统管理员"
  cbo.ListIndex = 0
End Sub

'文本框获得焦点时选中所有文字
Private Sub txt_GotFocus(Index As Integer)
  txt(Index).SelStart = 0                   '选中文字的起始位置
  txt(Index).SelLength = Len(txt(Index))    '选中文字的长度
End Sub