safrm.frm

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

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 addbook_Click()
'增添书籍操作
Dim mystr As String
Dim mystr1 As String
Dim response1 As String

If Text1.Text = "" Or Text2.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Combo1.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Then
   response1 = MsgBox("请将书籍信息填写完整！", vbExclamation, "警告")
   Text1.SetFocus
   Exit Sub
End If
mystr = "ISBN" & "=" & "'" & Trim(Text4.Text) & "'"
mystr1 = Text1.Text & Chr(9) & Text2.Text & Chr(9) & Text3.Text & Chr(9) & Text4.Text & Chr(9) & Text5.Text & Chr(9) & Combo1.Text & Chr(9) & Text7.Text & Chr(9) & Text8.Text & Chr(9) & Text9.Text
If Data1.Recordset.RecordCount = 0 Then
   Data1.Recordset.AddNew
   Data1.Recordset.Fields("书名").Value = Text1.Text
   Data1.Recordset.Fields("作者1").Value = Text2.Text
   Data1.Recordset.Fields("作者2").Value = Text3.Text
   Data1.Recordset.Fields("ISBN").Value = Text4.Text
   Data1.Recordset.Fields("主题词").Value = Text5.Text
   Data1.Recordset.Fields("分类").Value = Combo1.Text
   Data1.Recordset.Fields("出版社").Value = Text7.Text
   Data1.Recordset.Fields("价格").Value = Text8.Text
   Data1.Recordset.Fields("总量").Value = Val(Text9.Text)
   Data1.Recordset.Fields("现有数量").Value = Val(Text9.Text)
   Data1.Recordset.Update
   MSFlexGrid2.AddItem mystr1, MSFlexGrid2.Rows - 1
Else
   Data1.Recordset.MoveFirst
   Data1.Recordset.FindFirst mystr
   If Data1.Recordset.NoMatch Then
      Data1.Recordset.AddNew
      Data1.Recordset.Fields("书名").Value = Text1.Text
      Data1.Recordset.Fields("作者1").Value = Text2.Text
      Data1.Recordset.Fields("作者2").Value = Text3.Text
      Data1.Recordset.Fields("ISBN").Value = Text4.Text
      Data1.Recordset.Fields("主题词").Value = Text5.Text
      Data1.Recordset.Fields("分类").Value = Combo1.Text
      Data1.Recordset.Fields("出版社").Value = Text7.Text
      Data1.Recordset.Fields("价格").Value = Text8.Text
      Data1.Recordset.Fields("总量").Value = Val(Text9.Text)
      Data1.Recordset.Fields("现有数量").Value = Val(Text9.Text)
      Data1.Recordset.Update
      MSFlexGrid2.AddItem mystr1, MSFlexGrid2.Rows - 1
      
   Else
      Data1.Recordset.Edit
      Data1.Recordset.Fields("总量").Value = Val(Text9.Text) + Data1.Recordset.Fields("总量").Value
      Data1.Recordset.Fields("现有数量").Value = Val(Text9.Text) + Data1.Recordset.Fields("现有数量").Value
      Data1.Recordset.Update
      MSFlexGrid2.AddItem mystr1, MSFlexGrid2.Rows - 1
   End If
End If
Call cancelbook_Click
End Sub

Private Sub cancelbook_Click()
'取消增加书籍操作
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Combo1.Text = ""
Text1.SetFocus
End Sub

'判断查询条件
Private Sub Check1_Click()
If Check1.Value = 0 Then
   Text6(0).Enabled = False
   Text6(0).BackColor = &H8000000F
   Text6(0).Text = ""
End If
If Check1.Value = 1 Then
   Text6(0).Enabled = True
   Text6(0).BackColor = &HFFFFFF
   Text6(0).SetFocus
End If
End Sub

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

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

End Sub

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

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


Private Sub Command1_Click()
'查询
Dim selectsql As String
selectsql = ""

If Text6(0).Text <> "" Then selectsql = selectsql & " and 书名" & "=" & "'" & Text6(0).Text & "'"
If Text6(1).Text <> "" Then selectsql = selectsql & " and 作者1" & "=" & "'" & Text6(1).Text & "' or 作者2" & "=" & "'" & Text6(1).Text & "'"
If Combo2.Text <> "" Then selectsql = selectsql & " and 分类" & "=" & "'" & Combo2.Text & "'"
If Text6(2).Text <> "" Then selectsql = selectsql & " and 主题词" & "=" & "'" & Text6(2).Text & "'"
If Text6(3).Text <> "" Then selectsql = selectsql & " and 出版社" & "=" & "'" & Text6(3).Text & "'"

If selectsql <> "" Then
   Data3.Refresh
   Data3.RecordSource = "select * from 书库清单 where 书名<>''" & selectsql
   Data3.Refresh
   Call Command2_Click
End If
End Sub

Private Sub Command10_Click()
'取消删除用户
Text20.Text = ""
Text21.Text = ""
Option4.Value = False
Option5.Value = False
End Sub

