main.frm

本系统是图书管理信息系统一个简单实例。本系统主要有系统管理、图书管理、借书证管理、借书和还书操作、报表打印等模块组成。

    cmdKong_Click
End Sub
Private Sub cmdKong_Click() '清空所有文本
    txtBookId.Text = ""
    txtName.Text = ""
    txtClass.Text = ""
    txtDepart.Text = ""
    txtBookHao.Text = ""
    txtBookName = ""
    txtZhiCheng = ""
    txtFa.Text = ""
    txtBookBian.Text = ""
    Frame4.Visible = False
    Frame7.Visible = True
    LV2.ListItems.Clear
    CmdLogin.SetFocus
End Sub
Private Sub cmdOkCancel_Click(Index As Integer)
    Select Case Index
      Case 1
        If rst3.Fields("是否借出") = True Then
            MsgBox "此书已经借出！", 0 + 48, "提示"
            txtBookBian.Text = ""
            txtBookBian.SetFocus
            Frame4.Visible = False
            Frame7.Visible = True
            Exit Sub
        End If
        rst2.AddNew
        rst2.Fields("图书编号") = rst3.Fields("图书编号")
        rst2.Fields("书名") = rst3.Fields("书名")
        rst2.Fields("价格") = rst3.Fields("价格")
        rst2.Fields("出版社") = rst3.Fields("出版社")
        rst2.Fields("借出日期") = DateTime.Date
        rst2.Fields("借书证号") = BookId
        rst2.Fields("姓名") = txtName.Text
        rst2.Fields("类别") = rst3.Fields("类别")
        rst2.Update
        rst3.Edit
        rst3.Fields("是否借出") = True
        rst3.Fields("借出日期") = DateTime.Date
        rst3.Update
        DataRef
        txtBookBian.Text = ""
        txtBookBian.SetFocus
        'CmdLogin.SetFocus
        Frame4.Visible = False
        Frame7.Visible = True
    End Select
End Sub
Private Sub CmdLogin_Click()
loop1:          '如果没有此证，返回
    LentLogin.Show (1)
    If LoginFlag Then
        LV2.ListItems.Clear
        rst1.Seek "=", BookId  '查找借书证号码
        If rst1.NoMatch Then
            MsgBox "没有此借书证号码！", 0 + 48, "错误"
            LoginFlag = False
            GoTo loop1  '返回loop1
        End If
        txtBookId.Text = BookId
        txtName.Text = rst1.Fields("姓名") & vbNullString
        txtClass.Text = rst1.Fields("班级") & vbNullString
        txtDepart.Text = rst1.Fields("系别") & vbNullString
        txtZhiCheng = rst1.Fields("职称") & vbNullString
        txtFa.Text = rst1.Fields("罚款") & Empty
        txtBookBian.Text = ""
        Frame4.Visible = False
        Frame7.Visible = True
        txtBookBian.SetFocus
        DataRef '输出所借图书
        LoginFlag = False
        If rst1.Fields("罚款") > 0 Then
            If MsgBox(txtBookId & " " & txtName & " 共计欠费 " _
               & rst1.Fields("罚款") & "元 是否从数据库中删除？", 4 + 48, "欠费") _
               = vbYes Then
                '从数据库中删除欠费记录
                rst1.Edit
                rst1.Fields("罚款") = 0
                rst1.Update
                txtFa.Text = rst1.Fields("罚款") & Empty
            End If
        Else            '把罚款复制为0
            rst1.Edit
            rst1.Fields("罚款") = 0
            rst1.Update
        End If

    End If
End Sub

Private Sub dc_Click()
    DataReport2.Show
    DataReport2.WindowState = 2

End Sub

Private Sub dzbb_Click()
    DataReport3.Show
    DataReport3.WindowState = 2

End Sub

Private Sub EditIdMnu_Click()
    'Sb.Panels(1).Text = "编辑借书证"
    EditBookId.Show (1)
    'Sb.Panels(1).Text = "编辑借书证"
End Sub

