frmuser.frm

用于控制氧乐果生产的程序

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmUser 
   Caption         =   "用户列表窗口"
   ClientHeight    =   5280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7380
   ClipControls    =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   5280
   ScaleWidth      =   7380
   Begin VB.CommandButton cmdDelUser 
      Caption         =   "删除用户&D"
      Height          =   372
      Left            =   2280
      MouseIcon       =   "frmUser.frx":0000
      TabIndex        =   6
      ToolTipText     =   "删除系统中现有的某些用户"
      Top             =   3000
      Width           =   972
   End
   Begin VB.CommandButton cmdChangeUser 
      Caption         =   "修改用户&A"
      Height          =   372
      Left            =   720
      MouseIcon       =   "frmUser.frx":0152
      TabIndex        =   5
      ToolTipText     =   "修改用户名、用户类别和密码"
      Top             =   3480
      Width           =   972
   End
   Begin VB.ComboBox cboType 
      DataField       =   "type"
      DataSource      =   "Data1"
      Height          =   276
      Left            =   1560
      TabIndex        =   1
      Text            =   "操作工"
      Top             =   1058
      Width           =   1692
   End
   Begin VB.TextBox txtCertain 
      DataSource      =   "Data1"
      Height          =   330
      IMEMode         =   3  'DISABLE
      Left            =   1560
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   2160
      Visible         =   0   'False
      Width           =   1692
   End
   Begin VB.TextBox txtPassword 
      DataField       =   "password"
      DataSource      =   "Data1"
      Height          =   330
      IMEMode         =   3  'DISABLE
      Left            =   1560
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1582
      Width           =   1692
   End
   Begin VB.TextBox txtName 
      DataField       =   "name"
      DataSource      =   "Data1"
      Height          =   330
      Left            =   1560
      TabIndex        =   0
      Top             =   480
      Width           =   1692
   End
   Begin VB.Data Data1 
      Caption         =   "用户列表"
      Connect         =   "Access"
      DatabaseName    =   "D:\ylg2\csdata\user.mdb"
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   444
      Left            =   600
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "user"
      Top             =   4200
      Width           =   2652
   End
   Begin MSDBGrid.DBGrid DBgrid1 
      Bindings        =   "frmUser.frx":02A4
      Height          =   3732
      Left            =   3900
      OleObjectBlob   =   "frmUser.frx":02B8
      TabIndex        =   8
      Top             =   240
      Width           =   3300
   End
   Begin VB.CommandButton Command5 
      Cancel          =   -1  'True
      Caption         =   "退出&B"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   492
      Left            =   6120
      MouseIcon       =   "frmUser.frx":0C9F
      MousePointer    =   99  'Custom
      Picture         =   "frmUser.frx":0DF1
      Style           =   1  'Graphical
      TabIndex        =   9
      ToolTipText     =   "退出本窗口"
      Top             =   4080
      Width           =   588
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确   定&O"
      Height          =   372
      Left            =   2280
      MouseIcon       =   "frmUser.frx":0FB3
      TabIndex        =   7
      Top             =   3480
      Width           =   972
   End
   Begin VB.CommandButton cmdCreatUser 
      Caption         =   "建立用户&C"
      Height          =   372
      Left            =   720
      MouseIcon       =   "frmUser.frx":1105
      TabIndex        =   4
      ToolTipText     =   "建立新的用户和密码"
      Top             =   3000
      Width           =   972
   End
   Begin VB.Image Image2 
      BorderStyle     =   1  'Fixed Single
      Height          =   5052
      Left            =   3804
      Top             =   0
      Width           =   3492
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   5004
      Left            =   36
      Top             =   0
      Width           =   3732
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "用户类型："
      Height          =   180
      Left            =   480
      TabIndex        =   13
      Top             =   1116
      Width           =   900
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "密码确认："
      Height          =   180
      Left            =   480
      TabIndex        =   12
      Top             =   2232
      Visible         =   0   'False
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "用户密码："
      Height          =   180
      Left            =   480
      TabIndex        =   11
      Top             =   1680
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名称："
      Height          =   180
      Left            =   480
      TabIndex        =   10
      Top             =   552
      Width           =   900
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mblnAllowAddnew, mblnAllowChange, mblnAllowDelete As Boolean
Private IsSame As Boolean
Private Sub cmdChangeUser_Click()
On Error Resume Next
If Not mblnAllowChange Then
    With frmPassword
        .EventChar = "changeuser"
        .Show vbModal
    End With
End If
Data1.Recordset.MoveLast
With Data1.Recordset
    If .BOF Or Data1.Recordset.EOF Then .MoveLast
    If mblnAllowChange Then
        txtName.Locked = False
        cboType.Locked = False
        txtPassword.Locked = False
        .Edit
        cmdOK.Enabled = True
    End If
End With
End Sub

Private Sub cmdCreatUser_Click()
On Error Resume Next
If Not mblnAllowAddnew Then
    With frmPassword
        .EventChar = "addnewuser"
        .Show vbModal
    End With
End If
If mblnAllowAddnew Then
    txtName.Locked = False
    cboType.Locked = False
    txtPassword.Locked = False
    Data1.Recordset.AddNew
    cmdOK.Enabled = True
    txtName.SetFocus
End If
End Sub

Private Sub cmdDelUser_Click()
On Error Resume Next
If Not mblnAllowDelete Then
    With frmPassword
        .EventChar = "deleteuser"
        .Show vbModal
    End With
End If
With Data1.Recordset
    If .BOF Or Data1.Recordset.EOF Then .MoveLast
    If mblnAllowDelete Then
        .Delete
        .MoveLast
        cmdOK.Enabled = True
    End If
End With
End Sub

Private Sub cmdOK_Click()
On Error Resume Next
txtName.Locked = True
cboType.Locked = True
txtPassword.Locked = True
Data1.Recordset.Update
Data1.Refresh
DBGrid1.Refresh
Dim i, j, RecNum As Integer
Dim strUserName() As String
IsSame = False
RecNum = 0
With Data1.Recordset
    .MoveLast
    RecNum = .RecordCount
    .MoveFirst
    ReDim strUserName(1 To RecNum)
    For i = 1 To .RecordCount
        If .EOF Then Exit For
        strUserName(i) = .Fields("name")
        .MoveNext
    Next
End With
'*****************************
'检查是否有重复用户名
'*****************************
For i = 1 To RecNum
    For j = i + 1 To RecNum
        If strUserName(i) = strUserName(j) Then IsSame = True
    Next
Next
If IsSame Then
    Call Inform(41)
End If
mblnAllowAddnew = False
mblnAllowChange = False
mblnAllowDelete = False
cmdOK.Enabled = False
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Form_Load()
Width = Screen.Width - dataviewfrm.Width - dataviewfrm.Left
Left = dataviewfrm.Width + dataviewfrm.Left
Top = baojingfrm.Top + baojingfrm.Height
Height = Screen.Height - baojingfrm.Top - baojingfrm.Height
With cboType
    .List(0) = "操作工"
    .List(1) = "工程师"
    .List(2) = "管理员"
End With
txtName.Locked = True
cboType.Locked = True
txtPassword.Locked = True
mblnAllowAddnew = False
mblnAllowChange = False
mblnAllowDelete = False
cmdOK.Enabled = False
IsSame = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = cmdOK.Enabled
If Cancel Then
    Call Inform(61)
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Cancel = cmdOK.Enabled
txtName.Locked = True
cboType.Locked = True
txtPassword.Locked = True
mblnAllowAddnew = False
mblnAllowChange = False
mblnAllowDelete = False
cmdOK.Enabled = False
Data1.Recordset.Close
End Sub

Private Sub txtCertain_GotFocus()
Call GotFocusAgain(txtCertain)
End Sub

Private Sub txtName_GotFocus()
Call GotFocusAgain(txtName)
End Sub
Private Sub txtPassword_GotFocus()
Call GotFocusAgain(txtPassword)
End Sub