📄 form_user1.frm
字号:
VERSION 5.00
Begin VB.Form form_user1
BackColor = &H00C0FFFF&
Caption = "用户管理"
ClientHeight = 3630
ClientLeft = 1110
ClientTop = 345
ClientWidth = 5760
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3630
ScaleWidth = 5760
Begin VB.TextBox txtFields
DataField = "userGroup"
DataSource = "Data1"
Height = 285
Index = 6
Left = 1080
MaxLength = 50
TabIndex = 19
Top = 3240
Width = 2535
End
Begin VB.ComboBox cmbUserGroup
DataField = "userGroup"
DataSource = "Data1"
Height = 315
ItemData = "form_user1.frx":0000
Left = 1080
List = "form_user1.frx":0002
TabIndex = 6
Top = 2775
Width = 2535
End
Begin VB.CommandButton cmdAdd
Caption = "&A新增"
Height = 300
Left = 4200
TabIndex = 18
Top = 120
Width = 975
End
Begin VB.CommandButton cmdDelete
Caption = "&D删除"
Height = 300
Left = 4200
TabIndex = 17
Top = 840
Width = 975
End
Begin VB.CommandButton cmdRefresh
Caption = "&R刷新"
Height = 300
Left = 4200
TabIndex = 16
Top = 1440
Width = 975
End
Begin VB.TextBox txtFields
DataField = "phone"
DataSource = "Data1"
Height = 285
Index = 3
Left = 1080
MaxLength = 50
TabIndex = 3
Top = 1440
Width = 2535
End
Begin VB.TextBox txtFields
DataField = "e-mail"
DataSource = "Data1"
Height = 285
Index = 4
Left = 1080
MaxLength = 50
TabIndex = 4
Top = 1875
Width = 2535
End
Begin VB.TextBox txtFields
DataField = "address"
DataSource = "Data1"
Height = 285
Index = 5
Left = 1080
MaxLength = 50
TabIndex = 5
Top = 2325
Width = 2535
End
Begin VB.CommandButton cmdClose
Caption = "&B返回"
Height = 300
Left = 4200
TabIndex = 8
Top = 2760
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "&S保存"
Height = 300
Left = 4200
TabIndex = 7
Top = 2160
Width = 975
End
Begin VB.Data Data1
Align = 2 'Align Bottom
Connect = "Access 2000;"
DatabaseName = "E:\work\广州友联\src\warehouse\DB-Access\hunterPOS.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "hp_users"
Top = 3285
Width = 5760
End
Begin VB.TextBox txtFields
DataField = "password"
DataSource = "Data1"
Height = 285
Index = 2
Left = 1080
MaxLength = 50
TabIndex = 2
Top = 1035
Width = 2535
End
Begin VB.TextBox txtFields
DataField = "username"
DataSource = "Data1"
Height = 285
Index = 1
Left = 1080
MaxLength = 50
TabIndex = 1
Top = 600
Width = 2535
End
Begin VB.TextBox txtFields
DataField = "usercode"
DataSource = "Data1"
Height = 285
Index = 0
Left = 1080
MaxLength = 50
TabIndex = 0
Top = 165
Width = 2535
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "联系电话:"
Height = 255
Index = 3
Left = 120
TabIndex = 15
Top = 1455
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "e-mail:"
Height = 255
Index = 4
Left = 120
TabIndex = 14
Top = 1905
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "住 址:"
Height = 255
Index = 5
Left = 120
TabIndex = 13
Top = 2340
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "用户组:"
Height = 255
Index = 6
Left = 120
TabIndex = 12
Top = 2775
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "密 码:"
Height = 255
Index = 2
Left = 120
TabIndex = 11
Top = 1065
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "用户名称:"
Height = 255
Index = 1
Left = 120
TabIndex = 10
Top = 615
Width = 855
End
Begin VB.Label lblLabels
BackColor = &H00C0FFFF&
Caption = "用户编号:"
Height = 255
Index = 0
Left = 120
TabIndex = 9
Top = 180
Width = 855
End
End
Attribute VB_Name = "form_user1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private sqlData As String
Private Sub cmdAdd_Click()
Data1.Recordset.AddNew
txtFieldGetFocus (0)
End Sub
Private Sub cmdDelete_Click()
'this may produce an error if you delete the last
'record or the only record in the recordset
If MsgBox("真的要删除吗？", vbYesNo + vbDefaultButton2 + vbQuestion, "提示") = vbYes Then
Data1.Recordset.Delete
' Data1.Recordset.MoveNext
If Data1.Recordset.RecordCount > 0 Then
Data1.Refresh
Data1.Recordset.Move (0)
End If
MsgBox "删除成功", vbInformation, "提示"
End If
End Sub
Private Sub cmdRefresh_Click()
'this is really only needed for multi user apps
Data1.Refresh
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
If Me.cmbUserGroup.Text = "操作员" Then
Data1.Recordset.Fields("userGroup") = 0
End If
If Me.cmbUserGroup.Text = "管理员" Then
Data1.Recordset.Fields("userGroup") = 1
End If
If Me.cmbUserGroup.Text = "超级管理员" Then
Data1.Recordset.Fields("userGroup") = -1
End If
Data1.UpdateRecord
Data1.Recordset.Bookmark = Data1.Recordset.LastModified
MsgBox "保存成功!", vbInformation, "提示"
End Sub
Private Sub Data1_Error(DataErr As Integer, Response As Integer)
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Error$(DataErr)
Response = 0 'throw away the error
End Sub
Private Sub Data1_Reposition()
Screen.MousePointer = vbDefault
On Error Resume Next
Dim userGroup
userGroup = Data1.Recordset.Fields("userGroup")
If userGroup = 0 Then
Me.cmbUserGroup.Text = "操作员"
End If
If userGroup = 1 Then
Me.cmbUserGroup.Text = "管理员"
End If
If userGroup = -1 Then
Me.cmbUserGroup.Text = "超级管理员"
End If
'This will display the current record position
'for dynasets and snapshots
Data1.Caption = "第 " & (Data1.Recordset.AbsolutePosition + 1) & " 条记录！"
'for the table object you must set the index property when
'the recordset gets created and use the following line
'Data1.Caption = "Record: " & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub
Private Sub Data1_Validate(Action As Integer, Save As Integer)
'This is where you put validation code
'This event gets called when the following actions occur
Select Case Action
Case vbDataActionMoveFirst
Case vbDataActionMovePrevious
Case vbDataActionMoveNext
Case vbDataActionMoveLast
Case vbDataActionAddNew
Case vbDataActionUpdate
Case vbDataActionDelete
Case vbDataActionFind
Case vbDataActionBookmark
Case vbDataActionClose
End Select
Screen.MousePointer = vbHourglass
End Sub
Private Sub Form_Load()
Data1.DatabaseName = g_dbPath
sqlData = "select * from hp_users where 1=1 order by usercode"
Data1.RecordSource = sqlData
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
'txtFieldGetFocus (1)
cmbUserGroup.AddItem "操作员", 0
cmbUserGroup.AddItem "管理员", 1
cmbUserGroup.AddItem "超级管理员", 2
' cmbUserGroup.Text = "操作员"
End Sub
Private Sub Form_Unload(Cancel As Integer)
frm_main.Enabled = True
Screen.MousePointer = vbDefault
End Sub
Private Sub txtFieldGetFocus(i As Integer)
txtFields(i).SelStart = 0
txtFields(i).SelLength = Len(txtFields(i).Text)
txtFields(i).SetFocus
End Sub
Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Dim maxIndex As Integer
maxIndex = 5
If KeyCode = vbKeyReturn Then '按回车键
If (Index < maxIndex) Then
txtFieldGetFocus (Index + 1)
End If
If (Index = maxIndex) Then
' cmdSave.SetFocus
Me.cmbUserGroup.SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -