📄 frmuser_check.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmuser_check
BorderStyle = 1 'Fixed Single
Caption = "读者登记"
ClientHeight = 4860
ClientLeft = 45
ClientTop = 330
ClientWidth = 4545
Icon = "frmuser_check.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4860
ScaleWidth = 4545
StartUpPosition = 1 '所有者中心
Tag = "check"
Begin VB.OptionButton Option1
Caption = "女"
Height = 375
Index = 1
Left = 2280
TabIndex = 4
Top = 1440
Width = 495
End
Begin VB.OptionButton Option1
Caption = "男"
Height = 375
Index = 0
Left = 1320
TabIndex = 3
Top = 1440
Width = 495
End
Begin VB.TextBox txt_user
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 1
EndProperty
Height = 375
Index = 3
Left = 1080
MaxLength = 18
TabIndex = 5
Text = "3"
ToolTipText = "支持15位或18位身份证号"
Top = 2040
Width = 1815
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3960
Top = 4200
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Cmd_Ucheck_exit
Caption = "退出(&E)"
Height = 375
Left = 2640
TabIndex = 9
Top = 4200
Width = 1095
End
Begin VB.CommandButton Cmd_User_Check
Caption = "确认(&O)"
Default = -1 'True
Height = 375
Left = 840
TabIndex = 8
Top = 4200
Width = 1095
End
Begin VB.TextBox txt_user
Height = 615
Index = 5
Left = 1080
MultiLine = -1 'True
TabIndex = 7
Text = "frmuser_check.frx":08CA
Top = 3240
Width = 3255
End
Begin VB.TextBox txt_user
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 1
EndProperty
Height = 375
Index = 4
Left = 1080
MaxLength = 11
TabIndex = 6
Text = "4"
Top = 2640
Width = 1815
End
Begin VB.TextBox txt_user
Height = 375
Index = 1
Left = 1080
MaxLength = 4
TabIndex = 2
Text = "1"
Top = 840
Width = 1815
End
Begin VB.TextBox txt_user
BackColor = &H80000004&
BeginProperty DataFormat
Type = 1
Format = "##########"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
Enabled = 0 'False
Height = 375
Index = 0
Left = 1080
MaxLength = 10
TabIndex = 1
Text = "txt_user()"
Top = 240
Width = 1815
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 1815
Left = 3000
Picture = "frmuser_check.frx":08CE
Stretch = -1 'True
ToolTipText = "左键点击添加相片，右键点击删除相片"
Top = 120
Width = 1335
End
Begin VB.Label lbl_CHECK_DATE
Alignment = 2 'Center
Caption = "2004-11-20"
Height = 255
Left = 3240
TabIndex = 16
Top = 2520
Width = 975
End
Begin VB.Label Label2
Caption = "登记日期"
Height = 255
Left = 3360
TabIndex = 15
Top = 2160
Width = 735
End
Begin VB.Label lbl_user
Caption = "读者地址"
Height = 255
Index = 5
Left = 120
TabIndex = 14
Top = 3360
Width = 855
End
Begin VB.Label lbl_user
Caption = "读者电话"
Height = 255
Index = 4
Left = 120
TabIndex = 13
Top = 2760
Width = 855
End
Begin VB.Label lbl_user
Caption = "身份证号"
Height = 255
Index = 3
Left = 120
TabIndex = 12
Top = 2160
Width = 855
End
Begin VB.Label lbl_user
Caption = "读者性别"
Height = 255
Index = 2
Left = 120
TabIndex = 11
Top = 1560
Width = 855
End
Begin VB.Label lbl_user
Caption = "读者姓名"
Height = 255
Index = 1
Left = 120
TabIndex = 10
Top = 960
Width = 855
End
Begin VB.Label lbl_user
Caption = "读者编号"
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 360
Width = 855
End
End
Attribute VB_Name = "frmuser_check"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rds_userid As ADODB.Recordset
Option Explicit
Public Sub renew()
Dim i As Integer
Dim userid As String
rds_userid.Open "select max(USER_ID) from 读者信息", myconn, adOpenKeyset, adLockOptimistic, 1
If IsNull(rds_userid.Fields(0)) Then
txt_user(0).Text = 1
txt_user(0).SelStart = Len(txt_user(0)) + 1
Else
txt_user(0).Text = rds_userid.Fields(0) + 1
txt_user(0).SelStart = Len(txt_user(0)) + 1
End If
rds_userid.Close
For i = 1 To 5
If i <> 2 Then txt_user(i) = ""
Next i
Option1(0).Value = 1
'Image1.Picture = LoadPicture(App.Path + "\ico\photo.ico")
End Sub
Private Sub Form_Activate()
Set rds_userid = New ADODB.Recordset
If Me.Tag = "check" Then
Call renew
lbl_CHECK_DATE.Caption = Date
End If
End Sub
Private Sub Cmd_User_Check_Click()
Dim str_sex As String, str_photo As String
Dim i As Integer
'对信息的判断
'Debug.Print "txt_user(3).Tag:"; txt_user(3).Tag
For i = 0 To 5
If i <> 2 Then
If txt_user(i) = "" Then MsgBox "请输入" + lbl_user(i): txt_user(i).SetFocus: Exit Sub
End If
Next i
If Option1(0) = True Then str_sex = "男" Else: str_sex = "女"
'控制身份证号的长度为15或18位,且要求除最后一位可以X外,其它全为数字
'判断身份证号前17位是否为数字
If Not IsNumeric(Mid(txt_user(3), 1, 17)) Then
MsgBox "请输入正确的身份证号"
txt_user(3).SetFocus
txt_user(3).SelStart = 0
txt_user(3).SelLength = Len(txt_user(3))
Exit Sub
End If
'判断身份证号是否等于15位或18位
If Not (Len(txt_user(3)) = 15 Or Len(txt_user(3)) = 18) Then
MsgBox "请输入正确的身份证号"
txt_user(3).SetFocus
txt_user(3).SelStart = 0
txt_user(3).SelLength = Len(txt_user(3))
Exit Sub
'如果是18位最后一位如果不是数字允许是‘X’或‘x’
ElseIf Len(txt_user(3)) = 18 Then
If Not IsNumeric(Mid(txt_user(3), 18, 1)) And Not (Mid(txt_user(3), 18, 1) = "x" Or Mid(txt_user(3), 18, 1) = "X") Then
MsgBox "请输入正确的身份证号"
txt_user(3).SetFocus
txt_user(3).SelStart = 0
txt_user(3).SelLength = Len(txt_user(3))
Exit Sub
End If
End If
'控制电话号码必须为数字
If Not IsNumeric(txt_user(4)) Then
MsgBox "请输入正确的电话号码"
txt_user(4).SetFocus
txt_user(4).SelStart = 0
txt_user(4).SelLength = Len(txt_user(4))
Exit Sub
End If
'控制读者相片
If Image1.Picture.Type = 3 Then
MsgBox "请添加读者相片"
Exit Sub
End If
str_photo = CommonDialog1.FileName
With rds_user
If txt_user(3).Tag <> txt_user(3).Text Then
If .State = adStateOpen Then .Close
.Open "select USER_IDENTIFICATION from 读者信息 where USER_IDENTIFICATION='" + txt_user(3) + "'", myconn, adOpenKeyset, adLockPessimistic, 1
If .RecordCount > 0 Then
'If .Fields(0) <> "" Then
MsgBox "身份证号是唯一的而它已存在", vbCritical
txt_user(3).SetFocus
txt_user(3).SelStart = 0
txt_user(3).SelLength = Len(txt_user(3))
.Close
Exit Sub
End If
.Close
End If
If Me.Tag = "check" Then
If .State = adStateOpen Then .Close
.Open "读者信息", myconn, adOpenKeyset, adLockPessimistic, adCmdTable
.AddNew
.Update "USER_ID", txt_user(0)
ElseIf Me.Tag = "modify" Then
If .State = adStateOpen Then .Close
.Open "select * from 读者信息 where USER_ID='" + txt_user(0) + "'", myconn, adOpenKeyset, adLockPessimistic, 1
End If
.Update "USER_NAME", txt_user(1)
.Update "USER_SEX", str_sex
.Update "USER_IDENTIFICATION", txt_user(3)
.Update "USER_TEL", txt_user(4)
.Update "USER_ADDRESS", txt_user(5)
.Update "USER_PHOTO", str_photo
.Update "USER_CHECK_DATE", CDate(lbl_CHECK_DATE)
.Close
End With
Call renew
If Me.Tag = "regedit" Then
MsgBox "添加成功"
ElseIf Me.Tag = "modify" Then
Unload Me
End If
End Sub
Private Sub Cmd_Ucheck_exit_Click()
Me.Tag = "check"
Unload Me
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
CommonDialog1.Filter = "*.bmp|*.bmp;*.jpg|*.jpg;*.ico|*.ico"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Image1.Picture = LoadPicture(CommonDialog1.FileName)
Else
Image1.Picture = LoadPicture(App.Path + "\ico\photo.ico")
End If
End If
If Button = 2 And Image1.Picture.Type = 1 Then
If MsgBox("确认删除照片？", vbCritical + vbOKCancel) = vbOK Then Image1.Picture = LoadPicture(App.Path + "\ico\photo.ico")
End If
End Sub
Private Sub txt_user_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{ENTER}"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -