📄 rdfrm.frm
字号:
PasswordChar = "*"
TabIndex = 65
Top = 2280
Width = 1335
End
Begin VB.Data Data10
Caption = "Data10"
Connect = "Access"
DatabaseName = "F:\vb程序1\vb程序1\V_Library.mdb"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 2880
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "读者名单"
Top = 4200
Visible = 0 'False
Width = 1815
End
Begin VB.CommandButton Command12
Caption = "修改信息"
Enabled = 0 'False
Height = 255
Left = 3360
TabIndex = 62
Top = 3720
Width = 975
End
Begin VB.TextBox Text17
Height = 270
Left = 3120
TabIndex = 61
Top = 3240
Width = 2775
End
Begin VB.TextBox Text16
Height = 270
Left = 3120
TabIndex = 60
Top = 2760
Width = 2775
End
Begin VB.TextBox Text15
Height = 270
IMEMode = 3 'DISABLE
Left = 3120
PasswordChar = "*"
TabIndex = 59
Top = 1800
Width = 1335
End
Begin VB.CommandButton Command11
Caption = "身份确认"
Height = 255
Left = 5400
TabIndex = 53
Top = 630
Width = 975
End
Begin VB.TextBox Text14
Height = 270
IMEMode = 3 'DISABLE
Left = 3960
MaxLength = 7
PasswordChar = "*"
TabIndex = 52
Top = 615
Width = 1335
End
Begin VB.TextBox Text13
Height = 270
Left = 1920
MaxLength = 8
TabIndex = 51
Top = 615
Width = 1335
End
Begin VB.Label Label4
Caption = "密码验证"
Height = 255
Left = 2400
TabIndex = 64
Top = 2280
Width = 735
End
Begin VB.Label Label17
Caption = "联系地址"
Height = 255
Left = 2400
TabIndex = 58
Top = 3240
Width = 735
End
Begin VB.Label Label16
Caption = "工作单位"
Height = 255
Left = 2400
TabIndex = 57
Top = 2760
Width = 735
End
Begin VB.Label Label15
Caption = "新 密 码"
Height = 255
Left = 2400
TabIndex = 56
Top = 1800
Width = 735
End
Begin VB.Label Label14
Caption = "用 户 名"
Height = 255
Left = 2400
TabIndex = 55
Top = 1320
Width = 735
End
Begin VB.Label Label18
BorderStyle = 1 'Fixed Single
Height = 255
Left = 3120
TabIndex = 54
Top = 1320
Width = 1335
End
Begin VB.Label Label13
Caption = "密 码"
Height = 255
Left = 3360
TabIndex = 50
Top = 630
Width = 615
End
Begin VB.Label Label12
Caption = "帐 号"
Height = 255
Left = 1320
TabIndex = 49
Top = 630
Width = 615
End
End
End
Attribute VB_Name = "rdfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private FormOldWidth As Long
'保存窗体的原始宽度
Private FormOldHeight As Long
'保存窗体的原始高度
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0
End Sub
'按比例改变表单内各元件的大小，
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / FormOldWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / FormOldHeight
'保存窗体高度缩放比例
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
'读取控件的原始位置与大小
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next i
Next Obj
On Error GoTo 0
End Sub
'判断查询条件
Private Sub Check1_Click()
If Check1.Value = 0 Then
Text4.Enabled = False
Text4.BackColor = &H8000000F
Text4.Text = ""
End If
If Check1.Value = 1 Then
Text4.Enabled = True
Text4.BackColor = &HFFFFFF
Text4.SetFocus
End If
End Sub
Private Sub Check2_Click()
If Check2.Value = 0 Then
Text5.Enabled = False
Text5.BackColor = &H8000000F
Text5.Text = ""
End If
If Check2.Value = 1 Then
Text5.Enabled = True
Text5.BackColor = &HFFFFFF
Text5.SetFocus
End If
End Sub
Private Sub Check3_Click()
If Check3.Value = 0 Then
Combo1.Enabled = False
Combo1.Text = ""
End If
If Check3.Value = 1 Then Combo1.Enabled = True
End Sub
Private Sub Check4_Click()
If Check4.Value = 0 Then
Text6.Enabled = False
Text6.BackColor = &H8000000F
Text6.Text = ""
End If
If Check4.Value = 1 Then
Text6.Enabled = True
Text6.BackColor = &HFFFFFF
Text6.SetFocus
End If
End Sub
Private Sub Check5_Click()
If Check5.Value = 0 Then
Text7.Enabled = False
Text7.BackColor = &H8000000F
Text7.Text = ""
End If
If Check5.Value = 1 Then
Text7.Enabled = True
Text7.BackColor = &HFFFFFF
Text7.SetFocus
End If
End Sub
Private Sub Command1_Click()
'预订书身份确认
Dim mystr As String
Dim response As String
mystr = "帐号" & "=" & "'" & Trim(Text1.Text) & "'"
Data1.Recordset.MoveFirst
Data1.Recordset.FindFirst mystr
If Not Data1.Recordset.NoMatch Then
If Trim(Data1.Recordset.Fields("密码")) = Trim(Text2.Text) Then
Command2.Enabled = True
Text3.SetFocus
Else
response = MsgBox("对不起！您的密码输入有误，请重新输入！", vbExclamation, "警告")
Text2.Text = ""
Text2.SetFocus
End If
End If
End Sub
Private Sub Command10_Click()
'刷新列表
List1.Clear
If Data9.Recordset.RecordCount > 0 Then
Data9.Recordset.MoveFirst
Do While Not Data9.Recordset.EOF
List1.AddItem (Data9.Recordset.Fields("书名").Value)
Data9.Recordset.MoveNext
Loop
End If
End Sub
Private Sub Command11_Click()
'修改信息身份确认
Dim mystr As String
Dim response As String
Dim response1 As String
mystr = "帐号" & "=" & "'" & Trim(Text13.Text) & "'"
Data10.Recordset.MoveFirst
Data10.Recordset.FindFirst mystr
If Not Data10.Recordset.NoMatch Then
If Trim(Data10.Recordset.Fields("密码")) = Trim(Text14.Text) Then
Command12.Enabled = True
Label18.Caption = Data10.Recordset.Fields("用户名")
Text16.Text = Data10.Recordset.Fields("工作单位")
Text17.Text = Data10.Recordset.Fields("联系地址")
Text15.SetFocus
Else
response = MsgBox("对不起！您的密码输入有误，请重新输入！", vbExclamation, "警告")
Text14.Text = ""
Text14.SetFocus
End If
Else
response1 = MsgBox("对不起！您的帐号输入有误，请重新输入！", vbExclamation, "警告")
Text13.Text = ""
Text13.SetFocus
End If
End Sub
Private Sub Command12_Click()
'修改信息
Dim response As String
If Text15.Text <> Text18.Text Then
response = MsgBox("密码输入有误！请重新输入！", vbExclamation, "提示")
Text18.Text = ""
Text18.SetFocus
Exit Sub
End If
Data10.Recordset.Edit
If Text15.Text <> "" Then Data10.Recordset.Fields("密码") = Text15.Text
If Text16.Text <> "" Then Data10.Recordset.Fields("工作单位") = Text16.Text
If Text17.Text <> "" Then Data10.Recordset.Fields("联系地址") = Text17.Text
Data10.Recordset.Update
Text13.Text = ""
Text13.SetFocus
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Label18.Caption = ""
Command12.Enabled = False
End Sub
Private Sub Command2_Click()
'预订书籍预操作
Dim mystr As String
Dim response As String
If Text3.Text = "" Then
response = MsgBox("请填写您要预订的书籍名称！", vbInformation, "提示")
End If
mystr = "书名" & "=" & "'" & Text3.Text & "'"
Data3.Refresh
Data3.RecordSource = "select * from 书库清单 where " & mystr
Data3.Refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -