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..

'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

'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

'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

'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

'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

'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

'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

'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

'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

 

[JakeBullet70]

Good stuff!!! I see a few I can use.

 

[Informatix]

'Description: Convert a list to an array
'Tags: List, array, conversion
Public Sub ListToArray(lstFrom As List) As String()
    Dim totLst As Int: totLst = lstFrom.Size - 1
    Dim rslt(totLst) As String
    Dim i As Int
    For i = 0 To totLst
        rslt(i) = lstFrom.Get(i)
    Next
    Return rslt
End Sub

Cannot work. rslt must have the same size as lstFrom.
And you can do it with just 2 lines:

Dim JO As JavaObject = lstFrom
Dim rslt() As Object = JO.RunMethod("toArray", Null)

 

[Informatix]

'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

Should be renamed HasIPAddress because that does not test at all that you have a connection to Internet.

 

[Informatix]

'Description: Removes any duplicates items in a list
'Tags: list, remove duplicates
Sub ListRemoveDuplicates(xL As List) As List
    Dim nList As List
    nList.Initialize
    Dim i As Int
    Dim itm As String
    For i = 0 To xL.Size - 1
        itm = xL.Get(i)
        itm = itm.Trim
        If itm.Length > 0 Then
            If nList.IndexOf(itm) = -1 Then nList.Add(itm)
        End If
    Next
    Return nList
End Sub

An alternative using no extra list:

Sub ListRemoveDups(xL As List)
    Dim item As Object
    For i = xL.Size - 1 To 0 Step -1
        item = xL.Get(i)
        If xL.IndexOf(item) <> i Then
            xL.RemoveAt(i)
        End If
       Next
End Sub

 

[LucaMs]

An alternative using no extra list:

Sub ListRemoveDups(xL As List)
    Dim item As Object
    For i = xL.Size - 1 To 0 Step -1
        item = xL.Get(i)
        If xL.IndexOf(item) <> i Then
            xL.RemoveAt(i)
        End If
       Next
End Sub

"Classic" and very probably more fast.

 

[Mashiane]

Cannot work. rslt must have the same size as lstFrom.
And you can do it with just 2 lines:

Dim JO As JavaObject = lstFrom
Dim rslt() As Object = JO.RunMethod("toArray", Null)

Wow, thanks, yes I noted this a few days ago as the other one uses a Length property and the other one a Size Property. You're good!

 

[Reviewnow]

This is all great but please credit the original authors

 

[susu]

Thank you for sharing but B4A have some method already like Trim, Uppercase, Lowercase, Replace... right?

 

[Mashiane]

Thank you for sharing but B4A have some method already like Trim, Uppercase, Lowercase, Replace... right?

Hi Susu

Yes, you are right however my first post code section speaks to that exactly and the point is for someone who comes from a VB background where Uppercase is UCase and lowercase is LCase in some instances, thus the definition of such functions here.

 

[Mashiane]

This is all great but please credit the original authors

Your comments are noted, however please note the first paragraph of my first post reads, "This is a collection of methods that I have collected here in b4a..." , as much as some of the methods are originally mine, I did not credit anyone, however if you happen to remember the original authors, you are welcome to reply to the specific posts. My intentions are simply to help other coders.

 

[Informatix]

Your comments are noted, however please note the first paragraph of my first post reads, "This is a collection of methods that I have collected here in b4a..." , as much as some of the methods are originally mine, I did not credit anyone, however if you happen to remember the original authors, you are welcome to reply to the specific posts. My intentions are simply to help other coders.

For me, your intent was clear.
It's a good idea to create such a repository of useful functions, and try to improve them if we can. It's the purpose of this forum section.

 

[Mashiane]

'Description: Ensure you have a list with unique values, no duplicates.
'Tag: lists, unique, duplicates
Sub ListAddUniqueItem(lstName As List, itm As String)
    itm = LCase(itm)
    Dim ipos As Int
    ipos = lstName.IndexOf(itm)
    If ipos >= 0 Then Return
    lstName.add(itm)
End Sub

 

[Informatix]

'Description: Ensure you have a list with unique values, no duplicates.
'Tag: lists, unique, duplicates
Sub ListUnique(lstName As List, itm As String)
    itm = LCase(itm)
    Dim ipos As Int
    ipos = lstName.IndexOf(itm)
    If ipos >= 0 Then Return
    lstName.add(itm)
End Sub

I suggest to give it a clearer name. For example: AddIfUnique, or AddIfNotFound.

 

[Mashiane]

I suggest to give it a clearer name. For example: AddIfUnique, or AddIfNotFound.

Done.

 

[Mashiane]

'Description: get a file name from a complete file path
'Tag: file, path
Sub GetFileName(FullPath As String) As String
   Return FullPath.SubString(FullPath.LastIndexOf("/")+1)
End Sub

 

[Mashiane]

'Description: get a file extention from a complete file path
'Tag: file, path, extention
Sub GetFileExt(FullPath As String) As String
   Return FullPath.SubString(FullPath.LastIndexOf(".")+1)
End Sub

 

[Mashiane]

'Description: get a parent path of a file from a complete file path
'Tag: file, path, parent
Sub GetFileParentPath(Path As String) As String
   Dim Path1 As String
   Dim L As Int
   If Path = "/" Then
      Return "/"
   End If
   L = Path.LastIndexOf("/")
   If L = Path.Length - 1 Then
      'Strip the last slash
      Path1 = Path.SubString2(0,L)
   Else
      Path1 = Path
   End If
   L = Path.LastIndexOf("/")
   If L = 0 Then
      L = 1
   End If
   Return Path1.SubString2(0,L)
End Sub

 

[Mashiane]

'Description: set the text value of a panel label using its tag property
'Tag: label, text, tag
Sub SetPanelLabelTextByTag(pnl As Panel, lblTag As String, lblValue As String)
    For Each v As View In pnl.GetAllViewsRecursive
        If v Is Label Then
            If LCase(v.tag) = LCase(lblTag) Then
                Dim lbl As Label
                lbl = v
                lbl.Text = lblValue
            End If
        End If
    Next
End Sub

 

[Mashiane]

'Description: set imageview bitmap using its tag property
'Tag: label, text, tag
Sub SetPanelImageViewByTag(pnl As Panel, imgTag As String, imgPath As String, imgName As String)
    For Each v As View In pnl.GetAllViewsRecursive
        If v Is ImageView Then
            If LCase(v.tag) = LCase(imgTag) Then
                Dim img As ImageView
                img = v
                img.Bitmap = LoadBitmapSample(imgPath, imgName,100%x,100%y)
            End If
        End If
    Next
End Sub

 

[Mashiane]

'Description: find a panel label using its tag property
'Tag: label, tag
Sub FindPanelLabelByTag(pnl As Panel, lblTag As String) As Label
    For Each v As View In pnl.GetAllViewsRecursive
        If v Is Label Then
            If LCase(v.tag) = LCase(lblTag) Then
                Return v
            End If
        End If
    Next
    Return Null
End Sub