ReDim Shared SortMapS() As String

ReDim Shared SortMapI() As Integer

ReDim Shared SortMapD() As Double

Namespace MapOOP

     Type TChildMap

         pNext As TChildMap Ptr

         pPrev As TChildMap Ptr

         szKey As ZString*256

         sValue As ZString*256

         iValue As Integer

         dValue As Double

     End Type

     Type TMap

         iCount As Integer

         iCurrent As Integer

         pFirst As TChildMap Ptr

         pLast As TChildMap Ptr

         Declare Destructor()

         Declare Sub Add(szKey As String , sValue As String)

         Declare Sub Add(szKey As String , sValue As Integer)

         Declare Sub Add(szKey As String , sValue As Double)

         Declare Sub Del (szKey As String)

         Declare Sub Clear()

         Declare Sub Get(szKey As String, ByRef sReturnValue As String)

         Declare Sub Get(szKey As String, ByRef iReturnValue As Integer)

         Declare Sub Get(szKey As String, ByRef dReturnValue As Double)

         Declare Sub GetNext(ByRef sReturnValue As String)

         Declare Sub GetNext(ByRef iReturnValue As Integer)

         Declare Sub GetNext(ByRef dReturnValue As Double)

         Declare Sub Reset()

     End Type

     ' ---------------------Добавление в словарь-------------------
     #Macro MACRO_MAP_ADD( M_TYPE , M_VALUE )

         Sub TMap.Add(szKey As String , Value As M_TYPE)

             Dim pCheck As TChildMap Ptr = pFirst

             Do While pCheck

                 If pCheck->szKey = szKey  Then

                     Exit Sub

                 EndIf

                 pCheck = pCheck->pNext

             Loop

             Dim pTemp As TChildMap Ptr = New TChildMap

             M_VALUE = Value

             pTemp->szKey = szKey

             If pFirst = 0 Then

                 pFirst = pTemp

             Else

                 pLast->pNext = pTemp

                 pTemp->pPrev = pLast

             EndIf

             pLast = pTemp

             iCount+=1

         End Sub

     #EndMacro

     MACRO_MAP_ADD(String,pTemp->sValue)

     MACRO_MAP_ADD(Integer,pTemp->iValue)

     MACRO_MAP_ADD(Double,pTemp->dValue)
     '////////////////////////////////////////////////////////////////

     ' ---------------------Получение значения по заданному ключу-------------------
     #Macro MACRO_MAP_GET( M_TYPE , M_VALUE )

         Sub TMap.Get(szKey As String, ByRef ReturnValue As M_TYPE)

             Dim As M_TYPE TempClear

             ReturnValue = TempClear

             Dim pTemp As TChildMap Ptr

             pTemp = pFirst

             Do While pTemp

                 If pTemp->szKey = szKey  Then

                     ReturnValue = M_VALUE

                     Exit Sub

                 EndIf

                 pTemp = pTemp->pNext

             Loop

         End Sub

     #EndMacro

     MACRO_MAP_GET(String,pTemp->sValue)

     MACRO_MAP_GET(Integer,pTemp->iValue)

     MACRO_MAP_GET(Double,pTemp->dValue)
     '////////////////////////////////////////////////////////////////

     ' ---------------------Сброс счетчика массива-------------------
     Sub TMap.Reset()

         iCurrent = 0

     End Sub
     '////////////////////////////////////////////////////////////////

     #Macro MACRO_MAP_GETNEXT( M_TYPE , M_NAME_ARRAY , M_NAME_PROC, M_VALUE)

         ' ---------------------Сортировка-------------------
         Sub M_NAME_PROC(start As Integer,Finish As Integer)

             Dim As Integer I=start,J=Finish

             Dim As M_TYPE X = M_NAME_ARRAY(Int((I+J)/2)),A

             While  I <= J

                 While M_NAME_ARRAY(I) < X

                     I+=1

                 Wend

                 While M_NAME_ARRAY(J) > X

                     J-=1

                 Wend

                 If I<=J Then

                     A = M_NAME_ARRAY(I)

                     M_NAME_ARRAY(I) = M_NAME_ARRAY(J)

                     M_NAME_ARRAY(J) = A

                     I+=1

                     J-=1

                 EndIf

             Wend

             If J > Start Then M_NAME_PROC(start,J)

             If I < Finish Then M_NAME_PROC(I,Finish)

         End Sub
         '////////////////////////////////////////////////////////////////

         ' ---------------------Получение отсортированных значений по порядку-------------------
         Sub TMap.GetNext(ByRef ReturnValue As M_TYPE)

             Dim As M_TYPE TempClear

             ReturnValue = TempClear

             If iCurrent = 0 Then

                 ReDim M_NAME_ARRAY(iCount-1) As M_TYPE

                 Dim pTemp As TChildMap Ptr

                 Dim As Integer i

                 pTemp = pFirst

                 Do While pTemp

                     M_NAME_ARRAY(i) = M_VALUE

                     pTemp = pTemp->pNext

                     i+=1

                 Loop

                 M_NAME_PROC(0,iCount-1)

             EndIf

             If iCurrent <= iCount-1 Then

                 ReturnValue = M_NAME_ARRAY(iCurrent)

                 iCurrent+=1

             EndIf

         End Sub

     #EndMacro
     '////////////////////////////////////////////////////////////////

     MACRO_MAP_GETNEXT(String,SortMapS,QSORTS, pTemp->sValue)

     MACRO_MAP_GETNEXT(Integer,SortMapI,QSORTI, pTemp->iValue)

     MACRO_MAP_GETNEXT(Double,SortMapD,QSORTD, pTemp->dValue)

     ' -----------------------Удаление одного ключа из словаря--------------------
     Sub TMap.Del (szKey As String)

         Dim pTemp As TChildMap Ptr

         pTemp = pFirst

         Do While pTemp

             If pTemp->szKey = szKey  Then

                 If pTemp = pFirst Then

                     pFirst = pFirst->pNext

                 Else

                     pTemp->pPrev->pNext = pTemp->pNext

                 End If

                 If pLast = pTemp Then

                     pLast = pLast->pPrev

                 Else

                     pTemp->pNext->pPrev = pTemp->pPrev

                 End If

                 Delete pTemp

                 iCount-=1

                 Exit Sub

             End If

             pTemp = pTemp->pNext

         Loop

     End Sub
     '////////////////////////////////////////////////////////////////

     ' -----------------------Удаление словаря--------------------
     Destructor TMap()

         this.Clear()

     End Destructor
     '////////////////////////////////////////////////////////////////

     ' -----------------------Очистка словаря--------------------
     Sub TMap.Clear()

         Dim pTemp As TChildMap Ptr

         Dim pDel As TChildMap Ptr = pFirst

         If pDel Then

             Do

                 pTemp = pDel->pNext

                 Delete pDel

                 pDel = pTemp

             Loop While pTemp<>0

             pFirst = 0

             pLast = 0

             iCount = 0

             ReDim SortMapS(0) As String

             ReDim SortMapI(0) As Integer

             ReDim SortMapD(0) As Double

         EndIf

     End Sub
     '////////////////////////////////////////////////////////////////

End Namespace

' Пример 1
Using MapOOP ' открываем пространство имен

Dim map As TMap Ptr = New TMap ' создаем словарь

' Загоняем 100 случайных значений с ключами от 1 до 100
For i As Integer  = 1 To 100

     map->Add(Str(i),i*rnd)

Next

Dim As double dRet ' переменная куда будет возвращаться результат

map->Reset ' сбрасываем словарь на начало, необходимо перед выводом всех значений

' проходим по всему словарю , map->iCount - это кол-во записей в словаре
' значения будут отсортированы
For i As Integer = 1 To map->iCount

     map->GetNext(dRet) ' получаем значение

     ? dRet ' выводим его в консоль

Next

Sleep

' Пример 2
Using MapOOP ' открываем пространство имен

Dim map As TMap Ptr = New TMap ' создаем словарь

' Заносим три значения в словарь
map->Add("en","English Language")

map->Add("ru","Russian Language")

map->Add("ge","German Language")

Dim As string sRet ' переменная куда будет возвращаться результат

map->Get("ge",sRet) ' получаем значение с ключом "ge"

? sRet ' выводим его в консоль

map->Get("en",sRet) ' получаем значение с ключом "en"

? sRet ' выводим его в консоль

Sleep