?? frmuser.frm
字號:
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密碼"
BeginProperty Font
Name = "宋體"
Size = 8.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 165
Index = 2
Left = 240
TabIndex = 19
Tag = "&Password:"
Top = 960
Width = 360
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用戶名"
BeginProperty Font
Name = "宋體"
Size = 8.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 165
Index = 1
Left = 4800
TabIndex = 18
Tag = "&Password:"
Top = 360
Width = 540
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "登記日期"
BeginProperty Font
Name = "宋體"
Size = 8.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 165
Index = 0
Left = 240
TabIndex = 17
Tag = "&Password:"
Top = 360
Width = 720
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用戶ID"
BeginProperty Font
Name = "宋體"
Size = 8.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 165
Index = 3
Left = 2520
TabIndex = 16
Tag = "&Password:"
Top = 360
Width = 570
End
End
Begin VB.Frame Frame2
Caption = "系統(tǒng)用戶列表"
Height = 5415
Left = 120
TabIndex = 34
Top = 240
Width = 3255
End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim frmGVAR_lstUsersText As String
Private Sub cmdAddUser_Click()
If cmdAddUser.Caption = "添加用戶" Then
frmUser.Caption = "Users (Add User Mode)"
Call cmdClear_Click
txtDateEntered.Text = Format(Now, "mmm. d, yyyy")
txtUserID.Text = "(AUTO-ASSIGN)"
'' Disable other controls
cmdEdit.Enabled = False
lstUsers.Enabled = False
''Enable update
cmdUpdate.Enabled = True
cmdClear.Enabled = True
cmdAddUser.Caption = "&取消添加..."
Call UnlockTextboxes
txtUserName.SetFocus
Exit Sub
End If
If cmdAddUser.Caption = "&取消添加..." Then
frmUser.Caption = "Users"
'' Enable other controls
cmdEdit.Enabled = True
lstUsers.Enabled = True
cmdAddUser.Caption = "添加用戶"
lstUsers.SetFocus
lstUsers.Text = frmGVAR_lstUsersText
'' Enable controls
'' Disable on error
If Trim(lstUsers.Text) = "" Then
cmdEdit.Enabled = False
cmdUpdate.Enabled = False
cmdClear.Enabled = False
Else
cmdUpdate.Enabled = False
cmdClear.Enabled = False
Call LockTextboxes
End If
Exit Sub
End If
End Sub
Private Sub cmdClear_Click()
'' Start Clear Txt/Cbo boxes
txtUserName.Text = ""
txtPassword.Text = ""
txtConfirmPassword.Text = ""
txtAccessLevel.Text = ""
txtFirstName.Text = ""
txtMiddleName.Text = ""
txtFamilyName.Text = ""
txtSex.Text = ""
txtBirthday.Text = ""
txtContactNumber.Text = ""
txtHomeAddress.Text = ""
txtComments.Text = ""
txtUserName.SetFocus
End Sub
Private Sub cmdEdit_Click()
If cmdEdit.Caption = "編輯" Then
cmdEdit.Caption = "取消編輯"
lstUsers.Enabled = False
Call UnlockTextboxes
cmdAddUser.Enabled = False
cmdUpdate.Enabled = True
cmdClear.Enabled = True
txtUserName.SetFocus
frmUser.Caption = "Users (Edit Mode)"
Exit Sub
End If
If cmdEdit.Caption = "取消編輯" Then
Call cmdClear_Click
cmdEdit.Caption = "編輯"
Call LockTextboxes
cmdAddUser.Enabled = True
lstUsers.Enabled = True
cmdUpdate.Enabled = False
cmdClear.Enabled = False
lstUsers.SetFocus
frmUser.Caption = "Users"
lstUsers.Text = frmGVAR_lstUsersText
Exit Sub
End If
End Sub
Private Sub cmdRemove_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
If IsNumeric(txtUserID.Text) = True And cmdEdit.Caption = "編輯" And cmdAddUser.Caption = "添加用戶" Then
If MsgBox("你確定要刪除記錄嗎? ", vbYesNo) = vbNo Then Exit Sub
Call vr_engine.RemoveUser(Int(txtUserID.Text))
Call vr_engine.LoadUsers(lstUsers) ''Refresh listbox
txtDateEntered.Text = ""
txtUserID.Text = ""
Call cmdClear_Click
cmdEdit.Enabled = False
cmdUpdate.Enabled = False
cmdClear.Enabled = False
If lstUsers.Enabled = True Then lstUsers.SetFocus
Else
'' Put Message Here
If lstUsers.Enabled = True Then
lstUsers.SetFocus
Else
txtUserName.SetFocus
End If
End If
End Sub
Private Sub cmdSetPermission_Click()
If gVarAccessLevel < 6 Then
If lstUsers.Enabled = True Then
lstUsers.SetFocus
Else
txtDateEntered.SetFocus
End If
Exit Sub
End If
frmPermission.Show 1
If lstUsers.Enabled = True Then
lstUsers.SetFocus
Else
txtDateEntered.SetFocus
End If
End Sub
Private Sub cmdUpdate_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
If ValidateUserFields = 0 Then Exit Sub '' Chk fields
If cmdAddUser.Caption = "&取消添加..." Then
txtDateEntered.Text = Format(Now, "mmm. d, yyyy")
txtUserID.Text = "(Auto-assign)"
If ValidateUserFields = 0 Then Exit Sub '' Chk fields
If vr_engine.AddUserToDB(txtDateEntered, txtUserName, txtPassword, _
txtAccessLevel, txtFirstName, _
txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, _
txtHomeAddress, txtContactNumber, _
txtComments) Then
'' Do Nothing
Else
Exit Sub
End If
'' Enable other controls
cmdEdit.Enabled = True
lstUsers.Enabled = True
Call vr_engine.LoadUsers(lstUsers) ''Refresh listbox
frmGVAR_lstUsersText = Trim(txtFirstName.Text) & " " & Trim(Left(txtMiddleName.Text, 1)) & ". " & Trim(txtFamilyName.Text) & " (" & Trim(txtUserName.Text) & ")"
lstUsers.Text = frmGVAR_lstUsersText
lstUsers.SetFocus
cmdAddUser.Caption = "添加用戶"
'' Disable cmdUpdate/cmdClear
cmdUpdate.Enabled = False
cmdClear.Enabled = False
Exit Sub
Else
'' ========= Start Edit Update ============
If vr_engine.UpdateEditedUsersDB(txtUserName, txtPassword, _
txtAccessLevel, txtFirstName, _
txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, _
txtHomeAddress, txtContactNumber, _
txtComments, lstUsers) = True Then
'' Do Nothing
Else
Exit Sub
End If
Call vr_engine.LoadUsers(lstUsers) ''Refresh listbox
frmGVAR_lstUsersText = Trim(txtFirstName.Text) & " " & Trim(Left(txtMiddleName.Text, 1)) & ". " & Trim(txtFamilyName.Text) & " (" & Trim(txtUserName.Text) & ")"
'''MsgBox frmGVAR_lstUsersText
lstUsers.Enabled = True
cmdUpdate.Enabled = False
lstUsers.SetFocus
MsgBox "記錄已更新。", vbOKOnly, "成功更新！"
Call LockTextboxes
cmdEdit.Caption = "編輯"
frmUser.Caption = "Users"
cmdUpdate.Enabled = False
cmdClear.Enabled = False
cmdAddUser.Enabled = True
txtDateEntered.Locked = True
lstUsers.Text = frmGVAR_lstUsersText
'' ========= End Edit Update ============
End If
End Sub
Private Sub Form_Load()
lstUsers.Clear '' Clears listbox
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.LoadUsers(lstUsers)
End Sub
Private Sub lstUsers_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.getUserInfo(txtUserID, txtDateEntered, _
txtUserName, txtPassword, _
txtAccessLevel, txtFirstName, _
txtMiddleName, txtFamilyName, _
txtBirthday, txtSex, _
txtHomeAddress, txtContactNumber, _
txtComments, txtConfirmPassword, lstUsers)
cmdEdit.Enabled = True
frmGVAR_lstUsersText = lstUsers.Text
End Sub
Sub UnlockTextboxes()
'txtDateEntered.Locked = False
txtUserName.Locked = False
txtPassword.Locked = False
txtConfirmPassword.Locked = False
txtAccessLevel.Locked = False
txtFirstName.Locked = False
txtMiddleName.Locked = False
txtFamilyName.Locked = False
txtSex.Locked = False
txtBirthday.Locked = False
txtContactNumber.Locked = False
txtHomeAddress.Locked = False
txtComments.Locked = False
End Sub
Sub LockTextboxes()
txtUserName.Locked = True
txtPassword.Locked = True
txtConfirmPassword.Locked = True
txtAccessLevel.Locked = True
txtFirstName.Locked = True
txtMiddleName.Locked = True
txtFamilyName.Locked = True
txtSex.Locked = True
txtBirthday.Locked = True
txtContactNumber.Locked = True
txtHomeAddress.Locked = True
txtComments.Locked = True
End Sub
Function ValidateUserFields() '檢查所輸入數(shù)據(jù)是否合法！
If IsDate(txtDateEntered.Text) Then
txtDateEntered.Text = Format(txtDateEntered.Text, "mmm. d, yyyy")
Else
MsgBox "非法數(shù)據(jù)！ ", vbCritical, "發(fā)生錯誤"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtUserName.Text = "") Then
MsgBox "非法用戶名", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtPassword.Text) <> Trim(txtConfirmPassword.Text) Then
MsgBox "新密碼與確認密碼不符！ ", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If txtPassword.Text = "" Then
MsgBox "你必須輸入一個密碼", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If IsNumeric(Trim(txtAccessLevel.Text)) Then
txtAccessLevel.Text = Int(Trim(txtAccessLevel.Text))
Else
MsgBox "抱歉，非法權(quán)限", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtFirstName.Text) = "" Then
MsgBox "名字1為空！", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtMiddleName.Text) = "" Then
MsgBox "名字2為空！ ", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtFamilyName.Text) = "" Then
MsgBox "你沒有姓嗎？！", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtMiddleName.Text) = "" Then
MsgBox "名字2為空！ ", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If IsDate(txtBirthday.Text) Then
txtBirthday.Text = Format(txtBirthday.Text, "mmm. d, yyyy")
Else
MsgBox "生日數(shù)據(jù)非法！", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
If Trim(txtSex.Text) <> "男" And Trim(txtSex.Text) <> "女" _
And UCase(Trim(txtSex.Text)) <> "M" And UCase(Trim(txtSex.Text)) <> "F" Then
'MsgBox txtSex.Text
MsgBox "請輸入性別項！", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
Else
If Left(txtSex.Text, 1) = "M" Then txtSex.Text = "男"
If Left(txtSex.Text, 1) = "F" Then txtSex.Text = "女"
End If
If Trim(txtHomeAddress.Text = "") Then
MsgBox "請輸入你的地址", vbCritical, "Error"
ValidateUserFields = 0
Exit Function
End If
ValidateUserFields = 1
End Function
Private Sub txtAccessLevel_LostFocus()
If Val(txtAccessLevel.Text) > 6 Then
MsgBox "'權(quán)限不能超過6級！ ", vbInformation, "Invalid Entry"
txtAccessLevel.Text = ""
txtAccessLevel.SetFocus
Exit Sub
End If
If Val(txtAccessLevel.Text) > gVarAccessLevel Then
MsgBox "'通道權(quán)限' 不能比你自身的權(quán)限水平高！ ", vbInformation, "非法輸入！"
txtAccessLevel.Text = ""
txtAccessLevel.SetFocus
Exit Sub
End If
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -