📄 frmuser.frm
字号:
DataSource = "Adodc1"
ForeColor = &H00FF00FF&
Height = 300
ItemData = "FrmUser.frx":0015
Left = 2880
List = "FrmUser.frx":0017
TabIndex = 4
Text = "aa"
Top = 360
Width = 1095
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
DataField = "姓名"
DataSource = "Adodc1"
ForeColor = &H00FF00FF&
Height = 270
Left = 840
TabIndex = 2
Text = "Text1"
Top = 360
Width = 1215
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "工号："
ForeColor = &H00FF0000&
Height = 255
Left = 4200
TabIndex = 11
Top = 840
Width = 615
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "内线："
ForeColor = &H00FF0000&
Height = 255
Left = 2280
TabIndex = 9
Top = 840
Width = 615
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "电话："
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 7
Top = 840
Width = 615
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "部门："
ForeColor = &H00FF0000&
Height = 255
Left = 4200
TabIndex = 5
Top = 360
Width = 615
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "职务："
ForeColor = &H00FF0000&
Height = 255
Left = 2280
TabIndex = 3
Top = 360
Width = 615
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "姓名："
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 1
Top = 360
Width = 615
End
End
Begin FlatCom.MoveBar MoveBar1
Align = 1 'Align Top
Height = 270
Left = 0
Top = 0
Width = 7485
_ExtentX = 13203
_ExtentY = 476
BackColor = 16711680
ForeColor = 8438015
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "员工信息管理"
End
Begin as97Popup.asPopup asPopup3
Height = 615
Left = 6720
Top = 4320
Width = 615
_ExtentX = 1085
_ExtentY = 1085
CustomPicture = "FrmUser.frx":0019
MouseOverPicture= "FrmUser.frx":0CF3
MouseDownPicture= "FrmUser.frx":100D
Caption = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
UseFrame = 0 'False
ScaleWidth = 41
ScaleMode = 0
BackStyle = 0
End
Begin VB.Shape Shape1
Height = 255
Left = 120
Top = 360
Width = 375
End
End
Attribute VB_Name = "FrmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub asPopup3_Click(Cancel As Boolean)
Unload Me
End Sub
Private Sub Button1_Click()
On Error GoTo add_error
Adodc1.Recordset.AddNew
add_error:
If err.Number = 3426 Then
MsgBox "添加错误！ 错误：" & err & "，" & err.Description, 0, "提示"
Unload Me
End If
Button1.Enabled = False
End Sub
Private Sub Button2_Click()
On Error GoTo update_error
Adodc1.Recordset.Update
'Adodc1.Recordset.Bookmark = Data1.Recordset.LastModified
update_error:
If err.Number = 3020 Then
MsgBox "Err记录！ 错误：" & err & "，" & err.Description, 0, "提示"
Unload Me
End If
Button1.Enabled = True
Adodc1.Recordset.Update
DataGrid1.Refresh
End Sub
Private Sub Button3_Click()
On Error GoTo moveC_err
' Adodc1.Recordset.e
Adodc1.Recordset.CancelUpdate
moveC_err:
If err.Number = 3021 Then
MsgBox "无当前记录错误：" & err & "，" & err.Description, 0, "提示"
Exit Sub
End If
Button1.Enabled = True
End Sub
Private Sub Button4_Click()
On Error GoTo del_error
a = MsgBox("真的删除吗？", vbExclamation + vbOKCancel + vbApplicationModal, "删除记录")
If a = 1 Then
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveLast
End If
If a = 2 Then Exit Sub
del_error:
If err.Number = 3426 Then
MsgBox "已经全部删除！ 错误：" & err & "，" & err.Description, 0, "提示"
Unload Me
End If
End Sub
Private Sub Button5_Click()
Dim err As Integer
err = MCS_InitComm(0, 115200)
MCS_LED (2)
MCS_Buzzer (1)
err = MCS_Load_Key(0, 12, 255, 255, 255, 255, 255, 255)
err = MCS_Load_Key(4, 12, 255, 255, 255, 255, 255, 255)
MCS_LED (1)
err = MCS_ExitComm()
err = MCS_InitComm(0, 115200)
If err <> 0 Then
MsgBox "com_err"
End If
err = MCS_LED(2)
err = MCS_Config(198, 14)
If err <> 0 Then
MsgBox "config_err"
End If
'tagtype As Integer
err = MCS_Request(1, 4)
If err <> 0 Then
MsgBox "request_err"
End If
err = MCS_Buzzer(1)
If err <> 0 Then
MsgBox "buzzer_err"
End If
err = MCS_Anticoll(0, lserialno)
If err <> 0 Then
MsgBox "anticoll_err"
End If
err = MCS_Select(-560577950, 1)
If err <> 0 Then
MsgBox "select_err"
End If
err = MCS_Authentication(0, 12)
Dim buffer As String * 8
buffer = Text1
err = MCS_Write(48, buffer)
'err = MCS_Read(49, buffer)
'err = MCS_Read(50, buffer)
'err = MCS_Read(51, buffer)
If err <> 0 Then
MsgBox "read_err"
End If
err = MCS_Buzzer(0)
If err <> 0 Then
MsgBox "buzzer_err"
End If
err = MCS_LED(1)
err = MCS_ExitComm()
If err <> 0 Then
MsgBox "exitcomm_err"
End If
MsgBox "发卡完毕！"
End Sub
Private Sub Form_Load()
Me.BackColor = &H80000018
Me.BorderStyle = 0
Shape1.BorderWidth = 8
Shape1.BorderColor = &HFF8080
MoveBar1.BackColor = &HFF8080
MoveBar1.Align = 1
Data1.Visible = False
Adodc1.Visible = False
Data1.DatabaseName = App.Path & "\公司员工考勤库.mdb"
Combo1.AddItem "董事长"
Combo1.AddItem "副董事"
Combo1.AddItem "经理"
Combo1.AddItem "工程师"
Combo1.AddItem "业务员"
Combo1.AddItem "文员"
Combo1.AddItem "工人"
Combo2.AddItem "办公室"
Combo2.AddItem "电气公司"
Combo2.AddItem "电子公司"
Combo2.AddItem "成套厂"
Combo2.AddItem "家具公司"
Dim ConnStr As String
Dim SQL As String
ConnStr = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=" & App.Path & "\公司员工考勤库.mdb"
Adodc1.ConnectionString = ConnStr
Adodc1.CommandType = adCmdText
SQL = "SELECT * FROM 员工信息表"
Adodc1.RecordSource = SQL
Adodc1.Refresh
End Sub
Private Sub Form_Resize()
Shape1.Top = 270
Shape1.Left = 0
Shape1.Height = Me.Height - 270
Shape1.Width = Me.Width
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -