ObjList.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718
  1. {
  2. This Delphi unit is part of TIGCC.
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. unit ObjList;
  17. {
  18. Unit ObjList
  19. Copyright (c) 2000-2001 Sebastian Reichelt
  20. Objekt-Listen für Objektorientierte Programmierung nach den Regeln des
  21. Software Engineering
  22. TObjectList
  23. TObjectList ist die Basisklasse für Objektlisten. Sie stellt alle
  24. Eigenschaften und Methoden für eine abstrakte Liste von Objekten zur
  25. Verfügung. Sie ähnelt TList, wobei statt Zeigern Objekte eingefügt
  26. werden können.
  27. TObjectList sollte nur zum akuten Abspeichern einer bestimmten Auswahl
  28. an Objekten benutzt werden. Für alle weiteren Aufgaben stehen die
  29. anderen Listen zur Verfügung.
  30. TObjectContainer
  31. Jedes Objekt, das parallel zu anderen gleichartigen Objekten dynamisch
  32. erzeugt wird, benötigt ein übergeordnetes Objekt (Owner), das sämtliche
  33. dynamischen Objekte verwaltet.
  34. Ein solches übergeordnetes Objekt sollte ein Objekt der Klasse
  35. TObjectContainer oder einer davon abgeleiteten Klasse sein. Die
  36. dynamischen Objekte müssen dann von TContainerItem abgeleitet und beim
  37. Erstellen der übergeordnete Container als Parameter an den Constructor
  38. Create übergeben werden.
  39. Beim Freigeben oder Leeren (Clear) des Containers werden dann alle
  40. untergeordneten Objekte aus dem Speicher entfernt. Ebenso wird beim
  41. Freigeben eines untergeordneten Objektes dieses aus dem Container
  42. gelöscht.
  43. Um bei einem untergeordneten Objekt den Container zu wechseln, müssen
  44. Sie einfach der Eigenschaft Owner einen neuen Wert zuweisen. Der Owner
  45. kann auch NIL sein, dann handelt es sich um ein ganz normales Objekt.
  46. Mit PerformItemAction kann eine Integer-Konstante als Aktion an alle
  47. untergeordneten Objekte übergeben werden. Dort wird dann die virtuelle
  48. Methode PerformAction aufgerufen, die das Ereignis OnAction auslöst.
  49. Da diese Klasse von TCollection abgeleitet wurde, wird das Objekt in
  50. die Stream-Komponentenspeicherung mit einbezogen.
  51. TConnectionList
  52. Um ein Objekt auf bestimmte Weise mit einem oder mehreren anderen zu
  53. verbinden, muß jedem der Objekte eine TConnectionList hinzugefügt werden.
  54. Die Verbindung zwischen zwei Objekten kann dann hergestellt werden,
  55. indem man die Klassenmethode ConnectLists mit den beiden Listen der
  56. Objekte als Parameter aufruft. Mit DisconnectLists läßt sich die
  57. Verbindung wieder aufheben. Alternativ dazu kann man auch die Methode
  58. ConnectTo bzw. DisconnectFrom einer der beiden Listen verwenden.
  59. Auch bei dieser Klasse gibt es eine Methode PerformItemAction, die bei
  60. allen verknüpften Listen ein OnAction-Ereignis auslöst (s.o.).
  61. Auch diese Klasse wurde in die Stream-Speicherung einbezogen.
  62. TReferenceList
  63. Bei TReferenceList handelt es sich um eine spezielle Form der akuten
  64. Objektliste. Sie wird benutzt, wenn ein Objekt, das sich in einem
  65. Container befindet, genau ein Objekt eines bestimmten Typs referenzieren
  66. muß, dieses eine Objekt aber beliebig viele andere referenzieren kann.
  67. Dieses Objekt muß dann selbstverständlich an den Konstruktor des
  68. ContainerItem übergeben und dann in das private Symbol einer
  69. Eigenschaft eingetragen werden. Außerdem muß das erstellte ContainerItem
  70. mit der Methode Add in eine Liste des Typs TReferenceList des zu
  71. referenzierenden Objekts eingetragen werden. Ebenso muß es beim
  72. Entfernen mit Delete wieder ausgetragen werden. Das funktioniert auch
  73. mit akuten Listen, aber bei TReferenceList ergeben sich einige Vorteile.
  74. Neu ist, daß beim Entfernen eines Objekts mit Referenzliste(n) alle
  75. referenzierten Objekte (die ContainerItems irgendeines beliebigen
  76. Containers sind) gelöscht werden. Das gleiche geschieht beim Aufruf von
  77. Clear.
  78. Auch neu ist der gewohnte Einsatz von PerformItemAction bei einer
  79. Referenzliste.
  80. TReferenceList wird nicht automatisch gespeichert. Die Instanzen sollten
  81. daher automatisch verwaltet werden.
  82. }
  83. {$WEAKPACKAGEUNIT}
  84. interface
  85. uses
  86. Classes;
  87. type
  88. TObjectNotifyEvent = procedure(Sender, Item: TObject) of object;
  89. TOwnedPersistent = class(TPersistent)
  90. private
  91. FOwner: TPersistent;
  92. protected
  93. procedure SetOwner(const Value: TPersistent); virtual;
  94. function GetOwner: TPersistent; override;
  95. public
  96. constructor Create(AOwner: TPersistent); virtual;
  97. destructor Destroy; override;
  98. property Owner: TPersistent read FOwner write SetOwner;
  99. published
  100. end;
  101. TObjectList = class(TList)
  102. private
  103. FOwner: TObject;
  104. protected
  105. function Get(Index: Integer): TObject;
  106. procedure Put(Index: Integer; Item: TObject);
  107. public
  108. constructor Create(AOwner: TObject);
  109. function Add(Item: TObject): Integer;
  110. procedure Insert(Index: Integer; Item: TObject);
  111. procedure Delete(Index: Integer); overload;
  112. procedure Delete(Item: TObject); overload;
  113. procedure Remove(Item: TObject);
  114. function IndexOf(Item: TObject): Integer;
  115. function First: TObject;
  116. function Last: TObject;
  117. property Items[Index: Integer]: TObject read Get write Put; default;
  118. property Owner: TObject read FOwner;
  119. end;
  120. TContainerItem = class;
  121. TActionNotifyEvent = procedure(Sender: TObject; Action: Integer; Obj: TObject) of object;
  122. TSubItemNotifyEvent = procedure(Sender: TObject; Item: TContainerItem) of object;
  123. TReferenceList = class(TObjectList)
  124. private
  125. FOnAdd: TSubItemNotifyEvent;
  126. FOnDelete: TSubItemNotifyEvent;
  127. function Get(Index: Integer): TContainerItem;
  128. protected
  129. public
  130. destructor Destroy; override;
  131. procedure Clear; override;
  132. procedure Add(Item: TContainerItem);
  133. procedure Delete(Item: TContainerItem);
  134. procedure PerformItemAction(Action: Integer; Obj: TObject = nil); virtual;
  135. function IndexOf(Item: TContainerItem): Integer;
  136. property Items[Index: Integer]: TContainerItem read Get; default;
  137. property OnAdd: TSubItemNotifyEvent read FOnAdd write FOnAdd;
  138. property OnDelete: TSubItemNotifyEvent read FOnDelete write FOnDelete;
  139. end;
  140. TObjectContainer = class(TOwnedCollection)
  141. private
  142. protected
  143. public
  144. procedure PerformItemAction(Action: Integer; Obj: TObject = nil); virtual;
  145. end;
  146. TContainerItem = class(TCollectionItem)
  147. private
  148. FOnAction: TActionNotifyEvent;
  149. function GetItemOwner: TObjectContainer;
  150. procedure SetItemOwner(const Value: TObjectContainer);
  151. protected
  152. procedure PerformAction(Action: Integer; Obj: TObject); virtual;
  153. public
  154. property Owner: TObjectContainer read GetItemOwner write SetItemOwner;
  155. property OnAction: TActionNotifyEvent read FOnAction write FOnAction;
  156. end;
  157. TFastContainerItem = class;
  158. TFastContainerItemClass = class of TFastContainerItem;
  159. TFastObjectContainer = class(TObject)
  160. private
  161. FOwner: TPersistent;
  162. FItems: TObjectList;
  163. FCount: Integer;
  164. FItemClass: TFastContainerItemClass;
  165. protected
  166. procedure InsertItem(Item: TFastContainerItem);
  167. procedure RemoveItem(Item: TFastContainerItem);
  168. function GetItem(Index: Integer): TFastContainerItem;
  169. public
  170. constructor Create(AOwner: TPersistent; ItemClass: TFastContainerItemClass);
  171. destructor Destroy; override;
  172. property Owner: TPersistent read FOwner;
  173. function Add: TFastContainerItem;
  174. procedure Clear;
  175. function Insert(Index: Integer): TFastContainerItem;
  176. property Count: Integer read FCount;
  177. property ItemClass: TFastContainerItemClass read FItemClass;
  178. property Items[Index: Integer]: TFastContainerItem read GetItem;
  179. procedure PerformItemAction(Action: Integer; Obj: TObject = nil); virtual;
  180. end;
  181. TFastContainerItem = class(TPersistent)
  182. private
  183. FOnAction: TActionNotifyEvent;
  184. FCollection: TFastObjectContainer;
  185. function GetIndex: Integer;
  186. procedure SetIndex(const Value: Integer);
  187. procedure SetCollection(const Value: TFastObjectContainer);
  188. protected
  189. procedure PerformAction(Action: Integer; Obj: TObject); virtual;
  190. public
  191. constructor Create(Collection: TFastObjectContainer); virtual;
  192. destructor Destroy; override;
  193. property Owner: TFastObjectContainer read FCollection write SetCollection;
  194. property Collection: TFastObjectContainer read FCollection write SetCollection;
  195. property Index: Integer read GetIndex write SetIndex;
  196. property OnAction: TActionNotifyEvent read FOnAction write FOnAction;
  197. end;
  198. TConnectionList = class;
  199. TConItem = class(TCollectionItem)
  200. private
  201. function GetOtherItem: TConItem;
  202. protected
  203. FConList: TConnectionList;
  204. FOtherItem: TConItem;
  205. procedure SetConList(const Value: TConnectionList); virtual;
  206. public
  207. destructor Destroy; override;
  208. property OtherItem: TConItem read GetOtherItem;
  209. //published
  210. property ConList: TConnectionList read FConList write SetConList;
  211. end;
  212. {$WARNINGS OFF}
  213. TConCollection = class(TOwnedCollection)
  214. private
  215. function GetNewOwner: TConnectionList;
  216. public
  217. function SearchForList(List: TConnectionList): TConItem;
  218. property Owner: TConnectionList read GetNewOwner;
  219. end;
  220. {$WARNINGS ON}
  221. TConnectionNotifyEvent = procedure(Sender: TObject; Item: TConnectionList) of object;
  222. TConnectionList = class(TOwnedPersistent)
  223. private
  224. FCollection: TConCollection;
  225. FOnConnect: TConnectionNotifyEvent;
  226. FOnDisconnect: TConnectionNotifyEvent;
  227. FOnAction: TActionNotifyEvent;
  228. function GetCount: Integer;
  229. procedure SetCollection(const Value: TConCollection);
  230. protected
  231. procedure CreateCollection(AItemClass: TCollectionItemClass); virtual;
  232. procedure Add(Item: TConnectionList);
  233. procedure Delete(Item: TConnectionList);
  234. procedure PerformAction(Action: Integer; Obj: TObject = nil); virtual;
  235. public
  236. class procedure ConnectLists(List1, List2: TConnectionList);
  237. class procedure DisconnectLists(List1, List2: TConnectionList);
  238. constructor Create(AOwner: TPersistent); override;
  239. constructor CreateSpecial(AOwner: TPersistent; AItemClass: TCollectionItemClass); virtual;
  240. destructor Destroy; override;
  241. procedure Clear;
  242. procedure PerformItemAction(Action: Integer; Obj: TObject); virtual;
  243. procedure ConnectTo(List: TConnectionList);
  244. procedure DisconnectFrom(List: TConnectionList);
  245. function IsConnectedTo(List: TConnectionList): Boolean;
  246. property Count: Integer read GetCount;
  247. property OnConnect: TConnectionNotifyEvent read FOnConnect write FOnConnect;
  248. property OnDisconnect: TConnectionNotifyEvent read FOnDisconnect write FOnDisconnect;
  249. property OnAction: TActionNotifyEvent read FOnAction write FOnAction;
  250. published
  251. property Collection: TConCollection read FCollection write SetCollection;
  252. end;
  253. implementation
  254. { TObjectList }
  255. function TObjectList.Add(Item: TObject): Integer;
  256. begin
  257. Result := inherited Add (Pointer (Item));
  258. end;
  259. procedure TObjectList.Delete(Index: Integer);
  260. begin
  261. inherited Delete (Index);
  262. end;
  263. procedure TObjectList.Delete(Item: TObject);
  264. begin
  265. if Count > 0 then begin
  266. if Item = Last then
  267. inherited Delete (Count - 1)
  268. else
  269. inherited Delete (IndexOf (Item));
  270. end;
  271. end;
  272. function TObjectList.Get(Index: Integer): TObject;
  273. begin
  274. Result := TObject (inherited Get (Index));
  275. end;
  276. function TObjectList.IndexOf(Item: TObject): Integer;
  277. begin
  278. Result := inherited IndexOf (Pointer (Item));
  279. end;
  280. procedure TObjectList.Insert(Index: Integer; Item: TObject);
  281. begin
  282. inherited Insert (Index, Pointer (Item));
  283. end;
  284. procedure TObjectList.Put(Index: Integer; Item: TObject);
  285. begin
  286. inherited Put (Index, Pointer (Item));
  287. end;
  288. constructor TObjectList.Create(AOwner: TObject);
  289. begin
  290. inherited Create;
  291. FOwner := AOwner;
  292. end;
  293. function TObjectList.First: TObject;
  294. begin
  295. Result := Get (0);
  296. end;
  297. function TObjectList.Last: TObject;
  298. begin
  299. Result := Get (Count - 1);
  300. end;
  301. procedure TObjectList.Remove(Item: TObject);
  302. begin
  303. Delete (Item);
  304. end;
  305. { TReferenceList }
  306. procedure TReferenceList.Add(Item: TContainerItem);
  307. begin
  308. if IndexOf (Item) < 0 then begin
  309. if Assigned (FOnAdd) then
  310. FOnAdd (Self, Item);
  311. inherited Add (Item);
  312. end;
  313. end;
  314. procedure TReferenceList.Clear;
  315. var
  316. I: Integer;
  317. begin
  318. for I := Count - 1 downto 0 do
  319. Items[I].Free;
  320. inherited;
  321. end;
  322. procedure TReferenceList.Delete(Item: TContainerItem);
  323. begin
  324. if Assigned (FOnDelete) then
  325. FOnDelete (Self, Item);
  326. inherited Delete (Item);
  327. end;
  328. destructor TReferenceList.Destroy;
  329. begin
  330. Clear;
  331. inherited;
  332. end;
  333. function TReferenceList.Get(Index: Integer): TContainerItem;
  334. begin
  335. Result := TContainerItem (inherited Get (Index));
  336. end;
  337. function TReferenceList.IndexOf(Item: TContainerItem): Integer;
  338. begin
  339. Result := inherited IndexOf (Item);
  340. end;
  341. procedure TReferenceList.PerformItemAction(Action: Integer; Obj: TObject);
  342. var
  343. I: Integer;
  344. begin
  345. for I := Count - 1 downto 0 do
  346. Items[I].PerformAction(Action, Obj);
  347. end;
  348. { TContainerItem }
  349. function TContainerItem.GetItemOwner: TObjectContainer;
  350. begin
  351. Result := TObjectContainer (Collection);
  352. end;
  353. procedure TContainerItem.PerformAction(Action: Integer; Obj: TObject);
  354. begin
  355. if Assigned (FOnAction) then
  356. FOnAction (Self, Action, Obj);
  357. end;
  358. procedure TContainerItem.SetItemOwner(const Value: TObjectContainer);
  359. begin
  360. Collection := Value;
  361. end;
  362. { TConnectionList }
  363. procedure TConnectionList.Add(Item: TConnectionList);
  364. begin
  365. if not Assigned (FCollection.SearchForList (Item)) then begin
  366. with TConItem(FCollection.Add) do
  367. ConList := Item;
  368. end;
  369. end;
  370. procedure TConnectionList.Clear;
  371. var
  372. I: Integer;
  373. begin
  374. for I := Count - 1 downto 0 do
  375. DisconnectFrom (TConItem(FCollection.Items[I]).ConList);
  376. FCollection.Clear;
  377. end;
  378. class procedure TConnectionList.ConnectLists(List1, List2: TConnectionList);
  379. begin
  380. List1.Add (List2);
  381. List2.Add (List1);
  382. end;
  383. procedure TConnectionList.ConnectTo(List: TConnectionList);
  384. begin
  385. ConnectLists (Self, List);
  386. end;
  387. constructor TConnectionList.Create(AOwner: TPersistent);
  388. begin
  389. inherited;
  390. CreateCollection (TConItem);
  391. end;
  392. procedure TConnectionList.CreateCollection(AItemClass:
  393. TCollectionItemClass);
  394. begin
  395. FCollection := TConCollection.Create (Self, AItemClass);
  396. end;
  397. constructor TConnectionList.CreateSpecial(AOwner: TPersistent;
  398. AItemClass: TCollectionItemClass);
  399. begin
  400. inherited Create (AOwner);
  401. CreateCollection (AItemClass);
  402. end;
  403. procedure TConnectionList.Delete(Item: TConnectionList);
  404. var
  405. I: TConItem;
  406. begin
  407. I := FCollection.SearchForList (Item);
  408. if Assigned (I) then
  409. I.Free;
  410. end;
  411. destructor TConnectionList.Destroy;
  412. begin
  413. Clear;
  414. FCollection.Free;
  415. inherited;
  416. end;
  417. procedure TConnectionList.DisconnectFrom(List: TConnectionList);
  418. begin
  419. DisconnectLists (Self, List);
  420. end;
  421. class procedure TConnectionList.DisconnectLists(List1, List2: TConnectionList);
  422. begin
  423. List1.Delete (List2);
  424. List2.Delete (List1);
  425. end;
  426. function TConnectionList.GetCount: Integer;
  427. begin
  428. Result := FCollection.Count;
  429. end;
  430. function TConnectionList.IsConnectedTo(List: TConnectionList): Boolean;
  431. begin
  432. Result := Assigned (Collection.SearchForList (List));
  433. end;
  434. procedure TConnectionList.PerformAction(Action: Integer; Obj: TObject);
  435. begin
  436. if Assigned (FOnAction) then
  437. FOnAction (Self, Action, Obj);
  438. end;
  439. procedure TConnectionList.PerformItemAction(Action: Integer; Obj: TObject);
  440. var
  441. I: Integer;
  442. begin
  443. for I := Count - 1 downto 0 do
  444. TConItem(FCollection.Items[I]).ConList.PerformAction(Action, Obj);
  445. end;
  446. procedure TConnectionList.SetCollection(const Value: TConCollection);
  447. begin
  448. FCollection.Assign (Value);
  449. end;
  450. { TObjectContainer }
  451. procedure TObjectContainer.PerformItemAction(Action: Integer; Obj: TObject);
  452. var
  453. I: Integer;
  454. begin
  455. for I := Count - 1 downto 0 do
  456. TContainerItem(Items[I]).PerformAction(Action, Obj);
  457. end;
  458. { TOwnedPersistent }
  459. constructor TOwnedPersistent.Create(AOwner: TPersistent);
  460. begin
  461. inherited Create;
  462. SetOwner (AOwner);
  463. end;
  464. destructor TOwnedPersistent.Destroy;
  465. begin
  466. SetOwner (nil);
  467. inherited;
  468. end;
  469. function TOwnedPersistent.GetOwner: TPersistent;
  470. begin
  471. Result := FOwner;
  472. end;
  473. procedure TOwnedPersistent.SetOwner(const Value: TPersistent);
  474. begin
  475. FOwner := Value;
  476. end;
  477. { TConItem }
  478. destructor TConItem.Destroy;
  479. begin
  480. SetConList (nil);
  481. inherited;
  482. end;
  483. function TConItem.GetOtherItem: TConItem;
  484. begin
  485. if (not Assigned (FOtherItem)) and Assigned (ConList) then
  486. FOtherItem := ConList.Collection.SearchForList ((Collection as TConCollection).Owner);
  487. Result := FOtherItem;
  488. end;
  489. procedure TConItem.SetConList(const Value: TConnectionList);
  490. begin
  491. if Assigned (FConList) and Assigned (FConList.FOnDisconnect) then
  492. with TConCollection(Collection).GetOwner as TConnectionList do
  493. FOnDisconnect (FConList, TConnectionList(TConCollection(Collection).GetOwner));
  494. FConList := Value;
  495. if Assigned (FConList) and Assigned (FConList.FOnConnect) then
  496. with TConCollection(Collection).GetOwner as TConnectionList do
  497. FOnConnect (FConList, TConnectionList(TConCollection(Collection).GetOwner));
  498. end;
  499. { TConCollection }
  500. function TConCollection.GetNewOwner: TConnectionList;
  501. begin
  502. Result := GetOwner as TConnectionList;
  503. end;
  504. function TConCollection.SearchForList(List: TConnectionList): TConItem;
  505. var
  506. I: Integer;
  507. Res: TConItem;
  508. begin
  509. Result := nil;
  510. for I := 0 to Count - 1 do begin
  511. Res := TConItem (Items [I]);
  512. if Res.ConList = List then begin
  513. Result := Res;
  514. Break;
  515. end;
  516. end;
  517. end;
  518. { TFastContainerItem }
  519. constructor TFastContainerItem.Create(Collection: TFastObjectContainer);
  520. begin
  521. inherited Create;
  522. SetCollection (Collection);
  523. end;
  524. destructor TFastContainerItem.Destroy;
  525. begin
  526. SetCollection (nil);
  527. inherited;
  528. end;
  529. function TFastContainerItem.GetIndex: Integer;
  530. begin
  531. if Assigned (FCollection) then
  532. Result := Collection.FItems.IndexOf (Self)
  533. else
  534. Result := -1;
  535. end;
  536. procedure TFastContainerItem.PerformAction(Action: Integer; Obj: TObject);
  537. begin
  538. if Assigned (FOnAction) then
  539. FOnAction (Self, Action, Obj);
  540. end;
  541. procedure TFastContainerItem.SetCollection(const Value: TFastObjectContainer);
  542. begin
  543. if FCollection <> Value then begin
  544. if Assigned (FCollection) then
  545. FCollection.RemoveItem (Self);
  546. if Assigned (Value) then
  547. Value.InsertItem (Self);
  548. end;
  549. end;
  550. procedure TFastContainerItem.SetIndex(const Value: Integer);
  551. var
  552. CurIndex: Integer;
  553. begin
  554. CurIndex := GetIndex;
  555. if (CurIndex >= 0) and (CurIndex <> Value) then
  556. FCollection.FItems.Move (CurIndex, Value);
  557. end;
  558. { TFastObjectContainer }
  559. function TFastObjectContainer.Add: TFastContainerItem;
  560. begin
  561. Result := FItemClass.Create (Self);
  562. end;
  563. procedure TFastObjectContainer.Clear;
  564. begin
  565. while Count > 0 do
  566. FItems.Last.Free;
  567. end;
  568. constructor TFastObjectContainer.Create(AOwner: TPersistent; ItemClass: TFastContainerItemClass);
  569. begin
  570. inherited Create;
  571. FItemClass := ItemClass;
  572. FItems := TObjectList.Create (Self);
  573. FOwner := AOwner;
  574. end;
  575. destructor TFastObjectContainer.Destroy;
  576. begin
  577. if Assigned (FItems) then begin
  578. Clear;
  579. FItems.Free;
  580. end;
  581. inherited;
  582. end;
  583. function TFastObjectContainer.GetItem(Index: Integer): TFastContainerItem;
  584. begin
  585. Result := TFastContainerItem (FItems [Index]);
  586. end;
  587. function TFastObjectContainer.Insert(Index: Integer): TFastContainerItem;
  588. begin
  589. Result := Add;
  590. Result.Index := Index;
  591. end;
  592. procedure TFastObjectContainer.InsertItem(Item: TFastContainerItem);
  593. begin
  594. FItems.Add (Item);
  595. Item.FCollection := Self;
  596. Inc (FCount);
  597. end;
  598. procedure TFastObjectContainer.PerformItemAction(Action: Integer; Obj: TObject);
  599. var
  600. I: Integer;
  601. begin
  602. for I := Count - 1 downto 0 do
  603. TContainerItem(Items[I]).PerformAction(Action, Obj);
  604. end;
  605. procedure TFastObjectContainer.RemoveItem(Item: TFastContainerItem);
  606. begin
  607. FItems.Delete (Item);
  608. Item.FCollection := nil;
  609. Dec (FCount);
  610. end;
  611. end.