clientproject.cls

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

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uClientProjects
  Exit Function

Err_LoadList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"ClientProject","LoadList")
End Function
 
'******************************************************************************
'*                                                                            *
'* Name:    LoadByEmployeeID                                   *
'*                                                                            *
'* Purpose: Load records based on EmployeeID                         *
'*          Optionally you can include orderby clause to sort data.           *  
'*                                                                            *
'* Return: a ClientProjects object                  *
'******************************************************************************
Function LoadByEmployeeID(ByVal vEmployeeID As Long , Optional ByVal OrderByClause As String = vbNullString , Optional GetChildren As Boolean = False) As ClientProjects
  On Error GoTo Err_LoadByEmployeeID
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uClientProject As ClientProject
  Dim uClientProjects As New ClientProjects

  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.EmployeeID = " & vEmployeeID & "" & OrderByClause

  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.IsDirty = False 
      uClientProject.IsNew = False 
      uClientProject.ReSetBrokenRule False
      uClientProjects.AddExisting uClientProject, ":" & uClientProject.ProjectID 
      If GetChildren Then uClientProject.ProjTimeCardHours.LoadRelated uClientProject.ProjectID
      If GetChildren Then uClientProject.ProjTimeCardExpenses.LoadRelated uClientProject.ProjectID
      If GetChildren Then uClientProject.Payments.LoadRelated uClientProject.ProjectID

      .MoveNext
    Loop
    .Close
  End With

  Set LoadByEmployeeID = uClientProjects
  Exit Function

Err_LoadByEmployeeID:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"ClientProject","LoadByEmployeeID")
End Function
	


'******************************************************************************
'*                                                                            *
'* Name:    GetClientsList()                                                  *
'*                                                                            *
'* Purpose: Get the lookup table data into a string.                          *
'*          This is useful for client app to fill combo box                   *
'*                                                                            *
'* Returns: a string with Column delimeter vbTab and row delimeter "|"        *
'*                                                                            *
'******************************************************************************
Function GetClientsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select ClientID,CompanyName from [Clients]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetClientsList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetClientsList = vbNullString 
    End If
    .Close
  End With
End Function

'******************************************************************************
'*                                                                            *
'* Name:    GetEmployeesList()                                                  *
'*                                                                            *
'* Purpose: Get the lookup table data into a string.                          *
'*          This is useful for client app to fill combo box                   *
'*                                                                            *
'* Returns: a string with Column delimeter vbTab and row delimeter "|"        *
'*                                                                            *
'******************************************************************************
Function GetEmployeesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select EmployeeID,FirstName,LastName from [Employees]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetEmployeesList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetEmployeesList = vbNullString 
    End If
    .Close
  End With
End Function

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

  uClientProject.ClientID = m_ClientID
  uClientProject.CompanyName = m_CompanyName
  uClientProject.EmployeeID = m_EmployeeID
  uClientProject.FirstName = m_FirstName
  uClientProject.LastName = m_LastName
  uClientProject.ProjectDescription = m_ProjectDescription
  uClientProject.ProjectEndDate = m_ProjectEndDate
  uClientProject.ProjectID = m_ProjectID
  uClientProject.ProjectName = m_ProjectName
  uClientProject.ProjectTotalBillingEstimate = m_ProjectTotalBillingEstimate
  uClientProject.PurchaseOrderNumber = m_PurchaseOrderNumber
  uClientProject.ProjectBeginDate = m_ProjectBeginDate
  uClientProject.IsDirty = m_IsDirty
  uClientProject.IsNew = m_IsNew
  uClientProject.IsDeleted = m_IsDeleted
  uClientProject.OldProjectID = m_OldProjectID

  Dim uProjTimeCardHour As ProjTimeCardHour
  Dim oProjTimeCardHour As ProjTimeCardHour
  For Each oProjTimeCardHour In m_ProjTimeCardHours
    Set uProjTimeCardHour = Nothing
    Set uProjTimeCardHour = New ProjTimeCardHour
    Set uProjTimeCardHour = oProjTimeCardHour.CopyMe
    uClientProject.ProjTimeCardHours.AddExisting uProjTimeCardHour, m_ProjTimeCardHours.Key(oProjTimeCardHour)
  Next


  Dim uProjTimeCardExpense As ProjTimeCardExpense
  Dim oProjTimeCardExpense As ProjTimeCardExpense
  For Each oProjTimeCardExpense In m_ProjTimeCardExpenses
    Set uProjTimeCardExpense = Nothing
    Set uProjTimeCardExpense = New ProjTimeCardExpense
    Set uProjTimeCardExpense = oProjTimeCardExpense.CopyMe
    uClientProject.ProjTimeCardExpenses.AddExisting uProjTimeCardExpense, m_ProjTimeCardExpenses.Key(oProjTimeCardExpense)
  Next


  Dim uPayment As Payment
  Dim oPayment As Payment
  For Each oPayment In m_Payments
    Set uPayment = Nothing
    Set uPayment = New Payment
    Set uPayment = oPayment.CopyMe
    uClientProject.Payments.AddExisting uPayment, m_Payments.Key(oPayment)
  Next

  Set CopyMe = uClientProject
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 "ClientID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ClientIDIncludeLookup =  newData
      Case "CompanyName"
        Me.CompanyName =  newData
      Case "EmployeeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.EmployeeIDIncludeLookup =  newData
      Case "FirstName"
        Me.FirstName =  newData
      Case "LastName"
        Me.LastName =  newData
      Case "ProjectDescription"
        Me.ProjectDescription =  newData
      Case "ProjectEndDate"
        Me.ProjectEndDate =  newData
      Case "ProjectID"
        Me.ProjectID =  newData
      Case "ProjectName"
        Me.ProjectName =  newData
      Case "ProjectTotalBillingEstimate"
        Me.ProjectTotalBillingEstimate =  newData
      Case "PurchaseOrderNumber"
        Me.PurchaseOrderNumber =  newData
      Case "ProjectBeginDate"
        Me.ProjectBeginDate =  newData
    End Select
  End If
End Sub  

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

    Case "ClientID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ClientIDIncludeLookup =  newData
    Case "CompanyName"
        Me.CompanyName =  newData
    Case "EmployeeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.EmployeeIDIncludeLookup =  newData
    Case "FirstName"
        Me.FirstName =  newData
    Case "LastName"
        Me.LastName =  newData
    Case "ProjectDescription"
        Me.ProjectDescription =  newData
    Case "ProjectEndDate"
        Me.ProjectEndDate =  newData
    Case "ProjectID"
        Me.ProjectID =  newData
    Case "ProjectName"
        Me.ProjectName =  newData
    Case "ProjectTotalBillingEstimate"
        Me.ProjectTotalBillingEstimate =  newData
    Case "PurchaseOrderNumber"
        Me.PurchaseOrderNumber =  newData
    Case "ProjectBeginDate"
        Me.ProjectBeginDate =  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