clientprojects.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 = "ClientProjects"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder", "Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6", "Yes"
Attribute VB_Ext_KEY = "SavedWithCOMExpress", "Yes"
Attribute VB_Ext_KEY = "Collection" ,"ClientProject"
Attribute VB_Ext_KEY = "Member0" ,"ClientProject"
Attribute VB_Ext_KEY = "Top_Level", "No"
Option Explicit  
Implements COMEXDataSource
Private m_Fields() 
Private mcol As Collection

Public Event OnRecordInsert(ByRef vClientProject As ClientProject)

Public Property Get Item(vntIndexKey As Variant) As ClientProject
Attribute Item.VB_UserMemId = 0
  On Error Resume Next
  Set Item = mCol(vntIndexKey)
  If Err.Number <> 0 Then
    Set Item = Nothing
  End If
End Property

Public Function Key(ByRef vClientProject As ClientProject) As String
  Key = ":" & vClientProject.ProjectID 
End Function

Public Property Get Count() As Long
  Count = mCol.Count
End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
  Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
  Set mCol = New Collection 
  m_Fields = Array("ClientID", "EmployeeID", "ProjectDescription", "ProjectEndDate", "ProjectID", "ProjectName", "ProjectTotalBillingEstimate", "PurchaseOrderNumber", "ProjectBeginDate")
End Sub

Private Sub Class_Terminate()
  Set mCol = Nothing
End Sub

Public Sub Remove(vntIndexKey As Variant)
  mCol.Remove vntIndexKey
End Sub

Public Sub Clear()
  Set mCol = Nothing
  Set mCol = New Collection
End Sub

Public Function AddExisting(vClientProject As ClientProject, Optional sKey As String = vbNullString) As Boolean
  On Error GoTo Err_AddExisting
  If Len(sKey) = 0 Then
    mCol.Add vClientProject
  Else
    mCol.Add vClientProject, sKey
  End If
  AddExisting = True
  RaiseEvent OnRecordInsert(vClientProject)
  Exit Function
Err_AddExisting:
  AddExisting = False
End Function

Public Function Add(m_ClientID As Long, m_EmployeeID As Long, m_ProjectDescription As String, m_ProjectEndDate As Variant, m_ProjectID As Long, m_ProjectName As String, m_ProjectTotalBillingEstimate As Currency, m_PurchaseOrderNumber As String, m_ProjectBeginDate As Date, m_ProjTimeCardHours As ProjTimeCardHours, m_ProjTimeCardExpenses As ProjTimeCardExpenses, m_Payments As Payments, Optional sKey As String = vbNullString) As ClientProject
  Dim objNewMember As ClientProject
  Set objNewMember = New ClientProject
  objNewMember.ClientID = m_ClientID
  objNewMember.EmployeeID = m_EmployeeID
  objNewMember.ProjectDescription = m_ProjectDescription
  objNewMember.ProjectEndDate = m_ProjectEndDate
  objNewMember.ProjectID = m_ProjectID
  objNewMember.ProjectName = m_ProjectName
  objNewMember.ProjectTotalBillingEstimate = m_ProjectTotalBillingEstimate
  objNewMember.PurchaseOrderNumber = m_PurchaseOrderNumber
  objNewMember.ProjectBeginDate = m_ProjectBeginDate
  Set objNewMember.ProjTimeCardHours = m_ProjTimeCardHours
  Set objNewMember.ProjTimeCardExpenses = m_ProjTimeCardExpenses
  Set objNewMember.Payments = m_Payments

  If Len(sKey) = 0 Then
    mCol.Add objNewMember
  Else
    mCol.Add objNewMember, sKey
  End If
  Set Add = objNewMember
  RaiseEvent OnRecordInsert(objNewMember)
  Set objNewMember = Nothing
End Function


