📄 frmadminregister.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmAdminRegister
BorderStyle = 3 'Fixed Dialog
Caption = "管理员登记"
ClientHeight = 6825
ClientLeft = 465
ClientTop = 1635
ClientWidth = 7695
HelpContextID = 1
Icon = "frmAdminRegister.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6825
ScaleWidth = 7695
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin VB.CommandButton cmdExit
Caption = "关闭"
Height = 360
Left = 6000
TabIndex = 13
Tag = "确定"
Top = 6360
Width = 1260
End
Begin VB.Frame Frame1
Height = 6255
Left = 120
TabIndex = 14
Top = 0
Width = 7455
Begin VB.CommandButton cmdEditPass
Cancel = -1 'True
Caption = "设置密码"
Height = 360
Left = 5775
TabIndex = 10
Tag = "取消"
Top = 1440
Width = 1245
End
Begin VB.ListBox lstAccredit
Columns = 2
Height = 1320
ItemData = "frmAdminRegister.frx":000C
Left = 2400
List = "frmAdminRegister.frx":0025
Style = 1 'Checkbox
TabIndex = 5
Top = 2805
Width = 4815
End
Begin VB.TextBox txtPhone
Height = 300
Left = 3240
MaxLength = 12
TabIndex = 3
Top = 1185
Width = 1935
End
Begin VB.TextBox txtAdminID
Enabled = 0 'False
Height = 300
Left = 3240
MaxLength = 10
TabIndex = 1
Top = 480
Width = 1935
End
Begin VB.CommandButton cmdAccredit
Caption = "授权(&Q)"
Height = 300
Left = 5775
TabIndex = 6
Top = 2445
Width = 1245
End
Begin MSDataListLib.DataList dblAdmin
Height = 2370
Left = 240
TabIndex = 0
Top = 480
Width = 1935
_ExtentX = 3413
_ExtentY = 4180
_Version = 393216
ListField = ""
BoundColumn = ""
End
Begin VB.CommandButton cmdSavePhoto
Caption = "照片存档"
Height = 300
Left = 240
TabIndex = 12
Top = 5760
Width = 1935
End
Begin VB.TextBox txtName
Height = 300
Left = 3240
MaxLength = 10
TabIndex = 2
Top = 840
Width = 1935
End
Begin VB.CommandButton cmdOpenPhoto
Caption = "从文件取照片"
Height = 300
Left = 240
TabIndex = 11
Top = 5400
Width = 1935
End
Begin VB.CommandButton cmdAdd
Caption = "添加(&A)"
Height = 360
Left = 5775
TabIndex = 8
Top = 495
Width = 1245
End
Begin VB.CommandButton cmdDel
Caption = "删除(&D)"
Height = 360
Left = 5775
TabIndex = 9
Top = 960
Width = 1245
End
Begin VB.TextBox txtExplain
Height = 1560
Left = 2400
MaxLength = 255
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 4485
Width = 4815
End
Begin VB.CheckBox chkPause
Caption = "暂停使用"
Height = 255
Left = 3240
TabIndex = 4
Top = 1980
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "权限列表:"
Height = 180
Index = 4
Left = 2385
TabIndex = 22
Top = 2565
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "联系电话:"
Height = 180
Index = 7
Left = 2400
TabIndex = 21
Top = 1185
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "管理员ID:"
Height = 180
Index = 6
Left = 2400
TabIndex = 20
Top = 480
Width = 810
End
Begin VB.Label lblDate
BorderStyle = 1 'Fixed Single
Height = 300
Left = 3240
TabIndex = 19
Top = 1545
Width = 1935
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "登记日期:"
Height = 180
Index = 5
Left = 2400
TabIndex = 18
Top = 1545
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "管理员列表:"
Height = 180
Index = 2
Left = 240
TabIndex = 17
Top = 240
Width = 990
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名:"
Height = 180
Index = 0
Left = 2400
TabIndex = 16
Top = 840
Width = 450
End
Begin VB.Image imgPhoto
BorderStyle = 1 'Fixed Single
Height = 2295
Left = 240
Stretch = -1 'True
Top = 3000
Width = 1935
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "说明:"
Height = 180
Index = 3
Left = 2400
TabIndex = 15
Top = 4200
Width = 450
End
End
End
Attribute VB_Name = "frmAdminRegister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Dim mstrPhotoFile As String
Private Sub cmdAdd_Click()
'追加新记录
rs.AddNew
rs("管理员ID") = "新成员"
rs("姓名") = ""
rs("权限") = "00000000"
rs("停用") = False
rs("电话") = ""
rs("登记日期") = Date
rs("描述") = ""
txtAdminID.Enabled = True
txtAdminID.SetFocus
End Sub
Private Sub cmdDel_Click()
'删除记录
If Not (rs.EOF Or rs.BOF) Then
rs.Delete
rs.MoveNext
End If
End Sub
Private Sub cmdEditPass_Click()
Dim newForm As New frmEditPassword
newForm.lblAccreditID = rs("管理员ID")
newForm.Show vbModal
Set newForm = Nothing
End Sub
Private Sub cmdExit_Click()
On Error Resume Next
rs.Update
Unload Me
End Sub
Private Sub cmdOpenPhoto_Click()
On Error Resume Next
'调用过程取得图片文件路径
mstrPhotoFile = fMain.File_Open("*.BMP;*.JPG;*.GIF|*.BMP;*.JPG;" _
& "*.GIF|*.BMP|*.BMP|*.JPG|*.JPG|*.GIF|*.GIF|*.*|*.*", "从文件取照片")
If mstrPhotoFile = "" Then Exit Sub
imgPhoto.Picture = LoadPicture(mstrPhotoFile)
End Sub
Private Sub cmdAccredit_Click()
Dim strAccredit As String
Dim I As Byte
strAccredit = "0"
For I = 0 To lstAccredit.ListCount - 1
If lstAccredit.Selected(I) Then
strAccredit = strAccredit & 1
Else
strAccredit = strAccredit & 0
End If
Next
rs.Update "权限", strAccredit
MsgBox "授权成功！", vbInformation
End Sub
Private Sub cmdSavePhoto_Click()
'调用过程保存图片
fMain.SavePhoto "照片", rs, mstrPhotoFile
End Sub
Private Sub dblAdmin_Click()
Dim strAdminID As String
strAdminID = dblAdmin.Text
rs.MoveFirst
rs.Find "管理员ID='" & strAdminID & "'"
End Sub
Private Sub Form_Load()
Set rs = mCdt.rsAdminRegister
Set dblAdmin.RowSource = rs
dblAdmin.ListField = "管理员ID"
Set txtAdminID.DataSource = rs
txtAdminID.DataField = "管理员ID"
Set txtName.DataSource = rs
txtName.DataField = "姓名"
Set lblDate.DataSource = rs
lblDate.DataField = "登记日期"
Set txtPhone.DataSource = rs
txtPhone.DataField = "电话"
Set txtExplain.DataSource = rs
txtExplain.DataField = "描述"
Set chkPause.DataSource = rs
chkPause.DataField = "停用"
Set imgPhoto.DataSource = rs
imgPhoto.DataField = "照片"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If rs.EditMode = adEditAdd Or rs.EditMode = adEditInProgress Then
Cancel = 1
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
rs.Close
Set rs = Nothing
End Sub
Private Sub imgPhoto_Click()
Dim frmNewWin As New frmPhoto
frmNewWin.imgPhoto.Picture = imgPhoto.Picture
frmNewWin.Show vbModal
Set frmNewWin = Nothing
End Sub
Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
rsRefresh
End Sub
Private Sub ReadQx()
Dim strAccredit As String
Dim I As Byte
strAccredit = Right(rs("权限"), 7)
For I = 0 To 6
lstAccredit.Selected(I) = CBool(Mid(strAccredit, I + 1, 1))
Next
End Sub
Private Sub txtAdminID_GotFocus()
txtAdminID.SelStart = 0
txtAdminID.SelLength = Len(txtAdminID)
End Sub
Private Sub txtAdminID_LostFocus()
'检验数据
On Error Resume Next
If Trim(txtAdminID) = "" Then
MsgBox "管理员ID不能为空字串!", vbExclamation
txtAdminID.SetFocus
Exit Sub
End If
rs.Update
Select Case Err
Case 0
rsRefresh
txtAdminID.Enabled = False
Case -2147467259
MsgBox "管理员ID发生重复值冲突!" & Error, vbExclamation
txtAdminID.SetFocus
Case Else
txtAdminID.SetFocus
End Select
End Sub
Private Sub rsRefresh()
On Error Resume Next
If rs.AbsolutePosition < 1 Then
txtName.Enabled = False
txtPhone.Enabled = False
chkPause.Enabled = False
txtExplain.Enabled = False
cmdOpenPhoto.Enabled = False
cmdSavePhoto.Enabled = False
cmdDel.Enabled = False
cmdAccredit.Enabled = False
lstAccredit.Enabled = False
Else
txtName.Enabled = True
txtPhone.Enabled = True
txtExplain.Enabled = True
cmdOpenPhoto.Enabled = True
cmdSavePhoto.Enabled = True
If CBool(Left(rs("权限"), 1)) Then
cmdDel.Enabled = False
chkPause.Enabled = False
cmdAccredit.Enabled = False
lstAccredit.Enabled = False
Else
cmdDel.Enabled = True
chkPause.Enabled = True
cmdAccredit.Enabled = True
lstAccredit.Enabled = True
End If
ReadQx
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -