📄 payment.cls
字号:
VERSION 1.0 CLASS
Begin
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
End
Attribute VB_Name = Payment
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements COMEXDataSourceSingle
Private m_Fields()
Public Event OnRecordSaved(byRef aPayment As Payment)
Public Event OnRecordMarkForDelete(byRef aPayment As Payment)
Public Event OnDirty(byVal IsDirty As Boolean)
Public Event OnRecordLoad(byRef aPayment As Payment)
Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_CardholdersName As String
Private m_CreditCardNumber As String
Private m_PaymentAmount As Currency
Private m_PaymentID As Long
Private m_PaymentMethodID As Long
Private m_PaymentMethod As String
Private m_ProjectID As Long
Private m_ProjectName As String
Private m_CreditCardExpDate As Variant
Private m_PaymentDate As Variant
Private m_OldPaymentID As Long
Private m_IsNew As Boolean
Private m_IsDirty As Boolean
Private m_IsDeleted As Boolean
Friend Property Let IsNew(Byval vData As boolean)
m_IsNew = vData
End Property
Public Property Get IsNew() As Boolean
IsNew = m_IsNew
End Property
Friend Property Let IsDirty(Byval vData As boolean)
m_IsDirty = vData
RaiseEvent OnDirty(vData)
End Property
Public Property Get IsDirty() As Boolean
IsDirty = m_IsDirty
End Property
Friend Property Let IsDeleted(Byval vData As boolean)
m_IsDeleted = vData
RaiseEvent OnRecordMarkForDelete(Me)
End Property
Public Property Get IsDeleted() As Boolean
IsDeleted = m_IsDeleted
End Property
Public Property Get IsValid() As Boolean
IsValid = (mobjValid.Count = 0)
End Property
Private Sub mobjValid_BrokenRule()
RaiseEvent Valid(False)
End Sub
Private Sub mobjValid_NoBrokenRules()
RaiseEvent Valid(True)
End Sub
'******************************************************************************
'Begin property get/let/set *
'******************************************************************************
Friend Property Let OldPaymentID(vData As Long)
m_OldPaymentID = vData
End Property
Public Property Let CardholdersName (vData As String)
m_CardholdersName = vData
IsDirty = True
End Property
Public Property Get CardholdersName() As String
CardholdersName = m_CardholdersName
End Property
Public Property Let CreditCardNumber (vData As String)
m_CreditCardNumber = vData
IsDirty = True
End Property
Public Property Get CreditCardNumber() As String
CreditCardNumber = m_CreditCardNumber
End Property
Public Property Let PaymentAmount (vData As Currency)
m_PaymentAmount = vData
IsDirty = True
End Property
Public Property Get PaymentAmount() As Currency
PaymentAmount = m_PaymentAmount
End Property
Public Property Let PaymentID (vData As Long)
m_PaymentID = vData
IsDirty = True
End Property
Public Property Get PaymentID() As Long
PaymentID = m_PaymentID
End Property
Public Property Let PaymentMethodID (vData As Long)
m_PaymentMethodID = vData
IsDirty = True
End Property
Public Property Get PaymentMethodID() As Long
PaymentMethodID = m_PaymentMethodID
End Property
Public Property Get PaymentMethodIDIncludeLookup() As String
PaymentMethodIDIncludeLookup = m_PaymentMethodID & vbtab & PaymentMethod
End Property
Friend Property Let PaymentMethodIDIncludeLookup(byval vData As string)
On Error Resume Next
Dim strFields() As string
strFields = split(vData, vbtab)
PaymentMethodID = strFields(0)
m_PaymentMethod = strFields(1)
End Property
Friend Property Let PaymentMethod(vData As String)
m_PaymentMethod = vData
End Property
Public Property Get PaymentMethod() As String
PaymentMethod = m_PaymentMethod
End Property
Public Property Let ProjectID (vData As Long)
m_ProjectID = vData
IsDirty = True
End Property
Public Property Get ProjectID() As Long
ProjectID = m_ProjectID
End Property
Public Property Get ProjectIDIncludeLookup() As String
ProjectIDIncludeLookup = m_ProjectID & vbtab & ProjectName
End Property
Friend Property Let ProjectIDIncludeLookup(byval vData As string)
On Error Resume Next
Dim strFields() As string
strFields = split(vData, vbtab)
ProjectID = strFields(0)
m_ProjectName = strFields(1)
End Property
Friend Property Let ProjectName(vData As String)
m_ProjectName = vData
End Property
Public Property Get ProjectName() As String
ProjectName = m_ProjectName
End Property
Public Property Let CreditCardExpDate (vData As Variant)
m_CreditCardExpDate = vData
IsDirty = True
End Property
Public Property Get CreditCardExpDate() As Variant
CreditCardExpDate = m_CreditCardExpDate
End Property
Public Property Let PaymentDate (vData As Variant)
m_PaymentDate = vData
IsDirty = True
End Property
Public Property Get PaymentDate() As Variant
PaymentDate = m_PaymentDate
End Property
'******************************************************************************
'End property get/let/set *
'******************************************************************************
'******************************************************************************
'* *
'* Name: Clear *
'* *
'* Purpose: Reset this object and initialize data to default. *
'* *
'******************************************************************************
Public Sub Clear()
m_IsNew = True
m_IsDirty = False
m_IsDeleted = False
m_CardholdersName = vbnullstring
m_CreditCardNumber = vbnullstring
m_PaymentAmount = 0
m_PaymentID = 0
m_PaymentMethodID = 0
m_ProjectID = 0
m_CreditCardExpDate = Null
m_PaymentDate = Null
Set mobjValid = New BrokenRules
ReSetBrokenRule True
End Sub
Public Sub ReSetBrokenRule(byval BrokenAll As boolean)
End Sub
Private Sub Class_Initialize()
Clear
m_Fields = Array("CardholdersName", "CreditCardNumber", "PaymentAmount", "PaymentID", "PaymentMethodID", "ProjectID", "CreditCardExpDate", "PaymentDate")
End Sub
Private Sub Class_Terminate()
Clear
End Sub
'******************************************************************************
'* *
'* Name: Save *
'* *
'* Purpose: Save a changed object or a new record into database. *
'* *
'* Returns: True when successfully saved, false when failed to save. *
'* *
'******************************************************************************
Public Function Save(optional Byval bolStartTran As boolean = True) As Boolean
Dim adoRS As ADODB.Recordset
Dim strSQL As String
Dim Count As Long, i As Long, bolInTran As boolean
On Error GoTo Err_Save
If Not IsDirty Then GoTo Skip_Save
If Not IsValid Then
InvalidHandler(mobjValid.BrokenRules)
GoTo Done_Save
End If
If bolStartTran Then
Conn.BeginTrans
bolInTran = True
End If
Set adoRS = New ADODB.Recordset
strSQL ="Select * FROM Payments a WHERE a.PaymentID=" & m_OldPaymentID & ""
adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
With adoRS
If Not .EOF Then
If m_IsDeleted Then
.Delete
Else
SaveRecord:
adoRS("CardholdersName") = IIF(m_CardholdersName= vbNullString, vbNullString, m_CardholdersName)
adoRS("CreditCardNumber") = IIF(m_CreditCardNumber= vbNullString, vbNullString, m_CreditCardNumber)
adoRS("PaymentAmount") = m_PaymentAmount
adoRS("PaymentMethodID") = m_PaymentMethodID
adoRS("ProjectID") = m_ProjectID
adoRS("CreditCardExpDate") = m_CreditCardExpDate
adoRS("PaymentDate") = m_PaymentDate
.Update
m_PaymentID = adoRS("PaymentID")
m_OldPaymentID = m_PaymentID
End If
Else
If Not m_IsDeleted Then
.AddNew
GoTo SaveRecord
End If
End If
.Close
End With
Skip_Save:
If bolInTran Then
Conn.CommitTrans
bolInTran = False
End If
Save = True
IsDirty = False
IsNew = False
RaiseEvent OnRecordSaved(Me)
Done_Save:
Exit Function
Err_Save:
If bolStartTran Then GoSub Rollback_Save
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"Payment","Save")
GoTo Done_Save
Rollback_Save:
If bolInTran Then Conn.RollbackTrans
Return
End Function
'******************************************************************************
'* *
'* Name: Delete *
'* *
'* Purpose: mark this object and it's children as to be deleted when save *
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -