?? clientproject.cls
字號:
Private Sub Class_Initialize()
Clear
m_Fields = Array("ClientID", "EmployeeID", "ProjectDescription", "ProjectEndDate", "ProjectID", "ProjectName", "ProjectTotalBillingEstimate", "PurchaseOrderNumber", "ProjectBeginDate")
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 Projects a WHERE a.ProjectID=" & m_OldProjectID & ""
adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
With adoRS
If Not .EOF Then
If m_IsDeleted Then
.Delete
Else
SaveRecord:
adoRS("ClientID") = m_ClientID
adoRS("EmployeeID") = m_EmployeeID
adoRS("ProjectDescription") = IIF(m_ProjectDescription= vbNullString, vbNullString, m_ProjectDescription)
adoRS("ProjectEndDate") = m_ProjectEndDate
adoRS("ProjectName") = IIF(m_ProjectName= vbNullString, vbNullString, m_ProjectName)
adoRS("ProjectTotalBillingEstimate") = m_ProjectTotalBillingEstimate
adoRS("PurchaseOrderNumber") = IIF(m_PurchaseOrderNumber= vbNullString, vbNullString, m_PurchaseOrderNumber)
adoRS("ProjectBeginDate") = m_ProjectBeginDate
.Update
m_ProjectID = adoRS("ProjectID")
m_OldProjectID = m_ProjectID
End If
Else
If Not m_IsDeleted Then
.AddNew
GoTo SaveRecord
End If
End If
.Close
End With
Skip_Save:
Dim uProjTimeCardHour As ProjTimeCardHour
i = 1
Do While i <= m_ProjTimeCardHours.Count
Set uProjTimeCardHour = m_ProjTimeCardHours(i)
If uProjTimeCardHour.IsDeleted Then
If Not uProjTimeCardHour.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
m_ProjTimeCardHours.Remove i
Else
If uProjTimeCardHour.IsDirty Then
uProjTimeCardHour.ProjectID = m_ProjectID
End If
If Not uProjTimeCardHour.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
i = i + 1
End If
Loop
Dim uProjTimeCardExpense As ProjTimeCardExpense
i = 1
Do While i <= m_ProjTimeCardExpenses.Count
Set uProjTimeCardExpense = m_ProjTimeCardExpenses(i)
If uProjTimeCardExpense.IsDeleted Then
If Not uProjTimeCardExpense.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
m_ProjTimeCardExpenses.Remove i
Else
If uProjTimeCardExpense.IsDirty Then
uProjTimeCardExpense.ProjectID = m_ProjectID
End If
If Not uProjTimeCardExpense.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
i = i + 1
End If
Loop
Dim uPayment As Payment
i = 1
Do While i <= m_Payments.Count
Set uPayment = m_Payments(i)
If uPayment.IsDeleted Then
If Not uPayment.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
m_Payments.Remove i
Else
If uPayment.IsDirty Then
uPayment.ProjectID = m_ProjectID
End If
If Not uPayment.Save(False) Then
GoSub Rollback_Save
Exit Function
End If
i = i + 1
End If
Loop
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,"ClientProject","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()
m_ProjTimeCardHours.Delete
m_ProjTimeCardExpenses.Delete
m_Payments.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 Projects " & strDeleteSQL
Conn.Execute strSQL
DeleteList = True
Exit Function
Err_DeleteList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ClientProject","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 vProjectID As Long, Optional ByVal GetChildren As Boolean = True) As Boolean
On Error GoTo Err_Load
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
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.ProjectID=" & vProjectID & ""
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
If Not .EOF Then
m_ClientID= IIF(IsNull(adoRS("ClientID")), 0, adoRS("ClientID"))
m_CompanyName= IIF(IsNull(adoRS("CompanyName")), "", adoRS("CompanyName"))
m_EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
m_FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
m_LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
m_ProjectDescription= IIF(IsNull(adoRS("ProjectDescription")), "", adoRS("ProjectDescription"))
m_ProjectEndDate = adoRS("ProjectEndDate")
m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
m_ProjectTotalBillingEstimate= IIF(IsNull(adoRS("ProjectTotalBillingEstimate")), 0, adoRS("ProjectTotalBillingEstimate"))
m_PurchaseOrderNumber= IIF(IsNull(adoRS("PurchaseOrderNumber")), "", adoRS("PurchaseOrderNumber"))
m_ProjectBeginDate= IIF(IsNull(adoRS("ProjectBeginDate")), "12:00:00AM", adoRS("ProjectBeginDate"))
m_OldProjectID = m_ProjectID
ReSetBrokenRule False
Else
Load = False
.Close
Exit Function
End If
.Close
End With
If GetChildren Then m_ProjTimeCardHours.LoadRelated m_ProjectID
If GetChildren Then m_ProjTimeCardExpenses.LoadRelated m_ProjectID
If GetChildren Then m_Payments.LoadRelated m_ProjectID
Load = True
IsDirty = False
IsNew = False
RaiseEvent OnRecordLoad(Me)
Exit Function
Err_Load:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ClientProject","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 ClientProjects object *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As ClientProjects
On Error GoTo Err_LoadList
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" & SQLWhereClause
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -