📄 frmreader.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmreader
BorderStyle = 3 'Fixed Dialog
Caption = "读者信息"
ClientHeight = 7455
ClientLeft = 45
ClientTop = 405
ClientWidth = 9300
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7455
ScaleWidth = 9300
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdExit
Caption = "返 回(&X)"
Height = 615
Left = 4320
TabIndex = 18
Top = 5640
Width = 1935
End
Begin VB.CommandButton cmd
Caption = "保 存(&S)"
Height = 615
Left = 1920
TabIndex = 17
Top = 5640
Width = 1935
End
Begin VB.TextBox txtItem
Height = 375
Index = 3
Left = 5280
TabIndex = 10
Top = 960
Width = 2415
End
Begin VB.TextBox txtItem
Height = 375
Index = 2
Left = 5280
TabIndex = 9
Top = 480
Width = 2415
End
Begin VB.Frame Frame1
Caption = "读者信息"
Height = 5415
Left = 240
TabIndex = 0
Top = 0
Width = 8775
Begin VB.Frame Frame3
Caption = "照片"
Height = 3615
Left = 3360
TabIndex = 14
Top = 1560
Width = 5295
Begin MSComDlg.CommonDialog cdlg
Left = 4320
Top = 2280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "..."
Height = 495
Left = 4320
TabIndex = 16
Top = 1560
Width = 855
End
Begin VB.CheckBox Check1
Height = 375
Left = 4320
TabIndex = 15
Top = 960
Width = 855
End
Begin VB.Image Image1
Height = 3255
Left = 120
Stretch = -1 'True
Top = 240
Width = 3975
End
End
Begin VB.Frame Frame2
Caption = "性别"
Height = 2655
Left = 480
TabIndex = 11
Top = 2280
Width = 1575
Begin VB.OptionButton Option1
Caption = "女"
Height = 255
Index = 1
Left = 360
TabIndex = 13
Top = 1440
Width = 735
End
Begin VB.OptionButton Option1
Caption = "男"
Height = 255
Index = 0
Left = 360
TabIndex = 12
Top = 600
Width = 735
End
End
Begin VB.TextBox txtItem
Height = 420
Index = 1
Left = 1440
TabIndex = 8
Top = 960
Width = 1815
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1440
TabIndex = 7
Top = 480
Width = 1815
End
Begin VB.Label Label2
Caption = "借 书 数"
Height = 375
Index = 4
Left = 480
TabIndex = 6
Top = 1680
Width = 735
End
Begin VB.Label Label2
Caption = "出生时间"
Height = 375
Index = 3
Left = 4080
TabIndex = 5
Top = 1080
Width = 735
End
Begin VB.Label Label2
Caption = "姓 名"
Height = 375
Index = 2
Left = 480
TabIndex = 4
Top = 1080
Width = 735
End
Begin VB.Label Label2
Caption = "专 业 名"
Height = 375
Index = 1
Left = 4080
TabIndex = 3
Top = 480
Width = 735
End
Begin VB.Label Label2
Caption = "借书证号"
Height = 375
Index = 0
Left = 480
TabIndex = 2
Top = 480
Width = 735
End
Begin VB.Label Label1
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 420
Left = 1440
TabIndex = 1
Top = 1560
Width = 1815
End
End
End
Attribute VB_Name = "frmReader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mrc As ADODB.Recordset
Public txtsql As String
Public ImageChang As Integer
Public jszh As String
Private Sub Check1_Click()
If Check1.Value = 0 Then '表示无照片信息,命令按钮不可用
Image1.Picture = Nothing
Command1.Visible = False
Else '表示有照片信息时,添加和修改操作下,命令按钮command1可用
If flagadd = 1 Or flagadd = 2 Then
Command1.Visible = True
End If
End If
End Sub
Private Sub cmd_Click()
Dim icount As Integer
Dim smeg As String
Dim mrcc As ADODB.Recordset
Dim msgtext As String
Dim xm, zym As String
Dim jszh1 As String
Dim xb As Integer
Dim cssj As Date
Dim cnn As ADODB.Connection
Dim jss As Integer
Dim cmddele As New ADODB.Command
Select Case flagadd
Case 1 '对于添加操作的处理
xb = 0
If Trim(Combo1.Text & "") = "" Then
smeg = "借书证号"
End If
For icount = 1 To 2
If Trim(txtItem(icount) & "") = "" Then
Select Case icount
Case 1
smeg = "姓名"
Case 2
smeg = "专业名"
End Select
smeg = smeg & "不能为空!"
MsgBox smeg, vbOKOnly + vbExclamation, "警告"
txtItem(icount).SetFocus
Exit Sub
End If
Next icount
If Not IsDate(Trim(txtItem(3))) Then
MsgBox "请输入日期!", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
txtItem(3) = Format(txtItem(3), "yyyy-mm-dd")
End If
jszh = Combo1.Text
Combo1.AddItem Trim(jszh)
xm = txtItem(1).Text
zym = txtItem(2).Text
cssj = CDate(txtItem(3).Text)
If Option1(1) Then
xb = 1
End If
txtsql = "select * from xs where 借书证号='" & Trim(Combo1.Text) + "'"
Set mrcc = ExecuteSQL(txtsql, msgtext)
If mrcc.EOF = False Then
MsgBox "此借书证号已存在!", vbOKOnly + vbExclamation, "警告"
Combo1.SetFocus
mrcc.Close
Else
Set cnn = New ADODB.Connection
cnn.Open ConnectString
cnn.Execute "exec xs_insert '" & jszh & "', '" & xm & "',' " & zym & "', " & xb & ", '" & cssj & "'"
cnn.Close
If Check1.Value = 1 Then
jszh1 = jszh
Call SaveToDB(FileName, jszh1)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -