B4J Code Snippet Sharing the goodness: Useful methods

Hi

Mashy's B4J Overview

I'm new to b4j and have just finished my project in it which is a helper for me in relation to php generation. I shared my creation here. As I am working on an updated version, I needed some functionality on the listview,e.g. returning all items as a map, search for a text or searching for a tag property. Whilst this will start with code on a listview, I intend to collect my snippets here.

'Description: add two lines to a listview
'Tag: listview, add two lines
Sub ListViewAddTwoLines(lv As ListView, Line1 As String, Line2 As String, Value As Object)
   Dim ap As AnchorPane
   ap.Initialize("")
   Dim lbl1, lbl2 As Label
   lbl1.Initialize("")
   lbl1.Text = Line1                
   lbl1.Font = fx.DefaultFont(14)
   lbl2.Initialize("")
   lbl2.Text = Line2
   lbl2.Font = fx.DefaultFont(12)
   ap.AddNode(lbl1, 0, 0, lv.Width, 20dip)
   ap.AddNode(lbl2, 0, 25dip, lv.Width, 20dip)
   lv.Items.Add(ap)
   lbl1.Tag = Value
End Sub

'Description: add a single line to a listview
'Tag: listview, add single line
Sub ListViewAddOneLine(lv As ListView, Line1 As String, Value As Object)
  Dim ap As AnchorPane
  ap.Initialize("")
  Dim lbl1 As Label
  lbl1.Initialize("")
  lbl1.Text = Line1                
  lbl1.Font = fx.DefaultFont(14)
  lbl1.Tag = Value
  ap.AddNode(lbl1, 0, 0, lv.Width, 20dip)
  lv.Items.Add(ap)
End Sub

'Description: search for tag from a listview and return boolean
'Tag: b4j, listview, text, search
Sub ListViewTagExist(lstView As ListView, searchTag As String) As Boolean
    Dim l As List
    Dim i As Int
    Dim t As Int
    Dim m As Map
    Dim txt As String
    searchTag = searchTag.ToLowerCase
    ' get all items as a list
    l = ListViewGetItems(lstView)
    t = l.Size - 1
    For i = 0 To t
        m = l.Get(i)
        txt = m.Get("tag")
        txt = txt.ToLowerCase
        If txt = searchTag Then
            Return True
        End If
    Next
    Return False
End Sub

'Description: search for text from a listview and return boolean
'Tag: b4j, listview, text, search
Sub ListViewTextExist(lstView As ListView, searchText As String) As Boolean
    Dim l As List
    Dim i As Int
    Dim t As Int
    Dim m As Map
    Dim txt As String
    searchText = searchText.ToLowerCase
    ' get all items as a list
    l = ListViewGetItems(lstView)
    t = l.Size - 1
    For i = 0 To t
        m = l.Get(i)
        txt = m.Get("text")
        txt = txt.ToLowerCase
        If txt = searchText Then
            Return True
        End If
    Next
    Return False
End Sub

'Description: return all items in the listview as a list of maps
'Tag: listview, b4j, map, anchorpane
Sub ListViewGetItems(lstView As ListView) As List
    Dim lstTarget As List
    Dim ap As AnchorPane
    Dim title As Label
    Dim m As Map
    Dim l As List
    l.Initialize
    ' get all the items from the list
    lstTarget = lstView.items
    ' loop through each item
    For I = 0 To lstTarget.Size - 1
        ap = lstTarget.Get(I)
        title = ap.GetNode(0)
        m.Initialize
        m.Put("tag", title.tag)
        m.Put("text", title.Text)
        l.Add(m)
    Next
    Return l
End Sub

'Description: return a tag and text of selected listview item as a map
'Tag: listview, map, tag, text
Sub ListViewGetSelected(lstView As ListView) As Map
    Dim m As Map
    m.Initialize
    Dim fsel As Int = lstView.SelectedIndex
    If fsel = -1 Then
        m.Put("tag", "")
        m.Put("text", "")
        m.Put("index","-1")
    Else
        ' get the selected item
        Dim ap As AnchorPane = lstView.SelectedItem
        Dim title As Label = ap.GetNode(0)
        m.Put("tag", title.tag)
        m.Put("text", title.Text)
        m.Put("index", fsel)
    End If
    Return m
End Sub

 

[Mashiane]

The purpose of this snippet is to remove a column from a SQLite database via code. This is part 1 of this code as the indexes are not taken care of except the primary key.

Usage:

Dim colExist As Boolean = RemoveColumn(sql, "MyTable", "MyFieldName")
if colExist = True then
Log("column removed")
else
log("Column could not be removed")
end If

Here is the rest of the snippets making this work...

' return a delimited string from a list
private Sub Join(Delimiter, lst As List) As String
    Dim lStr As StringBuilder
    lStr.Initialize
    For Each strValue As String In lst
        lStr.Append(strValue).Append(Delimiter)
    Next
    Return RemDelim(Delimiter,lStr.tostring)
End Sub


'remove a delimiter from a string
private Sub RemDelim(delimiter As String, value As String) As String
    If value.EndsWith(delimiter) = True Then
        Dim delimLen As Int = delimiter.length
        Dim sb As StringBuilder
        sb.Initialize
        sb.Append(value)
        sb.Remove(sb.Length-delimLen,sb.Length)
        Return sb.tostring
    Else
        Return value
    End If
End Sub

'get all column names from a table
private Sub GetTableColumnNames(sql As SQL, tblName As String) As List
    Dim strFld As String
    Dim curFields As List
    Dim cur As ResultSet
    curFields.Initialize   
    cur = sql.ExecQuery("PRAGMA table_info ('" & tblName & "')")
    Do While cur.NextRow
        strFld = cur.GetString("name")
        curFields.Add(strFld)
    Loop
    cur.close
    Return curFields
End Sub

'gets the existance of a column from a table
private Sub ColumnExists(sql As SQL, tblName As String, colName As String) As Boolean
    Dim lst As List = GetTableColumnNames(sql,tblName)
    If lst.IndexOf(colName) = -1 Then
        Return False
    Else
        Return True
    End If
End Sub

'remove unwanted characters from sql command
Private Sub CleanSQL(sValue As String) As String
    Dim sb As StringBuilder
    Dim tCnt As Int= 0
    Dim tTot As Int = sValue.length - 1
    Dim sIt As String
    Dim sTo As String = "01234567890)[abcdefghijklmnopqrstuvwxyz_,]("
    sb.Initialize
    For tCnt = 0 To tTot
         sIt = sValue.SubString2(tCnt,tCnt+1)
         Select Case sIt
         Case " "
             sb.Append(sIt)
         Case Else
             If sTo.IndexOf(sIt.ToLowerCase) >= 0 Then
                sb.Append(sIt)
            End If
         End Select
    Next
    Return sb.tostring
End Sub

'remove a column from sqlite table, the fldname to remove is case sensitive
Sub RemoveColumn(sql As SQL, TableName As String, FldName As String) As Boolean
    Dim isremoved As Boolean = False
    sql.BeginTransaction
    Try
        Dim newFields As List
        'get the current table columns
        Dim curFields As List = GetTableColumnNames(sql,TableName)
        'remove the column to be removed from the list and define new column names
        Dim newFields As List
        newFields.Initialize
        For Each strColumn As String In curFields
            If strColumn.EqualsIgnoreCase(FldName) = False Then newFields.Add(strColumn)
        Next
        ' define the new fields to use in new table
        Dim newFieldsS As String = Join(",", newFields)
        'get the sql that was used to create the original table
        Dim sqlS As String = sql.ExecQuerySingleResult("SELECT sql from sqlite_master where name = '" & TableName & "'")
        'clean the sql command to create the table
        sqlS = CleanSQL(sqlS)
        'establish splitting locations
        sqlS = sqlS.Replace(",",",~")
        'ensure the tabs are cleaned out
        sqlS = sqlS.Replace(TAB,"~")
        sqlS = sqlS.Replace(CRLF,"~")
        Dim spCode() As String = Regex.Split("~",sqlS)
        Dim sb As StringBuilder
        sb.Initialize
        For Each strLine As String In spCode
            ' see if line starts with column not needed
            If strLine.StartsWith("[" & FldName & "] ") = True Then
                ' do nothing
            else if strLine.StartsWith(FldName & " ") = True Then
                ' do nothing, this is precaution
            else If strLine.StartsWith(" [" & FldName & "] ") = True Then
                ' do nothing
            Else
                ' this should be used on a new table
                sb.Append(strLine)   
            End If
        Next
           
        'now rename the original table, we will copy records across
        sql.ExecNonQuery("ALTER TABLE " & TableName & " RENAME TO " & TableName & "_old")
        'create a new table with updated fields
        Dim sCommand As String = sb.ToString.trim
        If sCommand.EndsWith(",") = True Then
            sCommand = RemDelim(",",sCommand)
            sCommand = sCommand & ")"
        End If
        sql.ExecNonQuery(sCommand)
        
        'copy records to new table from renamed table
        sql.ExecNonQuery("INSERT INTO " & TableName & "(" & newFieldsS & ") SELECT " & newFieldsS & " FROM " & TableName & "_old")
        ' drop the temporal table created
        sql.ExecNonQuery("DROP TABLE " & TableName & "_old")
        isremoved = Not(ColumnExists(sql, TableName, FldName))
        sql.TransactionSuccessful
    Catch
        sql.Rollback
        Log(LastException)
    End Try
    Return isremoved
End Sub

 

[Mashiane]

I wanted to have my statusbar to have FontAwesome icons instead of text..

Sub CreateStatusBar
    'add the status bar at the bottom
    StatusBar1.Text = "Conceptualized, Designed and Developed by Anele 'Mashy' Mbanga - anele@mbangas.com"
    'StatusBar1.Progress = 0.5
    'btnPreview.Initialize("btnPreview")
    'btnPreview.Text = "Preview Source Code"
    'btnPreview.Enabled = False
    btnFullScreen.Initialize("btnFullScreen")
    btnFullScreen.Text = "Full Screen"
    btnFullScreen.Enabled = True
    btnSnap.Initialize("btnSnap")
    btnSnap.Text = "Snap"
    btnSnap.Enabled = True
    'use font awesome
    btnFullScreen.Font = awesome
       btnFullScreen.Text = ""
    btnSnap.Font = awesome
    btnSnap.text = ""
    'Dim sep1 As Separator
    'sep1.Initialize("")
    StatusBar1.RightItems.AddAll(Array(btnFullScreen,btnSnap))
End Sub

So I downloaded the FontAwesome.otf and added it via the Files tab to my B4J project, and copied the icons I wanted to use from Here is a cheatsheet: http://fontawesome.io/cheatsheet/

In Process_Globals added..

Private awesome As Font

In AppStart added...

awesome = fx.LoadFont(File.DirAssets, "FontAwesome.otf", 20)

 

[Mashiane]

'Description: Reset the auto-increment counter to the max available rowid in a sqlite table
'Tag: sqlite, auto-increment, set

Sub SQLiteResetCounter(jSQL As SQL, tblName As String, id As String)
jSQL.BeginTransaction
    Try
        'get the last max on the table
        Dim lastmax As String = jSQL.ExecQuerySingleResult2($"SELECT MAX(${id}) FROM ${tblName}"$, Null)
        If lastmax = Null Then lastmax = 0
        'reset the counter lastmax value
        jSQL.ExecNonQuery($"UPDATE SQLITE_SEQUENCE SET SEQ=${lastmax} WHERE NAME='${tblName}'"$) 
       jSQL.TransactionSuccessful  
    Catch
        Log("SQLiteResetCounter: " & LastException)
    jSQL.Rollback
    End Try
End Sub

 

[Mashiane]

'Description: set the page of a TabPage in a TabPane
'tag: tabpane, tagpage
Sub TabPageSetText(tbPane As TabPane, idx As Int, Text As String)
    Dim tbPageList As List = tbPane.Tabs
    Dim tbPage As TabPage = tbPageList.Get(idx)
    tbPage.Text = Text
End Sub

 

[Mashiane]

'Description: Get a delimited string of values checked in a CheckComboBox control
'Tag: CheckComboBox values

Sub GetCheckedValues(cbc As CheckComboBox) As String
    Dim sb As StringBuilder
    sb.Initialize
    For Each index As Int In cbc.GetCheckedIndices
        Dim cvalue As String = cbc.items.Get(index)
        sb.Append(cvalue).Append(",")
    Next
    If sb.ToString.EndsWith(",") Then
        sb.Remove(sb.Length-1,sb.Length)
    End If
    Return sb.tostring
End Sub

 

[Mashiane]

'Description: Set checked values in a CheckComboBox control from a delimited string
'Tag: CheckComboBox values

private Sub SetCheckedValues(cbc As CheckComboBox, cv As String)
    'split the items to check
    Dim spItems() As String = Regex.Split(",",cv)
    'get the list of existing items
    Dim existingItems As List = cbc.Items
    'loop through each item to add and then check it
    For Each strItem As String In spItems
        Dim idx As Int = existingItems.IndexOf(strItem)
        If idx <> -1 Then
            cbc.SetChecked(idx,True)
        End If
    Next
End Sub

 

[Harris]

cbc as CheckComboBox

What is this?

Where did you create a cbc?

Did you add ABMCheckbox to a ABMCombo or a ABMList?

How does this determine it's State? - for each item?

Wee bit confused... All strange to me...

 

[alwaysbusy]

Did you add ABMCheckbox to a ABMCombo or a ABMList?

This is not for ABMaterial, but for a B4J javaFx combo I think

 

[giga]

Nice share! I am sure many will find these useful.

 

[Mashiane]

'Description: return all keys containing text like
'tag: key value store, keys
Public Sub ListKeysLike(sLike As String) As List
    Dim c As ResultSet = sql1.ExecQuery("SELECT key FROM main where key LIKE '%" & sLike & "%' order by key")
    Dim res As List
    res.Initialize
    Do While c.NextRow
        res.Add(c.GetString2(0))
    Loop
    c.Close
    Return res
End Sub

'Description: return all keys starting with text like
'tag: key value store, keys
Public Sub ListKeysStartsWith(sLike As String) As List
    Dim c As ResultSet = sql1.ExecQuery("SELECT key FROM main where key LIKE '" & sLike & "%' order by key")
    Dim res As List
    res.Initialize
    Do While c.NextRow
        res.Add(c.GetString2(0))
    Loop
    c.Close
    Return res
End Sub

 

[Erel]

You should close the ResultSets before you return from these subs.

 

[alwaysbusy]

and probably better use ExecQuery2 in case there are quotes in the sLike

 

[Mashiane]

You should close the ResultSets before you return from these subs.

Noted that I'm still using kvs 1.01, did the updates, thanks a lot!

 

[Mashiane]

and probably better use ExecQuery2 in case there are quotes in the sLike

Definately, thanks...

 

[Mashiane]

I wanted a quick way to execute multiple updates to my database using a where clause (defined with a map)

'description: use batch update methods
'tag: AddNonQueryToBatch, multiple updates
Public Sub UpdateRecord4(jSQL As SQL, TableName As String, Fields As Map, WhereFieldEquals As Map)
    If WhereFieldEquals.Size = 0 Then
        Log("WhereFieldEquals map empty!")
        Return
    End If
    If Fields.Size = 0 Then
        Log("Fields empty")
        Return
    End If
    WhereFieldEquals = DeDuplicateMap(WhereFieldEquals)
    Dim sb As StringBuilder
    sb.Initialize
    sb.Append("UPDATE ").Append(EscapeField(TableName)).Append(" SET ")
    Dim args As List
    args.Initialize
    For i=0 To Fields.Size-1
        If i<>Fields.Size-1 Then
            sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?,")
        Else
            sb.Append(EscapeField(Fields.GetKeyAt(i))).Append("=?")
        End If
        args.Add(Fields.GetValueAt(i))
    Next
   
    sb.Append(" WHERE ")
    For i = 0 To WhereFieldEquals.Size - 1
        If i > 0 Then
            sb.Append(" AND ")
        End If
        sb.Append(EscapeField(WhereFieldEquals.GetKeyAt(i))).Append(" = ?")
        args.Add(WhereFieldEquals.GetValueAt(i))
    Next
    jSQL.AddNonQueryToBatch(sb.tostring,args)
End Sub

'Description: execute a batch for AddNonQueryToBatch
'Tags: wait for, ExecNonQueryBatch execute
Sub ExecuteBatch(jSQL As SQL)
    Dim SenderFilter As Object = jSQL.ExecNonQueryBatch("SQL")
    Wait For (SenderFilter) SQL_NonQueryComplete (Success As Boolean)
    Log("NonQuery: " & Success)
End Sub

Usage: call multiple UpdateRecord4

....
DbUtils.UpdateRecord4()
DbUtils.UpdateRecord4()
DbUtils.UpdateRecord4()
DbUtils.UpdateRecord4()

then

DbUtils.ExecuteBatch() passing the database name

I have added this to my DBUtils.

 

[Mashiane]

'Description: Count records where using a map of fields that match
'Tag: count records
Public Sub CountRecordsWhere(jSQL As SQL, TableName As String,Field As String, WhereFieldEquals As Map) As Int
    If WhereFieldEquals.Size = 0 Then
        Log("WhereFieldEquals map empty!")
        Return 0
    End If
    Dim sb As StringBuilder
    sb.Initialize
    sb.Append($"SELECT Count(${Field}) As records From [${TableName}] WHERE "$)
    Dim args As List
    args.Initialize
    For i = 0 To WhereFieldEquals.Size - 1
        If i > 0 Then sb.Append(" AND ")
        sb.Append(EscapeField(WhereFieldEquals.GetKeyAt(i)))
        sb.Append(" = ?")
        args.Add(WhereFieldEquals.GetValueAt(i))
    Next
    Dim intRes As Int = jSQL.ExecQuerySingleResult2(sb.ToString,args)
    Return intRes
End Sub

 

[Mashiane]

Some menu item hiding / enabling code.

'Description: Set the menuItem to visible true/false
'Tag: MenuItem, hide, visibility
'Usage: MenuItemVisible(MenuBar1,"File","Copy",False) - will hide the Copy Menu Item in the File menu
Sub MenuItemVisible(MBar As MenuBar, MainMenu As String, MenuItem As String, bVisible As Boolean)
    Dim lMenus As List = MBar.menus
    For Each strMenu As Menu In lMenus
        Dim mText As String = strMenu.text
        If mText.EqualsIgnoreCase(MainMenu) Then
            For Each mi As MenuItem In strMenu.MenuItems
                Dim miText As String = mi.Text
                If miText.EqualsIgnoreCase(MenuItem) Then
                    mi.Visible = bVisible
                    Return
                End If
            Next
        End If
    Next
End Sub

'Description: Set the menuItem image
'Tag: MenuItem, image
'Usage: MenuItemSetImage(MenuBar1,"File","Copy",File.DirAssets,"copy.png")
Sub MenuItemSetImage(MBar As MenuBar, MainMenu As String, MenuItem As String, Dir As String, ImageName As String)
    Dim lMenus As List = MBar.menus
    For Each strMenu As Menu In lMenus
        Dim mText As String = strMenu.text
        If mText.EqualsIgnoreCase(MainMenu) Then
            For Each mi As MenuItem In strMenu.MenuItems
                Dim miText As String = mi.Text
                If miText.EqualsIgnoreCase(MenuItem) Then
                    mi.Image = fx.LoadImage(Dir,ImageName)
                    Return
                End If
            Next
        End If
    Next
End Sub

'Description: Disable / Enable MenuItem
'Tag: MenuItem, disable, enable
'Usage: MenuItemEnable(MenuBar1,"File","Copy",False)
Sub MenuItemEnable(MBar As MenuBar, MainMenu As String, MenuItem As String, bEnabled As Boolean)
    Dim lMenus As List = MBar.menus
    For Each strMenu As Menu In lMenus
        Dim mText As String = strMenu.text
        If mText.EqualsIgnoreCase(MainMenu) Then
            For Each mi As MenuItem In strMenu.MenuItems
                Dim miText As String = mi.Text
                If miText.EqualsIgnoreCase(MenuItem) Then
                    mi.enabled = bEnabled
                    Return
                End If
            Next
           
        End If
    Next
End Sub

 

[Mashiane]

'Description: Consolidate two lists and ensure there are no duplicates
'Tag: Lists, join, map
'Usage: Dim consol as List = ConsolidateLists(list1,list2)
Sub ConsolidateLists(lst1 As List, lst2 As List) As List
    Dim nMap As Map
    nMap.Initialize
    For Each strKey As String In lst1
        nMap.Put(strKey,strKey)
    Next
    For Each strKey As String In lst2
        nMap.Put(strKey,strKey)
    Next
    Dim nList As List
    nList.Initialize
    For Each strKey As String In nMap.Keys
        nList.Add(strKey)
    Next
    nList.Sort(True)
    Return nList
End Sub

 

[Mashiane]

'Description: Find the maximum number in the list (items should be numeric)
'Tag: List, Max, CInt
'Usage: Dim maxof As Int = MaxOfList(list1)
Sub MaxOfList(lst As List) As Int
    Dim maxcnt As Int = 0
    Dim curCnt As Int = 0
    For Each strID As String In lst
        curCnt = CInt(strID)
        If curCnt > maxcnt Then maxcnt = curCnt
    Next
    Return maxcnt
End Sub

'Description: Find the minimum number in the list (items should be numeric)
'Tag: List, Min, CInt
'Usage: Dim minof As Int = MinOfList(list1)
Sub MinOfList(lst As List) As Int
    'lets get the first value
    Dim fValue As String = lst.Get(0)
    Dim maxcnt As Int = CInt(fValue)
    Dim curCnt As Int = 0
    For Each strID As String In lst
        curCnt = CInt(strID)
        If curCnt < maxcnt Then maxcnt = curCnt
    Next
    Return maxcnt
End Sub

 

[Mashiane]

'Description: Copy a file from one directory to another, use same file name with option to replace. If you dont replace the file it wont be recopied if it exists
'Tag: File.Copy, replace file
'Usage: File_Copy(File.DirAssets,"mashy.png",File.DirApp,True)
Sub File_Copy(SourceDir As String, SourceFile As String, TargetDir As String, bReplace As Boolean)
    If bReplace = True Then
        File.Copy(SourceDir,SourceFile,TargetDir,SourceFile)
    Else
        If File.Exists(TargetDir,SourceFile) = False Then
            File.Copy(SourceDir,SourceFile,TargetDir,SourceFile)
        End If
    End If
End Sub