paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 12:10:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Added TFPObjectList implementation from Ales Katona

Browse Source 
git-svn-id: trunk@470 -
This commit is contained in:
michael 2005-06-22 07:24:07 +00:00
parent bd676198c1
commit 7d13839a55
1 changed files with 108 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
fcl/inc/contnrs.pp
View File

@ -21,6 +21,28 @@ uses
SysUtils,Classes;
Type
{$inline on}
TFPObjectList = class(TFPList)
private
FFreeObjects : Boolean;
protected
function GetItem(Index: Integer): TObject; {$ifdef HASINLINE} inline;{$endif}
procedure SetItem(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
public
constructor Create;
constructor Create(FreeObjects : Boolean);
function Add(AObject: TObject): Integer; {$ifdef HASINLINE} inline;{$endif}
function Extract(Item: TObject): TObject;
function Remove(AObject: TObject): Integer;
function IndexOf(AObject: TObject): Integer;
function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt: Integer): Integer;
procedure Insert(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
function First: TObject;
function Last: TObject;
property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
property Items[Index: Integer]: TObject read GetItem write SetItem; default;
end;
TObjectList = class(TList)
private
@ -131,6 +153,92 @@ Type
implementation
constructor TFPObjectList.Create(FreeObjects : boolean);
begin
inherited Create;
FFreeObjects:=Freeobjects;
end;
constructor TFPObjectList.Create;
begin
inherited Create;
FFreeObjects:=True;
end;
function TFPObjectList.GetItem(Index: Integer): TObject; {$ifdef HASINLINE} inline;{$endif}
begin
Result:=TObject(inherited Get(Index));
end;
procedure TFPObjectList.SetItem(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
var
O : TObject;
begin
if OwnsObjects then
begin
O:=GetItem(Index);
O.Free;
end;
Put(Index,Pointer(AObject));
end;
function TFPObjectList.Add(AObject: TObject): Integer; {$ifdef HASINLINE} inline;{$endif}
begin
Result:=inherited Add(Pointer(AObject));
end;
function TFPObjectList.Extract(Item: TObject): TObject;
begin
Result:=Tobject(inherited Extract(Pointer(Item)));
end;
function TFPObjectList.Remove(AObject: TObject): Integer;
begin
Result:=inherited Remove(Pointer(AObject));
end;
function TFPObjectList.IndexOf(AObject: TObject): Integer;
begin
Result:=inherited indexOF(Pointer(AObject));
end;
function TFPObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt : Integer): Integer;
var
I : Integer;
begin
I:=AStartAt;
Result:=-1;
If AExact then
while (I<Count) and (Result=-1) do
If Items[i].ClassType=AClass then
Result:=I
else
Inc(I)
else
while (I<Count) and (Result=-1) do
If Items[i].InheritsFrom(AClass) then
Result:=I
else
Inc(I);
end;
procedure TFPObjectList.Insert(Index: Integer; AObject: TObject); {$ifdef HASINLINE} inline;{$endif}
begin
inherited Insert(Index,Pointer(AObject));
end;
function TFPObjectList.First: TObject;
begin
Result := TObject(inherited First);
end;
function TFPObjectList.Last: TObject;
begin
Result := TObject(inherited Last);
end;
{ TObjectList }
constructor tobjectlist.create(freeobjects : boolean);
begin