activexexpense.frm

VB6数据库开发指南》的配套源程序

VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmExpClient 
   Caption         =   "Expense Client"
   ClientHeight    =   3480
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   ScaleHeight     =   3480
   ScaleWidth      =   5655
   StartUpPosition =   3  'Windows Default
   Begin MSMask.MaskEdBox mskAmountSpent 
      Height          =   285
      Left            =   1440
      TabIndex        =   3
      Top             =   1320
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   503
      _Version        =   327680
      Format          =   "$#,##0.00;($#,##0.00)"
      PromptChar      =   "_"
   End
   Begin VB.CommandButton cmdLast 
      Caption         =   "&Last"
      Height          =   495
      Left            =   3360
      TabIndex        =   13
      Top             =   2880
      Width           =   855
   End
   Begin VB.CommandButton cmdNext 
      Caption         =   "&Next"
      Height          =   495
      Left            =   2280
      TabIndex        =   12
      Top             =   2880
      Width           =   855
   End
   Begin VB.CommandButton cmdPrev 
      Caption         =   "&Prev"
      Height          =   495
      Left            =   1200
      TabIndex        =   11
      Top             =   2880
      Width           =   855
   End
   Begin VB.CommandButton cmdFirst 
      Caption         =   "&First"
      Height          =   495
      Left            =   120
      TabIndex        =   10
      Top             =   2880
      Width           =   855
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "&Delete"
      Height          =   495
      Left            =   3960
      TabIndex        =   9
      Top             =   1440
      Width           =   1575
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "&Update"
      Height          =   495
      Left            =   3960
      TabIndex        =   8
      Top             =   840
      Width           =   1575
   End
   Begin VB.CommandButton cmdNewExpense 
      Caption         =   "Ne&w Expense"
      Height          =   495
      Left            =   3960
      TabIndex        =   7
      Top             =   240
      Width           =   1575
   End
   Begin VB.TextBox txtSubmitDate 
      Enabled         =   0   'False
      Height          =   285
      Left            =   1440
      TabIndex        =   6
      Top             =   2400
      Width           =   2175
   End
   Begin VB.TextBox txtPurchaseDate 
      Height          =   285
      Left            =   1440
      TabIndex        =   5
      Top             =   2040
      Width           =   2175
   End
   Begin VB.TextBox txtDescription 
      Height          =   285
      Left            =   1440
      TabIndex        =   4
      Top             =   1680
      Width           =   2175
   End
   Begin VB.TextBox txtExpenseType 
      Height          =   285
      Left            =   1440
      TabIndex        =   2
      Top             =   960
      Width           =   2175
   End
   Begin VB.TextBox txtEmployeeId 
      Height          =   285
      Left            =   1440
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin VB.TextBox txtExpenseId 
      Enabled         =   0   'False
      Height          =   285
      Left            =   1440
      TabIndex        =   0
      Top             =   240
      Width           =   2175
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Employee:"
      Height          =   195
      Left            =   120
      TabIndex        =   20
      Top             =   600
      Width           =   735
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "Submission Date:"
      Height          =   195
      Left            =   120
      TabIndex        =   19
      Top             =   2400
      Width           =   1230
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "Purchase Date:"
      Height          =   195
      Left            =   120
      TabIndex        =   18
      Top             =   2040
      Width           =   1110
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "Description:"
      Height          =   195
      Left            =   120
      TabIndex        =   17
      Top             =   1680
      Width           =   840
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "Amount Spent:"
      Height          =   195
      Left            =   120
      TabIndex        =   16
      Top             =   1320
      Width           =   1050
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Expense Type:"
      Height          =   195
      Left            =   120
      TabIndex        =   15
      Top             =   960
      Width           =   1065
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Expense ID:"
      Height          =   195
      Left            =   120
      TabIndex        =   14
      Top             =   240
      Width           =   870
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "frmExpClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private expDetailClass As New ExpenseDetail

Private Sub cmdDelete_Click()
' Deletes current record from database

    Dim strResponse As String
    
    strResponse = expDetailClass.Delete
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If


End Sub

Private Sub cmdFirst_Click()
' Positions to first record in recordset and displays values

    Dim strResponse As String
    
    strResponse = expDetailClass.MoveFirst
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If

End Sub

Private Sub cmdLast_Click()
' Positions to last record in recordset and displays values

    Dim strResponse As String
    
    strResponse = expDetailClass.MoveLast
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If

End Sub

Private Sub cmdNewExpense_Click()
    
    Dim strResponse As String
    strResponse = SetObjectValues
    
    If "OK" = strResponse Then
        strResponse = expDetailClass.Insert
        If "OK" <> strResponse Then
            MsgBox strResponse
            Exit Sub
        End If
        Call ReadObjectValues
    Else
        MsgBox strResponse
    End If
        
End Sub

Private Sub cmdNext_Click()
' Positions to Next record in recordset and displays values

    Dim strResponse As String
    
    strResponse = expDetailClass.MoveNext
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If


End Sub

Private Sub cmdPrev_Click()
' Positions to Previous record in recordset and displays values

    Dim strResponse As String
    
    strResponse = expDetailClass.MovePrev
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If


End Sub

Private Sub cmdUpdate_Click()
' Updates current record with form values

    Dim strResponse As String
    strResponse = SetObjectValues
    
    If "OK" = strResponse Then
        strResponse = expDetailClass.Update
        If "OK" <> strResponse Then
            MsgBox strResponse
            Exit Sub
        End If
        Call ReadObjectValues
    Else
        MsgBox strResponse
    End If
    
End Sub

Private Sub Form_Load()
' Get the ActiveX object to open its database and position
' to the first record
    Dim strDbName As String
    Dim strResponse As String
    
    On Error GoTo LoadError
    
    strDbName = App.Path
    strDbName = strDbName & "\Expense.mdb"
    expDetailClass.strDbName = strDbName
    strResponse = expDetailClass.MoveFirst
    If "OK" <> strResponse Then
        MsgBox strResponse
    Else
        Call ReadObjectValues
    End If
    
    Exit Sub
LoadError:
    MsgBox Err.Description & Chr(13) & "from " & Err.Source _
            & " -- Number: " & CStr(Err.Number)
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    Set expDetailClass = Nothing
    
End Sub

Private Function SetObjectValues() As String
' Sets related object values from form fields

    Dim strResponse As String

    strResponse = expDetailClass.strSetExpenseType(txtExpenseType.Text)
    
    On Error GoTo TypeError
    
    If "OK" = strResponse Then
        expDetailClass.strEmployeeId = txtEmployeeId.Text
        expDetailClass.strDescription = txtDescription.Text
        expDetailClass.dtmDatePurchased = txtPurchaseDate.Text
        expDetailClass.curAmountSpent = CCur(mskAmountSpent.Text)
    End If
    
    SetObjectValues = strResponse
    Exit Function

TypeError:
    If Err.Number = 13 Then
        expDetailClass.curAmountSpent = 0
        Resume Next
    End If
    
End Function
Private Sub ReadObjectValues()
' Read the object values into the form fields

    txtExpenseId.Text = CStr(expDetailClass.lngExpenseId)
    txtEmployeeId.Text = expDetailClass.strEmployeeId
    txtExpenseType.Text = expDetailClass.strExpenseType
    txtDescription.Text = expDetailClass.strDescription
    mskAmountSpent.Text = CStr(expDetailClass.curAmountSpent)
    txtPurchaseDate.Text = CStr(expDetailClass.dtmDatePurchased)
    txtSubmitDate.Text = CStr(expDetailClass.dtmDateSubmitted)

End Sub

Private Sub mnuFileExit_Click()

    Unload Me

End Sub