paymentmethod.cls

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

'* Name:    Delete                                                            *
'*                                                                            *
'* Purpose: mark this object and it's children as to be deleted when save     *
'*          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 [Payment Methods] " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"PaymentMethod","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 vPaymentMethodID As Long) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.CreditCard,a.PaymentMethod,a.PaymentMethodID From [Payment Methods] a WHERE a.PaymentMethodID=" & vPaymentMethodID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_CreditCard= IIF(IsNull(adoRS("CreditCard")), 0, adoRS("CreditCard"))
      m_PaymentMethod= IIF(IsNull(adoRS("PaymentMethod")), "", adoRS("PaymentMethod"))
      m_PaymentMethodID= IIF(IsNull(adoRS("PaymentMethodID")), 0, adoRS("PaymentMethodID"))
      m_OldPaymentMethodID = m_PaymentMethodID

	  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,"PaymentMethod","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 PaymentMethods object                  *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As PaymentMethods
  On Error GoTo Err_LoadList
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uPaymentMethod As PaymentMethod
  Dim uPaymentMethods As New PaymentMethods

  strSQL = "Select a.CreditCard,a.PaymentMethod,a.PaymentMethodID From [Payment Methods] a" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uPaymentMethod = Nothing
      Set uPaymentMethod = New PaymentMethod
      uPaymentMethod.CreditCard= IIF(IsNull(adoRS("CreditCard")), 0, adoRS("CreditCard"))
      uPaymentMethod.PaymentMethod= IIF(IsNull(adoRS("PaymentMethod")), "", adoRS("PaymentMethod"))
      uPaymentMethod.PaymentMethodID= IIF(IsNull(adoRS("PaymentMethodID")), 0, adoRS("PaymentMethodID"))
      uPaymentMethod.OldPaymentMethodID = uPaymentMethod.PaymentMethodID
	
      uPaymentMethod.IsDirty = False    
      uPaymentMethod.IsNew = False 
      uPaymentMethod.ReSetBrokenRule False
      uPaymentMethods.AddExisting uPaymentMethod, ":" & uPaymentMethod.PaymentMethodID 

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uPaymentMethods
  Exit Function

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



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

  uPaymentMethod.CreditCard = m_CreditCard
  uPaymentMethod.PaymentMethod = m_PaymentMethod
  uPaymentMethod.PaymentMethodID = m_PaymentMethodID
  uPaymentMethod.IsDirty = m_IsDirty
  uPaymentMethod.IsNew = m_IsNew
  uPaymentMethod.IsDeleted = m_IsDeleted
  uPaymentMethod.OldPaymentMethodID = m_OldPaymentMethodID
  Set CopyMe = uPaymentMethod
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 "CreditCard"
        Me.CreditCard =  newData
      Case "PaymentMethod"
        Me.PaymentMethod =  newData
      Case "PaymentMethodID"
        Me.PaymentMethodID =  newData
    End Select
  End If
End Sub  

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

    Case "CreditCard"
        Me.CreditCard =  newData
    Case "PaymentMethod"
        Me.PaymentMethod =  newData
    Case "PaymentMethodID"
        Me.PaymentMethodID =  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