VERSION 1.0 CLASS
Begin      
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
End    

Attribute VB_Name = ExpenseCode
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 aExpenseCode As ExpenseCode)
Public Event OnRecordMarkForDelete(byRef aExpenseCode As ExpenseCode)
Public Event OnDirty(byVal IsDirty As Boolean)
Public Event OnRecordLoad(byRef aExpenseCode As ExpenseCode)

Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_ExpenseCode As String
Private m_ExpenseCodeID As Long
Private m_OldExpenseCodeID 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 OldExpenseCodeID(vData As Long)
  m_OldExpenseCodeID = vData
End Property

Public Property Let ExpenseCode (vData As String)
  m_ExpenseCode = vData 	
  IsDirty = True
End Property

Public Property Get ExpenseCode() As String
  ExpenseCode = m_ExpenseCode
End Property


Public Property Let ExpenseCodeID (vData As Long)
  m_ExpenseCodeID = vData 	
  IsDirty = True
End Property

Public Property Get ExpenseCodeID() As Long
  ExpenseCodeID = m_ExpenseCodeID
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_ExpenseCode = vbnullstring
  m_ExpenseCodeID = 0


  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("ExpenseCode", "ExpenseCodeID")  
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 [Expense Codes] a WHERE  a.ExpenseCodeID=" & m_OldExpenseCodeID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("ExpenseCode") = IIF(m_ExpenseCode= vbNullString, vbNullString, m_ExpenseCode)

      .Update
      m_ExpenseCodeID = adoRS("ExpenseCodeID")
      m_OldExpenseCodeID = m_ExpenseCodeID
    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,"ExpenseCode","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     *
'*          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 [Expense Codes] " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"ExpenseCode","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 vExpenseCodeID As Long) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.ExpenseCode,a.ExpenseCodeID From [Expense Codes] a WHERE a.ExpenseCodeID=" & vExpenseCodeID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_ExpenseCode= IIF(IsNull(adoRS("ExpenseCode")), "", adoRS("ExpenseCode"))
      m_ExpenseCodeID= IIF(IsNull(adoRS("ExpenseCodeID")), 0, adoRS("ExpenseCodeID"))
      m_OldExpenseCodeID = m_ExpenseCodeID

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

  strSQL = "Select a.ExpenseCode,a.ExpenseCodeID From [Expense Codes] a" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uExpenseCode = Nothing
      Set uExpenseCode = New ExpenseCode
      uExpenseCode.ExpenseCode= IIF(IsNull(adoRS("ExpenseCode")), "", adoRS("ExpenseCode"))
      uExpenseCode.ExpenseCodeID= IIF(IsNull(adoRS("ExpenseCodeID")), 0, adoRS("ExpenseCodeID"))
      uExpenseCode.OldExpenseCodeID = uExpenseCode.ExpenseCodeID
	
      uExpenseCode.IsDirty = False    
      uExpenseCode.IsNew = False 
      uExpenseCode.ReSetBrokenRule False
      uExpenseCodes.AddExisting uExpenseCode, ":" & uExpenseCode.ExpenseCodeID 

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uExpenseCodes
  Exit Function

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



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

  uExpenseCode.ExpenseCode = m_ExpenseCode
  uExpenseCode.ExpenseCodeID = m_ExpenseCodeID
  uExpenseCode.IsDirty = m_IsDirty
  uExpenseCode.IsNew = m_IsNew
  uExpenseCode.IsDeleted = m_IsDeleted
  uExpenseCode.OldExpenseCodeID = m_OldExpenseCodeID
  Set CopyMe = uExpenseCode
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 "ExpenseCode"
        Me.ExpenseCode =  newData
      Case "ExpenseCodeID"
        Me.ExpenseCodeID =  newData
    End Select
  End If
End Sub  

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

    Case "ExpenseCode"
        Me.ExpenseCode =  newData
    Case "ExpenseCodeID"
        Me.ExpenseCodeID =  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