RTTI и другие трюки с информацией о классах, модулях и т.п.

Code:

unit UmbCollection;

interface

uses

Windows, Messages, SysUtils, Classes, contnrs;

type

TUmbCollectionItemClass = Classof TUmbCollectionItem;

TUmbCollectionItem = class(TCollectionItem)

private

   FPosition: Integer;

public

   {when overriding this method, you must call the inherited assign.}

   procedure Assign(Source: TPersistent); Override;

published

   {the position property is used by the streaming mechanism to place the object in the

   right position when reading the items. do not use this property.}

   property Position: Integer read FPosition write FPosition;

end;

TUmbCollection = class(TObjectList)

private

   procedure SetItems(Index: Integer; Value: TUmbCollectionItem);

   function GetItems(Index: Integer): TUmbCollectionItem;

public

   function Add(AObject: TUmbCollectionItem): Integer;

   function Remove(AObject: TUmbCollectionItem): Integer;

   function IndexOf(AObject: TUmbCollectionItem): Integer;

   function FindInstanceOf(AClass: TUmbCollectionItemClass; AExact: Boolean = True;

                                                 AStartAt: Integer = 0): Integer;

   procedure Insert(Index: Integer; AObject: TUmbCollectionItem);

   procedure WriteToStream(AStream: TStream); virtual;

   procedure ReadFromStream(AStream: TStream); virtual;

   property Items[Index: Integer]: TUmbCollectionItem read GetItems write SetItems; default;

published

   property OwnsObjects;

end;

implementation

{ TUmbCollection }

function ItemsCompare(Item1, Item2: Pointer): Integer;

begin

Result := TUmbCollectionItem(Item1).Position - TUmbCollectionItem(Item2).Position;

end;

function TUmbCollection.Add(AObject: TUmbCollectionItem): Integer;

begin

Result := inherited Add(AObject);

end;

function TUmbCollection.FindInstanceOf(AClass: TUmbCollectionItemClass;

AExact: Boolean; AStartAt: Integer): Integer;

begin

Result := inherited FindInstanceOf(AClass, AExact, AStartAt);

end;

function TUmbCollection.GetItems(Index: Integer): TUmbCollectionItem;

begin

Result := inherited Items[Index] as TUmbCollectionItem;

end;

function TUmbCollection.IndexOf(AObject: TUmbCollectionItem): Integer;

begin

Result := inherited IndexOf(AObject);

end;

procedure TUmbCollection.Insert(Index: Integer; AObject: TUmbCollectionItem);

begin

inherited Insert(Index, AObject);

end;

procedure TUmbCollection.ReadFromStream(AStream: TStream);

var

Reader: TReader;

Collection: TCollection;

ItemClassName: string;

ItemClass: TUmbCollectionItemClass;

Item: TUmbCollectionItem;

i: Integer;

begin

Clear;

Reader := TReader.Create(AStream, 1024);

try

   Reader.ReadListBegin;

   whilenot Reader.EndOfList do

   begin

     ItemClassName := Reader.ReadString;

     ItemClass := TUmbCollectionItemClass(FindClass(ItemClassName));

     Collection := TCollection.Create(ItemClass);

     try

       Reader.ReadValue;

       Reader.ReadCollection(Collection);

       for i := 0to Collection.Count - 1do

       begin

         item := ItemClass.Create(nil);

         item.Assign(Collection.Items[i]);

         Add(Item);

       end;

     finally

       Collection.Free;

     end;

   end;

   Sort(ItemsCompare);

   Reader.ReadListEnd;

finally

   Reader.Free;

end;

end;

function TUmbCollection.Remove(AObject: TUmbCollectionItem): Integer;

begin

Result := inherited Remove(AObject);

end;

procedure TUmbCollection.SetItems(Index: Integer; Value: TUmbCollectionItem);

begin

inherited Items[Index] := Value;

end;

procedure TUmbCollection.WriteToStream(AStream: TStream);

var

Writer: TWriter;

CollectionList: TObjectList;

Collection: TCollection;

ItemClass: TUmbCollectionItemClass;

ObjectWritten: arrayof Boolean;

i, j: Integer;

begin

Writer := TWriter.Create(AStream, 1024);

CollectionList := TObjectList.Create(True);

try

   Writer.WriteListBegin;

   {init the flag array and the position property of the TCollectionItem objects.}

   SetLength(ObjectWritten, Count);

   for i := 0to Count - 1do

   begin

     ObjectWritten[i] := False;

     Items[i].Position := i;

   end;

   {write the TCollectionItem objects. we write first the name of the objects class,

   then write all the object of the same class.}

   for i := 0to Count - 1do

   begin

     if ObjectWritten[i] then

       Continue;

     ItemClass := TUmbCollectionItemClass(Items[i].ClassType);

     Collection := TCollection.Create(ItemClass);

     CollectionList.Add(Collection);

     {write the items class name}

     Writer.WriteString(Items[i].ClassName);

     {insert the items to the collection}

     for j := i to Count - 1do

       if ItemClass = Items[j].ClassType then

       begin

         ObjectWritten[j] := True;

         (Collection.Add as ItemClass).Assign(Items[j]);

       end;

     {write the collection}

     Writer.WriteCollection(Collection);

   end;

finally

   CollectionList.Free;

   Writer.WriteListEnd;

   Writer.Free;

end;

end;

{ TUmbCollectionItem }

procedure TUmbCollectionItem.Assign(Source: TPersistent);

begin

if Source is TUmbCollectionItem then

   Position := (Source as TUmbCollectionItem).Position

else

   inherited;

end;

end.