' ref: https://www.qb64.org/forum/index.php?topic=3786.msg131448#msg131448
' 2021-04-07 add some bells and whistles
ReDim MyDict
(1 To 1) As Dictionary
' use ubound of array to tell how many values we have
' make some new pairs
Print "Show empty MyDict at start of this demo:" ShowDict MyDict()
AddModDictionary MyDict(), "mammals", "Cats"
ShowDict MyDict()
AddModDictionary MyDict(), "trees", "Oak"
ShowDict MyDict()
AddModDictionary MyDict(), "fish", "Bass"
ShowDict MyDict()
Print "Swap Dogs for Cats in mammals:" AddModDictionary MyDict(), "mammals", "Dogs"
ShowDict MyDict()
Print "Check current mammals:" Print "What is current mammal ? answer: "; GetValue$
(MyDict
(), "mammals") RemoveKV MyDict(), "mammals"
ShowDict MyDict()
Print "Bring mammals back with Horses AND Dogs,Cats:" AddAppendDictionary MyDict(), "Mammals", "Horses"
AddAppendDictionary MyDict(), "mammals", "Cats,Dogs"
ShowDict MyDict()
Print "Remove Cats from mammals:" RemoveValue MyDict(), "mammals", "Cats"
ShowDict MyDict()
Print "Remove Horses from mammals:" RemoveValue MyDict(), "mammals", "Horses"
ShowDict MyDict()
Print "Remove Unicorns from mammals:" RemoveValue MyDict(), "mammals", "Unicorns"
ShowDict MyDict()
Print "And finally wipe out mammals again by removing dogs:" RemoveValue MyDict(), "mammals", "Dogs"
ShowDict MyDict()
' replace 2 TempodiBasic Functions with 1 Sub, to handle both new and modified values for keys and dynamic Dict() dbl string array.
' Now just take ubound of dict() and have number of pairs it contains
Sub AddModDictionary
(Dict
() As Dictionary
, K$
, V$
) ky$
= UCase$(_Trim$(K$
)) 'don't change k$ but make case insensitive? If ky$
<> "" Then ' bullet proof sub routine K$ must not be empty! If ub
= 1 And Dict
(1).K
= "" Then 'our very first pair! Dict
(1).K
= ky$: Dict
(1).V
= V$:
Exit Sub For i
= 1 To ub
' see if we have that name yet If ky$
= Dict
(i
).K
Then Dict
(i
).V
= V$:
Exit Sub ' yes name is registered so change value 'still here? add var name and value to dictionary
ReDim _Preserve Dict
(1 To ub
+ 1) As Dictionary
' create one slot at a time such that ubound = number or pairs Dict(ub + 1).K = ky$: Dict(ub + 1).V = V$ ' fill it with key and value
' fixed for
'modified for quick look
Sub ShowDict
(Dict
() As Dictionary
) Print i
, Dict
(i
).K
, Dict
(i
).V
Print "zzz... press any to continue"
'========================== new stuff 2021-04-07
Sub RemoveKV
(Dict
() As Dictionary
, K$
) Swap Dict
(j
- 1), Dict
(j
)
' instead or replacing a value with another we will add the new value delimited by a comma
Sub AddAppendDictionary
(Dict
() As Dictionary
, K$
, V$
) ky$
= UCase$(_Trim$(K$
)) 'don't change k$ but make case insensitive? If ky$
<> "" Then ' bullet proof sub routine K$ must not be empty! If ub
= 1 And Dict
(1).K
= "" Then 'our very first pair! Dict
(1).K
= ky$: Dict
(1).V
= V$:
Exit Sub For i
= 1 To ub
' see if we have that name yet If ky$
= Dict
(i
).K
Then Dict
(i
).V
= Dict
(i
).V
+ "," + V$:
Exit Sub ' yes name is registered so change value 'still here? add var name and value to dictionary
ReDim _Preserve Dict
(1 To ub
+ 1) As Dictionary
' create one slot at a time such that ubound = number or pairs Dict(ub + 1).K = ky$: Dict(ub + 1).V = V$ ' fill it with key and value
Sub RemoveValue
(Dict
() As Dictionary
, K$
, RemoveV$
) ky$
= UCase$(_Trim$(K$
)) 'don't change k$ but make case insensitive? If ky$
<> "" Then ' bullet proof sub routine K$ must not be empty! If ub
= 1 And Dict
(1).K
= "" Then 'our very first pair! For i
= 1 To ub
' see if we have that name yet Split Dict(i).V, ",", t$()
b$ = t$(j)
b$ = b$ + "," + t$(j)
Dict(i).V = b$
Dict(i).V = ""
' note: I buggered this twice now, FOR base 1 array REDIM MyArray (1 to 1) AS ... the (1 to 1) is not same as (1) which was the Blunder!!!
'notes: REDIM the array(0) to be loaded before calling Split '<<<< IMPORTANT dynamic array and empty, can use any lbound though
'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given. rev 2019-08-27
curpos
= 1: arrpos
= LBound(loadMeArray
): LD
= Len(delim
) dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
, dpos
- curpos
) arrpos = arrpos + 1
curpos = dpos + LD
dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
)