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.
Option Explicit Public Sub MoveFirst() ' End Sub Public Sub MoveLast() ' End Sub Public Sub MovePrevious() ' End Sub Public Sub MoveNext() ' End Sub
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
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:\visualbasic\validate\database\validate.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
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