Mega Code Archive
Descending from tobjectlist
<![CDATA[
A useful method for implementing a class specific version of TObjectList with out the need for all those type casts.
Here is a simple method of descending from TObjectList to remove the need for type casting whenever accessing its objects. Of course this is only suitable if you are only storing one class type.
Not very special code, but it can save you some time with typing in all those Type Casts (or forgetting to in my case ;-).
I use this method to implement those easy yet annoying class relationships such as a Tree or where one class needs to maintain a list of another.
e.g.
ParentObj - TMyParent
| ChildObj - TMyClass
| ...
ParentObj contains a list of ChildObjs - as shown in part below.
This could be extended so that ParentObj has an associated Object List also, or you may wish to go the other way so that ChildObj contains a list of another class of objects, and so on for however many levels of objects you require.
Another benefit of using TObjectList is you don't need to worry about freeing all those objects, all you need to do is free the ObjectList descendant and the list of objects contained are freed (provided you set OwnObjects to true in the Create(OwnsObjects: boolean).
Example Code:
type
TMyClassList = class(TObjectList);
TMyParent = class(TObject)
private
fChildren: TMyClassList;
...
public
...
end;
TMyClass = class(TObject)
private
...
public
...
end;
TMyClassList = class(TObjectList)
private
function GetItems(Index: Integer): TMyClass;
procedure SetItems(Index: Integer; value: TMyClass);
public
constructor Create;
// Note that TMyClass is replacing TObject. (see contnrs.pas).
// This will of course remove the ability to store any kind of class derived from TObject only those of TMyClass.
function Add(value: TMyClass): Integer;
function IndexOf(value: TMyClass): Integer;
procedure Insert(Index: Integer; value: TMyClass);
function Remove(value: TMyClass): Integer;
property Items[Index: Integer]: TMyClass read GetItems write SetItems; default;
// Plus your own code as needed i.e. FindByName etc...
end;
implementation
constructor Create;
begin
// I have added this because I always want the list to own its objects.
inherited Create(true);
end;
function TMyClassList.Add(value: TMyClass): Integer;
begin
Result := inherited Add(value);
end;
function TMyClassList.GetItems(Index: Integer): TMyClass;
begin
// Ahha this is that pesky one that puts type casts in a hundred
// different locations through your code ;-).. Hmm one place, much
// better.
Result := TMyClass(inherited Items[Index]);
end;
function TMyClassList.IndexOf(value: TMyClass): Integer;
begin
Result := inherited IndexOf(value);
end;
procedure TMyClassList.Insert(Index: Integer; value: TMyClass);
begin
inherited Insert(Index, value);
end;
function TMyClassList.Remove(value: TMyClass): Integer;
begin
Result := inherited Remove(value);
end;
procedure TMyClassList.SetItems(Index: Integer; value: TMyClass);
begin
inherited Items[Index] := value;
end;
]]>