frmadduser.frm

物业管理

         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
      Begin VB.Label Label4 
         Caption         =   "A或者B"
         Height          =   255
         Left            =   -72120
         TabIndex        =   17
         Top             =   2160
         Width           =   615
      End
      Begin VB.Label Label3 
         Caption         =   "用户级别"
         Height          =   255
         Left            =   -74280
         TabIndex        =   6
         Top             =   2160
         Width           =   855
      End
      Begin VB.Label Label2 
         Caption         =   "用户密码"
         Height          =   255
         Left            =   -74280
         TabIndex        =   5
         Top             =   1680
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "用户名"
         Height          =   255
         Left            =   -74280
         TabIndex        =   4
         Top             =   1200
         Width           =   735
      End
   End
End
Attribute VB_Name = "frmadduser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean


Private Sub Form_Load()
On Error Resume Next
    For Each TextBox In Me.Controls
        TextBox.Font.Name = "宋体"
        TextBox.Font.Size = 9
    Next
 Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select * from 用户信息", db, adOpenStatic, adLockOptimistic

   Set DataGrid2.DataSource = adoPrimaryRS
  Set Text1.DataSource = adoPrimaryRS
  Set Text2.DataSource = adoPrimaryRS
  Set Text3.DataSource = adoPrimaryRS
  
  
  Dim sql3 As String

    sql3 = "select  用户级别  from 用户信息 where 用户名 = '" & Username & "'"
    Set rs3 = db.Execute(sql3)
    UserGrade = Trim(rs3("用户级别"))
    
    If UserGrade <> "A" Then
         MsgBox "对不起！你不能授予他人使用权。", vbExclamation + vbOKOnly, pTitle
       GoTo logout
    Else
       Exit Sub
    End If
logout:
Text1 = ""
Text2 = ""
Text3 = ""
  DataGrid2.Visible = False
  Frame1.Visible = False
  CmdAdd.Visible = False
  cmdEdit.Visible = False
  CmdDelete.Visible = False
  cmdUpdate.Visible = False
  cmdRefresh.Visible = False
  cmdCancel.Visible = False
  cmdClose.Visible = True
  
End Sub
 Private Sub Form_Unload(Cancel As Integer)
  frmmain.Enabled = True
  Unload Me
End Sub
Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  
 With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
  mbAddNewFlag = True
  End With
  Text3.Text = "B"
  CmdAdd.Visible = False
  cmdEdit.Visible = False
  cmdUpdate.Visible = True
  cmdCancel.Visible = True
  CmdDelete.Visible = False
  cmdClose.Visible = False
  cmdRefresh.Visible = False

  Exit Sub
AddErr:
  MsgBox "增加操作有错误", vbExclamation + vbOKOnly, pTitle
  
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  Dim Resp As Integer
  Resp = MsgBox("你真的要删除该用户吗？", vbExclamation + vbOKCancel, pTitle)
  If Resp = 2 Then
     Exit Sub
  Else
   With adoPrimaryRS
     .Delete
     .MoveNext
    If .EOF Then .MoveLast
   End With
  End If
  
  Exit Sub
DeleteErr:
  MsgBox "删除操作有错误", vbExclamation + vbOKOnly, pTitle

End Sub

Private Sub cmdClose_Click()
  frmmain.Enabled = True
  Unload Me
End Sub

Private Sub SetButtons(bVal As Boolean)
  CmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  CmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  If bVal Then
   Set DataGrid2.DataSource = adoPrimaryRS
  Else
   Set DataGrid2.DataSource = Nothing
  End If
  End Sub

Private Sub cmdCancel_Click()
 ' On Error Resume Next
 On Error GoTo CancelErr


  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate

  If mvBookMark > 0 Then
   adoPrimaryRS.Bookmark = mvBookMark
  Else
   adoPrimaryRS.MoveFirst
  End If
 SetButtons True
  Exit Sub
CancelErr:
   
   MsgBox "取消操作有错误", vbExclamation + vbOKOnly, pTitle

End Sub
Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr
If mbAddNewFlag = True Then
       sqlRS = "select * from 用户信息 where 用户名 = '" & Text1.Text & "'"
       Set rs = db.Execute(sqlRS)
      If rs.EOF = False Then
          MsgBox "对不起!该用户名已存在，请输入新用户。", vbExclamation + vbOKOnly, pTitle
          Text1.SetFocus
          Text1.SelStart = 0
          mbAddNewFlag = True
          Exit Sub
      End If
End If
  adoPrimaryRS.UpdateBatch adAffectAll

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  Exit Sub
UpdateErr:
   MsgBox "保存操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub