📄 timecardhours.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 = "TimeCardHours"
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" ,"TimeCardHour"
Attribute VB_Ext_KEY = "Member0" ,"TimeCardHour"
Attribute VB_Ext_KEY = "Top_Level", "No"
Option Explicit
Implements COMEXDataSource
Private m_Fields()
Private mcol As Collection
Public Event OnRecordInsert(ByRef vTimeCardHour As TimeCardHour)
Public Property Get Item(vntIndexKey As Variant) As TimeCardHour
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 vTimeCardHour As TimeCardHour) As String
Key = ":" & vTimeCardHour.TimeCardDetailID
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("BillableHours", "BillingRate", "ProjectID", "TimeCardDetailID", "TimeCardID", "WorkCodeID", "WorkDescription", "DateWorked")
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(vTimeCardHour As TimeCardHour, Optional sKey As String = vbNullString) As Boolean
On Error GoTo Err_AddExisting
If Len(sKey) = 0 Then
mCol.Add vTimeCardHour
Else
mCol.Add vTimeCardHour, sKey
End If
AddExisting = True
RaiseEvent OnRecordInsert(vTimeCardHour)
Exit Function
Err_AddExisting:
AddExisting = False
End Function
Public Function Add(m_BillableHours As Double, m_BillingRate As Currency, m_ProjectID As Long, m_TimeCardDetailID As Long, m_TimeCardID As Long, m_WorkCodeID As Long, m_WorkDescription As String, m_DateWorked As Date, Optional sKey As String = vbNullString) As TimeCardHour
Dim objNewMember As TimeCardHour
Set objNewMember = New TimeCardHour
objNewMember.BillableHours = m_BillableHours
objNewMember.BillingRate = m_BillingRate
objNewMember.ProjectID = m_ProjectID
objNewMember.TimeCardDetailID = m_TimeCardDetailID
objNewMember.TimeCardID = m_TimeCardID
objNewMember.WorkCodeID = m_WorkCodeID
objNewMember.WorkDescription = m_WorkDescription
objNewMember.DateWorked = m_DateWorked
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(TimeCardID As Long, Optional ByVal SQLWhereClause As String = "") As Boolean
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim uTimeCardHour As New TimeCardHour
On Error GoTo Err_LoadRelated
Screen.MousePointer = vbHourglass
Clear
strSQL = "Select a.BillableHours,a.BillingRate,a.ProjectID,b.ProjectName As ProjectName,a.TimeCardDetailID,a.TimeCardID,c.DateEntered As DateEntered,a.WorkCodeID,d.WorkCode As WorkCode,a.WorkDescription,a.DateWorked From (([Time Card Hours] a LEFT JOIN Projects b ON a.ProjectID = b.ProjectID) RIGHT JOIN [Time Cards] c ON a.TimeCardID = c.TimeCardID) LEFT JOIN [Work Codes] d ON a.WorkCodeID = d.WorkCodeID WHERE a.TimeCardID = " & TimeCardID & ""
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 uTimeCardHour = Nothing
Set uTimeCardHour = New TimeCardHour
uTimeCardHour.BillableHours= IIF(IsNull(adoRS("BillableHours")), 0, adoRS("BillableHours"))
uTimeCardHour.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
uTimeCardHour.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
uTimeCardHour.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
uTimeCardHour.TimeCardDetailID= IIF(IsNull(adoRS("TimeCardDetailID")), 0, adoRS("TimeCardDetailID"))
uTimeCardHour.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
uTimeCardHour.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
uTimeCardHour.WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
uTimeCardHour.WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
uTimeCardHour.WorkDescription= IIF(IsNull(adoRS("WorkDescription")), "", adoRS("WorkDescription"))
uTimeCardHour.DateWorked= IIF(IsNull(adoRS("DateWorked")), "12:00:00AM", adoRS("DateWorked"))
uTimeCardHour.OldTimeCardDetailID = uTimeCardHour.TimeCardDetailID
uTimeCardHour.IsDirty = False
mcol.Add uTimeCardHour, ":" & uTimeCardHour.TimeCardDetailID
.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,"TimeCardHours","GetMultiRecords")
Resume Done_LoadRelated
End Function
Friend Sub Delete()
Dim uTimeCardHour As TimeCardHour
For Each uTimeCardHour In mCol
uTimeCardHour.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 TimeCardHour
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 TimeCardHour, 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -