frmrecordlocker.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmRecordLocker 
   Caption         =   "锁定记录"
   ClientHeight    =   2244
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   6168
   LinkTopic       =   "Form1"
   ScaleHeight     =   2244
   ScaleWidth      =   6168
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame fraRecord 
      Caption         =   "记录"
      Height          =   1515
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   4635
      Begin VB.TextBox txtCustomerName 
         Height          =   285
         Left            =   1620
         TabIndex        =   2
         Top             =   240
         Width           =   2775
      End
      Begin VB.TextBox txtStreetAddress 
         Height          =   285
         Left            =   1620
         TabIndex        =   4
         Top             =   660
         Width           =   2775
      End
      Begin VB.OptionButton optOptimisticLocking 
         Caption         =   "开放式锁定"
         Height          =   255
         Left            =   2280
         TabIndex        =   6
         Top             =   1140
         Width           =   2172
      End
      Begin VB.OptionButton optPessimisticLocking 
         Caption         =   "保守式锁定"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   1140
         Width           =   2232
      End
      Begin VB.Label lblCustomerName 
         Caption         =   "用户名称:"
         Height          =   195
         Left            =   180
         TabIndex        =   1
         Top             =   300
         Width           =   1335
      End
      Begin VB.Label lblStreetAddress 
         Caption         =   "街道地址:"
         Height          =   195
         Left            =   180
         TabIndex        =   3
         Top             =   720
         Width           =   1335
      End
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "退出程序"
      Default         =   -1  'True
      Height          =   375
      Left            =   4800
      TabIndex        =   14
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "刷新"
      Height          =   375
      Left            =   4800
      TabIndex        =   9
      Top             =   1020
      Width           =   1215
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "更新"
      Height          =   375
      Left            =   4800
      TabIndex        =   8
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "修改"
      Height          =   375
      Left            =   4800
      TabIndex        =   7
      Top             =   180
      Width           =   1215
   End
   Begin VB.CommandButton cmdMove 
      Caption         =   ">>"
      Height          =   435
      Index           =   3
      Left            =   2880
      TabIndex        =   13
      Top             =   1680
      Width           =   495
   End
   Begin VB.CommandButton cmdMove 
      Caption         =   ">"
      Height          =   435
      Index           =   2
      Left            =   2400
      TabIndex        =   12
      Top             =   1680
      Width           =   495
   End
   Begin VB.CommandButton cmdMove 
      Caption         =   "<"
      Height          =   435
      Index           =   1
      Left            =   1860
      TabIndex        =   11
      Top             =   1680
      Width           =   495
   End
   Begin VB.CommandButton cmdMove 
      Caption         =   "<<"
      Height          =   435
      Index           =   0
      Left            =   1380
      TabIndex        =   10
      Top             =   1680
      Width           =   495
   End
End
Attribute VB_Name = "frmRecordLocker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' form level object variables that hold the database and recordset objects
' used throughout this project
Private db As Database
Private rs As Recordset

' form level boolean variable used to indicate when the current record is
' in edit mode
Private m_bEditMode As Boolean

' form level constant declarations used to indicate pessimistic or
' optimistic record locking
Private Const PESSIMISTIC = True
Private Const OPTIMISTIC = False


Private Sub Form_Load()

    Dim sDBName As String
    
    ' get the path and name of the database used in this project from the
    ' ReadINI module
    sDBName = DBPath
    
    ' open the database and recordset
    Set db = DBEngine.Workspaces(0).OpenDatabase(sDBName)
    Set rs = db.OpenRecordset("Customers", dbOpenDynaset)
    
    With rs
    
        ' if the recordset is empty, then inform the user and end
        If (.EOF And .BOF) Then
            
            MsgBox "Table Empty!", vbExclamation, "ERROR"
            Unload Me
            End
        
        Else
            
            ' move to the first record and display it
            .MoveFirst
            DisplayRecord
        
        End If
    
    End With
    
    ' set the optPessimisticLocking value to true (this will automatically
    ' call the optPessimisticLocking_Click event
    optPessimisticLocking = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    ' set the form level object variables for the database and recordset
    ' to nothing (this is the same as closing each object)
    Set db = Nothing
    Set rs = Nothing
    
End Sub

Private Sub cmdEdit_Click()

