Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/dbawarco/person.cls

Text File | 1996-11-20 | 5.7 KB | 208 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Person"
Attribute VB_Creatable = False
Attribute VB_Exposed = True
Option Explicit

Public CustomerNumber As Long
Public FirstName As String
Public LastName As String
Public SSN As Long
Public Sex As String
Public DateOfBirth As Variant
Public MaritalStatus As String
Public ObjectID As Long

Private pvtAddressesCollection As New DBAwareCollection
Private pvtPhonesCollection As New DBAwareCollection

Public Function AddPhone(Optional ByVal Item As Variant, Optional ByVal Parent As Variant) As DBAwareCollection
' Return a Phone, added to my pvtPhonesCollection
'   (just a wrapper method for Phones.Add)

    Set AddPhone = Me.Phones.Add( _
        Item:=Item, _
        Parent:=Me)
End Function

Public Function InitializeFromRecordSet(Optional ByVal RecordSet As Variant) As Person
' Populate my variables from the RecordSet
'   (in support of DBAwareCollection)

    On Local Error Resume Next

    CustomerNumber = RecordSet("CustomerNumber")
    FirstName = RecordSet("FirstName")
    LastName = RecordSet("LastName")
    SSN = RecordSet("SSN")
    Sex = RecordSet("Sex")
    DateOfBirth = RecordSet("DateOfBirth")
    MaritalStatus = RecordSet("MaritalStatus")
    ObjectID = RecordSet("ObjectID")

    Set InitializeFromRecordSet = Me
End Function


Public Function InitializeRecordSet(Optional ByVal RecordSet As Variant) As Long
' Populate the RecordSet with my variables.
'   Do not initialize the ObjectID column.
'   Return any error code encountered.
'   (in support of DBAwareCollection)

    On Local Error GoTo InitializeRecordSet_SetError
    Err = 0

    RecordSet("CustomerNumber") = CustomerNumber
    RecordSet("FirstName") = FirstName
    RecordSet("LastName") = LastName
    RecordSet("SSN") = SSN
    RecordSet("Sex") = Sex
    RecordSet("DateOfBirth") = DateOfBirth
    RecordSet("MaritalStatus") = MaritalStatus

    GoTo InitializeRecordSet_SetError

InitializeRecordSet_SetError:
    InitializeRecordSet = Err
    Exit Function
End Function

Public Function TableName() As String
' Return the Table with which this Class is associated
'   (in support of DBAwareCollection)

    TableName = "Persons"
End Function
Public Function NewInstanceOfMyClass() As Person
' Return a new instance of this class
'   (in support of DBAwareCollection)

    Set NewInstanceOfMyClass = New Person
End Function


Public Function AddAddress(Optional ByVal Item As Variant, Optional ByVal Parent As Variant) As DBAwareCollection
' Return an Address, added to my pvtAddressesCollection
'   (just a wrapper method for Addresses.Add)

    Set AddAddress = Me.Addresses.Add( _
        Item:=Item, _
        Parent:=Me)
End Function



Public Function Addresses(Optional ByVal ObjectID As Variant) As Variant
' Returns a DBAwareCollection of Address objects which are
'   contained by this Person object,
' or
' Returns an Address object whose ObjectID matches the ObjectID
'   parameter.

    Dim tempNewAddress As New Address

    On Local Error Resume Next

' check for need to populate the collection from the database
    If Not pvtAddressesCollection.DatabaseHasBeenReferenced Then
        pvtAddressesCollection.SetDatabaseParameters _
            Database:=CompanyDatabase

        Set pvtAddressesCollection = _
            pvtAddressesCollection.InstantiateFromDatabase( _
                Parent:=Me, _
                SampleObject:=tempNewAddress)
    End If

' check for a request for a specific Address
    If Not IsMissing(ObjectID) Then
        Set Addresses = pvtAddressesCollection. _
                        Item(ObjectID)

' else, return the entire collection
    Else
        Set Addresses = pvtAddressesCollection
    End If
End Function

Public Function Phones(Optional ByVal ObjectID As Variant) As Variant
' Returns a DBAwareCollection of Phone objects which are
'   contained by this Person object,
' or
' Returns a Phone object whose ObjectID matches the ObjectID
'   parameter.

    Dim tempNewPhone As New Phone

    On Local Error Resume Next

' check for need to populate the collection from the database
    If Not pvtPhonesCollection.DatabaseHasBeenReferenced Then
        pvtPhonesCollection.SetDatabaseParameters _
            Database:=CompanyDatabase

        Set pvtPhonesCollection = _
            pvtPhonesCollection.InstantiateFromDatabase( _
                Parent:=Me, _
                SampleObject:=tempNewPhone)
    End If

' check for a request for a specific Phone
    If Not IsMissing(ObjectID) Then
        Set Phones = pvtPhonesCollection. _
                        Item(ObjectID)

' else, return the entire collection
    Else
        Set Phones = pvtPhonesCollection
    End If

End Function

Public Function FormattedName() As String

    Dim ReturnString As String

    If UCase$(Left$(Sex, 1)) = "M" Then
        ReturnString = "Mr. "
    ElseIf UCase$(Left$(Sex, 1)) = "F" Then
        ReturnString = "Ms. "
    End If

    FormattedName = ReturnString & FirstName & " " & LastName
End Function


Private Sub Class_Initialize()

    CustomerNumber = -1
    FirstName = ""
    LastName = ""
    SSN = -1
    DateOfBirth = ""
    ObjectID = -1

    Set pvtAddressesCollection = Nothing
End Sub



Public Function Age() As Double
    If DateOfBirth = "" Then
        Age = 0
    Else
        Age = DateDiff("yyyy", DateOfBirth, Now)
    End If
End Function

Public Function ObjectType() As String
' Return the type of this Class
'   (in support of DBAwareCollection)

    ObjectType = "Person"
End Function