Item$ Tools for Getting Strings to Behave Like Arrays

[bobalooie]

Allot of people complain you can't use arrays in UDT's but you can use strings and a string can function like an array, in fact they can be more dynamic than arrays! see InsertItem$

Luke gave us some nice routines for strings behaving as numeric arrays, here I will deal with variable length strings in a bigger variable length string.

These Item$ tools are for a string of variable length strings separated by Delimiter$

Code: (Select All)

_Title "Item$() and SetItem$ test demo" ' b+ 2024-01-28
' another test demo of array like strings

months$ = "February, March, April, May, June, July, August, September, October"
Print Item$(months$, ", ", 1)
months$ = InsertItem$(months$, ", ", "January", 1)
Print months$
months$ = InsertItem$(months$, ", ", "December", 12)
Print months$
months$ = SetItem$(months$, ", ", "November", 11)
Print months$
Print "9th Month = "; GetItem$(months$, ", ", 9)

' this gets the index& number Item$ from source string delimited by delimiter$
Function Item$ (Source$, Delimiter$, Index&)
    Dim c As Long, d As Long, lastd As Long
    If Len(Source$) = 0 Then Item$ = "": Exit Function
    lastd = 1: d = InStr(lastd, Source$, Delimiter$)
    While d > 0
        c = c + 1
        If c = Index& Then
            Item$ = Mid$(Source$, lastd, d - lastd): Exit Function
        Else
            lastd = d + 1: d = InStr(lastd, Source$, Delimiter$)
        End If
    Wend
    c = c + 1
    If c <> Index& Then Item$ = "" Else Item$ = Mid$(Source$, lastd, Len(Source$))
End Function

' Insert Insert$ in Source$ Delimiter$ string at the NthPlace& all values after slide over 1 place
Function InsertItem$ (Source$, Delimiter$, Insert$, NthPlace&)
    'use: Function StrCount& (AString$, Char$ )
    'use: Function StrPlace& (AString$, Char$, Nth&)
    'use: Function StrCopies$ (NumberOfCopies&, S$)

    ReDim Astring$, wCnt&, nthPlaceAt&, head$, tail$
    Astring$ = Source$ ' Source$ gets changed so return result through function name$
    wCnt& = StrCount&(Astring$, Delimiter$) + 1
    'make sure we have enough delimiters
    If wCnt& <= NthPlace& Then Astring$ = Astring$ + StrCopies$(NthPlace& - wCnt&, Delimiter$)
    If NthPlace& <= 1 Then
        'If something there then it comes before but if nothing probably just starting out.
        If Astring$ <> "" Then Astring$ = Insert$ + Delimiter$ + Astring$ Else Astring$ = Insert$
    ElseIf NthPlace& > wCnt& Then
        ' AString$ will be modified such that only insert has to be tacked to end after delimiter
        Astring$ = Astring$ + Insert$
    ElseIf NthPlace& <= wCnt& Then
        nthPlaceAt& = StrPlace&(Astring$, Delimiter$, NthPlace& - 1)
        head$ = Mid$(Astring$, 1, nthPlaceAt& + Len(Delimiter$) - 1) ' include delim
        tail$ = Mid$(Astring$, nthPlaceAt& + Len(Delimiter$)) ' no delim
        If tail$ <> "" Then
            Astring$ = head$ + Insert$ + Delimiter$ + tail$
        End If
    End If
    InsertItem$ = Astring$
End Function

' set or edit the NthPlace in Source$ delimited string with Value$
Function SetItem$ (Source$, Delimiter$, Value$, NthPlace&)
    'use: Function StrCount& (AString$, Char$ )
    'use: Function StrPlace& (AString$, Char$, Nth&)
    'use: Function StrCopies$ (NumberOfCopies&, S$)

    ReDim Astring$, wCnt&, nthPlaceAt&, nextAt&
    Astring$ = Source$ 'AstringCopy$ gets changed so return result through function name$
    wCnt& = StrCount&(Astring$, Delimiter$) + 1
    'make sure we have enough delimiters
    If wCnt& <= NthPlace& Then Astring$ = Astring$ + StrCopies$(NthPlace& - wCnt&, Delimiter$)
    ' string$ is the problem!!!!!
    If NthPlace& > wCnt& Then ' AString$ will be modified such that only insert has to be tacked to end after delimiter
        Astring$ = Astring$ + Value$
    ElseIf wCnt& = 1 Then 'If something there then it comes before but if nothing probably just starting out.
        Astring$ = Value$
    Else ' NthPlace& is between 2 delimiters
        nthPlaceAt& = StrPlace&(Astring$, Delimiter$, NthPlace& - 1)
        nextAt& = StrPlace&(Astring$, Delimiter$, NthPlace&)
        If NthPlace& = wCnt& Then 'no delim  on right end
            Astring$ = Mid$(Astring$, 1, nthPlaceAt& + Len(Delimiter$) - 1) + Value$
        ElseIf NthPlace& <= 1 Then 'no delim of left end
            If nextAt& Then Astring$ = Value$ + Mid$(Astring$, nextAt&) Else Astring$ = Value$
        Else 'between 2 delimiters
            Astring$ = Mid$(Astring$, 1, nthPlaceAt& + Len(Delimiter$) - 1) + Value$ + Mid$(Astring$, nextAt&)
        End If
    End If
    SetItem$ = Astring$
End Function

Function GetItem$ (AString$, Delimiter$, Index As Long) ' alternate Item$() function
    'use: Function StrCount& (AString$, Char$ )
    'use: Function StrPlace& (AString$, Char$, Nth&)

    ReDim cnt As Long, p1 As Long, p2 As Long
    cnt = StrCount&(AString$, Delimiter$) + 1
    p1 = StrPlace&(AString$, Delimiter$, Index - 1)
    p2 = StrPlace&(AString$, Delimiter$, Index)
    If Index > cnt Or Index < 1 Then
        Exit Function ' beyond the limit of string
    ElseIf Index = 1 Then
        GetItem$ = Mid$(AString$, 1, p2 - 1)
    ElseIf Index = cnt Then
        GetItem$ = Mid$(AString$, p1 + Len(Delimiter$))
    Else 'between
        GetItem$ = Mid$(AString$, p1 + Len(Delimiter$), p2 - p1 - Len(Delimiter$))
    End If
End Function

Function StrCopies$ (NumberOfCopies&, S$) ' Concatenate repeated copies of S$
    Dim i&, rtn$
    For i& = 1 To NumberOfCopies&
        rtn$ = rtn$ + S$
    Next
    StrCopies$ = rtn$
End Function

Function StrCount& (AString$, S$) ' Count S$ in Astring$
    ReDim place As Long, cnt As Long, lenS As Long
    place = InStr(AString$, S$): lenS = Len(S$)
    While place
        cnt = cnt + 1
        place = InStr(place + lenS, AString$, S$)
    Wend
    StrCount& = cnt
End Function

Function StrPlace& (Astring$, S$, Nth As Long) ' Locate the place the Nth S$ is in Astring$
    ReDim place As Long, cnt As Long, lenS As Long
    place = InStr(Astring$, S$): lenS = Len(S$)
    While place
        cnt = cnt + 1
        If cnt = Nth Then StrPlace& = place: Exit Function
        place = InStr(place + lenS, Astring$, S$)
    Wend
End Function

Interesting approach, reminds me of packing machine code into strings back in the 8 bit days.