timecardhour.cls

完整的三层数据库应用程序

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

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

Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_BillableHours As Double
Private m_BillingRate As Currency
Private m_ProjectID As Long
Private m_ProjectName As String
Private m_TimeCardDetailID As Long
Private m_TimeCardID As Long
Private m_DateEntered As Date
Private m_WorkCodeID As Long
Private m_WorkCode As String
Private m_WorkDescription As String
Private m_DateWorked As Date
Private m_OldTimeCardDetailID 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 OldTimeCardDetailID(vData As Long)
  m_OldTimeCardDetailID = vData
End Property

Public Property Let BillableHours (vData As Double)
  m_BillableHours = vData 	
  IsDirty = True
End Property

Public Property Get BillableHours() As Double
  BillableHours = m_BillableHours
End Property


Public Property Let BillingRate (vData As Currency)
  m_BillingRate = vData 	
  IsDirty = True
End Property

Public Property Get BillingRate() As Currency
  BillingRate = m_BillingRate
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 TimeCardDetailID (vData As Long)
  m_TimeCardDetailID = vData 	
  IsDirty = True
End Property

Public Property Get TimeCardDetailID() As Long
  TimeCardDetailID = m_TimeCardDetailID
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 WorkCodeID (vData As Long)
  m_WorkCodeID = vData 	
  IsDirty = True
End Property

Public Property Get WorkCodeID() As Long
  WorkCodeID = m_WorkCodeID
End Property


Public Property Get WorkCodeIDIncludeLookup() As String
  WorkCodeIDIncludeLookup = m_WorkCodeID & vbtab & WorkCode 		  
End Property 

Friend Property Let WorkCodeIDIncludeLookup(byval vData As string) 
  On Error Resume Next
  Dim strFields() As string
  strFields = split(vData, vbtab)
  WorkCodeID = strFields(0) 
  m_WorkCode = strFields(1) 		  
End Property 


Friend Property Let WorkCode(vData As String)
  m_WorkCode = vData
End Property
		
Public Property Get WorkCode() As String
  WorkCode = m_WorkCode
End Property
Public Property Let WorkDescription (vData As String)
  m_WorkDescription = vData 	
  IsDirty = True
End Property

Public Property Get WorkDescription() As String
  WorkDescription = m_WorkDescription
End Property


Public Property Let DateWorked (vData As Date)
  m_DateWorked = vData 
  mobjValid.RuleBroken "DateWorked", False	
  IsDirty = True
End Property

Public Property Get DateWorked() As Date
  DateWorked = m_DateWorked
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_BillableHours = 0
  m_BillingRate = 0
  m_ProjectID = 0
  m_TimeCardDetailID = 0
  m_TimeCardID = 0
  m_WorkCodeID = 0
  m_WorkDescription = vbnullstring
  m_DateWorked = "12:00:00AM"


  Set mobjValid = New BrokenRules
  ReSetBrokenRule True 
End Sub	


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


Private Sub Class_Initialize()
  Clear
  m_Fields = Array("BillableHours", "BillingRate", "ProjectID", "TimeCardDetailID", "TimeCardID", "WorkCodeID", "WorkDescription", "DateWorked")  
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 Hours] a WHERE  a.TimeCardDetailID=" & m_OldTimeCardDetailID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("BillableHours") = m_BillableHours
      adoRS("BillingRate") = m_BillingRate
      adoRS("ProjectID") = m_ProjectID
      adoRS("TimeCardID") = m_TimeCardID
      adoRS("WorkCodeID") = m_WorkCodeID
      adoRS("WorkDescription") = IIF(m_WorkDescription= vbNullString, vbNullString, m_WorkDescription)
      adoRS("DateWorked") = m_DateWorked

      .Update
      m_TimeCardDetailID = adoRS("TimeCardDetailID")
      m_OldTimeCardDetailID = m_TimeCardDetailID
    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,"TimeCardHour","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    
'******************************************************************************