adfrm.frm

图书管理系统：分成图书管理模块和图书查询模块

'在调用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
   Text6.Text = ""
   Text6.BackColor = &H8000000F
   Text6.Enabled = False
End If
If Check1.Value = 1 Then
   Text6.BackColor = &HFFFFFF
   Text6.Enabled = True
   Text6.SetFocus
End If
End Sub

Private Sub Check2_Click()
If Check2.Value = 0 Then
   Text7.Text = ""
   Text7.BackColor = &H8000000F
   Text7.Enabled = False
End If
If Check2.Value = 1 Then
   Text7.BackColor = &HFFFFFF
   Text7.Enabled = True
   Text7.SetFocus
End If

End Sub

Private Sub Check3_Click()
If Check3.Value = 0 Then
   Combo1.Text = ""
   Combo1.Enabled = False
End If
If Check3.Value = 1 Then
   Combo1.Enabled = True
   Combo1.SetFocus
End If

End Sub

Private Sub Check4_Click()
If Check4.Value = 0 Then
   Text8.Text = ""
   Text8.BackColor = &H8000000F
   Text8.Enabled = False
End If
If Check4.Value = 1 Then
   Text8.BackColor = &HFFFFFF
   Text8.Enabled = True
   Text8.SetFocus
End If

End Sub

Private Sub Check5_Click()
If Check5.Value = 0 Then
   Text9.Text = ""
   Text9.BackColor = &H8000000F
   Text9.Enabled = False
End If
If Check5.Value = 1 Then
   Text9.BackColor = &HFFFFFF
   Text9.Enabled = True
   Text9.SetFocus
End If

End Sub

Private Sub Command1_Click()
'借书用户身份确定
Dim mystr As String
Dim response As String

mystr = "帐号" & "=" & "'" & Trim(Text1.Text) & "'"

If Data3.Recordset.RecordCount = 0 Then
   response = MsgBox("对不起！您不是注册用户，无权借书！", vbExclamation, "警告")
   Text1.Text = ""
   Text2.Text = ""
   Text1.SetFocus
   Exit Sub
End If

Data3.Refresh
Data3.Recordset.MoveFirst
Data3.Recordset.FindFirst mystr

If Not Data3.Recordset.NoMatch Then
   If Trim(Data3.Recordset.Fields("密码")) = Trim(Text2.Text) Then
      Text16.Text = Data3.Recordset.Fields("用户名")
      Text17.Text = Data3.Recordset.Fields("已借本数")
      Data2.RecordSource = "select * from 借书单 where " & mystr
      Data2.Refresh
      If Val(Text17.Text) < 5 Then
         Text3.Enabled = True
         Text3.BackColor = &HFFFFFF
         Text3.SetFocus
         Command2.Enabled = True
      Else
         response = MsgBox("对不起！您已经达到借书本数上限，不能再借！", vbExclamation, "警告")
         Text1.Text = ""
         Text1.SetFocus
         Text2.Text = ""
         Text16.Text = ""
         Text17.Text = ""
      End If
   Else
      response = MsgBox("对不起！您的密码输入有误，请重新输入！", vbExclamation, "警告")
      Text2.Text = ""
      Text2.SetFocus
   End If
Else
   response = MsgBox("对不起！您不是注册用户，无权借书！", vbExclamation, "警告")
   Text1.Text = ""
   Text2.Text = ""
   Text1.SetFocus
End If

End Sub

Private Sub Command10_Click()
'遗失书籍登记操作
Dim i, j As Integer
Dim s, t As String
Dim response As String

i = MSFlexGrid8.RowSel
j = MSFlexGrid8.Rows

Data12.Recordset.AbsolutePosition = i - 1

s = Data12.Recordset.Fields("帐号")
t = Data12.Recordset.Fields("书名")

If j = 2 Then
   MSFlexGrid8.AddItem "", 1
   MSFlexGrid8.RemoveItem (2)
   Data12.Recordset.Delete
