?? timecard.cls
字號:
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,"TimeCard","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_TimeCardExpenses.Delete
m_TimeCardHours.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 [Time Cards] " & strDeleteSQL
Conn.Execute strSQL
DeleteList = True
Exit Function
Err_DeleteList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCard","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 vTimeCardID 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.DateEntered,a.EmployeeID,b.FirstName As FirstName,b.LastName As LastName,a.TimeCardID From [Time Cards] a LEFT JOIN Employees b ON a.EmployeeID = b.EmployeeID WHERE a.TimeCardID=" & vTimeCardID & ""
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
If Not .EOF Then
m_DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
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_TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
m_OldTimeCardID = m_TimeCardID
ReSetBrokenRule False
Else
Load = False
.Close
Exit Function
End If
.Close
End With
If GetChildren Then m_TimeCardExpenses.LoadRelated m_TimeCardID
If GetChildren Then m_TimeCardHours.LoadRelated m_TimeCardID
Load = True
IsDirty = False
IsNew = False
RaiseEvent OnRecordLoad(Me)
Exit Function
Err_Load:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCard","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 TimeCards object *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As TimeCards
On Error GoTo Err_LoadList
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim uTimeCard As TimeCard
Dim uTimeCards As New TimeCards
strSQL = "Select a.DateEntered,a.EmployeeID,b.FirstName As FirstName,b.LastName As LastName,a.TimeCardID From [Time Cards] a LEFT JOIN Employees b ON a.EmployeeID = b.EmployeeID" & SQLWhereClause
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
Do While Not .EOF
Set uTimeCard = Nothing
Set uTimeCard = New TimeCard
uTimeCard.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
uTimeCard.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
uTimeCard.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
uTimeCard.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
uTimeCard.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
uTimeCard.OldTimeCardID = uTimeCard.TimeCardID
uTimeCard.IsDirty = False
uTimeCard.IsNew = False
uTimeCard.ReSetBrokenRule False
uTimeCards.AddExisting uTimeCard, ":" & uTimeCard.TimeCardID
If GetChildren Then uTimeCard.TimeCardExpenses.LoadRelated uTimeCard.TimeCardID
If GetChildren Then uTimeCard.TimeCardHours.LoadRelated uTimeCard.TimeCardID
.MoveNext
Loop
.Close
End With
Set LoadList = uTimeCards
Exit Function
Err_LoadList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCard","LoadList")
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 TimeCard. *
'* *
'******************************************************************************
Public Function CopyMe() As TimeCard
Dim uTimeCard As New TimeCard
uTimeCard.DateEntered = m_DateEntered
uTimeCard.EmployeeID = m_EmployeeID
uTimeCard.FirstName = m_FirstName
uTimeCard.LastName = m_LastName
uTimeCard.TimeCardID = m_TimeCardID
uTimeCard.IsDirty = m_IsDirty
uTimeCard.IsNew = m_IsNew
uTimeCard.IsDeleted = m_IsDeleted
uTimeCard.OldTimeCardID = m_OldTimeCardID
Dim uTimeCardExpense As TimeCardExpense
Dim oTimeCardExpense As TimeCardExpense
For Each oTimeCardExpense In m_TimeCardExpenses
Set uTimeCardExpense = Nothing
Set uTimeCardExpense = New TimeCardExpense
Set uTimeCardExpense = oTimeCardExpense.CopyMe
uTimeCard.TimeCardExpenses.AddExisting uTimeCardExpense, m_TimeCardExpenses.Key(oTimeCardExpense)
Next
Dim uTimeCardHour As TimeCardHour
Dim oTimeCardHour As TimeCardHour
For Each oTimeCardHour In m_TimeCardHours
Set uTimeCardHour = Nothing
Set uTimeCardHour = New TimeCardHour
Set uTimeCardHour = oTimeCardHour.CopyMe
uTimeCard.TimeCardHours.AddExisting uTimeCardHour, m_TimeCardHours.Key(oTimeCardHour)
Next
Set CopyMe = uTimeCard
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 "DateEntered"
Me.DateEntered = 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 "TimeCardID"
Me.TimeCardID = newData
End Select
End If
End Sub
Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)
Select Case FieldName
Case "DateEntered"
Me.DateEntered = 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 "TimeCardID"
Me.TimeCardID = 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -