Android Code Snippet Sharing the goodness: Some useful methods

Hi

This is a collection of methods that I have collected here in b4a, perhaps one can find them useful..

B4X:
'Description: Return Left part of a string
'Tags: left method, string
Sub Left(Text As String, Length As Long)As String
   If Length>Text.Length Then Length=Text.Length
   Return Text.SubString2(0, Length)
End Sub

'Description: Return Right part of a string
'Tags: right method, string
Sub Right(Text As String, Length As Long) As String
   If Length>Text.Length Then Length=Text.Length
   Return Text.SubString(Text.Length-Length)
End Sub

'Description: Return the Mid portion of a string
'Tags: mid method, string
Sub Mid(Text As String, Start As Int, Length As Int) As String
   Return Text.SubString2(Start-1,Start+Length-1)
End Sub

'Description: Returns an array from a delimited string
'Tags: split method, string
Sub Split(Text As String, Delimiter As String) As String()
   Return Regex.Split(Delimiter,Text)
End Sub

'Description: Returns the length of a string
'Tags: length of string, len
Sub Len(Text As String) As Int
    Return Text.Length
End Sub

'Description: Replace a string within a string
'Tags: Replace function, string
Sub Replace(Text As String, sFind As String, sReplaceWith As String) As String
    Return Text.Replace(sFind, sReplaceWith)
End Sub

' Description: Return a string in lowercase
'Tags: lower case string, lcase
Sub LCase(Text As String) As String
    Return Text.ToLowerCase
End Sub

'Description: Return a string in uppercase
'Tags: upper case, ucase
Sub UCase(Text As String) As String
    Return Text.ToUpperCase
End Sub

'Description: Trim a string
'Tags: trim, string
Sub Trim(Text As String) As String
    Return Text.Trim
End Sub

'Description: Return position of sub string within a string
'Tags: indexof, position
Sub InStr(Text As String, sFind As String) As Int
    Return Text.IndexOf(sFind)
End Sub

'Description: Return position of a sub string within a string starting from a position
'Tags: indexof, position, string
Sub InStr1(iStart As Int, Text As String, sFind As String) As Int
    Return Text.IndexOf2(Text, iStart)
End Sub

'Description: Return position of a substring within a string starting from the back
'Tags: instrrev, string
Sub InStrRev(Text As String, str As String) As Int
    Return Text.LastIndexOf(str)
End Sub

'Description: Returns true if a string contains another string
'Tag: string, contains
Sub Contains(Text As String, sFind As String) As Boolean
    Return Text.Contains(sFind)
End Sub

B4X:
'Description: check if device has internet connection
'Tags: internet,connection
Sub HasInternet() As Boolean
    Dim  Server As ServerSocket
    Server.Initialize(0, Null)
    If Server.GetMyIP = "127.0.0.1" Then 'Test for internet connection
        Return False
    Else
        Return True
    End If
End Sub

'Description: sum all the values in a list
'Tags: list,sum
Sub ListSum(lst As List) As String
    Dim lTot As Int = lst.Size - 1
    Dim lCnt As Int
    Dim lStr As Int
    Dim lSum As Int = 0
 
    For lCnt = 0 To lTot
        lStr = lst.Get(lCnt)
        lSum = lSum + lStr
    Next
    Return lSum
End Sub

B4X:
'Description: Returns True if the CurrentDate and the CompareToDate are within X number of days(DateRange)
'of each other. Otherwise False will be returned.
'Tags: Date, search, range
Sub SearchDate(CurrentDate As String, CompareToDate As String, DateRange As Int) As Boolean
    Dim DayOfYearCompareDate, DayOfYearCurrentDate As Long
    If ValidDate(CurrentDate) And ValidDate(CompareToDate) Then
    Else
        Return False
    End If
    DayOfYearCompareDate = DateTime.GetDayOfYear(DateTime.DateParse(CompareToDate))
    DayOfYearCurrentDate = DateTime.GetDayOfYear(DateTime.DateParse(CurrentDate))
    If DayOfYearCompareDate >= DayOfYearCurrentDate And DayOfYearCompareDate <= (DayOfYearCurrentDate + DateRange) Then
        Return True
    Else
        Return False
    End If
End Sub

B4X:
'Description: Return the date tomorrow in ticks
'Tags: date, tomorrow
Sub Tomorrow() As Long
    Dim Tom As Long
    Tom = DateTime.Add(DateTime.Now, 0, 0, 1)
    Return DateTime.Date(Tom)
End Sub

'Description: Convert a json file to a map
'Tags: json, map, conversion
Sub JsonFileToMap(Dir As String, FileName As String) As Map
    Dim JSON As JSONParser
    Dim Map1 As Map
    JSON.Initialize(File.ReadString(Dir, FileName))
    Map1 = JSON.NextObject
    Return Map1
End Sub

'Description: Convert a json string to a map
'Tags: json, string, map, conversion
Sub Json2Map(jsonText As String) As Map
    Dim json As JSONParser
    Dim Map1 As Map
    json.Initialize(jsonText)
    Map1 = json.NextObject
    Return Map1
End Sub

B4X:
'Description: Returns whether the passed date is valid or not
'Tags: date validation,date
Public Sub ValidDate(ChkDate As String) As Boolean
    Private dcf As Int
    Private GoodDate As String
    dcf = 0
    Try
        GoodDate = DateTime.DateParse(ChkDate)
    Catch
        GoodDate = ""
        dcf = 1
    End Try
    If dcf = 0 Then
        Return True
    Else
        Return False
    End If 
End Sub

'Description: Returns a new date when adding them to an existing date
'Tags: Date, addition, calculation
Sub DateAdd(mDate As String, HowManyDays As Int) As String
    Dim ConvertDate, NewDateDay As Long
    ConvertDate = DateTime.DateParse(mDate)
    NewDateDay = DateTime.Add(ConvertDate, 0, 0, HowManyDays)
    Return DateTime.Date(NewDateDay)
End Sub

'Description: Returns the number of days that have passed between two dates.
'Pass the dates as a String
'Tags: Date, differences, calculation
Sub DateDiff(CurrentDate As String, OtherDate As String) As Int
    Dim CurrDate, OthDate, MyNewDate As Long
    CurrDate = DateTime.DateParse(CurrentDate)
    OthDate = DateTime.DateParse(OtherDate)
    Return (CurrDate-OthDate)/(DateTime.TicksPerDay)
End Sub


'Description: Return the position of a string within another
'Tags: at, string position
Sub At(Text As String,SearchFor As String) As Int
    Return Text.IndexOf(SearchFor)
End Sub

'Description: Return the left trimmed string from another
'Tags: ltrim, trim, left
Sub Ltrim(Text As String) As String
    Do While Left(Text, 1) =" "
        Text = Right(Text, Len(Text)-1)
    Loop
    Return Text
End Sub

'Description: Return the right trimmed string from another
'Tags: rtrim, trim, string
Sub Rtrim(Text As String) As String
    Do While Right(Text, 1) =" "
        Text = Left(Text, Len(Text)-1)
    Loop
    Return Text
End Sub

'Description: VB val function equivalent to return all numeric values in a string
'Tags: val, string, numericonly
Sub Val(Text As String) As String
    Do While IsNumber(Right(Text,1))=False Then
        If Len(Text) >0 Then
            Text=Left(Text, Len(Text)-1)
        Else
            Exit
        End If 
    Loop
    If Len(Text) > 0 Then
        Return Text + 0
    Else
        Return 0
    End If 
End Sub

'Description: vb IIf equivalent function
'Tags:iif
Sub iif(Text As String, Text1 As String, Text2 As String) As String
    If Text = True Then Return Text1 Else Return Text2
End Sub

'Description: Pauses operation
'Tags: pause, execution
Sub Pause(Tvar As Int)
    Dim Tstart As Long
    Tstart = DateTime.Now
    Do While DateTime.Now-Tstart < (Tvar*1000)
    Loop
End Sub

B4X:
'Description: Return space made of number of
'Tags: space
Sub Space(HM As Int) As String
    Dim RS As String = ""
    Do While Len(RS) < HM
        RS = RS & " "
    Loop
    Return RS
End Sub

B4X:
'Description: Load a combobox from a multi value delimited string
'Tags: combobox, picker, delimited
Sub ComboBoxFromMV(cbo As Spinner, sValues As String, sDelim As String, bClear As Boolean, xPrefix As String)
    ' load a combo box from multi value fields
    If bClear = True Then cbo.Clear
    Dim spvalues() As String
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    spvalues = Regex.Split(sDelim, sValues)
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.Trim
        ivalue = xPrefix & ivalue
        cbo.Add(ivalue)
    Next
End Sub

'Description: Returns a list from a multi value delimited string
'Tags: List, multi-value string,delimited
Sub ListFromMV(lst As List, sValues As String, sDelim As String, bClear As Boolean, bClean As String, xPrefix As String)
    ' convert multi value fields to a list
    If bClear = True Then lst.Initialize
    Dim spvalues() As String
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    spvalues = Regex.Split(sDelim, sValues)
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.Trim
        ivalue = xPrefix & ivalue
        If bClean = True Then ivalue = CleanValue(ivalue)
        If lst.IndexOf(ivalue) = -1 Then lst.Add(ivalue)
    Next
End Sub

'Description: Return a cleaned string without the values specified only
'Tags: string, replace
Public Sub CleanValue(sValue As String) As String
    sValue = sValue.replace(" ","")
    sValue = sValue.Replace(".","")
    sValue = sValue.Replace("-","")
    sValue = sValue.Replace("&","")
    sValue = sValue.Trim
    Return sValue
End Sub

'Description: Copy values from one combobox to another
'Tags: combobox, picker, copy
Sub ComboBoxCopy(cboSource As Spinner, cboTarget As Spinner)
    cboTarget.Clear
    Dim i As Int
    Dim itot As Int
    Dim ivalue As String
    itot = cboSource.Size - 1
    For i = 0 To itot
        ivalue = cboSource.GetItem(i)
        cboTarget.Add(ivalue)
    Next
End Sub

B4X:
'Description: Return true if device being used is a tablet
'Tags: device size
Sub IsTablet() As Boolean
    Dim lv As LayoutValues
    lv = GetDeviceLayoutValues
       Dim DeviceSize As Int = lv.ApproximateScreenSize
    If DeviceSize >= 6 Then
        Return True
    Else
        Return False
    End If
End Sub

B4X:
'Description: search for a string in a multi value string and return position
'Tags: search, multi-value string
Sub MvSearch(searchvalues As String,strsearch As String,delim As String) As Int
    If searchvalues.length = 0 Then Return -1
    Dim spvalues() As String
    Dim i As Int, itot As Int, ivalue As String
    spvalues = Regex.Split(delim,searchvalues)
    strsearch = strsearch.ToLowerCase
    itot = spvalues.length - 1
    For i = 0 To itot
        ivalue = spvalues(i)
        ivalue = ivalue.ToLowerCase
        If ivalue = strsearch Then Return i
    Next
    Return -1
End Sub
 
Last edited:

Mashiane

Expert
Licensed User
Longtime User
B4X:
' Helper function to get the icon drawable
Sub GetDrawable(Name As String) As Object
   Dim r As Reflector
   Dim package As String
   Dim id As Int
   package = r.GetStaticField("anywheresoftware.b4a.BA", "packageName")
   id = r.GetStaticField(package & ".R$drawable", Name)
   r.Target = r.GetContext
   r.Target = r.RunMethod("getResources")
   Return r.RunMethod2("getDrawable", id, "java.lang.int")
End Sub
 

Rick Harris

Well-Known Member
Licensed User
Longtime User
B4X:
'Description: Return the subscriber id of your device
'Tag: subscriber id number
Sub Phone_GetSubscriberID() As String
    Dim p As PhoneId
    Return p.GetSubscriberId
End Sub
Just a small comment regarding using such short subs: I have been having problems with the B4A Debugger that kept flagging a "Too many constants" error when starting to compile. My sourcecode was simply too large. I solved this bug today by kicking out as many short subs as I could and simply inserting the code where needed in the B4A code itself.
Especially if subs are only used once or twice there is no need to use subs like this in the first place.
Apparently a sub also counts as a constant. Subs also increase the actual size of your compiled code.
 

Mashiane

Expert
Licensed User
Longtime User
Just a small comment regarding using such short subs: I have been having problems with the B4A Debugger that kept flagging a "Too many constants" error when starting to compile. My sourcecode was simply too large. I solved this bug today by kicking out as many short subs as I could and simply inserting the code where needed in the B4A code itself.
Especially if subs are only used once or twice there is no need to use subs like this in the first place.
Apparently a sub also counts as a constant. Subs also increase the actual size of your compiled code.
In my past life of VB6, just like you have noted, I also learned for each project to just only use the code applicable to that app. What I usually did was to have code modules with code that I knew I will use sometime in the future and compiled this as a dll. As an example, using code modules with code that does not even apply to an app in the store will give permissions to app for functionality that is not even used by the app and thus dangerous.

I think someone suggested a code snippet manager for B4x, it will indeed come in handly because you will just copy and paste what you need. For now, B4x highlights unused subs and variables, one can just comment these out for the final app. Thanks ;)
 

Mashiane

Expert
Licensed User
Longtime User
B4X:
'Description: Convert rgb to hex string
'tag: rgb, hex, conversion
Sub Rgb2Hex(r As Int, g As Int, b As Int) As String
    Dim intC As Int
    Dim bc As ByteConverter
    intC = Colors.RGB(r,g,b)
    Return Bit.ToHexString(intC)
End Sub

'Description: convert hex string to rgb
'Tag: rbg, hex, conversion
Sub Hex2RGB(hex As String) As Map
    Dim m As Map
    m.Initialize
    Dim bc As ByteConverter
    Dim r,g,b As Int
    ' #E3E2E1
    'Log(hex.SubString2(1,3))
    r = Bit.ParseInt(hex.SubString2(1,3), 16)
    g = Bit.ParseInt(hex.SubString2(3,5), 16)
    b = Bit.ParseInt(hex.SubString2(5,7), 16)
    m.Put("r",r)
    m.put("g",g)
    m.Put("b", b)
    Return m
End Sub
 

Mashiane

Expert
Licensed User
Longtime User
'Description: Create indexes on an SQLite table
' Tag: sqlite, index, create
B4X:
' update an existing table and add columns
Sub AddIndexes(SQLite As SQL,TableName As String, Fields As Map)
    Dim i As Int
    For i = 0 To Fields.Size - 1
        Try
        Dim sb As StringBuilder
        Dim field As String
        Dim unique As Boolean
        field = Fields.GetKeyAt(i)
        unique = Fields.GetValueAt(i)
        sb.Initialize
        sb.Append("CREATE ")
        If unique = True Then sb.Append("UNIQUE ")
        sb.Append("INDEX [").Append(TableName).Append(field).Append("]")
        sb.Append(" ON [").Append(TableName).Append("] ([").Append(field).Append("])")
        Log(sb.ToString)
        SQLite.ExecNonQuery(sb.tostring)
        Catch
        End Try
    Next
End Sub

Usage

B4X:
Dim idxs as Map
idxs.initialize
idxs.put("ColumnName", True)
idxs.put("ColumnName1", False)

True above means the index is unique, i.e. no duplicates allowed. You can put this inside DBUtils.
 

freedom2000

Well-Known Member
Licensed User
Longtime User
Fantastic job : thank you !

Just an idea :
put all these codes into an App with some kind of topic search capabilities

I would for sure rate it 5 stars !
 

stanmiller

Active Member
Licensed User
Longtime User
This is a nice collection of how to's...

One caution with any routine manipulating the date format. Because DateTime.DateFormat is global you should save and restore the format on sub entry and exit respectively. Otherwise you could impact the date formatting of the caller.

YearNow with format save/restore
B4X:
'Description: Return the current system year
'Tags: year, date, today
Public Sub YearNow2() As String
    Dim lNow As Long
    Dim dt As String
    Dim saveformat As String
    saveformat = DateTime.DateFormat    ' save current format
    lNow = DateTime.Now
    DateTime.DateFormat = "yyyy"
    dt = DateTime.Date(lNow)
    DateTime.DateFormat = saveformat    ' restore format
    Return dt
End Sub

Nice work over at CodeProject as well!
 
Last edited:

Mashiane

Expert
Licensed User
Longtime User
This is a nice collection of how to's...

One caution with any routine manipulating the date format. Because DateTime.DateFormat is global you should save and restore the format on sub entry and exit respectively. Otherwise you could impact the date formatting of the caller.

YearNow with format save/restore
B4X:
'Description: Return the current system year
'Tags: year, date, today
Public Sub YearNow2() As String
    Dim lNow As Long
    Dim dt As String
    Dim saveformat As String
    saveformat = DateTime.DateFormat    ' save current format
    lNow = DateTime.Now
    DateTime.DateFormat = "yyyy"
    dt = DateTime.Date(lNow)
    DateTime.DateFormat = saveformat    ' restore format
    Return dt
End Sub

Nice work over at CodeProject as well!
Thanks, brilliant...
 

Mashiane

Expert
Licensed User
Longtime User
I have a table that I want to add records to but first I need to find the next available key, so I decided on a max function where before I add the record, i return the max value of a particular field in the table and then increment that with 1.

The problem with this approach though is that if the table does not have any records, NULL is returned by max and causes a NullException error on the app as my nc = nc + 1 gets a NULL value. After looking around I stumbled accross some function in SQLite called coalesce, so I updated my DBUtils to have this method.

The SQLite coalesce function returns the first non-null expression in the list.

B4X:
public Sub NextCount(SQL As SQL, TableName As String, PrimaryKey As String) As String
    'The SQLite coalesce function returns the first non-null expression in the list.
    Dim ll As List
    ll = ExecuteMemoryTable(SQL, "select coalesce(max(" & PrimaryKey & "),0) as records from " & TableName,Null,1)
    Dim Cols() As String
    Cols = ll.Get(0)
    Return Cols(0)
End Sub

usage

B4X:
Dim nc = DButils.NextCount(SQL,"Components","id")
nc = nc + 1

So if my max(id) is NULL, the function will return 0 which is the default and non NULL value in the list. This solved my problem.

Ta!
 

Mahares

Expert
Licensed User
Longtime User

Mashiane

Expert
Licensed User
Longtime User

Mashiane

Expert
Licensed User
Longtime User
B4X:
'executes a query and returns a result
Sub RunQuery(SQL As SQL, Qry As String)
    Try
        SQL.ExecNonQuery(Qry)
        RanOK = True
    Catch
        RanOK = False
        Log(LastException)
    End Try
End Sub

' update an existing table and add columns
Sub AddIndexes(SQL As SQL,TableName As String, Fields As Map)
    Dim i As Int
    For i = 0 To Fields.Size - 1
        Try
            Dim sb As StringBuilder
            Dim field As String
            Dim unique As Boolean
            field = Fields.GetKeyAt(i)
            unique = Fields.GetValueAt(i)
            sb.Initialize
            sb.Append("CREATE ")
            If unique = True Then sb.Append("UNIQUE ")
            sb.Append("INDEX IF NOT EXISTS [").Append(TableName).Append(field).Append("]")
            sb.Append(" ON [").Append(TableName).Append("] ([").Append(field).Append("])")
            RunQuery(SQL, sb.tostring)
        Catch
            Log("AddIndexes Error: " & LastException)
        End Try
    Next
End Sub
 

Mashiane

