11.txt

图书馆管理系统..大家多点给我鼓励给我支持哦...我会多点上载代码到这里的.

Dim db1 As Database
Dim db2 As Database
Dim db3 As Database
Dim rst As Recordset
Dim rst1 As Recordset '打开表Personal
Dim rst2 As Recordset '打开表Bookef
Dim rst3 As Recordset '打开表Book
Dim ws1 As Workspace
Dim ws2 As Workspace
Dim qry2 As QueryDef
Dim RecNumBookFf As Integer '表BookFf的记录个数
Dim SFlag As String
Private Type MSet
    BookNum As Integer
    BookCost As Single
End Type
Dim SetFlag As MSet
Option Explicit
Private Sub AboutMnu_Click()
Aboutfrm.Show (1)
End Sub


Private Sub AddMnu_Click()
AddNewBook.Show
End Sub

Private Sub BackMnu_Click()
Lentfrm.Show
End Sub

Private Sub CLAERMEU_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 cmdBackBook_Click() '打开还书对话框
cmdKong_Click
Lentfrm.Show (1)
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("借出日期") = Date
        rst2.Fields("借书证号") = BookId
        rst2.Fields("姓名") = txtName.Text
        rst2.Fields("类别") = rst3.Fields("类别")
        rst2.Update
        rst3.Edit
        rst3.Fields("是否借出") = True
        rst3.Fields("借出日期") = 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 EditIdMnu_Click()
Editjsz.Show
End Sub

Private Sub EditMnu_Click()
EditBook.Show
End Sub

Private Sub ExitMnu_Click()
Unload Me
End Sub

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

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


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

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

Open "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 = ""
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 LMEU_Click()
SetPer.Show
End Sub

Private Sub LoginMnu_Click()
LentLogin.Show
End Sub

Private Sub meu_L_Click()
liulan.Show
End Sub

Private Sub MEUXITONG_Click()
zhinan.Show
End Sub

Private Sub SearchMnu_Click()
 Findfrm.Show
End Sub
Private Sub Toolbar1_ButtonMenuClick(ByVal buttonmenu As MSComctlLib.buttonmenu)
'Select Case Button.Index
'    Case 1
'
'        LentLogin.Show (1)
'
'    Case 2
'      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
'
'
'    Case "管理"
'       SetPer.Show
'    Case "设置"
'       setmoney.Show
'End Select
End Sub

Private Sub SetMnu_Click()
setmoney.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   Select Case Button.Index
   Case 1
    LoginSys.Show
    Mainfrm.Hide
    Case 2
      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
   
  
    Case "3"
       SetPer.Show
    Case "4"
       setmoney.Show
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 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 = 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.