Private Sub Command2_Click()
'取消查询
Dim j As Integer
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0
For j = 0 To 3
    Text6(j).Text = ""
    Text6(j).Enabled = False
    Text6(j).BackColor = &H8000000F
Next j
Combo2.Text = ""
Combo2.Enabled = False
End Sub

Private Sub Command3_Click()
'读者查询
Dim mystr As String
If Text10.Text <> "" Then mystr = "用户名" & "=" & "'" & Text10.Text & "'"

If mystr <> "" Then
   Data4.Refresh
   Data4.RecordSource = "select * from 读者名单 where " & mystr
   Data4.Refresh
   Text10.Text = ""
   Text10.SetFocus
End If

End Sub

Private Sub Command4_Click()
'读者查询全部
Data4.Refresh
Data4.RecordSource = "select * from 读者名单"
Data4.Refresh
End Sub

Private Sub Command5_Click()
'管理员查询
Dim mystr As String

If Text11.Text <> "" Then mystr = "用户名" & "=" & "'" & Text11.Text & "'"

If mystr <> "" Then
   Data5.Refresh
   Data5.RecordSource = "select * from 管理员名单 where " & mystr
   Data5.Refresh
   Text11.Text = ""
   Text11.SetFocus
End If

End Sub

Private Sub Command6_Click()
'管理员查询全部
Data5.Refresh
Data5.RecordSource = "select * from 管理员名单"
Data5.Refresh
Text11.Text = ""
Text11.SetFocus

End Sub

Private Sub Command7_Click()
'注册管理员
Dim response As String
Dim mystr As String
Dim mystr1 As String
Dim response1 As String
Dim response2 As String

mystr1 = "用户名" & "=" & "'" & Trim(Text12.Text) & "'"

If Option1.Value = True Then
   If Text12.Text = "" Or Text13.Text = "" Or Combo3.Text = "" Then
      Exit Sub
      response = MsgBox("请将资料填写完整！", vbExclamation, "警告")
      Text12.SetFocus
   Else
      If Data6.Recordset.RecordCount > 0 Then
         Data6.Recordset.MoveFirst
         Data6.Recordset.FindFirst mystr1
         If Not Data6.Recordset.NoMatch Then
            response2 = MsgBox("这个用户名已经有人使用！", vbInformation, "提示")
            Text12.Text = ""
            Text12.SetFocus
         Else
            Data6.Recordset.AddNew
            Data6.Recordset.Fields("用户名") = Text12.Text
            Data6.Recordset.Fields("密码") = Text13.Text
            Data6.Recordset.Fields("权限") = Combo3.Text
            Data6.Recordset.Update
            Text12.Text = ""
            Text13.Text = ""
            Combo3.Text = ""
         End If
      Else
         Data6.Recordset.AddNew
         Data6.Recordset.Fields("用户名") = Text12.Text
         Data6.Recordset.Fields("密码") = Text13.Text
         Data6.Recordset.Fields("权限") = Combo3.Text
         Data6.Recordset.Update
         Text12.Text = ""
         Text13.Text = ""
         Combo3.Text = ""
      End If
   End If
   
End If

If Option2.Value = True Then
   mystr = "用户名" & "=" & "'" & Trim(Text12.Text) & "'"
   Data6.Recordset.MoveFirst
   Data6.Recordset.FindFirst mystr
   If Not Data6.Recordset.NoMatch Then
      If Trim(Data6.Recordset.Fields("密码")) = Trim(Text14.Text) Then
         Data6.Recordset.Edit
         Data6.Recordset.Fields("密码") = Text13.Text
         Data6.Recordset.Update
         Text12.Text = ""
         Text13.Text = ""
         Text14.Text = ""
      Else
         response1 = MsgBox("您无权修改密码！", vbExclamation, "警告")
         Call Option2_Click
      End If
   
   End If
   
End If


End Sub

Private Sub Command8_Click()
'注册读者
Dim response As String
Dim response1 As String
Dim mystr As String

If Text16.Text = "" Or Text17.Text = "" Or Text18.Text = "" Or Text19.Text = "" Then
   response = MsgBox("请将资料输入完整！", vbExclamation, "警告")
   Call Option3_Click
   Exit Sub
End If

mystr = "用户名" & "=" & "'" & Trim(Text16.Text) & "'"

If Data7.Recordset.RecordCount > 0 Then
   Data7.Recordset.MoveFirst
   Data7.Recordset.FindFirst mystr
   If Not Data7.Recordset.NoMatch Then
      response1 = MsgBox("这个用户名已经有人使用！", vbInformation, "提示")
      Text16.Text = ""
      Text16.SetFocus
   Else
      Data7.Recordset.AddNew
      Data7.Recordset.Fields("帐号") = Text15.Text
      Data7.Recordset.Fields("用户名") = Text16.Text
      Data7.Recordset.Fields("密码") = Text17.Text
      Data7.Recordset.Fields("工作单位") = Text18.Text
      Data7.Recordset.Fields("联系地址") = Text19.Text
      Data7.Recordset.Fields("已借本数") = 0
      Data7.Recordset.Update
   End If
End If