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$
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
b = b + ...
