?? 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 + -