class declaration section:
Tdmstrains = Class (TList)
Private
Fhashed:boolean;
Fhashlist:tfphashlist;
Fownsobjects:boolean;
Fsorted:boolean;
Fupdatelevel:integer;
Protected
function GetItem (Index:integer): Tdmstrain;
Procedure Notify (Ptr:pointer; Action:tlistnotification); Override
Procedure SetItem (Index:integer; Aobject:tdmstrain);
Public
Constructor Create; overload;
Constructor Create (Aownsobjects:boolean; Hashed:boolean; Autosorted:boolean);
overload;
destructor Destroy; Override
function Add (aobject:tdmstrain): Integer;
Procedure BeginUpdate;
Procedure endupdate;
function Extract (item:tdmstrain): Tdmstrain;
function Find (const atrainid:string): Tdmstrain;
function First:tdmstrain;
function IndexOf (aobject:tdmstrain): Integer;
Procedure Insert (Index:integer; Aobject:tdmstrain);
function Last:tdmstrain;
function Remove (aobject:tdmstrain): Integer;
Property Items[index:integer]: Tdmstrain read GetItem write SetItem;
Default
Property Ownsobjects:boolean read Fownsobjects write fownsobjects;
Property Updatelevel:integer read Fupdatelevel;
End
Implementation section:
{
Tdmstrains **********************************
}
Constructor Tdmstrains.create;
Begin
Inherited Create;
Fownsobjects: = True;
Fhashlist:=tfphashlist.create;
Fhashed:=true;
Fsorted:=true;
End
Constructor Tdmstrains.create (Aownsobjects:boolean; Hashed:boolean;
Autosorted:boolean);
Begin
Inherited Create;
Fhashlist:=tfphashlist.create;
Fownsobjects: = aownsobjects;
fhashed:=hashed;
fsorted:=autosorted;
End
destructor Tdmstrains.destroy;
Begin
inherited;
Fhashlist.free;
End
function Tdmstrains.add (aobject:tdmstrain): Integer;
Begin
Result: = inherited Add (aobject);
End
Procedure Tdmstrains.beginupdate;
Begin
INC (Fupdatelevel);
End
Procedure Tdmstrains.endupdate;
Begin
If Fupdatelevel>0 Then
Dec (Fupdatelevel);
if (fupdatelevel=0) and fsorted Then
Sort (SORTTRAINBY_PSTLJ_TRAINTYPE_ASC);
End
function Tdmstrains.extract (item:tdmstrain): Tdmstrain;
Begin
Result: = Tdmstrain (inherited Extract (Item));
End
function Tdmstrains.find (const atrainid:string): Tdmstrain;
Begin
Result:=tdmstrain (Fhashlist.find (Atrainid));
End
function TDMSTrains.First:TDMSTrain;
Begin
Result: = Tdmstrain (inherited first);
End
function Tdmstrains.getitem (Index:integer): Tdmstrain;
Begin
Result: = inherited items[index];
End
function Tdmstrains.indexof (aobject:tdmstrain): Integer;
Begin
Result: = inherited IndexOf (aobject);
End
Procedure Tdmstrains.insert (Index:integer; Aobject:tdmstrain);
Begin
Inherited Insert (Index, aobject);
End
function TDMSTrains.Last:TDMSTrain;
Begin
Result: = Tdmstrain (inherited last);
End
Procedure Tdmstrains.notify (Ptr:pointer; Action:tlistnotification);
Var
T:integer;
Begin
If Fhashed Then
Begin
if (action=lndeleted) then
Begin
T:=fhashlist.findindexof (Tdmstrain (PTR). Name);
If T<>-1 Then
Fhashlist.delete (T);
If Ownsobjects Then
Tdmstrain (PTR). Free;
End else if (action=lnadded) then
Begin
Fhashlist.add (Tdmstrain (PTR). name,ptr);
if (fupdatelevel=0) and fsorted Then
Sort (SORTTRAINBY_PSTLJ_TRAINTYPE_ASC);
End
End
Inherited Notify (Ptr, Action);
End
function Tdmstrains.remove (aobject:tdmstrain): Integer;
Begin
Result: = inherited Remove (aobject);
End
Procedure Tdmstrains.setitem (Index:integer; Aobject:tdmstrain);
Begin
Inherited Items[index]: = Aobject;
End
An example of inheriting tlist