Public Function LoadRelated(ClientID As Long, Optional ByVal SQLWhereClause As String = "") As Boolean
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uClientProject As New ClientProject
  On Error GoTo Err_LoadRelated

  Screen.MousePointer = vbHourglass

  Clear

  strSQL = "Select a.ClientID,b.CompanyName As CompanyName,a.EmployeeID,c.FirstName As FirstName,c.LastName As LastName,a.ProjectDescription,a.ProjectEndDate,a.ProjectID,a.ProjectName,a.ProjectTotalBillingEstimate,a.PurchaseOrderNumber,a.ProjectBeginDate From (Projects a LEFT JOIN Clients b ON a.ClientID = b.ClientID) LEFT JOIN Employees c ON a.EmployeeID = c.EmployeeID WHERE a.ClientID = " & ClientID & ""
  If SQLWhereClause <> "" Then
    If UCase(Trim(Left$(SQLWhereClause, 5))) = "WHERE" Then
      SQLWhereClause = Replace(UCase(SQLWhereClause), "WHERE ", "AND ")
    Else
      If UCase(Trim(Left$(SQLWhereClause, 3))) <> "AND" Then
        SQLWhereClause = "AND " & SQLWhereClause
      End If
    End If
  End If
  strSQL = strSQL & " " & SQLWhereClause

  adoRS.CacheSize = 250
  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
  With adoRS
    Do While Not .EOF
      Set uClientProject = Nothing
      Set uClientProject = New ClientProject
      uClientProject.ClientID= IIF(IsNull(adoRS("ClientID")), 0, adoRS("ClientID"))
      uClientProject.CompanyName= IIF(IsNull(adoRS("CompanyName")), "", adoRS("CompanyName"))
      uClientProject.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uClientProject.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uClientProject.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uClientProject.ProjectDescription= IIF(IsNull(adoRS("ProjectDescription")), "", adoRS("ProjectDescription"))
      uClientProject.ProjectEndDate = adoRS("ProjectEndDate")
      uClientProject.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      uClientProject.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      uClientProject.ProjectTotalBillingEstimate= IIF(IsNull(adoRS("ProjectTotalBillingEstimate")), 0, adoRS("ProjectTotalBillingEstimate"))
      uClientProject.PurchaseOrderNumber= IIF(IsNull(adoRS("PurchaseOrderNumber")), "", adoRS("PurchaseOrderNumber"))
      uClientProject.ProjectBeginDate= IIF(IsNull(adoRS("ProjectBeginDate")), "12:00:00AM", adoRS("ProjectBeginDate"))
      uClientProject.OldProjectID = uClientProject.ProjectID

      uClientProject.ProjTimeCardHours.LoadRelated uClientProject.ProjectID

      uClientProject.ProjTimeCardExpenses.LoadRelated uClientProject.ProjectID

      uClientProject.Payments.LoadRelated uClientProject.ProjectID

      uClientProject.IsDirty = False
      mcol.Add uClientProject, ":" & uClientProject.ProjectID 

      .MoveNext
    Loop
    .Close
  End With
    
  LoadRelated = True
Done_LoadRelated:
  Screen.MousePointer = vbDefault
  Exit Function

Err_LoadRelated:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"ClientProjects","GetMultiRecords")
  Resume Done_LoadRelated 
End Function

Friend Sub Delete()
	Dim uClientProject As ClientProject
  For Each uClientProject In mCol
    uClientProject.Delete
  Next
End Sub
 

Private Function COMEXDataSource_GetData(ByVal Field As Long, ByVal Record As Long) As Variant 
  If Record > 0 And Record <= mcol.Count Then
    Dim vItem As COMEXDataSourceSingle
    Set vItem = mcol.Item(Record)
    COMEXDataSource_GetData = vItem.GetData(Field)
  Else
    COMEXDataSource_GetData = Null
  End If
End Function

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

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

Private Function COMEXDataSource_GetRecordCount() As Long
  COMEXDataSource_GetRecordCount = mcol.Count
End Function

Private Sub COMEXDataSource_SetData(ByVal Field As Long, ByVal Record As Long, ByVal newData As Variant)
  Dim vItem As COMEXDataSourceSingle
  If Record > 0 And Record <= mcol.Count  Then    
    Set vItem = mcol.Item(Record)
    vItem.SetData Field, newData 
  ElseIf Record = mcol.count + 1 Then
    Set vItem = New ClientProject
    vItem.SetData Field, newData 
    mcol.Add vItem    
  End If
End Sub 

Private Sub COMEXDataSource_Delete(ByVal Record As Long)
  If Record > 0 And Record <= mcol.Count Then mcol.Item(Record).Delete  
End Sub

Private Function COMEXDataSource_Save() As Boolean
  Dim vItem As ClientProject, i As long, bolRet As Boolean  
  i = 1
  Do While i <= mcol.count
    Set vItem = mcol.Item(i)    
    If Not (vItem.IsNew and vItem.IsDeleted) Then 
      bolRet = vItem.Save
      If Not bolRet Then 
        COMEXDataSource_Save = False
        Exit Function
      End If                
      i = i + 1
    Else
      mcol.remove i
    End If
  Loop
  COMEXDataSource_Save = True  
End Function 

Private Property Get COMEXDataSource_IsDeleted(ByVal Record As Long) As Boolean
  If Record > 0 And Record <= mcol.Count Then  _
    COMEXDataSource_IsDeleted = Item(Record).IsDeleted
End Property