Step by step

Folks,

For everybody thats use a lot Chained lists on your projects:

 Delphi | 
 copy code |
?
 
001
uses SysUtils;
002
 
003
type
004
  PPointer = ^Pointer;
005
 
006
  TChainedList = class
007
  private
008
    FFirst   : Pointer;
009
    FLast    : Pointer;
010
    FCurrent : Pointer;
011
    FCount   : Integer;
012
    function GetCurrent: PPointer;
013
  public
014
    constructor Create;
015
    destructor Destroy; override;
016
 
017
    function First : TChainedList;
018
    function Last  : TChainedList;
019
    function Prior : TChainedList;
020
    function Next  : TChainedList;
021
 
022
    function Add: TChainedList;
023
    function Remove: TChainedList; overload;
024
    function Remove(AChainedReleaser: Pointer): TChainedList; overload;
025
 
026
    property Current: PPointer read GetCurrent;
027
    property Count: Integer read FCount;
028
  end;
029
 
030
implementation
031
 
032
type
033
  PChainedItem = ^TChainedItem;
034
  TChainedItem = record
035
    Prior, Next: PChainedItem;
036
    Data: Pointer;
037
  end;
038
 
039
{ TChainedList }
040
 
041
constructor TChainedList.Create;
042
begin
043
  FCount := 0;
044
  FFirst := nil;
045
  FLast := nil;
046
  FCurrent := nil;
047
end;
048
 
049
destructor TChainedList.Destroy;
050
begin
051
  First;
052
  while Current <> nil do
053
    Remove;
054
 
055
  inherited;
056
end;
057
 
058
function TChainedList.GetCurrent: PPointer;
059
begin
060
  if FCurrent <> nil then
061
    Result := @PChainedItem(FCurrent).Data
062
  else
063
    Result := nil;
064
end;
065
 
066
function TChainedList.First: TChainedList;
067
begin
068
  FCurrent := FFirst;
069
  Result := Self;
070
end;
071
 
072
function TChainedList.Last: TChainedList;
073
begin
074
  FCurrent := FLast;
075
  Result := Self;
076
end;
077
 
078
function TChainedList.Prior: TChainedList;
079
begin
080
  if FCurrent <> nil then
081
    FCurrent := PChainedItem(FCurrent)^.Prior
082
  else
083
    FCurrent := nil;
084
  Result := Self;
085
end;
086
 
087
function TChainedList.Next: TChainedList;
088
begin
089
  if FCurrent <> nil then
090
    FCurrent := PChainedItem(FCurrent)^.Next
091
  else
092
    FCurrent := nil;
093
  Result := Self;
094
end;
095
 
096
function TChainedList.Add: TChainedList;
097
var
098
  pNew: PChainedItem;
099
begin
100
  New(pNew);
101
  pNew^.Prior := nil;
102
  pNew^.Next := nil;
103
  pNew^.Data := nil;
104
 
105
  if FFirst = nil then
106
  begin
107
    FFirst := pNew;
108
    FLast := pNew;
109
  end else
110
  begin
111
    pNew^.Prior := PChainedItem(FLast);
112
    PChainedItem(FLast)^.Next := pNew;
113
    FLast := pNew;
114
  end;
115
 
116
  FCurrent := FLast;
117
  Result := Self;
118
  Inc(FCount);
119
end;
120
 
121
function TChainedList.Remove: TChainedList;
122
var
123
  pCur: PChainedItem;
124
begin
125
  pCur := FCurrent;
126
  if pCur^.Data <> nil then
127
    raise Exception.Create('Current item memory leak detected.');
128
 
129
  if pCur^.Next <> nil then
130
    pCur^.Next^.Prior := pCur^.Prior;
131
 
132
  if pCur^.Prior <> nil then
133
    pCur^.Prior^.Next := pCur^.Next;
134
 
135
  if pCur = FFirst then
136
  begin
137
    FFirst := pCur^.Next;
138
    FCurrent := FFirst;
139
  end else if pCur = FLast then
140
  begin
141
    FLast := pCur^.Prior;
142
    FCurrent := FLast;
143
  end else
144
    FCurrent := pCur^.Next;
145
 
146
  Result := Self;
147
  Dispose(pCur);
148
  Dec(FCount);
149
end;
150
 
151
function TChainedList.Remove(AChainedReleaser: Pointer): TChainedList;
152
type
153
  TRelease = procedure(APointer: Pointer);
154
var
155
  PdrRelease: TRelease;
156
begin
157
  @PdrRelease := AChainedReleaser;
158
  PdrRelease(PChainedItem(FCurrent)^.Data);
159
  PChainedItem(FCurrent)^.Data := nil;
160
  Result := Remove;
161
end;

See how to use it here: Delphi: Chained List

Hugs!

Tags: Chain List, Delphi, TChainedList, Usefull functions

This entry was posted on Friday, June 19th, 2009 at 10:54 am and is filed under articles. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.