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:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:

unit IntegerList;

 
{  
 Autor : Udontknow (webmaster@xnebula.de)  
 
 Unit mit der Klasse TIntegerlist, einer Liste von Integerwerten (Oh, wirklich??? ;) )

  2004-02-06 : Capacity an bestimmten Stellen gesetzt, um redundante
SpeicherVorgänge zu vermeiden.

}


interface

uses classes;


type TIntegerList= class(TObject)
  private
    FAcceptDuplicates:Boolean;
    FList:TList;


    function GetItems(Index: Integer): Integer;
    procedure SetItems(Index: Integer; const Value: Integer);
    function Get_AcceptDuplicates: Boolean;
    procedure Set_AcceptDuplicates(const Value: Boolean);
  public
    procedure LoadFromStream(Stream:TStream); virtual;
    procedure SaveToStream(Stream:TStream); virtual;
    procedure Assign(Source:TIntegerlist);
    function Count:Integer;
    procedure Delete(Index:Integer);
    procedure Clear;
    function Add(Value:Integer):Integer;
    procedure AddValues(IL:TIntegerlist);
    function IndexByValue(Value:Integer):Integer;
    procedure MoveToStringlist(StrL:TStringList);
    procedure GetFromStringList(StrL:TStringList);
    property Items[Index:Integer]:Integer read GetItems write SetItems; default;
    property AcceptDuplicates:Boolean read Get_AcceptDuplicates write Set_AcceptDuplicates;
    constructor Create;
    destructor Destroy; override;
end;


implementation


uses sysutils;


{ TIntegerList }


function TIntegerList.Add(Value: Integer): Integer;
var i:integer;
begin
  Result:=-1;


  //Nur Wert hinzufügen, wenn Dubletten erlaubt oder Wert nicht vorhanden
  if (FAcceptDuplicates) or (IndexByValue(Value)=-1) then
    Result:=FList.Add(Pointer(Value));


  //Einsortieren
  While (Result>0) and (Self[Result]<Self[Result-1]) do
  begin
    //Werte tauschen, sodaß neu eingefügter Wert nach vorne wandert
    i:=Self[Result-1];
    Self[Result-1]:=Self[Result];
    Self[Result]:=i;
    //Position ist nach Tausch weiter vorne
    Dec(Result);
  end;
end;


procedure TIntegerList.AddValues(IL: TIntegerlist);
var i:integer;
begin

  //Kapazität festlegen, um redundante Reserviervorgänge zu verhindern
  if FList.Capacity<Count+IL.Count then
    FList.Capacity:=Count+IL.Count;


  //Sämtliche Werte der Quelle einzeln einfügen
  for i:=0 to IL.Count-1 do
    Self.Add(IL[i]);
end;


procedure TIntegerList.Assign(Source:TIntegerlist);
var Stream:TMemoryStream;
begin
  Stream:=TMemoryStream.Create;
  try
    //Quelldaten in Stream schreiben
    Source.SaveToStream(Stream);
    Stream.Position:=0;
    //Stream von Ziel  einlesen lassen
    LoadFromStream(Stream);
  finally  
    Stream.Free;  
  end;  
end;  

 
procedure TIntegerList.Clear;  
begin  
  FList.Clear;  
end;  

 
function TIntegerList.Count: Integer;  
begin  
  Result:=FList.Count;  
end;  

 
constructor TIntegerList.Create;  
begin  
  FAcceptDuplicates:=True;  
  FList:=TList.Create;  
end;  

 
procedure TIntegerList.Delete(Index: Integer);  
begin
  FList.Delete(Index);
end;


destructor TIntegerList.Destroy;
begin
  FList.Free;
  inherited;
end;


procedure TIntegerList.GetFromStringList(StrL: TStringList);
var i:integer;
begin
  Clear;
  for i:=0 to StrL.Count-1 do
    Add(StrTOInt(StrL[i]));
end;

function TIntegerList.GetItems(Index: Integer): Integer;
begin
  Result:=Integer(FList.Items[Index]);
end;

 
function TIntegerList.Get_AcceptDuplicates: Boolean;  
begin  
  Result:=FAcceptDuplicates;  
end;  

 
function TIntegerList.IndexByValue(Value: Integer): Integer;  
var u,o,m:integer;  
begin  
  Result:=-1;  
  if Count=0 then  
    exit;  

 
  //Suche des Elementes mit Wert Value  
  //Verfahren: Iteratives Halbieren  
  u:=0;  
  o:=Count-1;  
  repeat  
    m:=(o+u) div 2;  
    if (u=o) then break;  
    if (Value>Self[m]) then  
      u:=m+1  
    else  
      o:=m;  
  until (Self[m]=Value);  

 
  if (Self[m]=Value) then
    Result:=m;
end;  

 
procedure TIntegerList.LoadFromStream(Stream: TStream);  
var Count:Integer;  
var i,Value:integer;  
begin  
  Self.Clear;  

 
  //Anzahl zu lesender Zahlen einlesen  
  Stream.ReadBuffer(Count,SizeOf(Count));  

 
  //Kapazität festlegen, um redundante Reserviervorgänge zu verhindern
  if FList.Capacity<Count then
    FList.Capacity:=Count;

 
  //Zahlen einlesen  
  for i:=0 to Count-1 do  
  begin  
    Stream.ReadBuffer(Value,SizeOf(Value));  
    Self.Add(Value);  
  end;  
end;  

 
procedure TIntegerList.MoveToStringlist(StrL: TStringList);
var i:integer;
begin
  StrL.Clear;
  for i:=0 to Count-1 do
    StrL.Add(IntToStr(Self[i]));
end;

procedure TIntegerList.SaveToStream(Stream: TStream);
var Count:Integer;  
var i,Value:integer;  
begin  
  Count:=Self.Count;  
    
  //Anzahl zu schreibender Zahlen schreiben  
  Stream.WriteBuffer(Count,SizeOf(Count));

 
  //Zahlen in Stream schreiben  
  for i:=0 to Count-1 do  
  begin  
    Value:=Self[i];  
    Stream.WriteBuffer(Value,SizeOf(Value));  
  end;  
end;  

 
procedure TIntegerList.SetItems(Index: Integer; const Value: Integer);  
begin  
  FList.Items[Index]:=Pointer(Value);  
end;  

 

 
procedure TIntegerList.Set_AcceptDuplicates(const Value: Boolean);  
begin  
  FAcceptDuplicates:=Value;  
end;  

 
end.