📄 frm_borrowbook.frm
字号:
Top = 6840
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "确定"
ToolTip = "用户充值"
BackColor = 14737632
ForeColor = 8421504
MouseDownColor = -2147483644
MouseOnColor = -2147483644
StyleColor = 16777215
Style3dColor1 = 16577259
Style3dColor2 = 8421504
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
IfDraw = -1 'True
End
Begin LabMangeSystem.XButton Cmd_Clear
Height = 375
Left = 1680
TabIndex = 3
Top = 6840
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "清空"
ToolTip = "清空记录"
BackColor = 14737632
ForeColor = 8421504
MouseDownColor = -2147483644
MouseOnColor = -2147483644
StyleColor = 16777215
Style3dColor1 = 16577259
Style3dColor2 = 8421504
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
IfDraw = -1 'True
End
Begin LabMangeSystem.XButton Cmd_Close
Height = 375
Left = 2880
TabIndex = 4
Top = 6840
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "关闭"
ToolTip = "刷新记录"
BackColor = 14737632
ForeColor = 8421504
MouseDownColor = -2147483644
MouseOnColor = -2147483644
StyleColor = 16777215
Style3dColor1 = 16577259
Style3dColor2 = 8421504
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
IfDraw = -1 'True
End
Begin VB.Line Line_SplitShadow
BorderColor = &H00FFFFFF&
X1 = 255
X2 = 255
Y1 = 615
Y2 = 6855
End
Begin VB.Line Line_Split
BorderColor = &H00C0C0C0&
X1 = 240
X2 = 240
Y1 = 600
Y2 = 6840
End
End
Attribute VB_Name = "Frm_BorrowBook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim IsRID As String '输入的正确的读者编号
Dim strSQL As String 'SQL查询语句
Dim strSELECT As String 'SQL查询语句的SELECT子句
Dim strFROM As String 'SQL查询语句的FROM子句
Dim strWHERE As String 'SQL查询语句的WHERE子句
Dim Err_Msg As String '错误信息
Option Explicit
Private Sub Cmd_Clear_Click()
Dim i As Integer
Txt_RID.Text = vbNullString
For i = 0 To 8
Txt_Reader(i).Text = vbNullString
Next i
Txt_BID.Text = vbNullString
For i = 0 To 5
Txt_Book(i).Text = vbNullString
Next i
Lbl_ShowRID.caption = vbNullString
IsRID = vbNullString
Lst_View.ListItems.Clear
Txt_RID.SetFocus
End Sub
Private Sub Cmd_Close_Click()
Call Cmd_TBarClose_Click
End Sub
Private Sub Cmd_OK_Click()
On Error GoTo ERRORZONE
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim i As Integer
Dim num As Integer
strSQL = "SELECT * FROM 读者档案 WHERE 读者编号 = " & Str2SQL(IsRID)
rs.Open strSQL, cnMain, 1, 1
If rs("状态") = "停用" Then
MsgFrm "读者 [ " & rs("姓名") & " ] 为停用状态，不可借书！", "x", "错误"
Exit Sub
End If
num = Lst_View.ListItems.Count
For i = 1 To Lst_View.ListItems.Count
If Lst_View.ListItems(i).Checked = False Then num = num - 1
Next i
If num = 0 Then MsgFrm "请选择要借出的图书！", "x", "错误": Exit Sub
If num + Val(rs("当前借书数量")) > Val(Txt_Reader(8).Text) Then
MsgFrm "超过借书数量上限！", "x", "错误"
Exit Sub
End If
num = Lst_View.ListItems.Count
For i = 1 To Lst_View.ListItems.Count
If Lst_View.ListItems(i).Checked = False Then num = num - 1: GoTo ADDOVER
cnMain.Execute "INSERT 图书借阅 VALUES(" & _
Str2SQL(Format(Date, "yymmdd") & Format(Time, "hhnnss") & Format(i, "000")) & "," & _
Str2SQL(Lst_View.ListItems(i).ListSubItems(1).Text) & "," & _
Str2SQL(IsRID) & "," & _
Str2SQL(Format(Date, "yyyy-mm-dd")) & "," & _
Str2SQL(Lst_View.ListItems(i).ListSubItems(4).Text) & ", Null, '0', " & _
Str2SQL(strUID) & ", Null)"
cnMain.Execute "UPDATE 图书库存 SET 状态 = '借出'" & _
",最近读者编号 = " & Str2SQL(IsRID) & _
",最近借阅日期 = " & Str2SQL(Format(Date, "yyyy-mm-dd")) & _
" WHERE 图书编号 = " & Str2SQL(Lst_View.ListItems(i).ListSubItems(1).Text)
ADDOVER:
Next i
cnMain.Execute "UPDATE 读者档案 SET 当前借书数量 = 当前借书数量 + " & num & _
",总借书数量 = 总借书数量 + " & num & _
",总借书次数 = 总借书次数 + 1" & _
",未还书总数 = 未还书总数 + " & num & _
" WHERE 读者编号 = " & Str2SQL(IsRID)
MsgFrm "借书成功！共借出 " & num & " 本图书。", "!", "借书成功"
Call Cmd_Clear_Click
Exit Sub
ERRORZONE:
MsgFrm Err.Description, "x", "错误"
End Sub
Private Sub Cmd_TBarClose_Click()
Unload Me
Frm_Welcome.Show
Set LastForm = Frm_Welcome
End Sub
Private Sub Form_Load()
Call HideContorl
If HavePower("办理借书权限") = False Then
Lbl_TBarText.ForeColor = RGB(255, 0, 0)
Lbl_TBarText.caption = "您没有权限完成当前操作！"
Exit Sub
End If
Lbl_TBarText.caption = Me.caption
Call ShowContorl
End Sub
Private Sub Form_Resize()
On Error Resume Next
Frame_Reader.Width = Me.Width - Frame_Reader.Left - 240 - 45
Line_Split1.X2 = Frame_Reader.Width - Line_Split1.X1 - 45
Line_Split1_Shadow.X2 = Line_Split1.X2
Frame_Book.Width = Frame_Reader.Width
Line_Split2.X2 = Line_Split1.X2
Line_Split2_Shadow.X2 = Line_Split1.X2
Cmd_OK.Top = Me.Height - Cmd_OK.Height - 240 - 435
Cmd_Clear.Top = Cmd_OK.Top
Cmd_Close.Top = Cmd_OK.Top
Frame_View.Width = Frame_Reader.Width
Frame_View.Height = Cmd_OK.Top - Frame_View.Top - 105
Lst_View.Width = Line_Split1.X2 - Line_Split1.X1
Lst_View.Height = Frame_View.Height - Lst_View.Top - 240
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call ShowTip
End Sub
Private Sub Pic_TitleBar_Resize()
On Error Resume Next
Cmd_TBarClose.Left = Pic_TitleBar.Width - 24 * 15
End Sub
'隐藏所有控件
Private Sub HideContorl()
Frame_Reader.Visible = False
Frame_Book.Visible = False
Frame_View.Visible = False
Cmd_OK.Visible = False
Cmd_Clear.Visible = False
Cmd_Close.Visible = False
End Sub
'显示所有控件
Private Sub ShowContorl()
Frame_Reader.Visible = True
Frame_Book.Visible = True
Frame_View.Visible = True
Cmd_OK.Visible = True
Cmd_Clear.Visible = True
Cmd_Close.Visible = True
End Sub
Private Sub Txt_BID_KeyPress(KeyAscii As Integer)
If KeyAscii <> 13 Then Exit Sub
If IsRID = vbNullString Then MsgFrm "请先输入正确的读者编号！", "!", "提示": Exit Sub
Dim i As Integer
For i = 1 To Lst_View.ListItems.Count
If Lst_View.ListItems(i).ListSubItems(1).Text = Trim(Txt_BID.Text) Then
MsgFrm "编号为 [ " & Trim(Txt_BID.Text) & " ] 的图书已经添加！", "x", "重复添加"
Exit Sub
End If
Next i
On Error GoTo ERRORZONE
Dim rs As New ADODB.Recordset
Dim xBID As String
xBID = Str2SQL(Txt_BID.Text)
strSELECT = "SELECT 图书名称, 作者, CONVERT(varchar(10),每日租金,0) AS 每日租金, 出版社名称, 图书档案.ISBN, 可否外借 = CASE WHEN 可否外借 = 1 THEN '是' ELSE '否' END, 状态"
strFROM = "FROM 图书档案, 图书库存"
strWHERE = "WHERE 图书编号 = " & xBID & " AND 图书档案.ISBN = 图书库存.ISBN"
strSQL = strSELECT & " " & strFROM & " " & strWHERE
rs.Open strSQL, cnMain, 1, 1
If rs.EOF Then
MsgFrm "找不到编号为" & Trim(Txt_BID.Text) & "的图书！", "x", "错误"
Txt_BID.SetFocus
Exit Sub
ElseIf rs(rs.Fields.Count - 1) = "借出" Then
MsgFrm "编号为" & Trim(Txt_BID.Text) & "的图书已借出！", "x", "错误"
Txt_BID.SetFocus
Exit Sub
ElseIf rs(rs.Fields.Count - 2) = "否" Then
MsgFrm "编号为" & Trim(Txt_BID.Text) & "的图书不可外借！", "x", "错误"
Txt_BID.SetFocus
Exit Sub
End If
For i = 0 To rs.Fields.Count - 2
Txt_Book(i).Text = rs(i)
Next i
i = Lst_View.ListItems.Count + 1
Lst_View.ListItems.Add i, , Txt_Book(0).Text
Lst_View.ListItems.Item(i).ListSubItems.Add , , Txt_BID.Text
Lst_View.ListItems.Item(i).ListSubItems.Add , , Txt_Book(4).Text
Lst_View.ListItems.Item(i).ListSubItems.Add , , Txt_Book(2).Text
Lst_View.ListItems.Item(i).ListSubItems.Add , , Format(DateAdd("d", Val(Txt_Reader(5).Text), Date), "yyyy-mm-dd")
Lst_View.ListItems.Item(i).Checked = True
Exit Sub
ERRORZONE:
MsgFrm Err.Description, "x", "错误"
End Sub
Private Sub Txt_RID_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Txt_RID_Validate(False)
End Sub
Private Sub Txt_RID_Validate(Cancel As Boolean)
On Error GoTo ERRORZONE
Dim rs As New ADODB.Recordset
Dim xRID As String
Dim i As Integer
xRID = Str2SQL(Txt_RID.Text)
If xRID = "''" Then Exit Sub
strSELECT = "SELECT 姓名, 性别, 读者档案.读者类别, CONVERT(varchar(10),账户金额,0) AS 账户余额, 状态, 借书时间期限, 当前借书数量, 借书数量限制 - 当前借书数量, 借书数量限制"
strFROM = "FROM 读者档案, 读者类别"
strWHERE = "WHERE 读者编号 = " & xRID & " AND 读者档案.读者类别 = 读者类别.读者类别"
strSQL = strSELECT & " " & strFROM & " " & strWHERE
rs.Open strSQL, cnMain, 1, 1
If rs.EOF Then
MsgFrm "找不到编号为" & Trim(Txt_RID.Text) & "的用户！", "x", "错误"
IsRID = vbNullString
Txt_RID.SetFocus
Exit Sub
End If
For i = 0 To rs.Fields.Count - 1
Txt_Reader(i).Text = rs(i) & vbNullString
Next i
Txt_BID.SetFocus
IsRID = Trim(Txt_RID.Text)
Lbl_ShowRID = IsRID
Exit Sub
ERRORZONE:
MsgFrm Err.Description, "x", "错误"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -