📄 读者库操作.frm
字号:
VERSION 5.00
Begin VB.Form 读者库操作
Caption = "图书管理系统"
ClientHeight = 3315
ClientLeft = 5355
ClientTop = 2445
ClientWidth = 5535
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 3315
ScaleWidth = 5535
Begin VB.CommandButton op
Caption = "保存"
Height = 375
Index = 5
Left = 4560
TabIndex = 17
Top = 2280
Width = 855
End
Begin VB.TextBox txtID
BackColor = &H80000000&
DataField = "ReaderID"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 10
Top = 240
Width = 3135
End
Begin VB.TextBox TxtName
DataField = "ReaderName"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 9
Top = 720
Width = 3135
End
Begin VB.TextBox TxtLevel
DataField = "Level"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 8
Top = 1200
Width = 3135
End
Begin VB.TextBox TxtAddr
DataField = "Address"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 7
Top = 1680
Width = 3135
End
Begin VB.TextBox TxtTel
DataField = "TelephoneNumber"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 6
Top = 2160
Width = 3135
End
Begin VB.TextBox TxtEmail
DataField = "Email"
DataMember = "Reader"
DataSource = "de"
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 5
Top = 2640
Width = 3135
End
Begin VB.CommandButton op
Caption = "修改"
Height = 375
Index = 4
Left = 4560
TabIndex = 4
Top = 1920
Width = 855
End
Begin VB.CommandButton op
Caption = "删除"
Height = 375
Index = 3
Left = 4560
TabIndex = 3
Top = 1560
Width = 855
End
Begin VB.CommandButton op
Caption = "添加"
Height = 375
Index = 2
Left = 4560
TabIndex = 2
Top = 1200
Width = 855
End
Begin VB.CommandButton op
Caption = "下移"
Height = 375
Index = 1
Left = 4560
TabIndex = 1
Top = 840
Width = 855
End
Begin VB.CommandButton op
Caption = "上移"
Height = 375
Index = 0
Left = 4560
TabIndex = 0
Top = 480
Width = 855
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "读者识别号"
Height = 180
Left = 240
TabIndex = 16
Top = 240
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "读者姓名"
Height = 180
Left = 240
TabIndex = 15
Top = 750
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "读者权限"
Height = 180
Left = 240
TabIndex = 14
Top = 1245
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "联系方法"
Height = 180
Left = 240
TabIndex = 13
Top = 1680
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "电话号码"
Height = 180
Left = 240
TabIndex = 12
Top = 2160
Width = 720
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "电子邮件"
Height = 180
Left = 240
TabIndex = 11
Top = 2640
Width = 720
End
End
Attribute VB_Name = "读者库操作"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
CanBrowse
End Sub
Private Sub Form_Unload(Cancel As Integer)
系统操作.Show
End Sub
Private Sub op_Click(Index As Integer) '注意：数据环境中的READER中的LOCKED应改为Optimistic
Dim rst As ADODB.Recordset
Dim strsql As String
Dim tmpID As String, temp As String
Set rst = de.rsReader
Select Case Index
Case 0: '上移
rst.MovePrevious
If rst.BOF = True Then rst.MoveFirst
Case 1: '下移
rst.MoveNext
If rst.EOF = True Then rst.MoveLast
Case 2: '增加
tmpID = txtID '自动产生ID号
If Len(CStr(rst.RecordCount + 1)) > 1 Then '此举产生ID号为01和11的效果
tmpID = Left(tmpID, 4) + CStr(rst.RecordCount + 1)
Else
tmpID = Left(tmpID, 4) + "0" + CStr(rst.RecordCount + 1)
End If
rst.AddNew
txtID.Text = tmpID
CanModify
Case 3: '删除
If MsgBox("确实要删除该记录吗？", vbOKCancel) = vbOK Then
rst.Delete adAffectCurrent
rst.MoveNext
If rst.EOF Then rst.MoveFirst
End If
Case 4: '修改
CanModify
Case 5: '保存到数据库中
If Not Trim(TxtName) = "" Then
With rst
!Readername = TxtName '权限可以不填
If Not Trim(TxtLevel) = "" Then '若你填的不正确，会自动设成默认值
If Len(TxtLevel) = Len(CStr(Val(TxtLevel))) Then '判断此填数字的文本框中有无字母
!Level = TxtLevel
Else
MsgBox "你所填权限信息有误，已改成默认值。若要修改，请按修改！"
!Level = 7
End If
Else
MsgBox "你未填权限信息，已改成默认值。若要修改，请按修改！"
!Level = 7
End If
If Not Trim(TxtAddr) = "" Then
!address = TxtAddr
Else
MsgBox "你未填权限信息，已改成默认值。若要修改，请按修改！"
!address = "USA"
End If
If Not Trim(TxtTel) = "" Then
If Len(TxtTel) = Len(CStr(Val(TxtTel))) Then
!telephonenumber = TxtTel
Else
MsgBox "你所填权限信息有误，已改成默认值。若要修改，请按修改！"
!telephonenumber = 110
End If
Else
MsgBox "你未填权限信息，已改成默认值。若要修改，请按修改！"
!telephonenumber = 110
End If
If Not Trim(TxtEmail) = "" Then
!Email = TxtEmail
Else
MsgBox "你未填权限信息，已改成默认值。若要修改，请按修改！"
!Email = "@dsa.sohu.com"
End If
.Update
MsgBox "读者数据已保存"
End With
Else
MsgBox "所填信息不全或有误！数据库未被修改"
rst.CancelUpdate
End If
CanBrowse
End Select
End Sub
Private Sub CanModify()
'''''''''''''''''''''''''''''''''''''''''''''''''
'函数名： CanModify
'入口参数： 无
'出口参数： 无
'''''''''''''''''''''''''''''''''''''''''''''''''
'函数功能： 对数据库的浏览功能切换成可修改功能
' 用于添加、修改按钮和窗口初始化时
'''''''''''''''''''''''''''''''''''''''''''''''''
TxtName.Enabled = True
TxtLevel.Enabled = True
TxtTel.Enabled = True
TxtAddr.Enabled = True
TxtEmail.Enabled = True
op(0).Enabled = False
op(1).Enabled = False
op(2).Enabled = False
op(3).Enabled = False
op(4).Enabled = False
op(5).Enabled = True
End Sub
Private Sub CanBrowse()
'''''''''''''''''''''''''''''''''''''''''''''''''
'函数名： CanBrowse
'入口参数： 无
'出口参数： 无
'''''''''''''''''''''''''''''''''''''''''''''''''
'函数功能： 对数据库的可修改功能切换成浏览功能
' 用于保存按钮
'''''''''''''''''''''''''''''''''''''''''''''''''
TxtName.Enabled = False
TxtLevel.Enabled = False
TxtTel.Enabled = False
TxtAddr.Enabled = False
TxtEmail.Enabled = False
op(0).Enabled = True
op(1).Enabled = True
op(2).Enabled = True
op(3).Enabled = True
op(4).Enabled = True
op(5).Enabled = False
End Sub
' If de.rsReader.State = 0 Then de.Libarary.Open
' If de.rsReader.State = 0 Then de.Reader
' Dim oldop As Integer
' oldop = Index
' If Index = 4 Then
' With de.Libarary
' If .State = 0 Then .Open
' .Execute strSql
' End With
' End If
' Case 5: '保存
' If oldop = 2 Then
' strsql = "insert into reader values(" + txtid + ",'" + Trim(Txtname) + "','" + Trim(TxtAddr) + "'," + TxtTel + ",'" + Trim(TxtEmail) + "', " + Txtlevel + ") "
' de.Libarary.Execute strsql
' End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -