B4J Question [ABMaterial] Infinite Scrolling Database Records??

Mashiane

Expert
Licensed User
Longtime User
Good day

The article about infinite scrolling bears reference, https://www.b4x.com/android/forum/t...nite-scrolling-pages-with-1-07.63259/#content

I would like to achieve the same result but based on database records. Can someone share ideas in terms of how I can do that and make this work?

I'm assuming

1. First I determine how many records are there and store this as a global variable.
2. Just like the pager, select 1 record to show and draw it and store the position on scroll up / down? Wait, how can I store a position when scrolling up/down (if that is possible)

Any thoughts?
 

mindful

Active Member
Licensed User
You can also use infi te scrolling within containers, you can find an example in some of the readme txt files in the library (can't remember of which version) ... and also you need to pull data from the db in batches, not one by one because if you fast scroll you won't get the desired effect... you pull 10 records and another 10 when it scrolls and another 10 when it scrolls again and so on ...
 
Upvote 0

amorosik

Expert
Licensed User

Hi Mashiane, have you managed to create an infinite scrolling system with database records?
 
Upvote 0

alwaysbusy

Expert
Licensed User
Longtime User
The latest version of ABM does contain an ABMTableInfinite component, which raises a NextContent event when the user scrolls. Here is a snippet from one of my projects that demonstrates this.

B4X:
Sub Class_Globals
    Private ABM As ABMaterial
    Private Page As ABMPage
    Private Caller As Object
   
    Public TableCurrentSort As String
    Public TableCurrentLoad As Int
    Public TableLoadLimit As Int = 50
    Public TableTotalRows As Int = 0
    Public TableCurrentLastLoaded As String
    Public TableDoneLoading As Boolean
    Public TableActiveID As Int
    Public TableActiveRowUniqueId As String
   
    Public Table As ABMTableInfinite
   
    Public Name As String
   
    Private mFilterType As Int
    Private mFilter As Object
   
    Dim WHEREClause As String = "WHERE "
    Dim WHEREVars As List
       
    Private RefreshCell As String = "{IC:#FFFFFF}fa fa-refresh{/IC}"

    Private Config As PageConfig
    Private FN As Map
   
    Public IsOTSession As Boolean
   
    Public FILTER_RECBYID_P, FILTER_RECBYID_T As String
    Public encMenuID As String
   
    Private AuthOTID As String
    Private AuthLoginID As String
   
    Private LastLocked As Int
   
    Private myToastId As Long
End Sub

'Initializes the object. You can add parameters to this method if needed.
Public Sub Initialize(ObjectName As String, TargetCaller As Object, TargetPage As ABMPage, Filter As Object, crdConfig As PageConfig, FieldNames As Map) As ABMTableInfinite
    Page = TargetPage
    Caller = TargetCaller
    Name = ObjectName
       
    mFilter = Filter
    If mFilter Is FilterCardsB Then
        mFilterType = 1
    End If
   
    Config = crdConfig
    FN = ABMShared.CopyMap(FieldNames)
   
    AuthOTID = Page.ws.Session.GetAttribute2("authCurrentMasterID2020", "")
    AuthLoginID = Page.ws.Session.GetAttribute2("authLoginID2020", "")
   
    Table.Initialize(Page, Name, True, "onetwo")
   
    Table.IsPrintable = False
   
    IsOTSession = False
   
    RefreshCell = "{NBSP}"
       
    Table.SetHeaders(                Array As String ("ID", RefreshCell   ,FN.Get("code"),FN.Get("description"), FN.Get("extra"),""    ,""    ))
    Table.SetHeaderThemes(           Array As String ("hl"  ,"hc"         ,"hld"         ,"hld"                ,"hld"           ,"hc"  ,"hc"  ))
    Table.SetHeaderHeights(          Array As Int    (0     ,0            ,0             ,0                    ,0               ,0     ,0     ))
    Table.SetColumnWidths(           Array As Int    (0     ,40           ,0             ,0                    ,0               ,40    ,40    ))
    Table.SetColumnMinWidths(        Array As Int    (0     ,40           ,100           ,180                  ,150             ,40    ,40    ))
    Table.SetColumnVisibles(         Array As String (IsOTSession ,True   ,True          ,True                ,False            ,True  ,False  ))
    Table.SetColumnDataFields(       Array As String ("$0"  , "$refresh"  ,"crdCode"     ,"crdDescription"     ,"crdComment"    ,"$2"  ,"$3"  ))  ' the $number fields are needed for the reordering of the columns.  Must start with $
    Table.SetColumnSorts(            Array As String (""    , ""          ,"ASC"         ,"ASC"                ,""              ,""    ,""    ))
    Table.SetColumnHideSameValues(   Array As Boolean(False ,False        ,True          ,True                 ,False           ,False ,False ))
    Table.SetColumnDraggables(       Array As Boolean(False ,False        ,True          ,True                 ,True            ,False ,False ))
       
    Table.SetFooter(FN.Get("loadedNoMatches"), 12,"hl")
    Table.IsTextSelectable = IsOTSession
    Table.OnlyAllowSortOnFirstColumn = True
       
    Table.EventHandler = Me
   
    WHEREVars.Initialize
   
    Return Table
End Sub

public Sub ParseEvent(params As Map)
    Dim eventName As String = params.Get("eventname")
    Dim eventParams() As String = Regex.Split(",",params.Get("eventparams"))
   
    If eventName.ToLowerCase.StartsWith(Name.ToLowerCase) Then
        eventName = "Table" & eventName.SubString(Name.Length)
    End If

    If SubExists(Me, eventName) Then
        params.Remove("eventname")
        params.Remove("eventparams")
        Select Case params.Size
            Case 0
                CallSub(Me, eventName)
            Case 1
                CallSub2(Me, eventName, params.Get(eventParams(0)))
            Case 2
                If params.get(eventParams(0)) = "abmistable" Then
                    Dim PassedTables As List = ABM.ProcessTablesFromTargetName(params.get(eventParams(1)))
                    CallSub2(Me, eventName, PassedTables)
                Else
                    CallSub3(Me, eventName, params.Get(eventParams(0)), params.Get(eventParams(1)))
                End If
            Case Else
                ' cannot be called directly, to many param
                CallSub2(Me, eventName, params)
        End Select
    End If
End Sub

Sub LoadTable()
    Dim ActRow As String = Table.GetActiveRow
   
    LastLocked = 2
   
    encMenuID = ABMShared.GetEncryptedMenuID(Page.ws, FILTER_RECBYID_P, FILTER_RECBYID_T)
   
    TableCurrentSort = ""
    Dim sortList As List = Table.GetCurrentOrderSort
    For i = 0 To sortList.Size - 1
        If i > 0 Then
            TableCurrentSort = TableCurrentSort & ","
        End If
        TableCurrentSort = TableCurrentSort & sortList.Get(i)
    Next
    If TableCurrentSort <> "" Then
        TableCurrentSort = " ORDER BY histLocked DESC," & TableCurrentSort
    End If
       
    Page.Row(5).Hide
    Table.Clear
    Table.Refresh

    TableCurrentLoad = 0
    TableCurrentLastLoaded = "uid0"
    TableDoneLoading = False
       
    Dim LastLoaded As String = GetNextBatch
    Table.BatchFlush
       
    If LastLoaded <> "" Then
        Page.Row(5).Show
        Table.RaiseNextContentOnRow(LastLoaded)
        TableCurrentLastLoaded = LastLoaded
    Else
        Table.SetFooter(FN.Get("loadedNoMatches"), 12,"hl")
        Page.Row(5).Show
    End If
   
    Page.ForceResizeCells(0, True)
   
    Table.SetActiveRow(ActRow)
   
    Table.RefreshFooter
End Sub

Sub Table_NextContent(rowUniqueId As String)
    If TableDoneLoading Then Return
   
    Dim ActRow As String = Table.GetActiveRow
   
    Dim LastLoaded As String = GetNextBatch
    Table.BatchFlush
   
    If LastLoaded = TableCurrentLastLoaded Then
        TableDoneLoading = True
    Else
        Table.RaiseNextContentOnRow(LastLoaded)
        TableCurrentLastLoaded = LastLoaded
    End If
   
    Table.SetActiveRow(ActRow)
   
    Table.RefreshFooter
End Sub

public Sub RefreshTable()
    LoadTable
End Sub

Sub Table_Clicked(PassedRowsAndColumns As List)
    Dim tblCellInfo As ABMTableCell = PassedRowsAndColumns.Get(0)
   
    TableActiveRowUniqueId =  tblCellInfo.RowUniqueID
   
    Dim editCol As Int = 5
    Dim deleteCol As Int = 6
       
    If tblCellInfo.Column = editCol Then ' edit
        Dim DeleteBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "DeleteBtn")
       
        TableActiveID = ABMShared.CleanRowID(Table.GetString(TableActiveRowUniqueId, 0))
       
        If 0 = DeleteBtn.Tag Then
           
            Dim crd As RecCard = DBMApp.CardFromRecord(TableActiveID, AuthOTID, AuthLoginID)
            If crd = Null Then
                DoDelete(False)
                myToastId = myToastId + 1
                Page.ShowToast("toast" & myToastId, "toastorange", "Deze kaart is niet meer beschikbaar!", 5000, False)
                Return
            End If
            If crd.crdcrdTypID = 800130 Then
                DoDelete(False)
                myToastId = myToastId + 1
                Page.ShowToast("toast" & myToastId, "toastorange", "Deze kaart is niet meer beschikbaar!", 5000, False)
                Return
            End If
            CallSub2(Caller, "TBL" & Name & "_OpenEdit", crd)
           
        End If
        Return
    End If
    If tblCellInfo.Column = deleteCol Then ' delete
        Dim DeleteBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "DeleteBtn")
       
        TableActiveID = ABMShared.CleanRowID(Table.GetString(TableActiveRowUniqueId, 0))
       
        Select Case DeleteBtn.Tag
            Case 0
                CallSub2(Caller, "CheckDoDelete", TableActiveID) 'ignore
            Case 1
                CallSub2(Caller, "CheckDoUndelete", TableActiveID) 'ignore
            Case Else
               
        End Select
        Return
    End If
End Sub

public Sub DoDelete(ShowUndo As Boolean)
    Table.SaveCellThemes(TableActiveRowUniqueId)
   
    Dim EditBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "EditBtn")
    Dim DeleteBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "DeleteBtn")
       
    Table.UseCellThemes(TableActiveRowUniqueId, 1, Array As String("deletedc", "deleted", "deleted", "deleted", "deleted", "deleted"))
   
    If ShowUndo Then
        EditBtn.Visibility = ABM.VISIBILITY_HIDE_ALL
        DeleteBtn.IconName = "mdi-content-undo"
        DeleteBtn.Tag = 1
    Else
        EditBtn.Visibility = ABM.VISIBILITY_HIDE_ALL
        DeleteBtn.Visibility = ABM.VISIBILITY_HIDE_ALL
        DeleteBtn.Tag = 2
    End If
           
    Table.SetFooter(TableCurrentLoad  & " van de " & TableTotalRows & " geladen", 12,"hl")
   
    Dim crd As RecCard = DBMApp.CardFromRecord(TableActiveID, AuthOTID, AuthLoginID)
    UpdateLineInTable(crd, True, True) 'ignore
               
    TableActiveID = 0
End Sub

public Sub DoUndelete()
    Table.RestoreCellThemes(TableActiveRowUniqueId)
   
    Dim EditBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "EditBtn")
    Dim DeleteBtn As ABMButton = Table.GetComponent(TableActiveRowUniqueId, "DeleteBtn")
   
    EditBtn.Visibility = ABM.VISIBILITY_ALL
    DeleteBtn.IconName = "fa fa-trash"
    DeleteBtn.Tag = 0
           
    Table.SetFooter(TableCurrentLoad  & " van de " & TableTotalRows & " geladen", 12,"hl")

    Dim crd As RecCard = DBMApp.CardFromRecord(TableActiveID, AuthOTID, AuthLoginID)
    UpdateLineInTable(crd, True, False) 'ignore
               
    TableActiveID = 0
