📄 borrowreturn_frm.frm
字号:
TabIndex = 2
Top = 1050
Width = 2745
End
Begin CSCommand.Command cmdBorrowOK
Height = 600
Left = 5520
TabIndex = 43
Top = 1320
Width = 1050
_ExtentX = 1852
_ExtentY = 1058
PICMaskColor = 16711680
Icon = "borrowreturn_frm.frx":0F1A
Caption = "确定"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
FontColor = 32768
DisabledFontColor= 32768
ShowFocus = 0 'False
Appearance = 2
BackStyle = 0
End
Begin CSCommand.Command cmdReturnOK
Height = 600
Left = -67680
TabIndex = 44
Top = 1920
Width = 1050
_ExtentX = 1852
_ExtentY = 1058
PICMaskColor = 16711680
Icon = "borrowreturn_frm.frx":1BF4
Caption = "确定"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
FontColor = 32768
DisabledFontColor= 32768
ShowFocus = 0 'False
Appearance = 2
BackStyle = 0
End
Begin VB.Label Label16
Caption = "图书编号:"
Height = 330
Left = -74055
TabIndex = 32
Top = 1260
Width = 1380
End
Begin VB.Label Label3
Caption = "图书编号:"
Height = 330
Left = 945
TabIndex = 5
Top = 1680
Width = 1275
End
Begin VB.Label Label2
Caption = "借书证编号:"
Height = 330
Left = 945
TabIndex = 3
Top = 1155
Width = 1905
End
End
Begin CSCommand.Command cmdExit
Height = 600
Left = 7800
TabIndex = 42
Top = 240
Width = 1050
_ExtentX = 1852
_ExtentY = 1058
PICMaskColor = 16711680
Icon = "borrowreturn_frm.frx":28CE
Caption = "退出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
FontColor = 32768
DisabledFontColor= 32768
ShowFocus = 0 'False
Appearance = 2
BackStyle = 0
End
Begin ShockwaveFlashObjectsCtl.ShockwaveFlash sf1
Height = 1065
Left = 315
TabIndex = 41
Top = 105
Width = 1065
_cx = 1879
_cy = 1879
FlashVars = ""
Movie = ""
Src = ""
WMode = "Transparent"
Play = -1 'True
Loop = -1 'True
Quality = "High"
SAlign = ""
Menu = -1 'True
Base = ""
AllowScriptAccess= "always"
Scale = "ShowAll"
DeviceFont = 0 'False
EmbedMovie = 0 'False
BGColor = ""
SWRemote = ""
End
Begin VB.Shape Shape1
BorderColor = &H0000FFFF&
BorderWidth = 2
Height = 1065
Left = 210
Shape = 3 'Circle
Top = 105
Visible = 0 'False
Width = 1275
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "借 书 与 还 书 管 理"
BeginProperty Font
Name = "华文彩云"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000002&
Height = 540
Left = 2100
TabIndex = 0
Top = 315
Width = 5370
End
End
Attribute VB_Name = "borrowandreturn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rsReaderInfo As ADODB.Recordset '声明读者信息记录集,用于验证该读者是否有权限借阅某本书
Dim rsAmount As ADODB.Recordset '声明读者已经借阅图书数量记录集,用于验证读者能够借阅的数量是否已经达到
Dim rsBorrow As ADODB.Recordset '声明借书记录集,用于验证某本书是否可借以及显示某本书的详细信息
Dim rsReturn As ADODB.Recordset '声明还书记录集
Dim cmdBorrow As ADODB.Command '声明借书命令对象
Dim cmdReturn As ADODB.Command '声明还书命令对象
Dim rsPrice As ADODB.Recordset
'Private Sub cmdBorrowCancel_Click()
' 'txtReaderID.Text = ""
' txtBookID.Text = ""
' txtBookID.SetFocus
'End Sub
Private Sub cmdBorrowOK_Click()
'判断记录集状态
If rsBorrow.State = 1 Then
rsBorrow.Close
End If
'判断记录集状态
If rsReaderInfo.State = 1 Then
rsReaderInfo.Close
End If
'判断记录集状态
If rsAmount.State = 1 Then
rsAmount.Close
End If
'打开记录集
rsBorrow.Open "select * from bookdetails inner join bookclass on bookdetails.isbn=bookclass.isbn where bookid='" & txtBookID.Text & "'", cnn.c, adOpenDynamic, adLockOptimistic
rsReaderInfo.Open "select readerdetails.grade,rights.grade,rights.borrowamount from readerdetails inner join rights on readerdetails.grade=rights.grade where readerid='" & txtReaderID.Text & "'", cnn.c, adOpenDynamic, adLockOptimistic
rsAmount.Open "select * from borrow where state='未还' and readerid='" & txtReaderID.Text & "'", cnn.c, adOpenDynamic, adLockPessimistic
'判断借书证的合法性
If rsReaderInfo.RecordCount = 0 Then
MsgBox "这个借书证编号不存在,请检查输入是否正确。"
Exit Sub
End If
'判断图书编号的合法性
If rsBorrow.RecordCount = 0 Then
MsgBox "这个图书编号不存在,请检查输入是否正确。"
Exit Sub
End If
'判断读者是否有权限借阅某本书
If rsReaderInfo.Fields("grade") < rsBorrow.Fields("grade") Then
MsgBox "这个图书证无权借阅此书!"
Exit Sub
End If
'判断借书数量是否已经达到读者所能借阅数量的上限
If rsAmount.RecordCount = rsReaderInfo.Fields("borrowamount") Then
MsgBox "这个借书证最多只能借" & rsReaderInfo.Fields("borrowamount") & "本书,数量已经达到,不能在借"
Exit Sub
End If
'判断图书是否可借(即是否已经出借)
If rsBorrow.Fields("state") = "已经出借" Then
MsgBox "此书已经出借!", vbOKOnly + vbQuestion
Exit Sub
Else
'改变图书状态
cmdBorrow.CommandText = "update bookdetails set state='已经出借' where bookid='" & txtBookID.Text & "'"
cmdBorrow.Execute
'向借书表添加借书记录
cmdBorrow.CommandText = "insert into borrow(bookid,readerid,outdate,outoperid,expired)" & _
"values('" & txtBookID.Text & "','" & txtReaderID.Text & "',N'" & Format(Date, "yyyy-mm-dd") & "','" & operatorid & "',N'" & Format((Date + 30), "yyyy-mm-dd") & "')"
cmdBorrow.Execute
End If
rsBorrow.Requery
Detailsdisp '显示图书详细信息
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdReturnOK_Click()
Dim expiredDates As Integer '声明超期天数
Dim amerce As Single ' 声明罚款金额
Dim punishcase As String '声明处罚原因
Dim punishdecision As String '声明处罚办法
'清空还书情况栏
clearLable
'判断记录集状态
If rsReturn.State = 1 Then
rsReturn.Close
End If
'判断记录集状态
If rsPrice.State = 1 Then
rsPrice.Close
End If
'判断输入还书编号是否存在
rsReturn.Open "select * from borrow where bookid='" & txtBookIDReturn.Text & "' and state='未还'", cnn.c, adOpenStatic, adLockOptimistic
rsPrice.Open "select price from bookclass inner join bookdetails on bookclass.isbn=bookdetails.isbn where bookid='" & txtBookIDReturn.Text & "'", cnn.c, adOpenStatic, adLockOptimistic
If rsReturn.RecordCount = 0 Then
MsgBox "找不到该未还图书"
Exit Sub
End If
'图书超期处理
If Format(rsReturn.Fields("expired"), "yyyy-mm-dd") < Format(Date, "yyyy-mm-dd") Then
expiredDates = CDate(Format(Date, "yyyy-mm-dd")) - CDate(Format(rsReturn.Fields("expired"), "yyyy-mm-dd"))
If expiredDates * rsPrice.Fields("price") * 0.001 < 0.5 Then
amerce = 0.5
Else
amerce = expiredDates * rsPrice.Fields("price") * 0.001
End If
punishcase = "[超期]"
punishdecision = "[罚款]"
MsgBox "图书已经超期" & expiredDates & "天,应交罚款" & amerce & "元"
End If
'图书污损处理
If optDirty.Value = True Then
MsgBox "图书污损,罚款2元"
amerce = amerce + 2
punishcase = punishcase & "[污损]"
punishdecision = punishdecision & "[罚款]"
End If
'图书丢失处理
If optLost.Value = True Then
Dim peichang As Integer
punishcase = punishcase & "[丢失]"
'丢失赔偿方式选择
peichang = MsgBox("图书丢失,是否赔偿新书?", vbYesNo)
If peichang = vbNo Then
MsgBox "图书丢失,按图书价格3倍赔偿,总共是:" & rsPrice.Fields("price") * 3
amerce = amerce + rsPrice.Fields("price") * 3
punishdecision = punishdecision & "[罚款]"
Else
punishdecision = punishdecision & "[赔新书]"
End If
End If
'数据库更新
If amerce <> 0 Or optLost.Value = True Then
lblPunishCase.Caption = "图书状态:" & punishcase
lblPunishDecision.Caption = "处罚办法:" & punishdecision
lblAmerce.Caption = "应交罚款:" & amerce
If MsgBox("确认还书吗?", vbYesNo) = vbYes Then
cmdReturn.CommandText = "update borrow set state='已还',returndate=N'" & Format(Date, "yyyy-mm-dd") & "',returnoperid='" & operatorid & "',punishcase='" & punishcase & "',punishdecision='" & punishdecision & "',amerce=" & amerce & " where bookid='" & txtBookIDReturn.Text & "' and state='未还'"
cmdReturn.Execute
cmdReturn.CommandText = "update bookdetails set state='可以出借' where bookid='" & txtBookIDReturn.Text & "'"
cmdReturn.Execute
MsgBox "图书已还"
Else
MsgBox "还书操作被取消"
clearLable
Exit Sub
End If
Else
cmdReturn.CommandText = "update borrow set state='已还',returndate=N'" & Format(Date, "yyyy-mm-dd") & "',returnoperid='" & operatorid & "' where bookid='" & txtBookIDReturn.Text & "'and state='未还'"
cmdReturn.Execute
cmdReturn.CommandText = "update bookdetails set state='可以出借' where bookid='" & txtBookIDReturn.Text & "'"
cmdReturn.Execute
lblPunishCase.Caption = "正常还书"
MsgBox "图书已还"
End If
End Sub
Private Sub Form_Load()
Set cmdBorrow = New ADODB.Command
Set cmdReturn = New ADODB.Command
Set rsBorrow = New ADODB.Recordset
Set rsReturn = New ADODB.Recordset
Set rsReaderInfo = New ADODB.Recordset
Set rsAmount = New ADODB.Recordset
Set rsPrice = New ADODB.Recordset
rsBorrow.CursorLocation = adUseClient '设定游标类型为客户端游标
rsReaderInfo.CursorLocation = adUseClient '设定游标类型为客户端游标
rsAmount.CursorLocation = adUseClient '设定游标类型为客户端游标
rsReturn.CursorLocation = adUseClient '设定游标类型为客户端游标
Set cmdBorrow.ActiveConnection = cnn.c
Set cmdReturn.ActiveConnection = cnn.c
cmdBorrow.CommandType = adCmdText
cmdReturn.CommandType = adCmdText
optNormal.Value = 1
sf1.Movie = App.Path & "\图书.swf"
sf1.Play
End Sub
'显示图书详细信息模块
Private Sub Detailsdisp()
With rsBorrow
lblBookID.Caption = .Fields("bookid")
lblBookName.Caption = .Fields("bookname")
lblAuthor.Caption = .Fields("author")
lblPublisher.Caption = .Fields("publisher")
lblInDate.Caption = .Fields("indate")
lblClass.Caption = .Fields("class")
lblBookCase.Caption = .Fields("bookcase")
lblGrade.Caption = .Fields("grade")
lblState.Caption = .Fields("state")
lblPrice.Caption = .Fields("price")
lblISBN.Caption = .Fields("isbn")
lblTerm.Caption = .Fields("term")
End With
End Sub
'清空还书情况栏模块
Private Sub clearLable()
lblPunishCase.Caption = ""
lblPunishDecision.Caption = ""
lblAmerce.Caption = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -