📄 frminouttest.frm
字号:
Left = 945
MaxLength = 5
TabIndex = 3
Top = 270
Width = 960
End
Begin VB.TextBox TxtInOutTimes
Enabled = 0 'False
Height = 285
Left = 4905
TabIndex = 2
Top = 810
Width = 1095
End
Begin MSComCtl2.DTPicker dtpStartingTime
Height = 285
Left = 4905
TabIndex = 4
Top = 315
Width = 1455
_ExtentX = 2566
_ExtentY = 503
_Version = 393216
Enabled = 0 'False
CustomFormat = "yyyy-mm-dd"
Format = 20185089
CurrentDate = 2
MinDate = 2
End
Begin MSComCtl2.DTPicker dtpDeadline
Height = 285
Left = 7605
TabIndex = 5
Top = 315
Width = 1455
_ExtentX = 2566
_ExtentY = 503
_Version = 393216
Enabled = 0 'False
CustomFormat = "yyyy-mm-dd"
Format = 20185089
CurrentDate = 2
MinDate = 2
End
Begin XP_Button.XPButton BtnConfirm
Height = 330
Left = 2340
TabIndex = 6
Top = 270
Width = 1005
_ExtentX = 1773
_ExtentY = 582
caption = "确定"
End
Begin VB.Label LblCard
AutoSize = -1 'True
Caption = "会员卡"
Height = 180
Left = 225
TabIndex = 10
Top = 315
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "起始日期"
Height = 180
Left = 3960
TabIndex = 9
Top = 360
Width = 720
End
Begin VB.Label LblDeadline
AutoSize = -1 'True
Caption = "截止日期"
Height = 180
Left = 6570
TabIndex = 8
Top = 360
Width = 720
End
Begin VB.Label LblInoutTimes
AutoSize = -1 'True
Caption = "使用次数"
Height = 180
Left = 3960
TabIndex = 7
Top = 855
Width = 720
End
End
End
Begin XP_Button.XPButton btnBack
Height = 330
Left = 8640
TabIndex = 36
Top = 6795
Width = 1005
_ExtentX = 1773
_ExtentY = 582
caption = "返回"
End
End
Attribute VB_Name = "FrmInOutTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Rs_Member As ADODB.Recordset '会员
Dim Card As String
Private Sub btnBack_Click()
Unload Me '返回
End Sub
Private Sub BtnConfirm_Click()
'会员卡号
If Not IsNumeric(TxtCard.Text) Or Len(TxtCard.Text) <> 5 Then
MsgBox "请输入会员卡号！会员卡号是由 0-9 中的五位数字组成。", vbInformation, "提示"
Exit Sub
End If
Call ControlClear '清除上一次的信息（从控件中）
Card = Me.TxtCard.Text '输入的卡号
'*************保存会员信息*****************************
Set Rs_Member = New ADODB.Recordset
Rs_Member.Open "SELECT Member.* FROM Member,Card Where Card.ID = '" & Card & "' AND Member.IDCard = Card.UserID", CN, adOpenStatic, adLockOptimistic
If Rs_Member.EOF Then
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\Warning.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
MsgBox "该卡没有注册", vbInformation, "提示"
Exit Sub
End If
'显示会员照片
If Rs_Member!FileLen > 0 Then
Call MdlPic.PhotoDisplay(Me.ImgPhoto, Rs_Member) '传控件
End If
'Me.TxtCard.Text = Rs_Member!ID '编号(他*拥*有*的第一张卡(正使用中的卡))
Me.TxtIDCard.Text = Rs_Member!IDCard '身份证
Me.TxtName.Text = Rs_Member!Name '姓名
'性别
If Rs_Member!Sex = "男" Then
Me.optSex(0).Value = True '男性
Else
Me.optSex(1).Value = True '女性
End If
Me.dtpBirthday.Value = Rs_Member!Birthday '生日
Me.TxtHandSet.Text = Rs_Member!Handset '移动电话
Me.TxtHomeTel.Text = Rs_Member!HomeTel '固定电话
Me.TxtAddress.Text = Rs_Member!Address '住址
Me.TxtCompany.Text = Rs_Member!Company '工作单位
Rs_Member.Close
Set Rs_Member = Nothing
'*************读取会员卡信息*****************************
Dim Rs_Card As ADODB.Recordset
Set Rs_Card = New ADODB.Recordset
Rs_Card.Open "SELECT * FROM Card Where ID ='" & Card & "'", CN, adOpenStatic, adLockOptimistic
If Not Rs_Card.EOF Then
'该卡在数据库中已经存在
'Me.TxtCard.Text = Rs_Card!Id '卡号
Me.dtpStartingTime.Value = Rs_Card!StartingTime '起始时间
Me.dtpDeadline.Value = Rs_Card!Deadline '截止时间
'判断该卡是否过期
If DateDiff("d", Format(Now, "short date"), Rs_Card!Deadline) >= 0 Then
'区分刷卡类型
Select Case Flag_CardCheck
Case 1 '仅仅入场时刷卡
Rs_Card!InOutTimes = Val(TestNull(Rs_Card!InOutTimes)) + 1 '使用次数加1
Rs_Card!EnterTime = Now '记录进入时间
Case 2 '进入离开都刷卡
'判断该次是进场还是出场（离开）
If Rs_Card!EnterTime <= Rs_Card!OutTime Or IsNull(Rs_Card!EnterTime) Then '进场
Rs_Card!InOutTimes = Val(TestNull(Rs_Card!InOutTimes)) + 1 '使用次数加1
Rs_Card!EnterTime = Now '记录出入时间
Else '离开
Rs_Card!OutTime = Now '记录出入时间
End If
Case Else
End Select
Else
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\Over.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
MsgBox "该卡已过期"
Exit Sub
End If
Me.TxtInOutTimes.Text = Val(TestNull(Rs_Card!InOutTimes)) '显示出入次数
Rs_Card.Update
End If
Rs_Card.Close
Set Rs_Card = Nothing
'************储物箱**************************
Dim Rs_Chest As ADODB.Recordset
Set Rs_Chest = New ADODB.Recordset
Rs_Chest.Open "SELECT Chest.* FROM Chest,Card,Member Where Card.ID = '" & Card & "' And Card.UserID = Member.IDCard And Member.IDCard = Chest.UserID", CN, adOpenStatic, adLockOptimistic
If Not Rs_Chest.EOF Then
'该箱在数据库中已经存在
Me.TxtChest.Text = Rs_Chest!Id '箱号
Me.dtpBoxStarting.Value = Rs_Chest!StartingTime '起始时间
Me.dtpBoxDeadLine.Value = Rs_Chest!Deadline '截止时间
End If
Rs_Chest.Close
Set Rs_Chest = Nothing
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\succeed.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
End Sub
'自动滤掉不合格的字符
Private Sub TxtCard_Change()
Dim i As Integer
Dim TxtStr As String
Dim GetTxt As String
GetTxt = Me.TxtCard.Text
Dim OverTxt As String
For i = 1 To Len(GetTxt)
Dim OneChar As String
OneChar = Mid(GetTxt, i, 1)
If IsNumeric(OneChar) Then
OverTxt = OverTxt & OneChar
End If
Next
Me.TxtCard.Text = OverTxt
Me.TxtCard.SelStart = Len(OverTxt) '让光标停留在最后一位
End Sub
'清除用于输入控件的显示内容
Public Sub ControlClear()
Me.TxtName.Text = ""
Me.TxtIDCard = ""
Me.TxtAddress.Text = ""
Me.TxtChest = ""
Me.TxtCompany = ""
Me.TxtHandSet = ""
Me.TxtHomeTel = ""
optSex(0).Value = True
Me.dtpBirthday.Value = "1980-01-01"
Me.dtpBoxDeadLine.Value = "1900-01-01"
Me.dtpBoxStarting.Value = "1900-01-01"
Me.dtpStartingTime.Value = "1900-01-01"
Me.dtpDeadline.Value = "1900-01-01"
Set Me.ImgPhoto.Picture = Nothing
End Sub
Private Sub Form_Load()
Me.Show '必须的否则控件的SetFocus 方法会失败
Me.TxtCard.SetFocus '输入会员卡号文本框获得焦点
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -