⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 payment.cls

📁 人事档案管理系统(PB)/人事工资管理系统/干部信息管理系统/投标报价与合同管理系统/... 超市...
💻 CLS
📖 第 1 页 / 共 2 页
字号:
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 + -