Expert
Licensed User
Longtime User
B4X:
' return a list of the table index names as a map list of name and unique indicator
Sub GetIndexNames(SQL As SQL,TableName As String) As List
    Dim res1 As List
    res1.Initialize
    Try
        Dim cur As ResultSet
        cur = SQL.ExecQuery("PRAGMA INDEX_LIST ('" & TableName & "')")
        Dim table As List
        table.Initialize
        Do While cur.NextRow
            Dim m As Map
            m.Initialize
            m.Put("name", cur.GetString("name").ToLowerCase)
            m.Put("unique", cur.GetString("unique"))
            res1.Add(m)
        Loop  
        cur.close
    Catch
        Log(LastException)
    End Try
    Return res1
End Sub
 

Mahares

Expert
Licensed User
Longtime User
Here is a different method but yields similar results to @Mashiane's. It makes use of the sqlite_master table which holds the database schema.It shows how to determine the index name. It can also show you the create index SQL statement syntax:
B4X:
Dim DBTableName="Base_Wells" As String
Cursor1 = SQL1.ExecQuery2("SELECT name FROM sqlite_master WHERE type= ? AND tbl_name = ?", _
    Array As String("index",DBTableName))
    For i=0 To Cursor1.RowCount-1
        Cursor1.Position=i
'        Log($"${Cursor1.GetString("name")}  ${Cursor1.GetString("sql")} "$)    'Displays: index name and the create index syntax
        Log($"${Cursor1.GetString("name")}"$)    'Displays : the name of the index
    Next
 

Mashiane

Expert
Licensed User
Longtime User
Here is a different method but yields similar results to @Mashiane's. It makes use of the sqlite_master table which holds the database schema.It shows how to determine the index name. It can also show you the create index SQL statement syntax:
B4X:
Dim DBTableName="Base_Wells" As String
Cursor1 = SQL1.ExecQuery2("SELECT name FROM sqlite_master WHERE type= ? AND tbl_name = ?", _
    Array As String("index",DBTableName))
    For i=0 To Cursor1.RowCount-1
        Cursor1.Position=i
'        Log($"${Cursor1.GetString("name")}  ${Cursor1.GetString("sql")} "$)    'Displays: index name and the create index syntax
        Log($"${Cursor1.GetString("name")}"$)    'Displays : the name of the index
    Next
Thanks, cool, I'm trying to use the same in my code to get the column names per index from the sql statement as I plan to use that in an app im working on. Was just busy today so havent concluded that. I like this as its more flexible..
 

AndOrNot

Well-Known Member
Licensed User
Longtime User
If can be useful, i use this sub to create label (to make code more leggible, i make a label only in a line)

B4X:
'Parent, left, top, width, height, initialize, text, textsize, gravity, textcolor, tag, typeface
Sub CreateLabel (arr() As Object) As Label
    Dim pnl As Panel = arr(0)
    Dim lbl As Label
    If arr.Length > 5 And arr(5) <> Null Then lbl.Initialize(arr(5)) Else lbl.Initialize("")
    pnl.AddView(lbl,arr(1),arr(2),arr(3),arr(4))
    If arr.Length > 6 And arr(6) <> Null Then lbl.Text = arr(6)
    If arr.Length > 7 And arr(7) <> Null Then lbl.Textsize = arr(7)
    If arr.Length > 8 And arr(8) <> Null Then lbl.Gravity= arr(8)
    If arr.Length > 9 And arr(9) <> Null Then lbl.TextColor = arr(9)
    If arr.Length > 10 And arr(10) <> Null Then lbl.Tag = arr(10)
    If arr.Length > 11 And arr(11) <> Null Then lbl.Typeface = arr(11)
    Return lbl
End Sub
 

AndOrNot

Well-Known Member
Licensed User
Longtime User
B4X:
'Description: return numeric values from a string. This picks ups dot and negative sign
'Tags: val method, numbers only
Public Sub NumericOnly(value As String) As String
    value = value.Trim
    Dim sout As String = ""
    Dim mout As String = ""
    Dim slen As Int = value.Length
    Dim i As Int = 0
    For i = 0 To slen - 1
        mout = value.CharAt(i)
        If InStr("0123456789.-", mout) <> -1 Then
            sout = sout & mout
        End If
    Next
    Return sout
End Sub
You can do also this with regex, but i don't remember right code
 
Top