projtimecardexpense.cls

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

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

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

Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_ExpenseAmount As Currency
Private m_ExpenseCodeID As Long
Private m_ExpenseCode As String
Private m_ExpenseDescription As String
Private m_ProjectID As Long
Private m_ProjectName As String
Private m_TimeCardExpenseID As Long
Private m_TimeCardID As Long
Private m_DateEntered As Date
Private m_ExpenseDate As Date
Private m_OldTimeCardExpenseID 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 OldTimeCardExpenseID(vData As Long)
  m_OldTimeCardExpenseID = vData
End Property

Public Property Let ExpenseAmount (vData As Currency)
  m_ExpenseAmount = vData 	
  IsDirty = True
End Property

Public Property Get ExpenseAmount() As Currency
  ExpenseAmount = m_ExpenseAmount
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


Public Property Get ExpenseCodeIDIncludeLookup() As String
  ExpenseCodeIDIncludeLookup = m_ExpenseCodeID & vbtab & ExpenseCode 		  
End Property 

Friend Property Let ExpenseCodeIDIncludeLookup(byval vData As string) 
  On Error Resume Next
  Dim strFields() As string
  strFields = split(vData, vbtab)
  ExpenseCodeID = strFields(0) 
  m_ExpenseCode = strFields(1) 		  
End Property 


Friend Property Let ExpenseCode(vData As String)
  m_ExpenseCode = vData
End Property
		
Public Property Get ExpenseCode() As String
  ExpenseCode = m_ExpenseCode
End Property
Public Property Let ExpenseDescription (vData As String)
  m_ExpenseDescription = vData 	
  IsDirty = True
End Property

Public Property Get ExpenseDescription() As String
  ExpenseDescription = m_ExpenseDescription
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 TimeCardExpenseID (vData As Long)
  m_TimeCardExpenseID = vData 	
  IsDirty = True
End Property

Public Property Get TimeCardExpenseID() As Long
  TimeCardExpenseID = m_TimeCardExpenseID
End Property


Public Property Let TimeCardID (vData As Long)
  m_TimeCardID = vData 	
  IsDirty = True
End Property

Public Property Get TimeCardID() As Long
  TimeCardID = m_TimeCardID
End Property


Public Property Get TimeCardIDIncludeLookup() As String
  TimeCardIDIncludeLookup = m_TimeCardID & vbtab & DateEntered 		  
End Property 

Friend Property Let TimeCardIDIncludeLookup(byval vData As string) 
  On Error Resume Next
  Dim strFields() As string
  strFields = split(vData, vbtab)
  TimeCardID = strFields(0) 
  m_DateEntered = strFields(1) 		  
End Property 


Friend Property Let DateEntered(vData As Date)
  m_DateEntered = vData
End Property
		
Public Property Get DateEntered() As Date
  DateEntered = m_DateEntered
End Property
Public Property Let ExpenseDate (vData As Date)
  m_ExpenseDate = vData 
  mobjValid.RuleBroken "ExpenseDate", False	
  IsDirty = True
End Property

Public Property Get ExpenseDate() As Date
  ExpenseDate = m_ExpenseDate
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_ExpenseAmount = 0
  m_ExpenseCodeID = 0
  m_ExpenseDescription = vbnullstring
  m_ProjectID = 0
  m_TimeCardExpenseID = 0
  m_TimeCardID = 0
  m_ExpenseDate = "12:00:00AM"


  Set mobjValid = New BrokenRules
  ReSetBrokenRule True 
End Sub	


Public Sub ReSetBrokenRule(byval BrokenAll As boolean)  
  mobjValid.RuleBroken "ExpenseDate", BrokenAll
End Sub


Private Sub Class_Initialize()
  Clear
  m_Fields = Array("ExpenseAmount", "ExpenseCodeID", "ExpenseDescription", "ProjectID", "TimeCardExpenseID", "TimeCardID", "ExpenseDate")  
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 [Time Card Expenses] a WHERE  a.TimeCardExpenseID=" & m_OldTimeCardExpenseID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("ExpenseAmount") = m_ExpenseAmount
      adoRS("ExpenseCodeID") = m_ExpenseCodeID
      adoRS("ExpenseDescription") = IIF(m_ExpenseDescription= vbNullString, vbNullString, m_ExpenseDescription)
      adoRS("ProjectID") = m_ProjectID
      adoRS("TimeCardID") = m_TimeCardID
      adoRS("ExpenseDate") = m_ExpenseDate

      .Update
      m_TimeCardExpenseID = adoRS("TimeCardExpenseID")
      m_OldTimeCardExpenseID = m_TimeCardExpenseID
    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,"ProjTimeCardExpense","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                                                        *
'*                                                                            *