Else
   MSFlexGrid8.RemoveItem (i)
   Data12.Recordset.AbsolutePosition = i - 1
   Data12.Recordset.Delete
End If

Data13.Recordset.MoveFirst
Data13.Recordset.FindFirst "帐号" & "=" & "'" & s & "'"
Data13.Recordset.Edit
Data13.Recordset.Fields("已借本数") = Data6.Recordset.Fields("已借本数") - 1
Data13.Recordset.Update

Data11.Recordset.MoveFirst
Data11.Recordset.FindFirst "书名" & "=" & "'" & t & "'"
Label18.Caption = CStr(Data11.Recordset.Fields("价格"))
Label19.Caption = CStr(Val(Label18.Caption) * 2)
Data11.Recordset.Edit
Data11.Recordset.Fields("现有数量") = Data4.Recordset.Fields("现有数量") + 1
Data11.Recordset.Update

Text12.Text = ""
Text13.Text = ""
Text12.SetFocus
Command10.Enabled = False
Data12.RecordSource = "select * from 借书单 where 帐号=' '"
Data12.Refresh
End Sub

Private Sub Command11_Click()
'登记新书介绍
Dim response As String

If Text15.Text = "" Or Text14.Text = "" Or Combo2.Text = "" Then
   response = MsgBox("请将书籍信息填写完整！", vbInformation, "提示")
   Text14.SetFocus
   Exit Sub
End If

Data14.Recordset.AddNew
Data14.Recordset.Fields("书名") = Text14.Text
Data14.Recordset.Fields("分类") = Combo2.Text
Data14.Recordset.Fields("简介") = Text15.Text
Data14.Recordset.Update

Call Command12_Click
End Sub

Private Sub Command12_Click()
'取消登记新书介绍
Text14.Text = ""
Text14.SetFocus
Text15.Text = ""
Combo2.Text = ""

End Sub
Private Sub Command2_Click()
'借书操作
Dim mystr As String
Dim mystr1 As String
Dim mystr2 As String
Dim mystr3 As String
Dim bookname As String
Dim response As String
Dim response1 As String

Const M = "m"

mystr = "ISBN" & "=" & "'" & Trim(Text3.Text) & "'"
mystr3 = "帐号" & "=" & "'" & Trim(Text1.Text) & "'"

Data1.Recordset.MoveFirst
Data1.Recordset.FindFirst mystr

If Check6.Value = 1 Then
   If Data15.Recordset.RecordCount = 0 Then
      Check6.Value = 0
      Text3.Text = ""
      Exit Sub
   End If
End If

If Data1.Recordset.NoMatch Then
   Text3.Text = ""
   Exit Sub
End If

If Val(Text17.Text) = 5 Then
   response1 = MsgBox("对不起！您已经达到借书本数上限，不能再借！", vbExclamation, "警告")
   Text1.Text = ""
   Text1.SetFocus
   Text2.Text = ""
   Text3.Text = ""
   Text16.Text = ""
   Text17.Text = ""
   Exit Sub
End If

bookname = Data1.Recordset.Fields("书名")
mystr1 = Data1.Recordset.Fields("书名") & Chr(9) & Data1.Recordset.Fields("作者1") & Chr(9) & Data1.Recordset.Fields("作者2") & Chr(9) & Data1.Recordset.Fields("ISBN") & Chr(9) & Data1.Recordset.Fields("主题词") & Chr(9) & Data1.Recordset.Fields("分类") & Chr(9) & Data1.Recordset.Fields("出版社") & Chr(9) & Data1.Recordset.Fields("价格") & Chr(9) & CStr(Data1.Recordset.Fields("总量"))

MSFlexGrid2.AddItem mystr1, MSFlexGrid2.Rows - 1

If Check6.Value = 1 Then
   Data15.Recordset.MoveFirst
   Data15.Recordset.FindFirst mystr3
   Data15.Recordset.Delete
   Data15.Refresh
