1 unit uSimpleList;
  2 
  3 interface
  4 
  5 uses
  6   Generics.Collections;
  7 
  8 type
  9 
 10   TSimpleList<T> = class(TList<T>)
 11   private
 12     FCurIndexPos: integer;
 13     function DoPopByIndex(Index: integer): T;
 14     procedure FreeAllItems;
 15     procedure SetCurIndexPos(const Value: integer);
 16   protected
 17     FNeedFreeItem: boolean;
 18     procedure FreeItem(Item: T); virtual; //子类可以重截这个以确定该如何释放
 19   public
 20 
 21     constructor Create;
 22     destructor Destroy; override;
 23 
 24     procedure Lock; //新版的Lock功能值得学习
 25     procedure Unlock; //
 26 
 27     function PopFirst: T; //不解释，下同
 28     function PopLast: T;
 29     function PopByIndex(Index: integer): T;
 30 
 31     procedure ClearAndFreeAllItems; //清空并释放所有的Item
 32     property CurIndexPos: integer read FCurIndexPos write SetCurIndexPos;
 33 
 34   end;
 35 
 36   //加 Constructor 限制是要求 T 要有一个没带参数的Create函数,也就是构造器
 37   TClassSimpleList<T: Class, Constructor> = class(TSimpleList<T>)
 38   protected
 39     procedure FreeItem(Item: T); override;
 40     function AddNewOne: T;// T有了Create 才能写这个
 41   end;
 42 
 43 implementation
 44 
 45 procedure TSimpleList<T>.ClearAndFreeAllItems;
 46 begin
 47   FreeAllItems;
 48   clear;
 49 end;
 50 
 51 constructor TSimpleList<T>.Create;
 52 begin
 53   inherited;
 54   FNeedFreeItem := true;
 55   FCurIndexPos := -1;
 56 end;
 57 
 58 destructor TSimpleList<T>.Destroy;
 59 begin
 60   FreeAllItems;
 61   inherited;
 62 end;
 63 
 64 function TSimpleList<T>.DoPopByIndex(Index: integer): T;
 65 begin
 66   if (index >= 0) and (index <= count - 1) then
 67   begin
 68     result := items[index];
 69     Delete(index);
 70     Exit;
 71   end;
 72   result := T(nil);
 73 end;
 74 
 75 procedure TSimpleList<T>.FreeAllItems;
 76 var
 77   Item: T;
 78 begin
 79   if FNeedFreeItem then
 80   begin
 81     FCurIndexPos := -1;
 82     for Item in self do
 83       FreeItem(Item);
 84   end;
 85 end;
 86 
 87 procedure TSimpleList<T>.FreeItem(Item: T);
 88 begin
 89   // 假设 T 是 PMyRec =^TMyRec  TMyRec=record;
 90   // 这个写法对吗？
 91   // if GetTypeKind(T) = tkPointer then
 92   // begin
 93   // Dispose(Pointer(Pointer(@Item)^));
 94   // end;
 95   // 此写法未认真测试所以不使用。
 96   // 如果 Item 是指针，我在继承类中的 FreeItem 中写 Dispose(Item);
 97 end;
 98 
 99 procedure TSimpleList<T>.Lock;
100 begin
101   system.TMonitor.Enter(self);
102 end;
103 
104 procedure TSimpleList<T>.Unlock;
105 begin
106   system.TMonitor.Exit(self);
107 end;
108 
109 function TSimpleList<T>.PopByIndex(Index: integer): T;
110 begin
111   result := DoPopByIndex(index);
112 end;
113 
114 function TSimpleList<T>.PopFirst: T;
115 begin
116   result := DoPopByIndex(0);
117 end;
118 
119 function TSimpleList<T>.PopLast: T;
120 begin
121   result := DoPopByIndex(count - 1);
122 end;
123 
124 procedure TSimpleList<T>.SetCurIndexPos(const Value: integer);
125 begin
126   FCurIndexPos := Value;
127 end;
128 
129 { TThreadClassList<T> }
130 
131 function TClassSimpleList<T>.AddNewOne: T;
132 begin
133   result := T.Create();
134   Add(result);
135 end;
136 
137 procedure TClassSimpleList<T>.FreeItem(Item: T);
138 begin
139   Item.Free;
140 end;
141 
142 end.