Private Sub EditMnu_Click()
    'Sb.Panels(1).Text = "编辑图书"
    EditBook.Show (1)
    'Sb.Panels(1).Text = "编辑图书"
End Sub

Private Sub ExitMnu_Click()
       End
End Sub

Private Sub FenMnu_Click()
    SetType.Show (1)
End Sub

Private Sub Form_Load()
    Set db1 = Workspaces(0).OpenDatabase(App.Path & "\DataBase\BookMIS.mdb", False)
    Set rst1 = db1.OpenRecordset("Personal", dbOpenTable)
    rst1.Index = "借书证号"

    Set db2 = Workspaces(0).OpenDatabase(App.Path & "\DataBase\BookMIS.mdb", False)
    Set rst2 = db2.OpenRecordset("BookFf", dbOpenTable)
    Set qry2 = db2.CreateQueryDef("")
    rst2.Index = "图书编号"

    Set db3 = Workspaces(0).OpenDatabase(App.Path & "\DataBase\BookMIS.mdb", False)
    Set rst3 = db3.OpenRecordset("Book", dbOpenTable)
    rst3.Index = "图书编号"

    Open App.Path & "\DataBase\Set.Dat" For Random As #1 Len = Len(SetFlag)
    Get #1, 1, SetFlag
    BookNum = SetFlag.BookNum
    FaCost = SetFlag.BookCost

    LV2.View = lvwReport
    LV2.ColumnHeaders.Add , , "借书证号"
    LV2.ColumnHeaders.Add , , "借书人姓名"
    LV2.ColumnHeaders.Add , , "图书编号"
    LV2.ColumnHeaders.Add , , "书名"
    LV2.ColumnHeaders.Add , , "价格"
    LV2.ColumnHeaders.Add , , "类别"
    LV2.ColumnHeaders.Add , , "出版社"
    LV2.ColumnHeaders.Add , , "借出日期"

    txtBookId.Text = ""
    txtName.Text = ""
    txtClass.Text = ""
    txtDepart.Text = ""
    txtBookHao.Text = ""
    txtBookName = ""
    txtZhiCheng = ""
    txtFa.Text = ""

    txtCost = ""
    txtChuBan = ""
    txtLentDate = ""
     
    Sb.Panels(1).Text = "当前图书管的操作人员为：" & Libadmin
End Sub

Private Sub Form_Unload(Cancel As Integer)
    rst1.Close
    rst2.Close
    rst3.Close
    db1.Close
    db2.Close
    db3.Close
    Close #1
End Sub
Private Sub gy_Click()
About.Show
End Sub

Private Sub LoginMnu_Click()
    CmdLogin_Click
End Sub

Private Sub mnuSysAdmin_Click()
SetPer.Show
End Sub

Private Sub SearchMnu_Click()
    Findfrm.Show
End Sub

Private Sub SetMnu_Click()
    setfrm.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
      Case 3
        'Sb.Panels(1).Text = "编辑借书证"
        EditBookId.Show (1)
        'Sb.Panels(1).Text = "编辑借书证"
      Case 5
        SetPer.Show (1)
      Case 7
        SetType.Show
      Case 9
        setfrm.Show
      Case 12
        End
    End Select
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal buttonmenu As MSComctlLib.buttonmenu)
    Select Case buttonmenu.Key
      Case "添加"
        'Sb.Panels(1).Text = "添加新书"
        AddNewBook.Show (1)
        'Sb.Panels(1).Text = SFlag
      Case "编辑"
        'Sb.Panels(1).Text = "编辑图书"
        EditBook.Show (1)
        'Sb.Panels(1).Text = "编辑图书"
      Case "新借"
        MsgBox "Add BookCard"
      Case "编借"
        MsgBox "Edit BookCard"
    End Select
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
      Case 1
        CmdLogin_Click
      Case 3
        cmdKong_Click
      Case 7
        cmdBackBook_Click
      Case 5
        Findfrm.Show
    End Select
End Sub

Private Sub tsbb_Click()
    DataReport1.Show
    DataReport1.WindowState = 2

End Sub

