VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDataDicts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsDataDict"
Attribute VB_Ext_KEY = "Member0" ,"clsDataDict"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private Const mSOURCE_MODULE As String = "clsDataDicts"
Private Const mSP_GET_DataDict_ALL As String = "spGetDataDictAll"

'*** Module variable declarations
Private mobjError As clsError
Private mcolDataDicts As Collection
Private mobjADO As clsADO
Private mrsDataDicts As ADODB.Recordset
'*** Public property declarations
Public Property Get pvItem(vntIndexKey As Variant) As clsDataDict
    Set pvItem = pcolDataDicts(vntIndexKey)
End Property
Public Property Get plCount() As Long
    plCount = pcolDataDicts.Count
End Property
Public Property Get piuNewEnum() As IUnknown
    Set piuNewEnum = pcolDataDicts.[_NewEnum]
End Property
Public Property Let pobjError(objError As clsError)
    Set mobjError = objError
End Property
Public Property Get pobjError() As clsError
    Set pobjError = mobjError
End Property
Public Property Let pcolDataDicts(ByVal colDataDict As Collection)
    Set mcolDataDicts = colDataDict
End Property
Public Property Get pcolDataDicts() As Collection
    Set pcolDataDicts = mcolDataDicts
End Property
Public Property Get pobjADO() As clsADO
    Set pobjADO = mobjADO
End Property
Public Property Let pobjADO(ByVal objInADO As clsADO)
    Set mobjADO = objInADO
End Property
Public Property Get prsDataDicts() As ADODB.Recordset
    Set prsDataDicts = mrsDataDicts
End Property
Public Property Let prsDataDicts(ByVal rsDataDicts As ADODB.Recordset)
    Set mrsDataDicts = rsDataDicts
End Property
Public Function fnbLoad() As Boolean
    
    On Error GoTo ErrorHandler
    
    Call sbClear
    
    '*** Execute stored procedure to create recordset
    prsDataDicts = pobjADO.fnrsExecSelectQry(mSP_GET_DataDict_ALL)
    
    '*** Iterate through the recordset and populate the collection
    With prsDataDicts
        While Not .EOF
            Call fnobjAdd(NO_OPTION, _
                IIf(.Fields("QueryOutput") = 0, False, True), _
                IIf(.Fields("AllowQuery") = 0, False, True), _
                IIf(.Fields("AllowZoom") = 0, False, True), _
                .Fields("CurrentModelValue").Value, _
                IIf(.Fields("UseCurrentModel") = 0, False, True), _
                IIf(.Fields("IsUnique") = 0, False, True), _
                IIf(.Fields("Indexed") = 0, False, True), _
                IIf(.Fields("NotNull") = 0, False, True), _
                .Fields("DataScale").Value, _
                .Fields("DataLength").Value, _
                .Fields("DataType").Value, _
                .Fields("AfterScript").Value, _
                .Fields("BeforeScript").Value, _
                .Fields("ValidQuery").Value, _
                .Fields("ValidColumn").Value, _
                .Fields("ValidTable").Value, _
                .Fields("DefaultValue").Value, _
                .Fields("FormLabel").Value, _
                IIf(.Fields("ReadOnly") = 0, False, True), _
                .Fields("EditMode").Value, _
                IIf(.Fields("Display") = 0, False, True), _
                .Fields("FieldID").Value, _
                .Fields("ColumnName").Value, _
                .Fields("TableName").Value)
            .MoveNext
        Wend
    End With
    fnbLoad = True

CommonExit:
    GoSub sbObjectCleanup
    Exit Function

sbObjectCleanup:
    If Not (prsDataDicts Is Nothing) Then
        prsDataDicts.Close
        prsDataDicts = Nothing
    End If
    Return
    
ErrorHandler:
    fnbLoad = False
    Call pobjError.sbVBErrorHandler(Err.Number, "clsDataDicts.fnbLoad", Err.Description)
    
