Ignore:
Timestamp:
Oct 28, 2010, 4:52:53 PM (14 years ago)
Author:
george
Message:
  • Added: Generic class TGDictionary and TGPair. Specialized class TDictionaryString.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Generics/TemplateGenerics/Generic/DictionaryImplementation.tpl

    r71 r72  
    1 uses
    2   RtlConsts;
    31
    4 // Used instead of System.Move form because of error: Identifier "System" not found
    5 procedure SystemMove(const Source; var Dest; Count: SizeInt);
     2{$INCLUDE 'ListImplementation.tpl'}
     3function TGDictionary.GetKey(Index: TDictionaryIndex): TDictionaryKey;
    64begin
    7   Move(Source, Dest, Count);
     5  Result := Items[Index].Key;
    86end;
    97
    10 { TGList }
    11 
    12 function TGList.GetCapacity: TListIndex;
     8function TGDictionary.GetValue(Key: TDictionaryKey): TDictionaryValue;
    139begin
    14   Result := Length(FItems);
     10  Result := Items[SearchKey(Key)].Value;
    1511end;
    1612
    17 procedure TGList.SetCapacity(const AValue: TListIndex);
     13procedure TGDictionary.PutKey(Index: TDictionaryIndex;
     14  const AValue: TDictionaryKey);
     15var
     16  Item: TGPair;
    1817begin
    19   SetLength(FItems, AValue);
     18  //Items[Index].Key := AValue;
     19  Item := Items[Index];
     20  Item.Key := AValue;
     21  Items[Index] := Item;
    2022end;
    2123
    22 function TGList.Get(Index: TListIndex): TListItem;
     24procedure TGDictionary.PutValue(Key: TDictionaryKey;
     25  const AValue: TDictionaryValue);
     26var
     27  Item: TGPair;
     28  Index: TDictionaryIndex;
    2329begin
    24   Result := FItems[Index];
     30  //Items[SearchKey(Index)].Value := AValue;
     31  Index := SearchKey(Key);
     32  Item := Items[Index];
     33  Item.Value := AValue;
     34  Items[Index] := Item;
    2535end;
    2636
    27 function TGList.GetCount: TListIndex;
     37function TGDictionary.SearchKey(Key: TDictionaryKey): TDictionaryIndex;
    2838begin
    29   Result := FCount;
    30 end;
    31 
    32 procedure TGList.Put(Index: TListIndex; const AValue: TListItem);
    33 begin
    34   FItems[Index] := AValue;
    35 end;
    36 
    37 procedure TGList.SetCount(const AValue: TListIndex);
    38 begin
    39   SetLength(FItems, AValue);
    40   FCount := AValue;
    41 end;
    42 
    43 procedure TGList.QuickSort(L, R: TListIndex; Compare: TGListSortCompare);
    44 var
    45   I, J: TListIndex;
    46   P, Q: TListItem;
    47 begin
    48  repeat
    49    I := L;
    50    J := R;
    51    P := FItems[ (L + R) div 2 ];
    52    repeat
    53      while Compare(P, FItems[I]) > 0 do
    54        I := I + 1;
    55      while Compare(P, FItems[J]) < 0 do
    56        J := J - 1;
    57      If I <= J then
    58      begin
    59        Q := FItems[I];
    60        FItems[I] := FItems[J];
    61        FItems[J] := Q;
    62        I := I + 1;
    63        J := J - 1;
    64      end;
    65    until I > J;
    66    if L < J then
    67      QuickSort(L, J, Compare);
    68    L := I;
    69   until I >= R;
    70 end;
    71 
    72 procedure TGList.Assign(List: TGList);
    73 var
    74   I: Integer;
    75 begin
    76   Count := List.Count;
    77   I := 0;
    78   while I < Count do begin
    79     Items[I] := List[I];
    80     I := I + 1;
     39  Result := 0;
     40  while Result < Count do begin
     41    if Items[Result].Key = Key then begin
     42      Break;
     43    end;
     44    Result := Result + 1;
    8145  end;
    8246end;
    8347
    84 procedure TGList.Expand;
     48procedure TGDictionary.Add(Key: TDictionaryKey; Value: TDictionaryValue);
    8549var
    86   IncSize: TListIndex;
     50  NewPair: TGPair;
    8751begin
    88   if FCount = Capacity then begin
    89     IncSize := 4;
    90     if Capacity > 3 then IncSize := IncSize + 4;
    91     if Capacity > 8 then IncSize := IncSize + 8;
    92     if Capacity > 63 then IncSize := IncSize + Capacity shr 2;
    93     Capacity := Capacity + IncSize;
    94   end;
     52  NewPair.Key := Key;
     53  NewPair.Value := Value;
     54  inherited Add(NewPair);
    9555end;
    96 
    97 function TGList.Extract(Item: TListItem): TListItem;
    98 var
    99   I: TListIndex;
    100 begin
    101   I := IndexOf(Item);
    102   if I >= 0 then begin
    103     Result := Item;
    104     Delete(I);
    105   end else
    106     raise EListError.CreateFmt(SListIndexError, [0]);
    107 end;
    108 
    109 function TGList.First: TListItem;
    110 begin
    111   if FCount = 0 then
    112     raise EListError.CreateFmt(SListIndexError, [0])
    113   else
    114     Result := Items[0];
    115 end;
    116 
    117 function TGList.IndexOf(Item: TListItem): TListIndex;
    118 begin
    119   Result := 0;
    120   while (Result < FCount) and (FItems[Result] <> Item) do
    121     Result := Result + 1;
    122   if Result = FCount then Result := -1;
    123 end;
    124 
    125 procedure TGList.Insert(Index: TListIndex; Item: TListItem);
    126 begin
    127   if (Index < 0) or (Index > FCount ) then
    128     raise EListError.CreateFmt(SListIndexError, [Index]);
    129   if FCount = Capacity then Expand;
    130   if Index < FCount then
    131     SystemMove(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TListItem));
    132   FItems[Index] := Item;
    133   FCount := FCount + 1;
    134 end;
    135 
    136 procedure TGList.InsertList(Index: TListIndex; List: TGList);
    137 var
    138   I: TListIndex;
    139 begin
    140   I := 0;
    141   while (I < List.Count) do begin
    142     Insert(Index + I, List[I]);
    143     I := I + 1;
    144   end;
    145 end;
    146 
    147 function TGList.Last: TListItem;
    148 begin
    149   if FCount = 0 then
    150     raise EListError.CreateFmt(SListIndexError, [0])
    151   else
    152     Result := Items[FCount - 1];
    153 end;
    154 
    155 procedure TGList.Move(CurIndex, NewIndex: TListIndex);
    156 var
    157   Temp: TListItem;
    158 begin
    159   if ((CurIndex < 0) or (CurIndex > Count - 1)) then
    160     raise EListError.CreateFmt(SListIndexError, [CurIndex]);
    161   if ((NewIndex < 0) or (NewIndex > Count -1)) then
    162     raise EListError.CreateFmt(SlistIndexError, [NewIndex]);
    163   Temp := FItems[CurIndex];
    164   Delete(CurIndex);
    165   Insert(NewIndex, Temp);
    166 end;
    167 
    168 procedure TGList.MoveItems(CurIndex, NewIndex, Count: TListIndex);
    169 var
    170   S: Integer;
    171   D: Integer;
    172 begin
    173   if CurIndex < NewIndex then begin
    174     S := CurIndex + Count - 1;
    175     D := NewIndex + Count - 1;
    176     while S >= CurIndex do begin
    177       Move(S, D);
    178       S := S - 1;
    179       D := D - 1;
    180     end;
    181   end else
    182   if CurIndex > NewIndex then begin
    183     S := CurIndex;
    184     D := NewIndex;
    185     while S < (CurIndex + Count) do begin
    186       Move(S, D);
    187       S := S + 1;
    188       D := D + 1;
    189     end;
    190   end;
    191 end;
    192 
    193 procedure TGList.Swap(Index1, Index2: TListIndex);
    194 var
    195   Temp: TListItem;
    196 begin
    197   Temp := Items[Index1];
    198   Items[Index1] := Items[Index2];
    199   Items[Index2] := Temp;
    200 end;
    201 
    202 function TGList.Remove(Item: TListItem): TListIndex;
    203 begin
    204   Result := IndexOf(Item);
    205   if Result <> -1 then
    206     Delete(Result);
    207 end;
    208 
    209 (*function TGList.Equals(Obj: TObject): Boolean;
    210 var
    211   I: TListIndex;
    212 begin
    213   Result := Count = (Obj as TGList).Count;
    214   if Result then begin
    215     I := 0;
    216     while I < Count do begin
    217       if Items[I] <> (Obj as TGList)[I] then begin
    218         Result := False;
    219         Break;
    220       end;
    221       I := I + 1;
    222     end;
    223   end;
    224 end;*)
    225 
    226 procedure TGList.Reverse;
    227 var
    228   I: TListIndex;
    229 begin
    230   I := 0;
    231   while I < (Count div 2) do begin
    232     Swap(I, Count - 1 - I);
    233     I := I + 1;
    234   end;
    235 end;
    236 
    237 procedure TGList.Sort(Compare: TGListSortCompare);
    238 begin
    239   if FCount > 1 then
    240     QuickSort(0, FCount - 1, Compare);
    241 end;
    242 
    243 procedure TGList.SetArray(Values: array of TListItem);
    244 var
    245   I: TListIndex;
    246 begin
    247   Clear;
    248   I := 0;
    249   while I <= High(Values) do begin
    250     Add(Values[I]);
    251     I := I + 1;
    252   end;
    253 end;
    254 
    255 function TGList.Implode(Separator: string; Converter: TGListStringConverter): string;
    256 var
    257   I: TListIndex;
    258 begin
    259   Result := '';
    260   I := 0;
    261   while I < Count do begin
    262     Result := Result + Converter(Items[I]);
    263     if I < (Count - 1) then
    264       Result := Result + Separator;
    265     I := I + 1;
    266   end;
    267 end;
    268 
    269 function TGList.Add(Item: TListItem): TListIndex;
    270 begin
    271   if FCount = Capacity then
    272     Self.Expand;
    273   FItems[FCount] := Item;
    274   Result := FCount;
    275   FCount := FCount + 1;
    276 end;
    277 
    278 procedure TGList.AddList(List: TGList);
    279 var
    280   I: TListIndex;
    281 begin
    282   I := 0;
    283   while I < List.Count do begin
    284     Add(List[I]);
    285     I := I + 1;
    286   end;
    287 end;
    288 
    289 procedure TGList.Clear;
    290 begin
    291   Count := 0;
    292   Capacity := 0;
    293 end;
    294 
    295 procedure TGList.Delete(Index: TListIndex);
    296 begin
    297   if (Index < 0) or (Index >= FCount) then
    298     raise EListError.CreateFmt(SListIndexError, [Index]);
    299   FCount := FCount - 1;
    300   SystemMove(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TListItem));
    301   // Shrink the list if appropriate
    302   if (Capacity > 256) and (FCount < Capacity shr 2) then
    303   begin
    304     Capacity := Capacity shr 1;
    305   end;
    306 end;
    307 
    308 procedure TGList.DeleteItems(Index, Count: TListIndex);
    309 var
    310   I: TListIndex;
    311 begin
    312   I := 0;
    313   while I < Count do begin
    314     Delete(I);
    315     I := I + 1;
    316   end;
    317 end;
    318 
    319 procedure TGList.Exchange(Index1, Index2: TListIndex);
    320 var
    321   Temp: TListItem;
    322 begin
    323   if ((Index1 >= FCount) or (Index1 < 0)) then
    324     raise EListError.CreateFmt(SListIndexError, [Index1]);
    325   if ((Index2 >= FCount) or (Index2 < 0)) then
    326     raise EListError.CreateFmt(SListIndexError, [Index2]);
    327   Temp := FItems[Index1];
    328   FItems[Index1] := FItems[Index2];
    329   FItems[Index2] := Temp;
    330 end;
Note: See TracChangeset for help on using the changeset viewer.