📄 frmgzrydj.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmGZRYDJ
BorderStyle = 3 'Fixed Dialog
Caption = "工作人员登记"
ClientHeight = 6825
ClientLeft = 465
ClientTop = 1635
ClientWidth = 7695
HelpContextID = 1
Icon = "frmGZRYDJ.frx":0000
LinkTopic = "Form1"
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 cmdEditMm
Cancel = -1 'True
Caption = "设置密码"
Height = 360
Left = 5775
TabIndex = 10
Tag = "取消"
Top = 1515
Width = 1245
End
Begin VB.ListBox lstSzqx
Height = 1320
ItemData = "frmGZRYDJ.frx":000C
Left = 2400
List = "frmGZRYDJ.frx":001C
Style = 1 'Checkbox
TabIndex = 5
Top = 2805
Width = 4815
End
Begin VB.TextBox txtDh
Height = 300
Left = 3240
MaxLength = 8
TabIndex = 3
Top = 1185
Width = 1935
End
Begin VB.TextBox txtZyID
Enabled = 0 'False
Height = 300
Left = 3240
MaxLength = 8
TabIndex = 1
Top = 480
Width = 1935
End
Begin VB.CommandButton cmdSaveQx
Caption = "授权(&Q)"
Height = 300
Left = 5775
TabIndex = 6
Top = 2445
Width = 1245
End
Begin MSDataListLib.DataList dblRylb
Height = 2370
Left = 240
TabIndex = 0
Top = 480
Width = 1935
_ExtentX = 3413
_ExtentY = 4180
_Version = 393216
ListField = ""
BoundColumn = ""
End
Begin VB.CommandButton cmdSaveZp
Caption = "照片存档"
Height = 300
Left = 240
TabIndex = 12
Top = 5760
Width = 1935
End
Begin VB.TextBox txtXm
Height = 300
Left = 3240
MaxLength = 8
TabIndex = 2
Top = 840
Width = 1935
End
Begin VB.CommandButton cmdOpenZp
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 = 915
Width = 1245
End
Begin VB.TextBox txtSm
Height = 1560
Left = 2400
MaxLength = 255
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 4485
Width = 4815
End
Begin VB.CheckBox chkZt
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 = 630
End
Begin VB.Label lblRq
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 = 1170
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 imgZp
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 = 4245
Width = 450
End
End
End
Attribute VB_Name = "frmGZRYDJ"
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 mstrZpFile As String
Private Sub cmdAdd_Click()
'追加新记录
On Error Resume Next
rs.AddNew
rs("职员ID") = "新职员"
rs("姓名") = ""
rs("操作权限") = "00000"
rs("停用") = False
rs("联系电话") = ""
rs("日期") = Date
rs("说明") = ""
txtZyID.Enabled = True
txtZyID.SetFocus
End Sub
Private Sub cmdDel_Click()
On Error Resume Next
'删除记录
Dim intWlcs As Integer
Dim rsWlcsTj As ADODB.Recordset
Set rsWlcsTj = mCdt.rsWlcsTj_ZyID(rs("职员ID"))
intWlcs = rsWlcsTj(0)
rsWlcsTj.Close
If intWlcs > 0 Then
MsgBox "该职员已经手物品流通,不能被删除!", vbInformation
Exit Sub
End If
If Not (rs.EOF Or rs.BOF) Then
rs.Delete
rs.MoveNext
End If
End Sub
Private Sub cmdEditMm_Click()
Dim newForm As New frmXgmm
newForm.lblZyID = 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 cmdOpenZp_Click()
On Error Resume Next
'调用过程取得图片文件路径
mstrZpFile = fMain.File_Open("*.BMP;*.JPG;*.GIF|*.BMP;*.JPG;" _
& "*.GIF|*.BMP|*.BMP|*.JPG|*.JPG|*.GIF|*.GIF|*.*|*.*", "从文件取照片")
If mstrZpFile = "" Then Exit Sub
imgZp.Picture = LoadPicture(mstrZpFile)
End Sub
Private Sub cmdSaveQx_Click()
On Error Resume Next
Dim strQxqd As String
Dim I As Byte
strQxqd = "0"
For I = 0 To lstSzqx.ListCount - 1
If lstSzqx.Selected(I) Then
strQxqd = strQxqd & 1
Else
strQxqd = strQxqd & 0
End If
Next
rs.Update "操作权限", strQxqd
MsgBox "授权成功！", vbInformation
End Sub
Private Sub cmdSaveZp_Click()
'调用过程保存图片
fMain.SaveZp "照片", rs, mstrZpFile
End Sub
Private Sub dblRylb_Click()
On Error Resume Next
Dim strZyID As String
strZyID = dblRylb.Text
rs.MoveFirst
rs.Find "职员ID='" & strZyID & "'"
End Sub
Private Sub Form_Load()
On Error Resume Next
Set rs = mCdt.rsGZRYDJ
Set dblRylb.RowSource = rs
dblRylb.ListField = "职员ID"
Set txtZyID.DataSource = rs
txtZyID.DataField = "职员ID"
Set txtXm.DataSource = rs
txtXm.DataField = "姓名"
Set lblRq.DataSource = rs
lblRq.DataField = "日期"
Set txtDh.DataSource = rs
txtDh.DataField = "联系电话"
Set txtSm.DataSource = rs
txtSm.DataField = "说明"
Set chkZt.DataSource = rs
chkZt.DataField = "停用"
Set imgZp.DataSource = rs
imgZp.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)
On Error Resume Next
rs.Close
Set rs = Nothing
End Sub
Private Sub imgZp_Click()
Dim frmNewWin As New frmZp
frmNewWin.Image1.Picture = imgZp.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()
On Error Resume Next
Dim strQxqd As String
Dim I As Byte
strQxqd = Right(rs("操作权限"), 4)
For I = 0 To 3
lstSzqx.Selected(I) = CBool(Mid(strQxqd, I + 1, 1))
Next
End Sub
Private Sub txtZyID_GotFocus()
txtZyID.SelStart = 0
txtZyID.SelLength = Len(txtZyID)
End Sub
Private Sub txtZyID_LostFocus()
'检验数据
On Error Resume Next
If Trim(txtZyID) = "" Then
MsgBox "职员ID不能为空字串!", vbExclamation
txtZyID.SetFocus
Exit Sub
End If
rs.Update
Select Case Err
Case 0
rsRefresh
txtZyID.Enabled = False
Case -2147467259
MsgBox "职员ID发生重名冲突!", vbExclamation
txtZyID.SetFocus
Case Else
txtZyID.SetFocus
End Select
End Sub
Private Sub rsRefresh()
On Error Resume Next
If rs.AbsolutePosition < 1 Then
txtXm.Enabled = False
txtDh.Enabled = False
chkZt.Enabled = False
txtSm.Enabled = False
cmdOpenZp.Enabled = False
cmdSaveZp.Enabled = False
cmdDel.Enabled = False
cmdSaveQx.Enabled = False
lstSzqx.Enabled = False
Else
txtXm.Enabled = True
txtDh.Enabled = True
txtSm.Enabled = True
cmdOpenZp.Enabled = True
cmdSaveZp.Enabled = True
If CBool(Left(rs("操作权限"), 1)) Then
cmdDel.Enabled = False
chkZt.Enabled = False
cmdSaveQx.Enabled = False
lstSzqx.Enabled = False
Else
cmdDel.Enabled = True
chkZt.Enabled = True
cmdSaveQx.Enabled = True
lstSzqx.Enabled = True
End If
ReadQx
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -