PC World Komputer 1999 January/pcwk_01_1999.iso/Wtestowe/Vistdstd/Install/Data.Z/Fields.BAS

BASIC Source File | 1996-09-04 | 9.9 KB | 310 lines

Attribute VB_Name = "FIELDS"
' -----------------------------------------------------------------------------
' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
'
' You have a royalty-free right to use, modify, reproduce and distribute
' the Sample Application Files (and/or any modified version) in any way
' you find useful, provided that you agree that Visio has no warranty,
' obligations or liability for any Sample Application Files.
' -----------------------------------------------------------------------------

Option Explicit
Option Base 0                                       '-- Zero Based Arrays

'--
'--   Initialized Flag : Indicates if fields list has been initialized or not.
'--                      Module level variable ONLY.  The shape fields list is
'--                      initialized by FieldNames when m_bInit is False.
'--

    Dim m_bInit As Integer

'--
'-- Index Constants : Use these constants to index into the fields list.
'--
    Global Const IDX_NAME = 0
    Global Const IDX_DATA1 = 1
    Global Const IDX_DATA2 = 2
    Global Const IDX_DATA3 = 3
    Global Const IDX_TEXT = 4
    Global Const IDX_WIDTH = 5
    Global Const IDX_HEIGHT = 6
    Global Const IDX_MAX = 6

'--
'-- Shape Fields List : The following type declares a shapes field descriptor.
'--                     Below it is a zero based array of the shape fields
'--                     that is initialized when m_bInit is False.
'--
    Type SHAPEFIELD
        strName As String
        iIncluded As Integer
        iOrder As Integer
    End Type

    Dim m_ShapeFields(0 To IDX_MAX) As SHAPEFIELD

'--
'-- Include List : Array of integers containing the indexes of every included
'--                field.  Their order also defines their appearance in the
'--                query when extracting from 0 to IncludeCount.  The counter
'--                maintains the total fields being included.
'--

    Dim m_iIncludeList() As Integer

    Dim m_iIncludeCount As Integer

Private Sub BuildIncludeList()
'------------------------------------
'--- BuildIncludeList ---------------
'--
'--   Builds the include list by reading through the shape fields and, for every
'-- included field, stores its index in the list.
'--

    Dim I As Integer, iCount  As Integer

    ReDim m_iIncludeList(FieldCount() - 1)          '-- Enlarge To Full Size
    iCount = 0

    For I = 0 To FieldCount() - 1                   '-- For Every Field...
        If m_ShapeFields(I).iIncluded Then          '--   If Included...
            m_iIncludeList(iCount) = I              '--     Store Its Index
            iCount = iCount + 1                     '--     Inc. Include Count
        End If
    Next I

    m_iIncludeCount = iCount
End Sub

Sub DumpFields()
    Dim I As Integer

    Debug.Print "Dumping Fields List - FieldCount() = "; FieldCount()
    Debug.Print "-----------------------------------------------------------"

    For I = 0 To FieldCount() - 1
        Debug.Print I; Tab(4); "strName:"; m_ShapeFields(I).strName;
        Debug.Print Tab(24); "Inc:"; m_ShapeFields(I).iIncluded;
        Debug.Print "Ord:"; m_ShapeFields(I).iOrder
    Next I
End Sub

Sub DumpIncludes()
    Dim I As Integer

    Debug.Print "Dumping Include List - m_iIncludeCount = "; IncludeCount()
    Debug.Print "-----------------------------------------------------------"

    For I = 0 To IncludeCount() - 1
        Debug.Print Tab(5); I; m_iIncludeList(I); Tab(15); IncludeNames(I)
    Next I
End Sub

Function FieldCount() As Integer
'------------------------------------
'--- FieldCount ---------------------
'--
'--   Returns total number of fields available.
'--
'--    Returns : Integer containing number of field available.
'--

  FieldCount = IDX_MAX + 1                              '-- Return Total Fields
End Function

Function FieldNames(iIndex As Integer) As String
'------------------------------------
'--- FieldNames ---------------------
'--
'--   Returns a string containing the field named by iIndex.
'--
'-- Parameters : iIndex   Integer containing 0 based index of field to return.
'--
'--    Returns : String containing field name or "" if iIndex is invalid.
'--

  Dim I As Integer                                  '-- Field Counter

  If m_bInit = False Then InitFields                '-- Initialize If Needed

  If iIsWithin(iIndex, 0, IDX_MAX) Then             '-- If Valid Index...
    FieldNames = m_ShapeFields(iIndex).strName      '--   Return Field Name
  End If
End Function