Private Sub txtBookBian_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If txtBookId.Text = "" Then
            MsgBox "请先登录！", 0 + 48, "提示"
            CmdLogin.SetFocus
            txtBookBian.Text = ""
            Exit Sub
        End If
        rst3.Seek "=", txtBookBian.Text
        If rst3.NoMatch Then
            MsgBox "没有此图书编号，请重新填写", 0 + 48, "填写错误"
            txtBookBian.SetFocus
            Frame4.Visible = False
            Frame7.Visible = True
            Exit Sub
        End If
        Frame4.Visible = True
        Frame7.Visible = False
        txtBookHao.Text = txtBookBian.Text
        txtBookName.Text = rst3.Fields("书名") & vbNullString
        txtChuBan.Text = rst3.Fields("出版社") & vbNullString
        txtCost.Text = rst3.Fields("价格") & Empty
        txtLentDate = DateTime.Date
        txtType.Text = rst3.Fields("类别") & vbNullString
    End If
End Sub
Private Sub DataRef()
    Dim i As Integer
    Dim SeaStr As String
    SeaStr = "select * from Bookff where 借书证号="
    SeaStr = SeaStr & "'" & BookId & "'"
    qry2.SQL = SeaStr
    Set rst = qry2.OpenRecordset()
    If rst.RecordCount = 0 Then
        Label1.Caption = "可以借" & BookNum & "本书"
        Exit Sub
    End If
    rst.MoveLast
    RecNumBookFf = rst.RecordCount
    rst.MoveFirst
    LV2.ListItems.Clear
    For i = 1 To RecNumBookFf
        LV2.ListItems.Add i, , rst.Fields("借书证号") & vbNullString
        With LV2.ListItems(i)
            .SubItems(1) = rst.Fields("姓名") & vbNullString
            .SubItems(2) = rst.Fields("图书编号") & vbNullString
            .SubItems(3) = rst.Fields("书名") & vbNullString
            .SubItems(4) = rst.Fields("价格") & Empty
            .SubItems(5) = rst.Fields("类别") & vbNullString
            .SubItems(6) = rst.Fields("出版社") & vbNullString
            .SubItems(7) = rst.Fields("借出日期") & vbNullString
        End With
        rst.MoveNext
        If rst.EOF Then Exit For
    Next i
    If RecNumBookFf = BookNum Then
        MsgBox "已经借了 " & BookNum & "本书,不能再借了,请登录其它借书证号", 0 + 48, "提示"
        txtBookId.Text = ""
        txtName.Text = ""
        txtClass.Text = ""
        txtDepart.Text = ""
        txtZhiCheng = ""
        txtFa.Text = ""
        CmdLogin.SetFocus
        LV2.ListItems.Clear
        Label1.Caption = "已经借的书"
        Exit Sub
    End If
    Label1.Caption = "已经借出 " & RecNumBookFf & "本，还可以再借 " _
                     & BookNum - RecNumBookFf & "本"
End Sub
Private Sub txtBookId_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        LV2.ListItems.Clear
        BookId = txtBookId
        rst1.Seek "=", BookId  '查找借书证号码
        If rst1.NoMatch Then
            MsgBox "没有此借书证号码！", 0 + 48, "错误"
            txtBookId.SetFocus
            txtName.Text = ""
            txtClass.Text = ""
            txtDepart.Text = ""
            Exit Sub
        End If
        txtBookHao.Text = ""
        txtBookName.Text = ""
        txtCost.Text = ""
        txtChuBan.Text = ""
        txtLentDate.Text = ""
        txtBookBian.Text = ""
        txtBookId.Text = BookId
        txtName.Text = rst1.Fields("姓名") & vbNullString
        txtClass.Text = rst1.Fields("班级") & vbNullString
        txtDepart.Text = rst1.Fields("系别") & vbNullString
        txtZhiCheng = rst1.Fields("职称") & vbNullString
        txtFa.Text = rst1.Fields("罚款") & Empty
        txtBookBian.SetFocus
        DataRef '输出所借图书
    End If
End Sub