End Sub

Sub Table_SortChanged(DataField As String, Order As String)
    ' gives the new requested order, NOT the order it is in currently!
    Table.UpdateSort(DataField, Order)
    LoadTable
End Sub

Sub Table_ColumnMoved(Drag As String, DroppedBefore As String)
    Table.UpdateColumnOrder(Drag, DroppedBefore)
    LoadTable
End Sub

Sub GetNextBatch() As String
    BuildWHERE
   
    TableTotalRows = DBMApp.SELECTCardsCount(WHEREClause, WHEREVars)
   
    Table.SetFooter(FN.get("loading"), 12,"hl")
    Table.RefreshFooter

    Dim Limit As String = $" LIMIT ${TableCurrentLoad},${TableLoadLimit}"$
    If TableCurrentLoad + TableLoadLimit + TableLoadLimit/2 > TableTotalRows Then
        Limit = $" LIMIT ${TableCurrentLoad},${TableLoadLimit*2}"$
        TableCurrentLoad = TableTotalRows
        TableDoneLoading= True
    Else
        TableCurrentLoad = TableCurrentLoad + TableLoadLimit
    End If
   
    Dim LastLoaded As String
    Dim founds As List = DBMApp.SELECTCards(WHEREClause, Limit, TableCurrentSort, WHEREVars)
    If LastLoaded <> TableCurrentLastLoaded Then
        For i = 0 To founds.Size - 1
            LastLoaded = AddLineToTable(founds.Get(i), False, False, "{NBSP}", "same")
        Next
   
        Dim loaded As String = FN.Get("loaded")
        If TableCurrentLoad >= TableTotalRows Then
            loaded = loaded.Replace("@1", TableTotalRows)
            loaded = loaded.Replace("@2", TableTotalRows)
            Table.SetFooter(loaded, 12,"hl")
        Else
            loaded = loaded.Replace("@1", TableCurrentLoad)
            loaded = loaded.Replace("@2", TableTotalRows)
            Table.SetFooter(loaded, 12,"hl")
        End If
    End If
   
    Return LastLoaded
End Sub

private Sub BuildWHERE()
    Dim NeedsAnd As Boolean
   
    WHEREClause = "WHERE "
    NeedsAnd = False
       
    Select Case mFilterType
        Case 1           
            Dim Filter1 As FilterCardsB = mFilter
                       
            Dim MasterID As String = Page.ws.Session.GetAttribute2("authCurrentMasterID2020", "0")
           
            If NeedsAnd Then
                WHEREClause = WHEREClause & " AND tCard.crdCrdTypID=" & Config.JP("activeTypes/card/ids/0",0) & " AND tCard.OTID=" & MasterID & " "
            Else
                WHEREClause = WHEREClause & " tCard.crdCrdTypID=" & Config.JP("activeTypes/card/ids/0",0) & " AND tCard.OTID=" & MasterID & " "
            End If
               
            WHEREVars.Clear
            WHEREVars.Add(AuthOTID)
            WHEREVars.Add(AuthLoginID)
            If Filter1.TextSearchValue <> "" Then
                WHEREVars.add("%" & Filter1.TextSearchValue.Replace("_", "\_") & "%")
                WHEREVars.add("%" & Filter1.TextSearchValue.Replace("_", "\_") & "%")
                WHEREVars.Add(Filter1.TextSearchValue.Replace("_", "\_"))
               
                WHEREClause = WHEREClause & " AND (tCard.crdCode LIKE ? OR tCard.crdDescription LIKE ? OR MATCH(tCard.crdSearchText) AGAINST(? IN BOOLEAN MODE)) "
               
            End If   
           
           
    End Select
End Sub

