1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Juha Manninen / Antônio Galvão
Abstract:
This is an unsorted StringList with a fast lookup feature.
Internally it uses a map container to store the strings again
which is then used for Contains, IndexOf and Find methods.
The extra container does not reserve too much memory because the strings are
reference counted and not really copied.
All Duplicates property values are fully supported,
including dupIgnore and dupError, unlike in unsorted StringList.
This class is useful only when you must preserve the order in list, but
also need to do fast lookups to see if a string exists, or must prevent duplicates.
}
unit DictionaryStringList;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, AvgLvlTree;
type
{ TDictionaryStringList }
TDictionaryStringList = class(TStringList)
private
FMap: TStringMap;
protected
procedure InsertItem(Index: Integer; const S: string); override;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
function Add(const S: string): Integer; override;
function AddObject(const S: string; AObject: TObject): Integer; override;
function Contains(const S: string): Boolean; // A new function
function Find(const S: string; out Index: Integer): Boolean; override;
function IndexOf(const S: string): Integer; override;
end;
implementation
{ TDictionaryStringList }
constructor TDictionaryStringList.Create;
begin
inherited Create;
FMap := TStringMap.Create(True);
end;
destructor TDictionaryStringList.Destroy;
begin
FMap.Free;
inherited Destroy;
end;
procedure TDictionaryStringList.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TDictionaryStringList then
FMap.Assign(TDictionaryStringList(Source).FMap);
end;
procedure TDictionaryStringList.Clear;
begin
inherited Clear;
FMap.Clear;
end;
procedure TDictionaryStringList.Delete(Index: Integer);
var
s: String;
begin
s := Strings[Index];
inherited Delete(Index);
// The string must not be deleted from map if there are duplicates.
// Calling IndexOf is slow but it is needed.
if (Duplicates <> dupAccept) or (inherited IndexOf(s) = -1) then
FMap.Remove(s);
end;
function TDictionaryStringList.Add(const S: string): Integer;
begin
if not Sorted and (Duplicates = dupIgnore) and FMap.Contains(S) then
Result := -1
else
Result := inherited Add(S);
end;
function TDictionaryStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
Result := Add(S);
if Result > -1 then
Objects[Result] := AObject;
end;
procedure TDictionaryStringList.InsertItem(Index: Integer; const S: string);
begin
if not Sorted and (Duplicates <> dupAccept) then
if FMap.Contains(S) then
case Duplicates of
DupIgnore : Exit;
DupError : raise Exception.Create('TDictionaryStringList.InsertItem:'
+' Duplicates are not allowed.');
end;
inherited InsertItem(Index, S);
FMap.Add(S); // Insert string to map, too.
end;
function TDictionaryStringList.Contains(const S: string): Boolean;
begin
Result := FMap.Contains(S);
end;
function TDictionaryStringList.Find(const S: string; out Index: Integer): Boolean;
begin
Index := IndexOf(S);
Result := Index <> -1;
end;
function TDictionaryStringList.IndexOf(const S: string): Integer;
begin
if FMap.Contains(S) then
Result := inherited IndexOf(S)
else
Result := -1
end;
end.
|
