frmbookmessage.frm

实现某班级的图书信息管理

   End
   Begin VB.Label Label1 
      Caption         =   "状态"
      Height          =   255
      Index           =   5
      Left            =   660
      TabIndex        =   18
      Top             =   2760
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "类型"
      Height          =   375
      Index           =   4
      Left            =   660
      TabIndex        =   17
      Top             =   2280
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "作者"
      Height          =   375
      Index           =   3
      Left            =   660
      TabIndex        =   16
      Top             =   1800
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "图书名称"
      Height          =   495
      Index           =   2
      Left            =   660
      TabIndex        =   15
      Top             =   840
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "图书编号"
      Height          =   495
      Index           =   0
      Left            =   660
      TabIndex        =   14
      Top             =   360
      Width           =   855
   End
End
Attribute VB_Name = "FrmBookmessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 '************************************************************************
     '本窗本用于图书登记，编辑与浏览
     '采用了自动编号，当删除了编号最大的那个以后，
     '就会造成在文本框中看到的与添加后的编号不一致，
     '所以本系统要以添加完后的编号为该书的编号。
 '*************************************************************************
Option Explicit
Private recRs As Recordset '窗体模块的共同变量
Private Mindex As Integer '存储自动编号的值以显示，取得的值为记录中的最大的值。
Private mAdd As Boolean
Private Sub CmdCancel_Click()
    
    '对界面进行管理的过程，用了两个的子过程 EditEnable 和 Datatotext
    
    EditEnable (True) '当数据库中有数据时取消后即可回到可编辑状态了, 那些删除，修改，上下移的键都在该函数中被击激活了
   
    Datatotext '这里当有数据的时候起到付值的作用，没有的时候就起到锁定控键的作用
    
    StatusBar1.Panels(2).Text = "当前状态：浏览"
    StatusBar1.Panels(3).Text = Position
     
End Sub

Private Sub CmdDelete_Click()
    '检查书本是否被借出，来判定是否能被删除。
    
    Dim mdb As Database '存放数据库对象，定义过程变量，缩短变量 的作用范围
    Dim recDRS As Recordset
    Dim dbname As String
     
    StatusBar1.Panels(2).Text = "当前状态：删除记录"
     
    If Right(App.Path, 1) <> "\" Then
        dbname = App.Path & "\LibraryDB.mdb"
    Else
        dbname = App.Path & "librarydb.mdb"
    End If
    
    Set mdb = OpenDatabase(dbname) 'Set database = workspace.OpenDatabase (dbname, options, read-only, connect)
    Set recDRS = mdb.OpenRecordset("select bookindex, returntime from borrowmessage " _
     & "where bookindex = " & TxtBookindex & " and returntime = #1111-1-1# ")   '在SQL语中条件用到了returntime = #1111-1-1# ，如果是这个达不到的时间，说明未还，免除了另添一字段来记录

      If recDRS.EOF = False Then '其实这一段可以不要，因为Rcordcount在没有记录时会返回零，有记录时返回一
        recDRS.MoveLast ' 这样能统计出所有的记录来
      End If
     
     If recDRS.RecordCount <> 0 Then
        MsgBox "些书已经借出，不能被删！", vbOKOnly + vbExclamation, "图书资料登记"
        StatusBar1.Panels(2).Text = "当前状态：浏览"
        Exit Sub
        
     End If

    If recRs.RecordCount > 0 Then '这样即可判断有无记录了
        With recRs
            If MsgBox("确实要永久性地删除这条记录吧？", vbOKCancel + vbQuestion, "图书资料登记") = vbOK Then
                .Delete
                TextClear   '对文本的清空，这个作用表现在删除最后一条记录时，让用户看不到残留在界面上的记录
                TxtJoinTime.Text = ""
                
                .MoveNext '当对数据进行移动时，就要进行检验，以防对无记录进行处理
                
                ' Although you can't edit or use the deleted record, it remains current.
                'Once you move to another record, however, you can't make the deleted record current again.
                'Subsequent references to a deleted record in a Recordset are invalid and produce an error.
                 '所有在对已删除记录的引用的同时，都将产生错误
                
                If .EOF Then
                   .MovePrevious '当指到最后一条记录的后一空记录时前移一条
                End If
            Else
                StatusBar1.Panels(2).Text = "当前状态：浏览"
                Exit Sub
            End If
            
            Datatotext '代码绑定，在进行记录改变时，要对数据的重新提取付值
        
        End With
        
        StatusBar1.Panels(2).Text = "当前状态：浏览" '删除记录后回到浏览状态
        StatusBar1.Panels(3).Text = Position
        DatBMessage.Refresh
    Else
        '其实这一段已用不上了，因为在DataToText中加了一判断语句，无记录时就已作出了处理
        MsgBox "无记录可删！", vbOKOnly + vbExclamation, "图书资料登记"
        CmdPrevious.Enabled = False
        CmdNext.Enabled = False
        
        StatusBar1.Panels(2).Text = "当前状态：浏览"
        TextClear
    
    End If