public Sub AddLineToTable(tmpCrd As RecCard, DoFlush As Boolean, CheckFilter As Boolean, typeIcon As String, sameTheme As String) As String
    Dim rCellValues As List
    Dim rCellThemes As List
    rCellValues.Initialize
    rCellThemes.Initialize
   
    Dim enc As String = encMenuID
   
    If IsOTSession Then
        rCellValues.Add("{AL}" & "../" & FILTER_RECBYID_P & "/?id=" & enc & "&tbl=" & ABMShared.Encrypt2("1") & "&tblid=" & ABMShared.Encrypt2(tmpCrd.crdId) & "{AT}" & tmpCrd.crdId & "{/AL}")
    Else
        rCellValues.Add("" & tmpCrd.crdId)
    End If       
    rCellThemes.Add("")
   
    rCellValues.Add(typeIcon)
    rCellThemes.Add("bgc")
   
    If tmpCrd.HistLocked = 1 Then
        rCellValues.Add(tmpCrd.crdCode & "{NBSP}{IC:#ff8f00}fa fa-lock{/IC}")       
    Else
        If tmpCrd.HistLocked = 0 Then
            rCellValues.Add(tmpCrd.crdCode & "{NBSP}{IC:#ff8f00}fa fa-history{/IC}")
        Else
            rCellValues.Add(tmpCrd.crdCode)
        End If       
    End If   
    Dim ExtraBorder As String = ""
    If tmpCrd.HistLocked < LastLocked Then
        ExtraBorder = "border"
    End If
    rCellThemes.Add(GetFilteredTheme(tmpCrd, "Code", CheckFilter, sameTheme & ExtraBorder))   
   
    rCellValues.Add(tmpCrd.crdDescription)
    rCellThemes.Add(GetFilteredTheme(tmpCrd, "Description", CheckFilter, sameTheme & ExtraBorder))
   
    rCellValues.Add(ABMShared.Truncate(tmpCrd.crdComment,100))
    rCellThemes.Add(GetFilteredTheme(tmpCrd, "Comment", CheckFilter, sameTheme & ExtraBorder))
       
    Dim EditBtn As ABMButton
    EditBtn.InitializeFloating(Page, "EditBtn", "fa fa-pencil", "onetwotablebutton")
    EditBtn.Size = ABM.BUTTONSIZE_SMALL
    rCellValues.Add(EditBtn)
    rCellThemes.Add("bgc" & ExtraBorder)

    Dim DeleteBtn As ABMButton
    DeleteBtn.InitializeFloating(Page, "DeleteBtn", "fa fa-trash", "onetwotablebutton")
    DeleteBtn.Size = ABM.BUTTONSIZE_SMALL
    DeleteBtn.Tag = 0
    rCellValues.Add(DeleteBtn)
    rCellThemes.Add("bgc" & ExtraBorder)

    Table.AddRow("uid" & tmpCrd.crdId, rCellValues,rCellThemes)
   
    LastLocked = tmpCrd.HistLocked
   
    If DoFlush Then
        Table.BatchFlush
       
        Table.SetActiveRow("uid" & tmpCrd.crdId)
               
        TableCurrentLoad = TableCurrentLoad + 1
        TableTotalRows = TableTotalRows + 1
               
        Table.SetFooter(TableCurrentLoad  & " van de " & TableTotalRows & " geladen", 12,"hl")
               
        Table.RefreshFooter
    End If
   
    Return "uid" & tmpCrd.crdId
End Sub

Sub GetFilteredTheme(tmpCrd As RecCard, typeCheck As String, CheckFilter As Boolean, defTheme As String) As String 'ignore
    If CheckFilter Then
        Select Case typeCheck
           
        End Select
    End If
    Return defTheme
End Sub

Sub UpdateLineInTable(tmpCrd As RecCard, CheckFilter As Boolean, IsDeleted As Boolean) 'ignore
    Dim tmpCode As String = tmpCrd.crdCode
    If tmpCrd.HistLocked = 1 Then
        tmpCode = tmpCrd.crdCode & "{NBSP}{IC:#ff8f00}fa fa-lock{/IC}"
    End If
    Table.SetValues(TableActiveRowUniqueId,1, Array As Object("{IC:#fb8c00}" & ABMShared.ChangedIcon & "{/IC}", tmpCode, tmpCrd.crdDescription, ABMShared.Truncate(tmpCrd.crdComment,100)))
    If CheckFilter Then
        ' not applicable
        'Table.UseCellThemes(TableActiveRowUniqueId,2, Array As String())
    End If
   
    Table.SetActiveRow(TableActiveRowUniqueId)
    Table.RefreshRow(TableActiveRowUniqueId)
   
    Table.BatchFlush
End Sub

Alwaysbusy
 
Last edited:
Upvote 0

alwaysbusy

Expert
Licensed User
Longtime User
PageConfig, RecCard objects are unknown. ABMaterial v.5.0
yes, this is part of a much larger client project of which I am not allowed to share the full code. The 'snippet' above demonstrates how the NextContent event works but is not runnable AS IS.
 
Upvote 0
Cookies are required to use this site. You must accept them to continue using the site. Learn more…