' if there is an error, goto the code labeled by ERR_cmdEdit_Click
On Error GoTo ERR_cmdEdit_Click:

    ' if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    
    ' set the record to edit mode
    rs.Edit
    
    ' indicate that the record is in edit mode through the m_m_bEditMode
    ' form level boolean variable
    m_bEditMode = True
    
    ' disable the edit command button and enable the update command button
    ' and text box controls
    cmdEdit.Enabled = False
    cmdUpdate.Enabled = True
    txtCustomerName.Enabled = True
    txtStreetAddress.Enabled = True
    
Exit Sub

ERR_cmdEdit_Click:

    ' an error has occurred, call the RecordError routine with the error
    ' object that describes the error and a string indicating the method
    ' attempted at the time of the error
    RecordError Err, "edit"
    
End Sub

Private Sub cmdUpdate_Click()

    ' update the current record in the database
    UpdateRecord
    
End Sub

Private Sub cmdRefresh_Click()

    ' if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    
    ' requery dynaset and move the record pointer
    With rs
        .Requery
        .MoveNext
        .MovePrevious
    End With
    
    ' redisplay the current record
    DisplayRecord
    
End Sub

Private Sub cmdClose_Click()
    
    ' end the application, this will call the Form_Unload event
    Unload Me
    
End Sub

Private Sub optPessimisticLocking_Click()
    
    ' if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    
    ' set the LockEdits property of the recordset to Pessimistic record
    ' locking
    rs.LockEdits = PESSIMISTIC
    
End Sub

Private Sub optOptimisticLocking_Click()

    ' if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    
    ' set the LockEdits property of the recordset to Optimistic record
    ' locking
    rs.LockEdits = OPTIMISTIC

End Sub

Private Sub cmdMove_Click(Index As Integer)

    ' local constant values used to indicate which command button was
    ' pressed
    ' each constant corresponds to the index of each command button
    Const MOVE_FIRST = 0
    Const MOVE_PREVIOUS = 1
    Const MOVE_NEXT = 2
    Const MOVE_LAST = 3
    
    ' if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    
    With rs
    
        Select Case Index
        
            ' move to the first record
            Case MOVE_FIRST:
                .MoveFirst
                
            ' move to the previous record, if the record pointer is before
            ' the first record, then move to the first record
            Case MOVE_PREVIOUS:
                .MovePrevious
                If (.BOF) Then .MoveFirst
                
            ' move to the next record, if the record pointer is beyond the
            ' last record, then move to the last record
            Case MOVE_NEXT:
                .MoveNext
                If (.EOF) Then .MoveLast
                
            ' move to the last record
            Case MOVE_LAST:
                .MoveLast
                
        End Select
        
    End With
    
    ' display the current record after moving to a new one
    DisplayRecord
        
End Sub

Private Sub DisplayRecord()
    
    ' disable the customer name and fill it with the current records
    ' corresponding field value
    With txtCustomerName
        .Text = rs.Fields("Customer Name")
        .Enabled = False
    End With
    
    ' disable the street address and fill it with the current records
    ' corresponding field value
    With txtStreetAddress
        .Text = rs.Fields("Street Address")
        .Enabled = False
    End With
    
    ' enable the edit and disable the update command buttons
    cmdEdit.Enabled = True
    cmdUpdate.Enabled = False
    
    ' currently not in edit mode
    m_bEditMode = False
    
End Sub

Private Sub UpdateRecord()

' if there is an error, goto the code labeled by ERR_UpdateRecord
On Error GoTo ERR_UpdateRecord:

    ' set the new values of the record fields to those displayed on the
    ' form and update the record (this is where an error can occur)
    With rs
        .Fields("Customer Name") = txtCustomerName
        .Fields("Street Address") = txtStreetAddress
        .Update
    End With
    
    ' display the updated record
    DisplayRecord
    
Exit Sub

ERR_UpdateRecord:

    ' an error has occurred, call the RecordError routine with the error
    ' object that describes the error and a string indicating the method
    ' attempted at the time of the error
    RecordError Err, "update"

End Sub

Private Sub RecordError(oErr As ErrObject, sAction As String)

    Dim sMessage As String
    
    ' error constant used to indicate that the current record is locked and
    ' cannot be updated or edited
    Const RECORD_LOCKED = 3260
    
    With Err
    
        Select Case .Number
            
            ' the record cannot be edited
            Case RECORD_LOCKED:
                sMessage = "Cannot " & sAction & " at this time because " _
                         & "the record is currently locked by another " _
                         & "user."
            
            ' an unexpected error has occurred
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & .Description
        
        End Select
        
    End With
    
    ' display the error message created above
    MsgBox sMessage, vbExclamation, "ERROR"
    
End Sub