payment.cls

人事档案管理系统(PB)/人事工资管理系统/干部信息管理系统/投标报价与合同管理系统/... 超市...

'*          is callled. Note it doesn't do the deletion in the database.      *
'******************************************************************************
Public Sub Delete()

  IsDirty = True
  IsDeleted = True  
End Sub    
'******************************************************************************
'*                                                                            *
'* Name:    DeleteList                                                        *
'*                                                                            *
'* Purpose: Delete record in database based on a where SQL clause.            *
'*          Note it doesn't delete children records.                          *   
'*                                                                            *
'******************************************************************************
Public Function DeleteList(ByVal strDeleteSQL As String) As Boolean
  On Error GoTo Err_DeleteList
  Dim strSQL As String

  strSQL = "DELETE * FROM Payments " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Payment","DeleteList")
End Function
    
'******************************************************************************
'*                                                                            *
'* Name:    Load                                                              *
'*                                                                            *
'* Purpose: Get the specified record. If found, fill this object with correct *
'*          record data. GetChildren is optional so if true get children      *
'*          record as well.                                                   *
'*                                                                            *
'* Returns: Boolean - True (record found); False (otherwise).                 *
'*                                                                            *
'******************************************************************************
Public Function Load(ByVal vPaymentID As Long) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.CardholdersName,a.CreditCardNumber,a.PaymentAmount,a.PaymentID,a.PaymentMethodID,b.PaymentMethod As PaymentMethod,a.ProjectID,c.ProjectName As ProjectName,a.CreditCardExpDate,a.PaymentDate From (Payments a LEFT JOIN [Payment Methods] b ON a.PaymentMethodID = b.PaymentMethodID) LEFT JOIN Projects c ON a.ProjectID = c.ProjectID WHERE a.PaymentID=" & vPaymentID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_CardholdersName= IIF(IsNull(adoRS("CardholdersName")), "", adoRS("CardholdersName"))
      m_CreditCardNumber= IIF(IsNull(adoRS("CreditCardNumber")), "", adoRS("CreditCardNumber"))
      m_PaymentAmount= IIF(IsNull(adoRS("PaymentAmount")), 0, adoRS("PaymentAmount"))
      m_PaymentID= IIF(IsNull(adoRS("PaymentID")), 0, adoRS("PaymentID"))
      m_PaymentMethodID= IIF(IsNull(adoRS("PaymentMethodID")), 0, adoRS("PaymentMethodID"))
      m_PaymentMethod= IIF(IsNull(adoRS("PaymentMethod")), "", adoRS("PaymentMethod"))
      m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      m_CreditCardExpDate = adoRS("CreditCardExpDate")
      m_PaymentDate = adoRS("PaymentDate")
      m_OldPaymentID = m_PaymentID

	  ReSetBrokenRule False 
    Else
      Load = False
      .Close
      Exit Function
    End If
    .Close
  End With


  Load = True
  IsDirty = False  
  IsNew = False
  RaiseEvent OnRecordLoad(Me)
  Exit Function

Err_Load:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Payment","Load")
End Function


'******************************************************************************
'*                                                                            *
'* Name:    LoadList                                                          *
'*                                                                            *
'* Purpose: Load records based on a where SQL clause.                         *
'*          You can include orderby clause in SQLWhereClause to sort data.    *  
'*                                                                            *
'* Return: a Payments object                  *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As Payments
  On Error GoTo Err_LoadList
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uPayment As Payment
  Dim uPayments As New Payments

  strSQL = "Select a.CardholdersName,a.CreditCardNumber,a.PaymentAmount,a.PaymentID,a.PaymentMethodID,b.PaymentMethod As PaymentMethod,a.ProjectID,c.ProjectName As ProjectName,a.CreditCardExpDate,a.PaymentDate From (Payments a LEFT JOIN [Payment Methods] b ON a.PaymentMethodID = b.PaymentMethodID) LEFT JOIN Projects c ON a.ProjectID = c.ProjectID" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uPayment = Nothing
      Set uPayment = New Payment
      uPayment.CardholdersName= IIF(IsNull(adoRS("CardholdersName")), "", adoRS("CardholdersName"))
      uPayment.CreditCardNumber= IIF(IsNull(adoRS("CreditCardNumber")), "", adoRS("CreditCardNumber"))
      uPayment.PaymentAmount= IIF(IsNull(adoRS("PaymentAmount")), 0, adoRS("PaymentAmount"))
      uPayment.PaymentID= IIF(IsNull(adoRS("PaymentID")), 0, adoRS("PaymentID"))
      uPayment.PaymentMethodID= IIF(IsNull(adoRS("PaymentMethodID")), 0, adoRS("PaymentMethodID"))
      uPayment.PaymentMethod= IIF(IsNull(adoRS("PaymentMethod")), "", adoRS("PaymentMethod"))
      uPayment.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      uPayment.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      uPayment.CreditCardExpDate = adoRS("CreditCardExpDate")
      uPayment.PaymentDate = adoRS("PaymentDate")
      uPayment.OldPaymentID = uPayment.PaymentID
	
      uPayment.IsDirty = False    
      uPayment.IsNew = False 
      uPayment.ReSetBrokenRule False
      uPayments.AddExisting uPayment, ":" & uPayment.PaymentID 

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uPayments
  Exit Function

Err_LoadList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Payment","LoadList")
End Function



