120 lines
4.7 KiB
Plaintext
120 lines
4.7 KiB
Plaintext
'dictionary is not native data type of QB64
|
|
' here a dictionary engine using a string to store data
|
|
Dim Shared Skey As String * 1, SValue As String * 1, EValue As String * 1
|
|
Skey = Chr$(0)
|
|
SValue = Chr$(1)
|
|
EValue = Chr$(255)
|
|
|
|
'Demo area---------------->
|
|
Dim MyDictionary As String
|
|
|
|
If ChangeValue(MyDictionary, "a", "Ananas") Then Print "added new couple key value"
|
|
If ChangeValue(MyDictionary, "b", "Banana") Then Print "added new couple key value"
|
|
If ChangeValue(MyDictionary, "c", "cherry") Then Print "added new couple key value"
|
|
If ChangeValue(MyDictionary, "d", "Drake") Then Print "added new couple key value"
|
|
If ChangeValue(MyDictionary, "e", "Elm") Then Print "added new couple key value"
|
|
If ChangeValue(MyDictionary, "f", "Fire") Then Print "added new couple key value"
|
|
Print LenDict(MyDictionary)
|
|
Print "to key e there is "; GetDict$(MyDictionary, "e")
|
|
Print "to key e there is "; GetDict$(MyDictionary, "a")
|
|
If ChangeValue(MyDictionary, "e", "Elephant") Then Print " changed value of key passed"
|
|
Print "to key e there is "; GetDict$(MyDictionary, "e")
|
|
If Not (EraseKeyValue(MyDictionary, "e")) Then Print " Failed to erase key value passed" Else Print "Erased key value passed"
|
|
If GetDict$(MyDictionary, "e") = "" Then Print " No couple key value found for key value 'e'"
|
|
If ChangeKey(MyDictionary, "e", "f") = 0 Then
|
|
Print "key -a- has value "; GetDict$(MyDictionary, "a")
|
|
Print "we change key a to key e "
|
|
If ChangeKey(MyDictionary, "a", "e") = -1 Then
|
|
Print "key -a- has value "; GetDict$(MyDictionary, "a")
|
|
Print "key -e- has value "; GetDict$(MyDictionary, "e")
|
|
End If
|
|
End If
|
|
If InsertCouple(MyDictionary, "c", "m", "mellon") = -1 Then
|
|
Print " New couple inserted after key -c- "; GetDict$(MyDictionary, "c")
|
|
Print " new couple is key -m- "; GetDict$(MyDictionary, "m")
|
|
End If
|
|
Print LenDict(MyDictionary)
|
|
' End demo area --------------->
|
|
End
|
|
|
|
|
|
' it returns value/s for a key
|
|
Function GetDict$ (dict As String, Keys As String)
|
|
Dim StartK As Integer, StartV As Integer, EndV As Integer
|
|
StartK = InStr(dict, Skey + Keys + SValue)
|
|
StartV = InStr(StartK, dict, SValue)
|
|
EndV = InStr(StartV, dict, EValue)
|
|
If StartK = 0 Then GetDict$ = "" Else GetDict = Mid$(dict, StartV + 1, EndV - StartV)
|
|
End Function
|
|
|
|
' it changes value of a key or append the couple key, newvalue if key is new
|
|
Function ChangeValue (dict As String, Keys As String, NewValue As String)
|
|
ChangeValue = 0
|
|
Dim StartK As Integer, StartV As Integer, EndV As Integer
|
|
StartK = InStr(dict, Skey + Keys + SValue)
|
|
StartV = InStr(StartK, dict, SValue)
|
|
EndV = InStr(StartV, dict, EValue)
|
|
If StartK = 0 Then
|
|
dict = dict + Skey + Keys + SValue + NewValue + EValue
|
|
Else
|
|
dict = Left$(dict, StartV) + NewValue + Right$(dict, Len(dict) - EndV + 1)
|
|
End If
|
|
ChangeValue = -1
|
|
End Function
|
|
|
|
'it changes a key if it is in the dictionary
|
|
Function ChangeKey (dict As String, Keys As String, NewKey As String)
|
|
ChangeKey = 0
|
|
Dim StartK As Integer, StartV As Integer
|
|
StartK = InStr(dict, Skey + Keys + SValue)
|
|
StartV = InStr(StartK, dict, SValue)
|
|
If StartK = 0 Then
|
|
Print "Key " + Keys + " not found"
|
|
Exit Function
|
|
Else
|
|
dict = Left$(dict, StartK) + NewKey + Right$(dict, Len(dict) - StartV + 1)
|
|
End If
|
|
ChangeKey = -1
|
|
End Function
|
|
|
|
'it erases the couple key value
|
|
Function EraseKeyValue (dict As String, keys As String)
|
|
EraseKeyValue = 0
|
|
Dim StartK As Integer, StartV As Integer, EndV As Integer
|
|
StartK = InStr(dict, Skey + keys + SValue)
|
|
StartV = InStr(StartK, dict, SValue)
|
|
EndV = InStr(StartV, dict, EValue)
|
|
If StartK = 0 Then
|
|
Exit Function
|
|
Else
|
|
dict = Left$(dict, StartK - 1) + Right$(dict, Len(dict) - EndV + 1)
|
|
End If
|
|
EraseKeyValue = -1
|
|
End Function
|
|
|
|
'it inserts a couple after a defined key, if key is not in dictionary it append couple key value
|
|
Function InsertCouple (dict As String, SKeys As String, Keys As String, Value As String)
|
|
InsertCouple = 0
|
|
Dim StartK As Integer, StartV As Integer, EndV As Integer
|
|
StartK = InStr(dict, Skey + SKeys + SValue)
|
|
StartV = InStr(StartK, dict, SValue)
|
|
EndV = InStr(StartV, dict, EValue)
|
|
If StartK = 0 Then
|
|
dict = dict + Skey + Keys + SValue + Value + EValue
|
|
Else
|
|
dict = Left$(dict, EndV) + Skey + Keys + SValue + Value + EValue + Right$(dict, Len(dict) - EndV + 1)
|
|
End If
|
|
InsertCouple = -1
|
|
End Function
|
|
|
|
Function LenDict (dict As String)
|
|
LenDict = 0
|
|
Dim a As Integer, count As Integer
|
|
If Len(dict) <= 0 Then Exit Function
|
|
While a <= Len(dict)
|
|
a = InStr(a + 1, dict, EValue)
|
|
If a > 0 Then count = count + 1 Else Exit While
|
|
Wend
|
|
LenDict = count
|
|
End Function
|