End Function
Public Function fnobjAdd(peOperationType As DB_OPTION, pbQueryOutput As Boolean, pbAllowQuery As Boolean, pbAllowZoom As Boolean, psCurrentModelValue As String, pbUseCurrentModel As Boolean, pbIsUnique As Boolean, pbIndexed As Boolean, pbNotNull As Boolean, piDataScale As Integer, piDataLength As Integer, psDataType As String, psAfterScript As String, psBeforeScript As String, psValidQuery As String, psValidColumn As String, psValidTable As String, psDefaultValue As String, psFormLabel As String, pbReadOnly As Boolean, psEditMode As String, pbDisplay As Boolean, piFieldID As Integer, psColumnName As String, psTableName As String, Optional sKey As String) As clsDataDict
    
    Dim objDataDict As clsDataDict
    
    On Error GoTo ErrorHandler

    Set objDataDict = New clsDataDict

    '*** Assign the properties passed into the method
    With objDataDict
        .peOperationType = peOperationType
        .pbQueryOutput = pbQueryOutput
        .pbAllowQuery = pbAllowQuery
        .pbAllowZoom = pbAllowZoom
        .psCurrentModelValue = psCurrentModelValue
        .pbUseCurrentModel = pbUseCurrentModel
        .pbIsUnique = pbIsUnique
        .pbIndexed = pbIndexed
        .pbNotNull = pbNotNull
        .piDataScale = piDataScale
        .piDataLength = piDataLength
        .psDataType = psDataType
        .psAfterScript = psAfterScript
        .psBeforeScript = psBeforeScript
        .psValidQuery = psValidQuery
        .psValidColumn = psValidColumn
        .psValidTable = psValidTable
        .psDefaultValue = psDefaultValue
        .psFormLabel = psFormLabel
        .pbReadOnly = pbReadOnly
        .psEditMode = psEditMode
        .pbDisplay = pbDisplay
        .piFieldID = piFieldID
        .psColumnName = psColumnName
        .psTableName = psTableName
    End With
    If Len(sKey) = 0 Then
        pcolDataDicts.Add objDataDict
    Else
        pcolDataDicts.Add objDataDict, sKey
    End If

    '*** Return the object created
    Set fnobjAdd = objDataDict

CommonExit:
    GoSub sbObjectCleanup
    Exit Function

sbObjectCleanup:
    If Not (objDataDict Is Nothing) Then Set objDataDict = Nothing
    Return

ErrorHandler:
    GoSub sbObjectCleanup
    Call pobjError.sbVBErrorHandler(Err.Number, "clsDataDicts.fnobjAdd", Err.Description)

End Function
Sub sbClear()

    On Error GoTo ErrorHandler
    
    pcolDataDicts = Nothing
    pcolDataDicts = New Collection

CommonExit:
    Exit Sub
    
ErrorHandler:
    Call pobjError.sbVBErrorHandler(Err.Number, "clsDataDicts.sbClear", Err.Description)
    
End Sub
Public Sub sbFillList(ctlList As Object)
    
    Dim objDataDict As clsDataDict

    On Error GoTo ErrorHandler
    
    ctlList.Clear
    
    For Each objDataDict In pcolDataDicts
        ctlList.AddItem objDataDict.psColumnName
    Next

CommonExit:
    GoSub sbObjectCleanup
    Exit Sub

sbObjectCleanup:
    If Not (objDataDict Is Nothing) Then Set objDataDict = Nothing
    Return

ErrorHandler:
    GoSub sbObjectCleanup
    Call pobjError.sbVBErrorHandler(Err.Number, "clsDataDicts.sbFillList", Err.Description)
    
End Sub
Public Sub sbRemove(vntIndexKey As Variant)

    On Error GoTo ErrorHandler
    
    pcolDataDicts.Remove vntIndexKey

CommonExit:
    Exit Sub
    
ErrorHandler:
    Call pobjError.sbVBErrorHandler(Err.Number, "clsDataDicts.sbRemove", Err.Description)

End Sub
Private Sub Class_Initialize()
    
    pobjError = New clsError
    pcolDataDicts = New Collection

End Sub
Private Sub Class_Terminate()
    
    pobjError = Nothing
    pcolDataDicts = Nothing

End Sub