CD Actual Thematic 25: Programming/pc_actual_25.iso/Basic/GridOne/setup.EXE/BOUNDDATA.CLS

Visual Basic class definition | 2001-09-09 | 6.6 KB | 256 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSimpleOLEDB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' This is a part of the BeeGrid ActiveX control.
' Copyright ⌐ 2000 Stinga
' All rights reserved.
'
' You have a right to use and distribute the BeeGrid sample files in original
' form or modified, provided that you agree that Stinga has no warranty,
' obligations, or liability for any sample application files.
'-----------------------------------------------------------------------------
Option Explicit
Implements OLEDBSimpleProvider

Private mlRowsCount As Long
Private miColCount As Integer

Private Const COL_COUNT = 7

Private colListeners As New Collection

Private marPlayersList() As Variant
Public Filename As String


Private Sub SaveData()
   Dim sData As String, iFreeFile As Integer
   Dim i As Long, j As Integer

   On Error GoTo ErrorTrap

   For i = 0 To mlRowsCount
      For j = 0 To COL_COUNT - 2
         sData = sData & marPlayersList(j, i) & vbTab
      Next

      sData = sData & marPlayersList(COL_COUNT - 1, i)
      sData = sData & vbCrLf
   Next

   If Len(sData) > 0 Then
      sData = Left(sData, Len(sData) - 2)
   End If
   iFreeFile = FreeFile

   Kill Filename
   Open Filename For Binary _
      Access Write Lock Write As #iFreeFile

   Put #iFreeFile, , sData
   Close #iFreeFile

   Exit Sub
ErrorTrap:
    MsgBox VBA.Error, vbExclamation
    Exit Sub
End Sub
Private Sub Class_Terminate()
   Set colListeners = Nothing
   SaveData
End Sub


Private Sub OLEDBSimpleProvider_addOLEDBSimpleProviderListener(ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
   'Add a listener to the Listeners collection
   If Not (pospIListener Is Nothing) Then
      Dim ospl As OLEDBSimpleProviderListener

      Set ospl = pospIListener
      colListeners.Add ospl

      Set ospl = Nothing
   End If

End Sub

Private Function OLEDBSimpleProvider_deleteRows _
   (ByVal iRow As Long, ByVal cRows As Long) As Long
   Dim i As Long, j As Integer
   Dim listener As OLEDBSimpleProviderListener
   Dim v As Variant

   For Each v In colListeners
      Set listener = v
      listener.aboutToDeleteRows iRow, cRows
   Next

   mlRowsCount = mlRowsCount - 1

   For i = iRow To mlRowsCount
      For j = 0 To UBound(marPlayersList, 1)
         marPlayersList(j, i) = marPlayersList(j, i + 1)
      Next
   Next

   For Each v In colListeners
      Set listener = v
      listener.deletedRows iRow, cRows
   Next

   OLEDBSimpleProvider_deleteRows = 1
End Function


Private Function OLEDBSimpleProvider_find(ByVal iRowStart As Long, ByVal iColumn As Long, ByVal val As Variant, ByVal findFlags As MSDAOSP.OSPFIND, ByVal compType As MSDAOSP.OSPCOMP) As Long

End Function


Private Function OLEDBSimpleProvider_getColumnCount() As Long
   OLEDBSimpleProvider_getColumnCount = COL_COUNT
End Function


Private Function OLEDBSimpleProvider_getEstimatedRows() As Long
   OLEDBSimpleProvider_getEstimatedRows = mlRowsCount
End Function


Private Function OLEDBSimpleProvider_getLocale() As String

End Function


Private Function OLEDBSimpleProvider_getRowCount() As Long
   OLEDBSimpleProvider_getRowCount = mlRowsCount
End Function



Public Sub LoadData()
   Dim iFreeFile As Integer
   Dim sData As String, arRows() As String, arRow() As String
   Dim i As Long, j As Integer

   On Error GoTo ErrorTrap
   'get data from file
   iFreeFile = FreeFile

   sData = String(FileLen(Filename), " ")
   Open Filename For Binary Access Read As #iFreeFile
   Get #iFreeFile, , sData
   Close #iFreeFile

   If Len(sData) = 0 Then
      ReDim marPlayersList(COL_COUNT - 1, 30)
      Exit Sub
   End If
   'add data to an array
   arRows = Split(sData, vbCrLf)
   mlRowsCount = UBound(arRows)

   ReDim marPlayersList(COL_COUNT - 1, mlRowsCount + 30)

   For i = 0 To mlRowsCount
      arRow = Split(arRows(i), vbTab)
      For j = 0 To COL_COUNT - 1
         marPlayersList(j, i) = arRow(j)
      Next
   Next

   Exit Sub
ErrorTrap:
   MsgBox VBA.Error, vbExclamation
   Resume Next
End Sub
Private Function OLEDBSimpleProvider_getRWStatus(ByVal iRow As Long, ByVal iColumn As Long) As MSDAOSP.OSPRW
   OLEDBSimpleProvider_getRWStatus = OSPRW_READWRITE
End Function


Private Function OLEDBSimpleProvider_getVariant(ByVal iRow As Long, ByVal iColumn As Long, ByVal format As MSDAOSP.OSPFORMAT) As Variant
   OLEDBSimpleProvider_getVariant = marPlayersList(iColumn - 1, iRow)
End Function


Private Function OLEDBSimpleProvider_insertRows _
   (ByVal iRow As Long, ByVal cRows As Long) As Long
   Dim listener As OLEDBSimpleProviderListener
   Dim v As Variant

   mlRowsCount = mlRowsCount + 1

   For Each v In colListeners
      Set listener = v
      listener.aboutToInsertRows iRow, cRows
   Next

   If mlRowsCount > UBound(marPlayersList, 2) Then
      ReDim Preserve marPlayersList _
         (UBound(marPlayersList, 1), mlRowsCount + 30) As Variant
   End If

   For Each v In colListeners
      Set listener = v
      listener.insertedRows iRow, cRows
   Next
End Function


Private Function OLEDBSimpleProvider_isAsync() As Long
    OLEDBSimpleProvider_isAsync = False
End Function


Private Sub OLEDBSimpleProvider_removeOLEDBSimpleProviderListener(ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
    Dim i As Integer

    'Remove the listener:
    For i = 1 To colListeners.Count
        If colListeners(i) Is pospIListener Then
            colListeners.Remove i
        End If
    Next

End Sub


Private Sub OLEDBSimpleProvider_setVariant _
   (ByVal iRow As Long, ByVal iColumn As Long, _
   ByVal format As MSDAOSP.OSPFORMAT, ByVal Var As Variant)
    Dim listener As OLEDBSimpleProviderListener
    Dim v As Variant

    For Each v In colListeners
        Set listener = v
        listener.aboutToChangeCell iRow, iColumn    'Pre-notification
    Next

    marPlayersList(iColumn - 1, iRow) = Var

    For Each v In colListeners
        Set listener = v
        listener.cellChanged iRow, iColumn          'Post-notification
    Next

End Sub


Private Sub OLEDBSimpleProvider_stopTransfer()

End Sub