TList 源码分析
TPointerList = array[0..MaxListSize - 1] of Pointer;
TList 的本质就是个无类型指针的数组
TList = class(TObject)
private
FList: PPointerList;
FCount: Integer;
FCapacity: Integer;
protected
function Get(Index: Integer): Pointer;
procedure Grow; virtual;
procedure Put(Index: Integer; Item: Pointer);
procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
procedure SetCapacity(NewCapacity: Integer);
procedure SetCount(NewCount: Integer);
public
destructor Destroy; override;
function Add(Item: Pointer): Integer;
procedure Clear; virtual;
procedure Delete(Index: Integer);
class procedure Error(const Msg: string; Data: Integer); overload; virtual;
class procedure Error(Msg: PResStringRec; Data: Integer); overload;
procedure Exchange(Index1, Index2: Integer);
function Expand: TList;
function Extract(Item: Pointer): Pointer;
function First: Pointer;
function IndexOf(Item: Pointer): Integer;
procedure Insert(Index: Integer; Item: Pointer);
function Last: Pointer;
procedure Move(CurIndex, NewIndex: Integer);
function Remove(Item: Pointer): Integer;
procedure Pack;
procedure Sort(Compare: TListSortCompare);
procedure Assign(ListA: TList; AOperator: TListAssignOp = laCopy; ListB: TList = nil);
property Capacity: Integer read FCapacity write SetCapacity;
property Count: Integer read FCount write SetCount;
property Items[Index: Integer]: Pointer read Get write Put; default;
property List: PPointerList read FList;
end;
// 根据在List的索引返回数组中数据，以无类型指针返回
function TList.Get(Index: Integer): Pointer;
begin
if (Index < 0) or (Index >= FCount) then
Error(@SListIndexError, Index);
Result := FList^[Index];
end;
// 扩大数组中的内存分配，FCapacity 默认是16，Delta 为16和4，估计主要是避免过多次数的内存分配而产生内存碎片，所以一次分配多点，如果list要加载的数据过多，应该把FCapacity 设置相对大
procedure TList.Grow;
var
Delta: Integer;
begin
if FCapacity > 64 then
Delta := FCapacity div 4
else
if FCapacity > 8 then
Delta := 16
else
Delta := 4;
SetCapacity(FCapacity + Delta);
end;
// 代替数组中的数据，删除原有的数据， 同时调用Notify函数，传递lnDeleted， lnAdded 参数
procedure TList.Put(Index: Integer; Item: Pointer);
var
Temp: Pointer;
begin
if (Index < 0) or (Index >= FCount) then
Error(@SListIndexError, Index);
if Item <> FList^[Index] then
begin
Temp := FList^[Index];
FList^[Index] := Item;
if Temp <> nil then
Notify(Temp, lnDeleted);
if Item <> nil then
Notify(Item, lnAdded);
end;
end;
// TList.Grow 或者TList.SetCount调用，主要为重新分配内存，ReallocMem分配连续的内存
procedure TList.SetCapacity(NewCapacity: Integer);
begin
if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
Error(@SListCapacityError, NewCapacity);
if NewCapacity <> FCapacity then
begin
ReallocMem(FList, NewCapacity * SizeOf(Pointer));
FCapacity := NewCapacity;
end;
end;
// 如果NewCount大于现在有的内存，则扩大内存，SetCapacity(NewCount), 同时将Fcount 到 NewCount 之间的数据清空
( if NewCount > FCount then
FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0) ), 小则将Fcount 到 NewCount 之间的数据删除
( for I := FCount - 1 downto NewCount do
Delete(I);)
最后将数组中的数目设为 NewCount
procedure TList.SetCount(NewCount: Integer);
var
I: Integer;
begin
if (NewCount < 0) or (NewCount > MaxListSize) then
Error(@SListCountError, NewCount);
if NewCount > FCapacity then
SetCapacity(NewCount);
if NewCount > FCount then
FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0)
else
for I := FCount - 1 downto NewCount do
Delete(I);
FCount := NewCount;
end;
// 调用clear
destructor TList.Destroy;
begin
Clear;
end;
// 先判断是否需要扩大内存分配，然后将Item添加到LIST默尾
function TList.Add(Item: Pointer): Integer;
begin
Result := FCount;
if Result = FCapacity then
Grow;
FList^[Result] := Item;
Inc(FCount);
if Item <> nil then
Notify(Item, lnAdded);
end;
// 清空，将数据清空，同时将内存释放
procedure TList.Clear;
begin
SetCount(0);
SetCapacity(0);
end;
// 删除数据，使用move用后边的数据代替前边的数据
procedure TList.Delete(Index: Integer);
var
Temp: Pointer;
begin
if (Index < 0) or (Index >= FCount) then
Error(@SListIndexError, Index);
Temp := Items[Index];
Dec(FCount);
if Index < FCount then
System.Move(FList^[Index + 1], FList^[Index],
(FCount - Index) * SizeOf(Pointer));
if Temp <> nil then
Notify(Temp, lnDeleted);
end;
// 俩个位置的数据交换
procedure TList.Exchange(Index1, Index2: Integer);
var
Item: Pointer;
begin
if (Index1 < 0) or (Index1 >= FCount) then
Error(@SListIndexError, Index1);
if (Index2 < 0) or (Index2 >= FCount) then
Error(@SListIndexError, Index2);
Item := FList^[Index1];
FList^[Index1] := FList^[Index2];
FList^[Index2] := Item;
end;
// 先判断是否需要扩大内存分配，然后返回LIST自身
function TList.Expand: TList;
begin
if FCount = FCapacity then
Grow;
Result := Self;
end;
// 删除数据，同时将要删除的数据返回
function TList.Extract(Item: Pointer): Pointer;
var
I: Integer;
begin
Result := nil;
I := IndexOf(Item);
if I >= 0 then
begin
Result := Item;
FList^[I] := nil;
Delete(I);
Notify(Result, lnExtracted);
end;
end;
// 返回首个位置的数据
function TList.First: Pointer;
begin
Result := Get(0);
end;
// 插入数据，同时将要插入的位置的数据都往后挪一个位置
procedure TList.Insert(Index: Integer; Item: Pointer);
begin
if (Index < 0) or (Index > FCount) then
Error(@SListIndexError, Index);
if FCount = FCapacity then
Grow;
if Index < FCount then
System.Move(FList^[Index], FList^[Index + 1],
(FCount - Index) * SizeOf(Pointer));
FList^[Index] := Item;
Inc(FCount);
if Item <> nil then
Notify(Item, lnAdded);
end;
// 获得最后一个位置的数据
function TList.Last: Pointer;
begin
Result := Get(FCount - 1);
end;
// 将CurIndex的数据在NewIndex位置插入，同时将CurIndex位置数据删除
procedure TList.Move(CurIndex, NewIndex: Integer);
var
Item: Pointer;
begin
if CurIndex <> NewIndex then
begin
if (NewIndex < 0) or (NewIndex >= FCount) then
Error(@SListIndexError, NewIndex);
Item := Get(CurIndex);
FList^[CurIndex] := nil;
Delete(CurIndex);
Insert(NewIndex, nil);
FList^[NewIndex] := Item;
end;
end;
// 根据传入的Item 删除对应位置的数据
function TList.Remove(Item: Pointer): Integer;
begin
Result := IndexOf(Item);
if Result >= 0 then
Delete(Result);
end;
// 清理作用，将数组中为nil 的数据清除
procedure TList.Pack;
var
I: Integer;
begin
for I := FCount - 1 downto 0 do
if Items[I] = nil then
Delete(I);
end;
// 标准的快速排序，同时传入 TListSortCompare类型的Compare函数指针来作为交换函数
procedure TList.Sort(Compare: TListSortCompare);
begin
if (FList <> nil) and (Count > 0) then
QuickSort(FList, 0, Count - 1, Compare);
end;
//
TList类实现了一个带缺省参数的方法procedure Assign(ListA: TList; AOperator: TListAssignOp = laCopy; ListB: TList = nil)，
如果ListB不为空, 临时变量LSource := ListB;，则递归，Assign(ListA);默认参数 laCopy， ListB: TList = nil
递归函数操作(LSource := ListA, 清空List, 然后将ListA 拷贝到list中)
执行递归函数后， 然后根据AOperator和ListB进行各类运算
如果ListB为空，则根据AOperator将self和ListA进行各类运算。
procedure TList.Assign(ListA: TList; AOperator: TListAssignOp; ListB: TList);
var
I: Integer;
LTemp, LSource: TList;
begin
// ListB given?
if ListB <> nil then
begin
LSource := ListB;
Assign(ListA);
end
else
LSource := ListA;
// on with the show
case AOperator of
// 12345, 346 = 346 : only those in the new list
laCopy:
begin
Clear;
Capacity := LSource.Capacity;
for I := 0 to LSource.Count - 1 do
Add(LSource[I]);
end;
// 12345, 346 = 34 : intersection of the two lists
laAnd:
for I := Count - 1 downto 0 do
if LSource.IndexOf(Items[I]) = -1 then
Delete(I);
// 12345, 346 = 123456 : union of the two lists
laOr:
for I := 0 to LSource.Count - 1 do
if IndexOf(LSource[I]) = -1 then
Add(LSource[I]);
// 12345, 346 = 1256 : only those not in both lists
laXor:
begin
LTemp := TList.Create; // Temp holder of 4 byte values
try
LTemp.Capacity := LSource.Count;
for I := 0 to LSource.Count - 1 do
if IndexOf(LSource[I]) = -1 then
LTemp.Add(LSource[I]);
for I := Count - 1 downto 0 do
if LSource.IndexOf(Items[I]) <> -1 then
Delete(I);
I := Count + LTemp.Count;
if Capacity < I then
Capacity := I;
for I := 0 to LTemp.Count - 1 do
Add(LTemp[I]);
finally
LTemp.Free;
end;
end;
// 12345, 346 = 125 : only those unique to source
laSrcUnique:
for I := Count - 1 downto 0 do
if LSource.IndexOf(Items[I]) <> -1 then
Delete(I);
// 12345, 346 = 6 : only those unique to dest
laDestUnique:
begin
LTemp := TList.Create;
try
LTemp.Capacity := LSource.Count;
for I := LSource.Count - 1 downto 0 do
if IndexOf(LSource[I]) = -1 then
LTemp.Add(LSource[I]);
Assign(LTemp);
finally
LTemp.Free;
end;
end;
end;
end;ssssssss
// 在数组中做循环，从低到高，判断是否有和 Item 相等的，如果相等则返回索引，无则返回 -1
function TList.IndexOf(Item: Pointer): Integer;
begin
Result := 0;
while (Result < FCount) and (FList^[Result] <> Item) do
Inc(Result);
if Result = FCount then
Result := -1;
end;