'******************************************************************************
'*                                                                            *
'* Name:    GetPayment MethodsList()                                                  *
'*                                                                            *
'* Purpose: Get the lookup table data into a string.                          *
'*          This is useful for client app to fill combo box                   *
'*                                                                            *
'* Returns: a string with Column delimeter vbTab and row delimeter "|"        *
'*                                                                            *
'******************************************************************************
Function GetPaymentMethodsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select PaymentMethodID,PaymentMethod from [Payment Methods]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetPaymentMethodsList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetPaymentMethodsList = vbNullString 
    End If
    .Close
  End With
End Function

'******************************************************************************
'*                                                                            *
'* Name:    GetProjectsList()                                                  *
'*                                                                            *
'* Purpose: Get the lookup table data into a string.                          *
'*          This is useful for client app to fill combo box                   *
'*                                                                            *
'* Returns: a string with Column delimeter vbTab and row delimeter "|"        *
'*                                                                            *
'******************************************************************************
Function GetProjectsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select ProjectID,ProjectName from [Projects]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetProjectsList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetProjectsList = vbNullString 
    End If
    .Close
  End With
End Function

'******************************************************************************
'*                                                                            *
'* Name:    CopyMe                                                            *
'*                                                                            *
'* Purpose: this method make another copy of this object in the memory        *
'*                                                                            *
'* Returns: Another Payment.                              *
'*                                                                            *
'******************************************************************************
Public Function CopyMe() As Payment
  Dim uPayment As New Payment

  uPayment.CardholdersName = m_CardholdersName
  uPayment.CreditCardNumber = m_CreditCardNumber
  uPayment.PaymentAmount = m_PaymentAmount
  uPayment.PaymentID = m_PaymentID
  uPayment.PaymentMethodID = m_PaymentMethodID
  uPayment.PaymentMethod = m_PaymentMethod
  uPayment.ProjectID = m_ProjectID
  uPayment.ProjectName = m_ProjectName
  uPayment.CreditCardExpDate = m_CreditCardExpDate
  uPayment.PaymentDate = m_PaymentDate
  uPayment.IsDirty = m_IsDirty
  uPayment.IsNew = m_IsNew
  uPayment.IsDeleted = m_IsDeleted
  uPayment.OldPaymentID = m_OldPaymentID
  Set CopyMe = uPayment
End Function     


Private Function COMEXDataSourceSingle_GetData(ByVal Field As Long) As Variant
  On Error Resume Next
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then     
    COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1) & "IncludeLookup" , vbGet)
  	If err<>0 Then COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1), vbGet)
  Else
    COMEXDataSourceSingle_GetData = vbNullString
  End If
End Function

Private Function COMEXDataSourceSingle_GetDataByName(ByVal FieldName As String) As Variant
  On Error Resume Next
  COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName & "IncludeLookup", vbGet)
  If err<>0 Then COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName, vbGet)
End Function

Private Function COMEXDataSourceSingle_GetFieldCount() As Long
  COMEXDataSourceSingle_GetFieldCount = UBound(m_Fields) + 1
End Function

Private Function COMEXDataSourceSingle_GetFieldName(ByVal Field As Long) As String
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then 
    COMEXDataSourceSingle_GetFieldName = m_Fields(Field - 1)
  Else
    COMEXDataSourceSingle_GetFieldName = vbNullString
  End If
End Function

Private Sub COMEXDataSourceSingle_SetData(ByVal Field As Long, ByVal newData As Variant)     
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then 
    Select Case m_Fields(Field-1)

      Case "CardholdersName"
        Me.CardholdersName =  newData
      Case "CreditCardNumber"
        Me.CreditCardNumber =  newData
      Case "PaymentAmount"
        Me.PaymentAmount =  newData
      Case "PaymentID"
        Me.PaymentID =  newData
      Case "PaymentMethodID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.PaymentMethodIDIncludeLookup =  newData
      Case "PaymentMethod"
        Me.PaymentMethod =  newData
      Case "ProjectID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ProjectIDIncludeLookup =  newData
      Case "ProjectName"
        Me.ProjectName =  newData
      Case "CreditCardExpDate"
        Me.CreditCardExpDate =  newData
      Case "PaymentDate"
        Me.PaymentDate =  newData
    End Select
  End If
End Sub  

Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)     
  Select Case FieldName

    Case "CardholdersName"
        Me.CardholdersName =  newData
    Case "CreditCardNumber"
        Me.CreditCardNumber =  newData
    Case "PaymentAmount"
        Me.PaymentAmount =  newData
    Case "PaymentID"
        Me.PaymentID =  newData
    Case "PaymentMethodID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.PaymentMethodIDIncludeLookup =  newData
    Case "PaymentMethod"
        Me.PaymentMethod =  newData
    Case "ProjectID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ProjectIDIncludeLookup =  newData
    Case "ProjectName"
        Me.ProjectName =  newData
    Case "CreditCardExpDate"
        Me.CreditCardExpDate =  newData
    Case "PaymentDate"
        Me.PaymentDate =  newData
  End Select  
End Sub

Private Sub COMEXDataSourceSingle_Delete()
  Call Delete
End Sub 

Private Function COMEXDataSourceSingle_Save() As Boolean
  COMEXDataSourceSingle_Save = Save
End Function 

Private Function COMEXDataSourceSingle_CopyMe() As COMEXDataSourceSingle
  Set COMEXDataSourceSingle_CopyMe = CopyMe
End Function

Private Property Get COMEXDataSourceSingle_IsDeleted() As Boolean
  COMEXDataSourceSingle_IsDeleted = IsDeleted
End Property