Class TableJar
%REM
Author: Jens Seiler
Date: 2006/10/18
http://www.jens-seiler.de

This class implements a 2-dimensional table which grows dynamically and has certain features as
removing/inserting rows and sorting the table by a column.

This implementation has not yet been fully tested. So use it with caution!
%END REM
       
        Private retNotValue As Integer                
        Private lastRowIndex As Integer
        Private rows() As Row
                 'Private something As Variant
       
        Sub New
                retNotValue = True
                lastRowIndex% = -1
        End Sub 'New
       
        Property Get Count As Integer
                Count = lastRowIndex% + 1
        End Property ' Count
       
        Public Sub useNothingAsReturn(retNotValue2 As Variant)
                If (retNotValue2) Then
                        retNotValue = True
                Else
                        retNotValue = False
                End If
        End Sub
       
                 ' writes columns into a document
        Public Sub writeIntoDoc(doc As NotesDocument, columnFieldNames As Variant)
                Dim column As Integer
                Dim row As Integer
                Dim tempColumn As Variant
                Redim tempColumn(0 To lastRowIndex%)
               
                For column% = Lbound(columnFieldNames) To Ubound(columnFieldNames)
                        For row% = 0 To lastRowIndex%
                                tempColumn(row%) = getValue(row%, column%)
                        Next row%
                        Call doc.replaceItemValue(columnFieldNames(column%), tempColumn)
                Next column%
        End Sub
       
                 ' reads columns from a document
        Public Sub readFromDoc(doc As NotesDocument, columnFieldNames As Variant)
                Dim column As Integer
                Dim row As Integer
                Dim rows As Integer
                Dim tempColumn As Variant
               
                For column% = Lbound(columnFieldNames) To Ubound(columnFieldNames)
                        tempColumn = doc.getItemValue(columnFieldNames(column%))
                        rows% = Ubound(tempColumn)
                        For row% = 0 To rows%
                                Call setValue(row%, column%, tempColumn(row%))
                        Next row%
                Next column%
        End Sub
       
        Public Function getValue(row As Integer, column As Integer) As Variant
                On Error Goto ErrorGetValue
                Dim rowObj As Row
                Set rowObj = rows(row%)
                If (Datatype(rowObj.getValue(column%)) >= 34) Then ' >= 34: object, list or array reference
                        Set getValue = rowObj.getValue(column%)
                Else
                        getValue = rowObj.getValue(column%)
                End If
                Exit Function
ErrorGetValue:
                If (Err()) = 91 Then ' empty row / column = return nothing
                        If (retNotValue) Then
                                Set getValue = Nothing
                        Else
                                getValue = ""
                        End If
                End If
                If (Err()) = 9 Then ' empty row / column = return nothing
                        If (retNotValue) Then
                                Set getValue = Nothing
                        Else
                                getValue = ""
                        End If
                End If
                Exit Function
                Msgbox Err() & " " & Error$ & " " & Erl
        End Function 'getValue
       
        Public Sub setValue(row As Integer, column As Integer, value As Variant)
                If (row% > lastRowIndex%) Then
                        lastRowIndex% = row%
                        Redim Preserve rows(0 To lastRowIndex%)
                End If
                Dim rowObj As Row
                Set rowObj = rows(row%)
                If (rowObj Is Nothing) Then
                        Set rowObj = New Row
                End If
                Call rowObj.setValue(column, value)
                Set rows(row%) = rowObj
        End Sub 'setValue
       
        Private Sub swap(row1 As Integer, row2 As Integer)
                Dim tempRow As Row
                Set tempRow = rows(row1%)
                Set rows(row1%) = rows(row2%)
                Set rows(row2%) = tempRow
        End Sub 'swap
       
        Public Sub deleteRow(row As Integer)
                Dim i As Integer
                If (row% <= lastRowIndex%) Then
                        If (lastRowIndex% = 0) Then
                                lastRowIndex% = -1
                                Erase rows
                                Exit Sub
                        End If
                        For i% = row% To lastRowIndex% - 1
                                Call swap(i%, i%+1)
                        Next
                        lastRowIndex% = lastRowIndex% - 1
                        Redim Preserve rows(0 To lastRowIndex%)                                  
                End If
        End Sub 'deleteRow
       
        Public Function findRow(searchValue As Variant, column As Integer) As Integer ' finds the first row with searchValue in the given column, returns -1 if searchValue not found
                Dim i As Integer
                For i% = 0 To lastRowIndex%
                        If (searchValue = getValue(i%, column%)) Then
                                findRow = i%
                                Exit Function
                        End If
                Next
                findRow% = -1
        End Function
       
        Public Sub insertRow(row As Integer) ' inserts an empty row before the given one and moves up all following rows
                lastRowIndex% = lastRowIndex% + 1
                Redim Preserve rows(0 To lastRowIndex%)
                Dim i As Integer
                For i% = lastRowIndex% To row% + 1Step -1
                        Call swap (i%, i% - 1)
                Next
        End Sub 'insertRow
       
        Public Sub sort(keyColumn As Integer)
                Dim i As Integer
                For i% = (lastRowIndex%+1) / 2 To 1 Step -1
                        Call reheap(keyColumn, i%, lastRowIndex% + 1)
                Next
                For i% = (lastRowIndex% + 1) To 2 Step -1
                        Call swap(0, i% - 1)
                        Call reheap(keyColumn%, 1, i% - 1)
                Next
        End Sub 'sort
       
        Private Sub reheap(keyColumn As Integer, pos As Integer, size As Integer)
                If ( pos% > size%/2) Then Exit Sub
                If ( pos% = size%/2) Then
                        If ( rows(pos% - 1).getValue(keyColumn%) >= rows((2*pos%) -1).getValue(keyColumn%) ) Then
                                Exit Sub
                        Else
                                Call swap(pos% - 1, (2*pos%) - 1)
                        End If
                End If
                If ( pos% < size%/2) Then
                        Dim l As Integer
                        If ( rows((2*pos%) - 1).getValue(keyColumn%) >= rows(2*pos%).getValue(keyColumn%) ) Then
                                l% = 2*pos%
                        Else
                                l% = 2*pos% + 1
                        End If
                        If ( rows(pos% - 1).getValue(keyColumn%) >= rows(l% -1).getValue(keyColumn%) ) Then
                                Exit Sub
                        Else
                                Call swap(pos% - 1, l% - 1)
                                Call reheap(keyColumn%, l%, size%)
                        End If
                End If
        End Sub 'reheap
       
End Class ' TableJar


Class Row
        Private lastColumnIndex As Integer
        Private row() As Variant
       
        Sub New
                lastColumnIndex% = 0
                Redim row(0 To lastColumnIndex%)
        End Sub 'New
       
        Public Function getValue(column As Integer) As Variant
                If (column > lastColumnIndex) Then
                        Set getValue = Nothing
                        Exit Function
                End If
                If ( Datatype(row(column%)) >= 34 ) Then ' >= 34: object, list or array reference
                        Set getValue = row(column%)
                Else
                        getValue = row(column%)
                End If
        End Function 'getValue
       
        Public Sub setValue(column As Integer, value As Variant)
                If (column% > lastColumnIndex%) Then
                        lastColumnIndex% = column%
                        Redim Preserve row(0 To lastColumnIndex)
                End If
                If (Datatype(value) >= 34) Then ' >= 34: object, list or array reference
                        Set row(column%) = value
                Else
                        row(column%) = value
                End If
        End Sub 'setValue
       
End Class 'Row