Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dbcexe/names.cls

Visual Basic class definition | 1999-03-30 | 17.8 KB | 461 lines

VERSION 1.0 CLASS
BEGIN
    MultiUse = -1  'True
End
attribute VB_Name = "Names"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'-- Created in part by DBClass Class Generator, copyright (c) 1997 Dew Design, LLC.
Option explicit

Private Const m_CLASSNAME = "Names.cls"
'-- The class default SQL statement.
Private Const CLS_SQL = "SELECT Names.* FROM Names"

Private m_SQL As String
Private m_WHERE As String
Private m_lFieldSize As Long
Private m_Recordset As Recordset
Private PropertyUpdates As New Collection

'--------------------------------------------------------------------------------------------------------------------------'
'----------   Class Properties   -------------------------------'
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Get ID() As Long
    On Error Resume Next
    ID = PropertyUpdates.Item("ID").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_ID
    If Not IsNull(m_Recordset!ID) Then _
    ID = m_Recordset!ID
    Exit Property
Error_Get_ID:
    If Not oError(Err.Number, m_CLASSNAME & " : Get ID") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let IsNew(ByVal vData As Boolean)
    MarkPropertyUpdated "IsNew", "IsNew", vData
End Property
Public Property Get IsNew() As Boolean
    On Error Resume Next
    IsNew = PropertyUpdates.Item("IsNew").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_IsNew
    If Not IsNull(m_Recordset!IsNew) Then _
    IsNew = m_Recordset!IsNew
    Exit Property
Error_Get_IsNew:
    If Not oError(Err.Number, m_CLASSNAME & " : Get IsNew") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let lname(ByVal vData As String)
    m_lFieldSize = m_Recordset!lname.Size
    vData = Trim(vData)
    If Len(vData) > m_lFieldSize Then
         vData = Left(vData, m_lFieldSize)
         MsgBox "This Field is limited to "& m_lFieldSize & " characters in length."
    End If
    MarkPropertyUpdated "lname", "lname", vData
End Property
Public Property Get lname() As String
    On Error Resume Next
    lname = PropertyUpdates.Item("lname").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_lname
    If Not IsNull(m_Recordset!lname) Then _
    lname = m_Recordset!lname
    Exit Property
Error_Get_lname:
    If Not oError(Err.Number, m_CLASSNAME & " : Get lname") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let fname(ByVal vData As String)
    m_lFieldSize = m_Recordset!fname.Size
    vData = Trim(vData)
    If Len(vData) > m_lFieldSize Then
         vData = Left(vData, m_lFieldSize)
         MsgBox "This Field is limited to "& m_lFieldSize & " characters in length."
    End If
    MarkPropertyUpdated "fname", "fname", vData
End Property
Public Property Get fname() As String
    On Error Resume Next
    fname = PropertyUpdates.Item("fname").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_fname
    If Not IsNull(m_Recordset!fname) Then _
    fname = m_Recordset!fname
    Exit Property
Error_Get_fname:
    If Not oError(Err.Number, m_CLASSNAME & " : Get fname") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let address(ByVal vData As String)
    m_lFieldSize = m_Recordset!address.Size
    vData = Trim(vData)
    If Len(vData) > m_lFieldSize Then
         vData = Left(vData, m_lFieldSize)
         MsgBox "This Field is limited to "& m_lFieldSize & " characters in length."
    End If
    MarkPropertyUpdated "address", "address", vData
End Property
Public Property Get address() As String
    On Error Resume Next
    address = PropertyUpdates.Item("address").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_address
    If Not IsNull(m_Recordset!address) Then _
    address = m_Recordset!address
    Exit Property
Error_Get_address:
    If Not oError(Err.Number, m_CLASSNAME & " : Get address") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let city(ByVal vData As String)
    m_lFieldSize = m_Recordset!city.Size
    vData = Trim(vData)
    If Len(vData) > m_lFieldSize Then
         vData = Left(vData, m_lFieldSize)
         MsgBox "This Field is limited to "& m_lFieldSize & " characters in length."
    End If
    MarkPropertyUpdated "city", "city", vData
End Property
Public Property Get city() As String
    On Error Resume Next
    city = PropertyUpdates.Item("city").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_city
    If Not IsNull(m_Recordset!city) Then _
    city = m_Recordset!city
    Exit Property
Error_Get_city:
    If Not oError(Err.Number, m_CLASSNAME & " : Get city") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let state(ByVal vData As String)
    m_lFieldSize = m_Recordset!state.Size
    vData = Trim(vData)
    If Len(vData) > m_lFieldSize Then
         vData = Left(vData, m_lFieldSize)
         MsgBox "This Field is limited to "& m_lFieldSize & " characters in length."
    End If
    MarkPropertyUpdated "state", "state", vData
End Property
Public Property Get state() As String
    On Error Resume Next
    state = PropertyUpdates.Item("state").Value
    If Err.Number = 0 Then Exit Property
    Err.Number = 0
    On Error GoTo Error_Get_state
    If Not IsNull(m_Recordset!state) Then _
    state = m_Recordset!state
    Exit Property
Error_Get_state:
    If Not oError(Err.Number, m_CLASSNAME & " : Get state") Then Resume
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let Filter(vData As String)
    m_Where = vData
End Property
Public Property Get Filter() As String
    Filter = m_Where
End Property
'--------------------------------------------------------------------------------------------------------------------------'
Public Property Let SQL(vData As String)
    m_SQL = vData
End Property
Public Property Get SQL() As String
    SQL = m_SQL
End Property
'--------------------------------------------------------------------------------------------------------------------------'
'----------   Class Methods   ------------------------------'
'--------------------------------------------------------------------------------------------------------------------------'
Public Function Add(Optional addIsNew As String) As Boolean
    '-- Adjust the function parameters to whichever fields need to be passed
    '-- Be sure to include default record specifics below
    Dim iID As Long
    On Error GoTo Error_Add
    CancelUpdate
    BeginTrans
         With m_Recordset
              .AddNew
              '-- Default record specifics here
              '!IsNew = addIsNew
              !IsNew = True
              iID = !ID
              .Update
         End With
    CommitTrans
    Add = True
    If Not FindFirst("ID = " & iID) Then _
         MsgBox "Unable to find the new record!"
    Exit Function
Error_Add:
    If Not oError(Err.Number, m_CLASSNAME & " : Add") Then Resume
    Add = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Sub CancelUpdate()
    Do While PropertyUpdates.Count <> 0
         PropertyUpdates.Remove (1)
    Loop
End Sub

'--------------------------------------------------------------------------------------------------------------------------'
Public Function Count() As Long
    On Error GoTo Error_Count
    Dim vBookmark as Variant
    With m_Recordset
         If (Not .EOF) And (Not .BOF) then
              vBookmark = .Bookmark
              .MoveFirst
              .MoveLast
              Count = .RecordCount
              .Bookmark = vBookmark
         End If
    End With
    Exit Function
Error_Count:
    If Not oError(Err.Number, m_CLASSNAME & " : Count") Then Resume
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function Delete(delID As Long) As Boolean
    '-- Be sure to include related records checking here
    On Error GoTo Error_Delete
    CancelUpdate
    BeginTrans
    With m_Recordset
         .FindFirst "ID = " & delID
         If Not .NoMatch Then
              .Delete
              Delete = True
         End If
    End With
    CommitTrans
    Exit Function
Error_Delete:
    If Not oError(Err.Number, m_CLASSNAME & " : Delete") Then Resume
    Delete = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Sub FillList(ByRef cmbObj As Object, Optional sFilter As String, Optional bBlank As Boolean)
    On Error GoTo Error_FillList
    cmbObj.Clear
    If bBlank Then
         cmbObj.AddItem " "
         cmbObj.ItemData(cmbObj.NewIndex) = 0
    End If
    If IsMissing(sFilter) Or (sFilter = "") Then
         With m_Recordset
              .MoveFirst
              While Not .EOF
                   If Not IsNull(!IsNew) Then
                        cmbObj.AddItem !IsNew
                        cmbObj.ItemData(cmbObj.NewIndex) = !ID
                   End If
                   .MoveNext
              Wend
         End With
    Else
         With m_Recordset
              .FindFirst (sFilter)
              While Not .NoMatch
                   If Not IsNull(!IsNew) Then
                        cmbObj.AddItem !IsNew
                        cmbObj.ItemData(cmbObj.NewIndex) = !ID
                   End If
                   .FindNext (sFilter)
              Wend
         End With
    End If
    Exit Sub
Error_FillList:
    If Not oError(Err.Number, m_CLASSNAME & " : FillList") Then Resume
End Sub
'--------------------------------------------------------------------------------------------------------------------------'
Public Function FindFirst(SearchCrit As String) As Boolean
    On Error GoTo Error_FindFirst
    CancelUpdate
    m_Recordset.FindFirst SearchCrit
    If Not (m_Recordset.NoMatch) then FindFirst = True
    Exit Function
Error_FindFirst:
    If Not oError(Err.Number, m_CLASSNAME & " : FindFirst " & SearchCrit) Then Resume
    FindFirst = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function FindLast(SearchCrit As String) As Boolean
    On Error GoTo Error_FindLast
    CancelUpdate
    m_Recordset.FindLast SearchCrit
    If Not (m_Recordset.NoMatch) then FindLast = True
    Exit Function
Error_FindLast:
    If Not oError(Err.Number, m_CLASSNAME & " : FindLast" & SearchCrit) Then Resume
    FindLast = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function FindNext(SearchCrit As String) As Boolean
    On Error GoTo Error_FindNext
    CancelUpdate
    m_Recordset.FindNext SearchCrit
    If Not (m_Recordset.NoMatch) then FindNext = True
    Exit Function