End If
If Check6.Value = 0 Then
   Data1.Recordset.Edit
   Data1.Recordset.Fields("现有数量") = Data1.Recordset.Fields("现有数量") - 1
   Data1.Recordset.Update
End If

Data2.Recordset.AddNew
Data2.Recordset.Fields("帐号") = Text1.Text
Data2.Recordset.Fields("书名") = bookname
Data2.Recordset.Fields("借书日期") = Date
Data2.Recordset.Fields("还书日期") = DateAdd(M, 2, Date)
Data2.Recordset.Update

Data3.Recordset.Edit
Data3.Recordset.Fields("已借本数") = Data3.Recordset.Fields("已借本数") + 1
Data3.Recordset.Update


response = MsgBox("当前用户是否继续进行操作？", vbYesNo, "提示")
If response = vbYes Then
   Data3.Refresh
   Data2.Refresh
   Text17.Text = Data3.Recordset.Fields("已借本数")
   Text3.Text = ""
   Text3.SetFocus
   Check6.Value = 0
   Call Command1_Click
End If
If response = vbNo Then
   Text1.Text = ""
   Text1.SetFocus
   Text2.Text = ""
   Text3.Text = ""
   Text3.BackColor = &H8000000F
   Text3.Enabled = False
   Command2.Enabled = False
   Text16.Text = ""
   Text17.Text = ""
   Data2.RecordSource = "select * from 借书单 where 帐号=''"
   Data2.Refresh
End If
End Sub

Private Sub Command3_Click()
'还书身份确认
Dim mystr As String
Dim response As String

mystr = "帐号" & "=" & "'" & Trim(Text4.Text) & "'"

Data6.Recordset.MoveFirst
Data6.Recordset.FindFirst mystr

If Not Data6.Recordset.NoMatch Then
   If Trim(Data6.Recordset.Fields("密码")) = Trim(Text5.Text) Then
      'Command4.Enabled = True
      Data5.RecordSource = "select * from 借书单 where " & mystr
      Data5.Refresh
   Else
      response = MsgBox("对不起！您的密码输入有误，请重新输入！", vbExclamation, "警告")
      Text5.Text = ""
      Text5.SetFocus
   End If
End If

End Sub

Private Sub Command4_Click()
'还书操作
Dim i, j As Integer
Dim myday As Long
Dim s, t, r, Y As String
Dim response As String
Dim response1 As String
Dim response2 As String
Dim mydate1 As Date
Dim mydate2 As Date
Const M = "d"

i = MSFlexGrid4.RowSel
j = MSFlexGrid4.Rows

Data5.Recordset.AbsolutePosition = i - 1
mydate1 = Data5.Recordset.Fields("还书日期")
mydate2 = Date
myday = DateDiff(M, mydate1, mydate2)

s = Data5.Recordset.Fields("帐号")
t = Data5.Recordset.Fields("书名")
r = CStr(Data5.Recordset.Fields("借书日期"))
Y = s & Chr(9) & t & Chr(9) & r & Chr(9) & CStr(Date)

If j = 2 Then
   MSFlexGrid4.AddItem "", 1
   MSFlexGrid4.RemoveItem (2)
   Data5.Recordset.Delete
Else
   MSFlexGrid4.RemoveItem (i)
   Data5.Recordset.AbsolutePosition = i - 1
   Data5.Recordset.Delete
End If

MSFlexGrid3.AddItem Y, MSFlexGrid3.Rows - 1


Data6.Recordset.MoveFirst
Data6.Recordset.FindFirst "帐号" & "=" & "'" & s & "'"
Data6.Recordset.Edit
Data6.Recordset.Fields("已借本数") = Data6.Recordset.Fields("已借本数") - 1
Data6.Recordset.Update

If Data7.Recordset.RecordCount > 0 Then
   Data7.Recordset.MoveFirst
   Data7.Recordset.FindFirst "书名" & "=" & "'" & t & "'"
   If Not Data7.Recordset.NoMatch Then