• Category Archives Software Development
  • VB Class Implementation with Pseudo Inheritance

    This is an interesting example and simply shows that inheritance is sort-of possible using Visual Basic. There is another method using the Implements keyword. However, the implements keyword requires a lot of duplication of code. I am sure that someone out there has a better way of implementing inheritance in Visual Basic. I would like to know how to do inheritance properly if possible. Please let me know.


    RecordSet Class

    Option Explicit
    
    Public Sub MoveFirst()
    '
    End Sub
    
    Public Sub MoveLast()
    '
    End Sub
    
    Public Sub MovePrevious()
    '
    End Sub
    
    Public Sub MoveNext()
    '
    End Sub
    

    Search Module

    Option Explicit
    
    Public Sub MoveFirst(TheRecordset As CRecordset)
        TheRecordset.MoveFirst
    End Sub
    
    Public Sub MoveLast(TheRecordset As CRecordset)
        TheRecordset.MoveLast
    End Sub
    
    Public Sub MoveNext(TheRecordset As CRecordset)
        TheRecordset.MoveNext
    End Sub
    
    Public Sub MovePrevious(TheRecordset As CRecordset)
        TheRecordset.MovePrevious
    End Sub
    

    Element Class (a relational database table)

    Option Explicit
    
    Implements CRecordset
    
    Public trans_ic As String
    Public trans_set As String
    Public trans_type As Integer ' first char of posno (header/detail/summary
    Public posno As String
    Public Segment As String
    Public Element As Integer
    Public composite As Integer
    Public usage As String
    Public typ As String
    Public min_len As Integer
    Public max_len As Integer
    Public data_element As String
    Public valid_values As String
    Public depend As String
    Public special As String
    Public element_name As String
    
    Public Event DataChanged()
    
    Private m_Elements As Recordset
    Private m_Database As Database
    
    Public Sub CRecordset_MovePrevious()
        
        On Error GoTo ErrorHandler
        
        If Not m_Elements.BOF Then
            m_Elements.MovePrevious
            Reload_Members
        End If
        Exit Sub
    
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
        
    End Sub
    
    Public Sub CRecordset_MoveNext()
        
        On Error GoTo ErrorHandler
        
        If Not m_Elements.EOF Then
            m_Elements.MoveNext
            Reload_Members
        End If
        Exit Sub
        
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
    
    End Sub
    
    Public Sub CRecordset_MoveLast()
        
        On Error GoTo ErrorHandler
    
        m_Elements.MoveLast
        Reload_Members
        Exit Sub
    
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
        
    End Sub
    
    Public Sub CRecordset_MoveFirst()
    
        On Error GoTo ErrorHandler
    
        m_Elements.MoveFirst
        Reload_Members
        Exit Sub
    
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
    
    End Sub
    
    Private Sub Class_Initialize()
    
    Dim i As Integer
    
        On Error GoTo ErrorHandler
    
        Set m_Database = Workspaces(0).OpenDatabase("c:visualbasicvalidatedatabasevalidate.mdb")
        Set m_Elements = m_Database.OpenRecordset("select * from element where trans_ic='003050' and trans_set='840'", dbOpenSnapshot)
        Exit Sub
        
    ErrorHandler:
        MsgBox "There was a problem opening either the Validate database or the Element table", vbExclamation, "Problem"
        
    End Sub
    
    Private Sub Class_Terminate()
    
    On Error Resume Next
    
        m_Elements.Close
        m_Database.Close
        
    End Sub
    
    Private Sub Reload_Members()
    
    On Error GoTo ErrorHandler
    
        If m_Elements.BOF = False And m_Elements.EOF = False Then
            With m_Elements
                trans_ic = "" & .Fields("trans_ic")
                trans_set = "" & .Fields("trans_set")
                posno = "" & .Fields("posno")
                Segment = "" & .Fields("segment")
                Element = .Fields("element")
                composite = .Fields("composite")
                usage = "" & .Fields("usage")
                typ = "" & .Fields("type")
                min_len = .Fields("min_len")
                max_len = .Fields("max_len")
                data_element = "" & .Fields("data_element")
                valid_values = "" & .Fields("valid_values")
                depend = "" & .Fields("depend")
                special = "" & .Fields("special")
                element_name = "" & .Fields("element_name")
            End With
            RaiseEvent DataChanged
        End If
        Exit Sub
        
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
        
    End Sub
    

    The Get Element Class

    Option Explicit
    
    Private WithEvents DataElements As CDataElements
    
    Private Type DataElementRecord
        trans_ic As String
        data_element As String
        value As String
        description As String
    End Type
    
    Private DataElement As DataElementRecord
    
    Private Sub Class_Initialize()
        Set DataElements = New CDataElements
    End Sub
    
    Static Function FirstDataElement()
        MoveFirst DataElements
        FirstDataElement = DataElement
    End Function
    
    Static Function LastDataElement()
        MoveLast DataElements
        LastDataElement = DataElement
    End Function
    
    Static Function NextDataElement()
        MoveNext DataElements
        NextDataElement = DataElement
    End Function
    
    Static Function PreviousDataElement()
        MovePrevious DataElements
        PreviousDataElement = DataElement
    End Function
    
    Private Sub DataElements_DataChanged()
        On Error GoTo ErrorHandler
        With DataElements
            DataElement.trans_ic = .trans_ic
            DataElement.data_element = .data_element
            DataElement.value = .value
            DataElement.description = .description
        End With
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number + ":" + Err.description
    End Sub