Function GetIncludeFlag(iIndex As Integer) As Integer
'------------------------------------
'--- GetIncludeFlag -----------------
'--
'--   Returns the included flag for given shape field.
'--

    GetIncludeFlag = False

    If Not m_bInit Then InitFields

    If iIsWithin%(iIndex, 0, IDX_MAX) Then
        GetIncludeFlag = m_ShapeFields(iIndex).iIncluded
    End If
End Function

Function IncludeCount() As Integer
'------------------------------------
'--- IncludeCount -------------------
'--
'--   Returns the total fields that are to be included during a query.  If the
'-- module has not been initialized we do so.
'--


    If Not m_bInit Then InitFields

    IncludeCount = m_iIncludeCount
End Function

Function IncludeIndex(iIndex As Integer) As Integer
'------------------------------------
'--- IncludeIndex -------------------
'--
'--   Returns the include list index corresponding to the field index passed.
'-- Only works for fields that are in the include list.
'--
'-- Parameters : iIndex - Zero based index of the include field.
'--
'-- Return Val : Integer containing the INCLUDE index of the field passed.  If
'--              iIndex is not in the include list then -1.
'--

    Dim I As Integer

    If Not m_bInit Then InitFields

    IncludeIndex = -1

    If iIsWithin(iIndex, 0, FieldCount() - 1) Then
        For I = 0 To IncludeCount() - 1
            If m_iIncludeList(I) = iIndex Then
                IncludeIndex = I
                Exit For
            End If
        Next I
    End If
End Function

Function IncludeNames(iIndex As Integer)
'------------------------------------
'--- IncludeName --------------------
'--
'--   Equivalent to FieldNames except it returns field names only from the
'-- include list.  To get the size of the include field list use IncludeCount.
'--
'-- Parameters : iIndex - Zero based index of the include field name.
'--
'-- Return Val : String containing the field name or "" if iIndex is invalid.
'--

    If Not m_bInit Then InitFields

    If iIsWithin(iIndex, 0, IncludeCount() - 1) Then
      IncludeNames = FieldNames(m_iIncludeList(iIndex))
    End If
End Function

Private Sub InitFields()
'------------------------------------
'--- InitFields ---------------------
'--
'--   Initalized the field array by setting the name of each field and making
'-- all included by default.
'--

    Dim I As Integer

    I = -1

    I = I + 1: m_ShapeFields(I).strName = "Name"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Data1"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Data2"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Data3"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Text"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Width"
               m_ShapeFields(I).iIncluded = True
    I = I + 1: m_ShapeFields(I).strName = "Height"
               m_ShapeFields(I).iIncluded = True

    BuildIncludeList

    m_bInit = True
End Sub

Function SetIncludeFlag(iIndex As Integer, iFlag As Integer) As Integer
'------------------------------------
'--- SetIncludeFlag -----------------
'--
'--   Sets the included flag for a specified shape field.  After setting the
'-- flag we must add the index to the include list.
'--

    Dim I As Integer, J As Integer, iTests As Integer

    If Not m_bInit Then InitFields

'-- Our first two If's make sure that the index and flag are valid.  After that
'-- we check to see if we actually changing a value.  If so we must make sure
'-- that we will not delete the last included field.  However, remember that it
'-- is valid to un-include a field that is ALREADY un-included, it's just
'-- illegal to remove the last include field.

    iTests = ((iFlag = True) Or (iFlag = False))
    iTests = iTests And (iIsWithin%(iIndex, 0, IDX_MAX))
    If Not iTests Then Exit Function

    SetIncludeFlag = True

    If (m_ShapeFields(iIndex).iIncluded <> iFlag) Then
        iTests = ((IncludeCount() > 1) Or iFlag)

        If Not iTests Then
            SetIncludeFlag = False
            Exit Function
        End If
    Else
        Exit Function
    End If

'--     If all these are True we procede by updating the field's include flag
'-- and updating the include list.
'--     If iFlag = True, we simply add the index to the end of the include list.
'-- Otherwise we search the include list for the index being removed.  When
'-- we find it we copy all indexes above it down one.

    m_ShapeFields(iIndex).iIncluded = iFlag

    If iFlag = True Then
        m_iIncludeCount = m_iIncludeCount + 1
        m_iIncludeList(m_iIncludeCount - 1) = iIndex
    Else
        '-- Search include list for the element.
        For I = 0 To IncludeCount() - 1
            If m_iIncludeList(I) = iIndex Then          '-- Found!

                '-- Move all elements above it down one in the list.
                For J = I To ((IncludeCount() - 1) - 1)
                    m_iIncludeList(J) = m_iIncludeList(J + 1)
                Next J

                m_iIncludeCount = m_iIncludeCount - 1
                Exit For
            End If
        Next I
    End If
End Function