ctlexpensedetail.ctl

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.UserControl ctlExpenseDetail 
   ClientHeight    =   1965
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3915
   ScaleHeight     =   1965
   ScaleWidth      =   3915
   Begin VB.Frame fraBorder 
      Caption         =   "Expense Data Control"
      Height          =   1815
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3735
      Begin VB.Frame fraNavigate 
         Caption         =   "Navigate"
         Height          =   735
         Left            =   120
         TabIndex        =   2
         Top             =   960
         Width           =   3495
         Begin VB.CommandButton cmdLast 
            Caption         =   "&Last"
            Height          =   375
            Left            =   2640
            TabIndex        =   6
            Top             =   240
            Width           =   735
         End
         Begin VB.CommandButton cmdNext 
            Caption         =   "&Next"
            Height          =   375
            Left            =   1800
            TabIndex        =   5
            Top             =   240
            Width           =   735
         End
         Begin VB.CommandButton cmdPrev 
            Caption         =   "&Prev"
            Height          =   375
            Left            =   960
            TabIndex        =   4
            Top             =   240
            Width           =   735
         End
         Begin VB.CommandButton cmdFirst 
            Caption         =   "&First"
            Height          =   375
            Left            =   120
            TabIndex        =   3
            Top             =   240
            Width           =   735
         End
      End
      Begin VB.Frame fraMaintain 
         Caption         =   "Maintain"
         Height          =   735
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   3495
         Begin VB.CommandButton cmdDelete 
            Caption         =   "&Delete"
            Height          =   375
            Left            =   2400
            TabIndex        =   9
            Top             =   240
            Width           =   975
         End
         Begin VB.CommandButton cmdUpdate 
            Caption         =   "&Update"
            Height          =   375
            Left            =   1200
            TabIndex        =   8
            Top             =   240
            Width           =   1095
         End
         Begin VB.CommandButton cmdNew 
            Caption         =   "Ne&w"
            Height          =   375
            Left            =   120
            TabIndex        =   7
            Top             =   240
            Width           =   975
         End
      End
   End
End
Attribute VB_Name = "ctlExpenseDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' Data changed event for data control movement
' or internally generated change tells the container
' that the control's view of the data has changed
Public Event DataChanged()

' Action enum for validate event eases container
' code development
Public Enum EXP_CHANGE_TYPE
    expAddNewValidate
    expUpdateValidate
    expDeleteValidate
End Enum

' Validate response enum tells the control whether to
' proceed with the data change
Public Enum EXP_RESPONSE_TYPE
    expOk
    expCancel
End Enum

' Validate event for data control
Public Event ValidateData(ByRef Response As EXP_RESPONSE_TYPE, _
        ByVal Change As EXP_CHANGE_TYPE)

' Variables to define and control the recordset
Private mblnRecSetOpen As Boolean
Private mdbExpense As Database
Private mrecExpense As Recordset
Private mstrDbName As String

' Module variables to hold property value(s)
Private mlngExpenseId As Long
Private mstrEmployeeId As String
Private mstrExpenseType As String
Private mcurAmountSpent As Currency
Private mstrDescription As String
Private mdtmDatePurchased As Date
Private mdtmDateSubmitted As Date

Private Sub cmdDelete_Click()
' Deletes the expense detail record whose value is
' current from the database

Dim uexpResponse As EXP_RESPONSE_TYPE
    
    On Error GoTo DeleteError
    
    RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
    If expOk = uexpResponse Then
        With mrecExpense
            .Delete
            If 0 = .RecordCount Then
                Call ClearObject
            Else
                .MoveNext
                If .EOF Then
                    Call ClearObject
                Else
                    Call GetRecordset(mrecExpense)
                End If
            End If
        End With
    End If
    RaiseEvent DataChanged

    Exit Sub

DeleteError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub

End Sub

Private Sub cmdFirst_Click()
' Move to the first record

   On Error GoTo MoveError
   If mblnRecSetOpen Then
        With mrecExpense
            If Not (True = .BOF _
            And True = .EOF) Then
                ' Dataset is not empty.
                ' Move to the first record.
                .MoveFirst
                Call GetRecordset(mrecExpense)
                RaiseEvent DataChanged
            End If
        End With
    End If
    
    Exit Sub
    
MoveError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub

End Sub

Private Sub cmdLast_Click()
' Move to the last record

   On Error GoTo MoveError
   If mblnRecSetOpen Then
        With mrecExpense
            If Not (True = .BOF _
            And True = .EOF) Then
                ' Dataset is not empty.
                ' Move to the last record.
                .MoveLast
                Call GetRecordset(mrecExpense)
                RaiseEvent DataChanged
            End If
        End With
    End If
    
    Exit Sub
    
MoveError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub
    
End Sub

Private Sub cmdNew_Click()
' Inserts a brand new record into the database and leaves the newly
' inserted values as the current object values.

Dim uexpResponse As EXP_RESPONSE_TYPE

    On Error GoTo InsertError
    RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
    If expOk = uexpResponse Then
        With mrecExpense
            .AddNew
            mdtmDateSubmitted = Now
            Call SetRecordset(mrecExpense)
            .Update
            'Move to the most recently modified record
            .Bookmark = .LastModified
            Call GetRecordset(mrecExpense)
            RaiseEvent DataChanged
        End With
    End If
    
    Exit Sub

InsertError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub
    
End Sub

Private Sub cmdNext_Click()
' Move to the next record

   On Error GoTo MoveError
    If mblnRecSetOpen Then
        With mrecExpense
            If True = .BOF _
            And True = .EOF Then
                .MoveLast
            Else
                ' Dataset is not empty.
                ' Move to the previous record.
                .MoveNext
                If .EOF Then
                    .MoveLast
                End If
            End If
            Call GetRecordset(mrecExpense)
            RaiseEvent DataChanged
        End With
    End If
    
    Exit Sub
    
MoveError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub
    

End Sub


Private Sub cmdPrev_Click()
' Move to the previous record

   On Error GoTo MoveError
       
    If mblnRecSetOpen Then
        With mrecExpense
            If True = .BOF _
            And True = .EOF Then
                .MoveFirst
            Else
                ' Dataset is not empty.
                ' Move to the previous record.
                .MovePrevious
                If .BOF Then
                    .MoveFirst
                End If
            End If
            Call GetRecordset(mrecExpense)
            RaiseEvent DataChanged
        End With
    End If
    
    Exit Sub
    
MoveError:
    ' Return the error description
    Err.Raise Number:=Err.Number, Source:=Err.Source, _
        Description:=Err.Description
    Err.Clear
    Exit Sub
    
End Sub

Private Sub cmdUpdate_Click()
' Updates Expenses table from current object values
Dim uexpResponse As EXP_RESPONSE_TYPE

    On Error GoTo UpdateError
    RaiseEvent ValidateData(uexpResponse, expAddNewValidate)
    If expOk = uexpResponse Then