End Sub

Private Sub CmdEdit_Click()
    '进行记录的修改
    StatusBar1.Panels(2).Text = "当前状态：修改记录"
    EditEnable (False)
    
    With recRs
        .Edit '注意修改后，没有进行即时的更新，而进行其它数据操作，将使修改不保存
    End With
    
    TxtBookName.SetFocus '方便用户
   
    
End Sub

Private Sub CmdExit_Click()
    Unload Me
End Sub

Private Sub CmdNext_Click()

    CmdPrevious.Enabled = True '激活上移
        
    With recRs
        .MoveNext 'EOF并非最后一条记录，而是最后一条记录的下一条，无记录的
        If .EOF Then
            MsgBox "这已经是最后一条记录了", vbOKOnly + vbInformation, "图书资料登记"
            .MovePrevious '将记录往前移一条
            'DataToText 其实这里不要了，虽然移动了记录，但最后还是移到原先的那条，和保留在界面的记录是一至的
            CmdNext.Enabled = False
        End If
        Datatotext '记录的位置变了，界面上也应该有相应的变化
    End With
        
        StatusBar1.Panels(3).Text = Position '对位置进行显示 用了一个函数
End Sub

Private Sub CmdPrevious_Click()
    
    CmdNext.Enabled = True '激活下移
            
    With recRs
        .MovePrevious
  
        If .BOF Then '如果为最后一条移回去
            MsgBox "这已经是第一条记录了", vbOKOnly + vbInformation, "图书资料登记"
            .MoveNext
'
'            DataToText
            CmdPrevious.Enabled = False
        End If
            Datatotext
    End With
     StatusBar1.Panels(3).Text = Position
     
End Sub

Private Sub CmdRegister_Click()
   
    On Error Resume Next
    mAdd = True
    StatusBar1.Panels(2).Text = "当前状态：添加记录"
    TextClear '对文本进行初始化
    recRs.MoveFirst
    If recRs.RecordCount > 0 Then
        If Mindex = 0 Then
            TxtBookindex = recRs.Fields("bookindex") + 1
        Else
            TxtBookindex = Mindex + 1
        End If
    Else
        recRs.AddNew
        TxtBookindex.Text = recRs.Fields("bookindex")
    End If
    
    EditEnable (False) '编辑状态时的按钮状态
    
End Sub

Private Sub CmdSave_Click()
    '检查并添加与保存
    On Error GoTo errpro:
    
    If TxtBookindex.Text = "" Or TxtBookName.Text = "" Or TxtAuthor.Text = "" _
        Or TxtPublish.Text = "" Or TxtJoinTime.Text = "" Or CmbType.Text = "" _
        Or CmbStatus.Text = "" Then
        MsgBox "所有的资料都不能为空，请填完整！", vbOKOnly, "图书资料登记"
        StatusBar1.Panels(2).Text = "当前状态：浏览"
      Exit Sub
      
    End If

    If mAdd = True Then
        
        With recRs
                                    ' Caution   If you issue an AddNew and then perform any operation that moves to another record,
                                              ' but without using Update, your changes are lost without warning.
             If .RecordCount > 0 Then
                                             ' In addition, if you close the Recordset or end the procedure that declares the Recordset or its Database object, the new record is discarded without warning.
                .AddNew                        '在这之后与Update这间如果有Move等对数据的操作，都会使AddNew所开辟的新行丢失，当再进行Update就会因没有Addnew 而出错
                 TxtBookindex.Text = .Fields("bookindex")   '用了AddNew后字段将被付上默认的置'
                 Mindex = .Fields("bookindex")     '对刚添的编号进行提取。以供自动编号用                               'Add the auto index of bookmessage
             
             End If
                                                   ' Use the AddNew method to create and add a new record in the Recordset object named by recordset.
                                                    'This method sets the fields to default values, and if no default values are specified, it sets the fields to Null (the default values specified for a table-type Recordset).
        End With
        
        mAdd = False
    
    End If
    
    TextToData
    
    With recRs
          '