Error_FindNext:
    If Not oError(Err.Number, m_CLASSNAME & " : FindNext" & SearchCrit) Then Resume
    FindNext = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function FindPrevious(SearchCrit As String) As Boolean
    On Error GoTo Error_FindPrevious
    CancelUpdate
    m_Recordset.FindPrevious SearchCrit
    If Not (m_Recordset.NoMatch) then FindPrevious = True
    Exit Function
Error_FindPrevious:
    If Not oError(Err.Number, m_CLASSNAME & " : FindPrevious" & SearchCrit) Then Resume
    FindPrevious = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Private Sub Class_Initialize()
    On Error GoTo Error_Class_Initialize
    '-- Open the recordset based on cls_sql from your database object: dbtest
    m_SQL = CLS_SQL
    m_WHERE = vbNullString
    '-- By default, set the recordset to full table when the class is initialized...
    '-- Comment this out if you wish to filter your query to limit network traffic due to large tables...
    '-- Set m_Recordset = dbtest.OpenRecordset(m_SQL,dbOpenDynaset)
    Exit Sub
Error_Class_Initialize:
    '-- Put extra error stuff here
    If Not oError(Err.Number, m_CLASSNAME & " : Class_Initialize") Then Resume
End Sub
'--------------------------------------------------------------------------------------------------------------------------'
Public Function IsFiltered() As Boolean
    IsFiltered = Not (m_WHERE = vbNullString)
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Private Sub MarkPropertyUpdated(PropertyName As String, RSFieldName As String, vData As Variant)
    On Error Resume Next
    PropertyUpdates.Item(PropertyName).Value = vData
    If Err.Number <> 0 Then
         Dim ObjProperty As New PropertyUpdate
         ObjProperty.Fieldname = RSFieldName
         ObjProperty.Value = vData
         PropertyUpdates.Add ObjProperty, PropertyName
         Err.Number = 0
    End If
End Sub
'--------------------------------------------------------------------------------------------------------------------------'
Public Function MoveFirst() As Boolean
    On Error GoTo Error_MoveFirst
    CancelUpdate
    If Not m_Recordset.BOF Then
         m_Recordset.MoveFirst
         If Not m_Recordset.BOF Then MoveFirst = True
    End If
    Exit Function
Error_MoveFirst:
    If Not oError(Err.Number, m_CLASSNAME & " : MoveFirst") Then Resume
    MoveFirst = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function MoveLast() As Boolean
    On Error GoTo Error_MoveLast
    CancelUpdate
    If Not m_Recordset.EOF Then
         m_Recordset.MoveLast
         If Not m_Recordset.EOF Then MoveLast = True
    End If
    Exit Function
Error_MoveLast:
    If Not oError(Err.Number, m_CLASSNAME & " : MoveLast") Then Resume
    MoveLast = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function MoveNext() As Boolean
    On Error GoTo Error_MoveNext
    CancelUpdate
    If Not m_Recordset.EOF Then
         m_Recordset.MoveNext
         If m_Recordset.EOF Then
              m_Recordset.MoveLast
         Else
              MoveNext = True
         End If
    End If
    Exit Function
Error_MoveNext:
    If Not oError(Err.Number, m_CLASSNAME & " : MoveNext") Then Resume
    MoveNext = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Function MovePrevious() As Boolean
    On Error GoTo Error_MovePrevious
    CancelUpdate
    If Not m_Recordset.BOF Then
         m_Recordset.MovePrevious
         If m_Recordset.BOF Then
              m_Recordset.MoveFirst
         Else
              MovePrevious = True
         End If
    End If
    Exit Function
Error_MovePrevious:
    If Not oError(Err.Number, m_CLASSNAME & " : MovePrevious") Then Resume
    MovePrevious = False
End Function
'--------------------------------------------------------------------------------------------------------------------------'
Public Sub Requery()
    On Error GoTo Error_Requery
    CancelUpdate
    Set m_Recordset = dbtest.OpenRecordset(m_SQL & " " & m_WHERE,dbOpenDynaset)
    Exit Sub
Error_Requery:
    If Not oError(Err.Number, m_CLASSNAME & " : Requery") Then Resume
End Sub
'--------------------------------------------------------------------------------------------------------------------------'
Public Sub Save()
    On Error GoTo Error_Save
    If PropertyUpdates.Count = 0 Then Exit Sub
    Dim loProperty  'Loop Object
    Dim Bookmark As Variant
    With m_Recordset
         Bookmark = .Bookmark
         .Edit
         For Each loProperty In PropertyUpdates
              .Fields(loProperty.FieldName) = loProperty.Value
         Next
         .Update
         .Bookmark = Bookmark
    End With
    Set loProperty = Nothing
    CancelUpdate
    Exit Sub
Error_Save:
    If Not oError(Err.Number, m_CLASSNAME & " : Save") Then Resume
End Sub
'--------------------------------------------------------------------------------------------------------------------------'
Private Sub Class_Terminate()
    On Error GoTo Error_Class_Terminate
    Save

    m_Recordset.Close
    Set m_Recordset = Nothing
    Exit Sub
Error_Class_Terminate:
    Exit Sub
End Sub
'--------------------------------------------------------------------------------------------------------------------------'