Client/Library/dxx8/samples/Multimedia/VBSamples/Direct3D/AutoParts/data.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Data"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
'
'  File:       data.cls
'  Content:    DATA MIDDLEWARE           
'              replace with your favorite
'              database code
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Type rec
    AssemblyId As Long
    ModelPart As String
    PartID As String
    Description As String
    Price As Currency
    CompatibleParts As String
    Stock As String
    PartMake As String
End Type
 
Dim rs() As rec
Dim index As Integer
Dim lastindex As Integer
Dim maxsize As Integer

Public Function MoveTop()
    index = 0
    MoveTop = True
End Function

Public Function IsEOF()
    If index = -1 Then IsEOF = True
End Function
Public Function MoveNext()
    If index = lastindex Then
        index = -1
        Exit Function
    End If
        
    index = index + 1
    MoveNext = True
End Function

Public Property Get ModelPart() As String
    ModelPart = rs(index).ModelPart
End Property

Public Property Get PartID() As String
    PartID = rs(index).PartID
End Property

Public Property Get Description() As String
    Description = rs(index).Description
End Property

Public Property Get Price() As Currency
    Price = rs(index).Price
End Property

Public Property Get CompatibleParts() As String
    CompatibleParts = rs(index).CompatibleParts
End Property

Public Property Get Stock() As String
    Stock = rs(index).Stock
End Property

Public Property Get PartMake() As String
    PartMake = rs(index).PartMake
End Property

Public Function MoveToModelPartRecord(sname As String) As Boolean
    
    For index = 0 To lastindex
        If (UCase(rs(index).ModelPart) = UCase(sname)) Then
            MoveToModelPartRecord = True
            Exit Function
        End If
    Next
    MoveToModelPartRecord = False
End Function

Function InitData(sFile As String) As Boolean
    Dim strData As String
    On Local Error GoTo errOut
    
    ReDim rs(100)
    maxsize = 100
    
    Dim fl As Long
    fl = FreeFile
    index = 0
    Open sFile For Input As #fl
    Line Input #fl, strData
    Do While Not EOF(fl)
        Line Input #fl, strData
    
        
        Dim j As Long, q As Long
        Dim r As rec
        
        'Assembly ID - what assembly does this belong to
        j = 1
        q = InStr(j, strData, Chr(9))
        r.AssemblyId = Mid$(strData, 1, q - 1)
        
        'Unique ID for all parts
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.PartID = Mid$(strData, j, q - j)
    
        'Model Part .. whats the name of the part in the xfile
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.ModelPart = Mid$(strData, j + 1, q - 2 - j)
        
        'Part Price
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.Price =val(Mid$(strData, j + 1, q - 1 - j))
        
        'Description
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.Description = Mid$(strData, j + 1, q - 2 - j)
        
        'Stock
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.Stock = Mid$(strData, j, q - j)
        
        'PartMake
        j = q + 1
        q = InStr(j, strData, Chr(9))
        r.PartMake = Mid$(strData, j + 1, q - j - 2)
                
        'CompatibleParts
        j = q + 1
        r.CompatibleParts = Mid$(strData, j + 1)
        q = Len(r.CompatibleParts) - 1
        r.CompatibleParts = Mid$(r.CompatibleParts, 1, q)
        
        If index > maxsize Then
            maxsize = maxsize + 100
            ReDim Preserve rs(maxsize)
        End If
        
        rs(index) = r
        lastindex = index
        index = index + 1
        
    Loop
    InitData = True
    Exit Function
errOut:
    InitData = False
End Function